Common Controls (Индикатор прогресса)
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
Весь приведённый здесь код проверен и работоспособен.