назад | содержание | вперед

Добавление компонента к проекту

Для добавления компонента к проекту в окне Project Group установите указатель на проекте ownControls и щелкните правой кнопкой мыши, затем выберите команду Add (Добавить) и затем значение UserControl. К нашему проекту будет добавлен еще один компонент. Назовите его ownslider. Откройте окно редактора кода и введите там следующий текст, описывающий необходимые свойства и переменные:

Dim rnlngValue As Long

Dim rnlngLimit As Long

Dim rnlngStep As Long

Public Property Get Value() As Long

Value = rnlngValue

End Property

Public Property Let Value(ByVal NewValue As Long)

If NewValue >= 0 Then rnlngValue == NewValue Else rnlngValue = 0

PaintView

PropertyChanged "Value"

End Property

Public Property Get Limit() As Long

Limit = rnlngLimit

End Property

Public Property Let Limit(ByVal NewLimit As Long)

If NewLimit > 0 Then rnlngLimit = NewLimit Else rnlngLimit = 1

PaintView

PropertyChanged "Limit"

End Property

Public Property Get Step() As Long

Step = rnlngStep End Property

Public Property Let Step(ByVal NewStep As Long)

If NewStep > 0 Then rnlngStep = NewStep Else rnlngStep = 1

PaintView

PropertyChanged "Step"

End Property

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

Limit = PropBag.ReadProperty("Limit", 1000000)

Value = PropBag.ReadProperty("Value", 500000)

Step = PropBag.ReadProperty("Step", 1000)

End Sub

Private Sub UserControl WriteProperties(PropBag As PropertyBag)

PropBag.WriteProperty "Limit", Limit, 1000000

PropBag.WriteProperty "Value", Limit, 500000

PropBag.WriteProperty "Step", Step, 1000

End Sub

Private Sub UserControl_InitProperties ()

Limit = 1000000

Value = 500000

Step = 1000

End Sub

При изменении значения каждого из этих свойств запускается процедура перерисовки объекта:

Private Sub PaintView()

'установить позицию карандаша в верхний левый угол

CurrentX = 0

CurrentY = 0

'установить ширину линии в зависимости от признака фокуса

If HaveFocus Then DrawWidth = ScaleHeight / 50

Else DrawWidth = ScaleHeight / 500

'прорисовать белый прямоугольник по всей площади компонента

Line (0, 0)-(Width - 10, Height - 10), &H80000005, BF

'нарисовать синюю полоску в зависимости от значения Value

Line (0, 0)-((Value / Limit) * Width - 10, Height - 10), &H8000000D, BF

'отобразить значение Value в текстовой форме поверх изображения желтым цветом с контрастной черной тенью

ForeColor = &HO&

CurrentX = 10

CurrentY = Height /2-90

Print Value

ForeColor = &HFFFF&

CurrentX = 0

CurrentY = Height / 2 - 100

Print Value

'нарисовать ограничивающую рамку

Line (0, 0)-(Width - 10, Height - 10), &НО, В

End Sub

При возникновении события paint также следует вызывать перерисовку, так как это событие происходит всякий раз, когда системе требуется отобразить объект:

Private Sub UserControl_Paint()

PaintView

End Sub

Для контроля за фокусом предусмотрим переменную HaveFocus, значение которой будет устанавливаться при возникновении событий GotFocus и LostFocus. Таким образом, когда наш объект имеет фокус, значение переменной HaveFocus равно True, в противном случае HaveFocus имеет значение False.

Dim HaveFocus As Boolean

Private Sub UserControl_GotFocus()

HaveFocus = True

PaintView

End Sub

Private Sub UserControl_LostFocus()

HaveFocus = False

PaintView

End Sub

Чтобы обрабатывать нажатие клавиш <<--> и <-->>, установим в окне Properties для свойства Keypreview компонента значение True и опишем реакцию на событие KeyDown:

Private Sub UserControl KeyDown(KeyCode As Integer, Shift As Integer)

Select Case KeyCode

Case vbKeyLeft

Value = Value - Step

Case vbKeyRight

Value = Value + Step

End Select

End Sub

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

назад | содержание | вперед