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
Весь приведённый здесь код проверен и работоспособен.
Оставить комментарий
Комментарии


