Программирование на Visual Basic

Прогресс на visual basic

Как уже видно из заголовка, мы рассмотрим самый часто употребляемый (после строки состояния) "общий элемент управления", - индикатор прогресса. Без него (в том или ином виде) не обходится ни одна программа установки. Естественно с ним можно работать через 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


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

Hosted by uCoz