ActiveX

Опыт создания Овального ProgressBar'а

Бедный-бедный ProgressBar! В свое время, разработчики VB, создав мощную библиотеку элементов управления (но очень "тяжелую"), подвигли программистов на создание собственных контролов. И первым стоял ProgressBar. Этот элемент используется в 90% программ и далеко не всегда нужны остальные элементы. В своих разработках я неоднократно обращался к созданию ProgressBar'ов, например "вырезанный" в виде песочных часов. Наверно потому, что это достаточно простой элемент и на его примере можно показать работу других различных функций, процедур и т.п.

Сегодняшний пример - это создание овального ProgressBar'а. Я не буду подробно останавливаться на некоторых мелочах, для этого существует свой цикл статей.

Ну что ж, начнем. Создадим 2 проекта: основной (Name=ProgressCircle) и тестировочный (Name=TestPrCircle).С помощью ActiveX Control Interface Wizard добавим на наш UserControl (Name=PrCircle, AutoRedraw=True, ScaleMode=3 (Pixel)) следующие свойства:

Имя	Описание	Привязка к свойствам UserControl'а	Тип	Значение по умолчанию
BackColor	Цвет фона	UserControl.BackColor	-	-
ForeColorPercent	Цвет выводимой надписи %	UserControl.ForeColor	-	-
FontPercent	Шрифт выводимой надписи %	UserControl.Font	-	-
ProgressColor	Цвет закрашиваемого сегмента	-	OLE_COLOR	0
PercentVisible	Отображение надписи %	-	Boolean	True
Min	Минимальное значение	-	Long	0
Max	Максимальное значение	-	Long	100
Value	Текущее значение	-	Long	0

В Property Let каждого свойства добавим последней строкой выполнение внутренней процедуры Draw (ей мы займемся чуть позже). Так же эту процедуру добавим в события UserControl_Resize и UserControl_Show.

Теперь нам необходимо создать еще одно свойство (только для чтения) - Percent. Расчет выполняемого процента несложен и укладывается в простую формулу.

Public Property Get Percent() As Integer
    On Error Resume Next
    Percent = Format((m_Value - m_Min) * 100 / _
        (m_Max - m_Min), "0")
End Property

Заготовка сделана. Все остальное будем добавлять по мере написания процедуры Draw, которой сейчас и займемся:

В раздел деклараций добавим функцию, рисующую эллипс:
Private Declare Function Ellipse Lib "gdi32" _
    (ByVal hdc As Long, _
    ByVal X1 As Long, _
    ByVal Y1 As Long, _
    ByVal X2 As Long, _
    ByVal Y2 As Long) _
    As Long

Private Sub Draw()
'переменные, используемые в процедуре
Dim i%, C As Single, S As Single, numPt&, hRgn&, hBrush&, LB As LOGBRUSH
    Cls
    Ellipse hdc, 0, 0, ScaleWidth, ScaleHeight
    Line (lWidth, lHeight)-(lWidth, 0), m_ProgressColor
    ...
Сначала очищаем контрол от предыдущей графики, затем рисуем эллипс, заполняющим весь контрол. И наконец, рисуем стартовую вертикальную линию от центра строго вверх. Чтобы многократно не вызывать одно и то же свойство контрола, объявим две переменные в разделе деклараций: lWidth As Long и lHeight As Long, а инициализацию их будем проводить в событии UserControl_Resize. В окончательном виде это событие выглядит так:
Private Sub UserControl_Resize()
    lWidth = ScaleWidth / 2
    lHeight = ScaleHeight / 2
    Draw
End Sub

Для просчета точек дуги, нам необходимо создать регион, причем каждая точка имеет координаты по вертикали и по горизонтали. Опять же в разделе деклараций объявим тип и массив:
Private Type COORD
    x As Long
    y As Long
End Type
Private arrFillRgn() As COORD

В процедуре Draw высчитываем количество точек и переопределяем массив:
...
numPt = Round(Percent * 3.6, 0)
ReDim arrFillRgn(numPt + 1)
...

Далее вносим координаты каждой точки в массив, используя константу rd перевода в радианы (для тех, кто забыл математику, подсказываю Pi/180). Последняя точка получает координаты центра эллипса, тем самым замыкая регион (выделяемую область). И создаем сам регион. Для этого объявляем в разделе деклараций еще одну API-функцию:
Private Declare Function CreatePolygonRgn Lib "gdi32" _
    (lpPoint As Any, _
    ByVal nCount As Long, _
    ByVal nPolyFillMode As Long) _
    As Long

...
For i = 0 To numPt
    C = Cos(i * rd)
    S = Sin(i * rd)
    arrFillRgn(i).x = S * lWidth + lWidth
    arrFillRgn(i).y = -C * lHeight + lHeight
Next i
arrFillRgn(numPt + 1).x = lWidth
arrFillRgn(numPt + 1).y = lHeight
hRgn = CreatePolygonRgn(arrFillRgn(1), numPt + 1, ALTERNATE)
...

Для того, чтобы залить полученный регион цветом, необходимо создать кисть. Поэтому в разделе деклараций появляется еще один тип и 2 API-функции:
Private Type LOGBRUSH
    lbStyle As Long
    lbColor As Long
    lbHatch As Long
End Type

Private Const ALTERNATE = 1
Private Const HS_SOLID = 8
Private Const BS_SOLID = 0

Private Declare Function CreateBrushIndirect Lib "gdi32" _
    (lpLogBrush As LOGBRUSH) _
    As Long

Private Declare Function FillRgn Lib "gdi32" _
    (ByVal hdc As Long, _
    ByVal hRgn As Long, _
    ByVal hBrush As Long) _
    As Long

Вернемся в Draw и продолжим:
...
LB.lbColor = m_ProgressColor
LB.lbHatch = HS_SOLID
LB.lbStyle = BS_SOLID

hBrush = CreateBrushIndirect(LB)

FillRgn hdc, hRgn, hBrush
...

Выполнив все, что нам было необходимо, мы обязаны освободить память с помощью функции
Private Declare Function DeleteObject Lib "gdi32" _
    (ByVal hObject As Long) _
    As Long 

...
DeleteObject hRgn
DeleteObject hBrush
...

Ну и напоследок, отображаем (или нет) надпись процентов на нашем контроле:
If m_PercentVisible Then
    Dim strPercent$
    strPercent = Str(Percent) & " %"
    CurrentX = (ScaleWidth - TextWidth(strPercent)) / 2
    CurrentY = (ScaleHeight - TextHeight(strPercent)) / 2
    Print strPercent
End If
Refresh

В тестировочной форме разместим наш контрол, кнопку и добавим код:
Private Sub cmdTest_Click()
Dim i&
With PrCircle1
    For i = .Min To .Max
        .Value = i
    Next
End With
End Sub

В основе - это все. Мы получили полнофункциональный элемент управления. При желании Вы можете добавить свойства, подстраивая контрол "под себя".
Удачи!

2002 г.