Common Controls (Индикатор прогресса)

Как уже видно из заголовка, мы рассмотрим самый часто употребляемый (после строки состояния) "общий элемент управления", - индикатор прогресса. Без него (в том или ином виде) не обходится ни одна программа установки. Естественно с ним можно работать через WinAPI, игнорируя компоненты "Windows Common Controls". Я реализовал индикатор, как класс CProgressBar. Можно было создать UserControl, но мне как-то больше по душе класс.

Итак, для начала объявления. В заготовку класса, надо добавить стандартные API-функции: CreateWindowEx, SetWindowPos, SendMessage, DestroyWindow, и константы: WS_CHILD, WS_VISIBLE, WM_USER, SWP_NOZORDER. Теперь блок специфичных объявлений.

' Инициализация общих элементов управления
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
' Имя класса окна индикатора
Private Const PB_CLASS_NAME = "msctls_progress32"
' Сообщение - установка значения
Private Const PBM_SETPOS = WM_USER + 2
' Сообщение - установка диапазона
Private Const PBM_SETRANGE = WM_USER + 1
' Сообщение - установка изменения длины индикатора
Private Const PBM_DELTAPOS = WM_USER+3
' Сообщение - установка шага индикатора
Private Const PBM_SETSTEP = WM_USER+4
' Сообщение - шаг индикатора 
Private Const PBM_STEPIT = WM_USER+5

' Манипулятор индикатора 
Private hProgress As Long 
' Текущее значение
Private lValue As Long
' Максимальное значение
Private lMax As Long
' Минимальное значение
Private lMin As Long
' Габариты окна
Private lTop As Long
Private lLeft As Long
Private lWidth As Long
Private lHeight As Long
' Изменение длины индикатора
Private lDeltaPos As Long 

Теперь обработаем событие инициализации, возникающее при создании класса. В нём инициализируем общие элементы управления, и установим максимальное значение равное 100.

Private Sub Class_Initialize
    InitCommonControls
    lMax=100
End Sub

Событие завершения уничтожит окно, если оно существует.

Private Sub Class_Terminate
    If hProgress <> 0 Then DestroyWindow hProgress
End Sub 

Наш индикатор создаётся методом Create, который, в свою очередь вызывает CreateWindowEx. Метод получает в качестве параметров манипулятор окна - контейнера, и габариты окна будущего индикатора.

Public Sub Create (ByVal hWndParent As Long , _
    ByVal Left As Long, ByVal Top As Long, _
    ByVal Width As Long, ByVal Height As Long)
   ' Создаём окно по полученным параметрам и внутренним константам.
    hProgress = CreateWindowEx(0, PB_CLASS_NAME, "PB", _
    WS_CHILD Or WS_VISIBLE, Left, Top, Width, Height, _
    hWndParent, 0, App.hInstance, ByVal 0&)
    ' Установим значения внутренних переменных
    lTop = Top
    lLeft = Left
    lWidth = Width 
    lHeight = Height
End Sub 

После создания объекта, обычно устанавливаются свойства. Но мы сначала рассмотрим две внутренние процедуры Resize и SetRange. Первая изменяет размер и положение окна по внутренним переменным. Вторая задаёт диапазон.

Private Sub Resize ()
    ' Вызываем SetWindowPos, для установки размера, и положения 
    ' исключая ZOrder с омощью SWP_NOZORDER.
    ' Проверим наличие окна
    If hProgress <> 0 Then SetWindowPos hProgress, 0, lLeft, lTop,
    lWidth, lHeight, SWP_NOZORDER
End Sub

Private Sub SetRange()
    On Error Resume Next
    Dim R As Long
    ' Временная переменная для передачи функции SendMessage
    ' составляетсч из внутренних переменных lMin и lMax.
    ' lMin помещается в младшее слово, а lMax в старшее.
    R = CLng((lMin And &HFFFF&) Or ((lMax And &HFFFF&) * 65536))
    If hProgress <> 0 Then SendMessage hProgress, PBM_SETRANGE, 0,
    ByVal R
End Sub

Теперь рассмотрим метод Move. Он олучает габариты нового окна, как необязательные параметры.

Public Sub Move (Optional Left As Long, Optional Top As Long, _ 
    Optional Width As Long, Optional Height As Long) 
    ' Сохраняем существующие параметры в соответствующих внутренних переменных.
    If Not IsMissing(Top) Then lTop = Top 
    If Not IsMissing(Left) Then lLeft = Left 
    If Not IsMissing(Width) Then lWidth = Width 
    If Not IsMissing(Height) Then lHeight = Height 
    Resize
End Sub 

Осталось только реализовать необходимые свойства, с использованием уже набранного кода.

Public Property Let Left(ByVal NewLeft As Long)
    lLeft = NewLeft
    Resize
End Property
Public Property Get Left () As Long
    Left = lLeft
End Property

Public Property Let Top(ByVal NewTop As Long)
    lTop = NewTop
    Resize
End Property
Public Property Get Top () As Long
    Top = lTop
End Property

Public Property Let Width(ByVal NewWidth As Long)
    lWidth = NewWidth
    Resize
End Property
Public Property Get Width () As Long
    Width = lWidth
End Property

Public Property Let Height(ByVal NewHeight As Long)
    lHeight = NewHeight
    Resize
End Property
Public Property Get Height () As Long
    Height = lHeight
End Property


Public Property Let Min(ByVal NewMin As Long)
    lMin = NewMin
    SetRange
End Property
Public Property Get Min () As Long
    Min = lMin
End Property

Public Property Let Max(ByVal NewMax As Long)
    lMax = NewMax
    SetRange
End Property
Public Property Get Max () As Long
    Max = lMax
End Property


Public Property Let Value(ByVal NewValue As Long)
    lValue = NewValue
    If hProgress <> 0 Then SendMessage hProgress, PBM_SETPOS,
    lValue, ByVal 0&
End Property
Public Property Get Value () As Long
    Value = lValue
End Property


Public Property Let DeltaPos(ByVal NewDeltaPos As Long)
    lDeltaPos = NewDeltaPos
    If hProgress <> 0 Then SendMessage hProgress, PBM_SETPOS,
    lDeltaPos, ByVal 0&
End Property
Public Property Get DeltaPos () As Long
    DeltaPos = lDeltaPos
End Property


Public Property Get hWnd () As Long
    hWnd = hProgress
End Property

Весь приведённый здесь код проверен и работоспособен.