назад | содержание | вперед Добавление компонента к проекту Для добавления компонента к проекту в окне 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.
назад | содержание
| вперед
Поделитесь этой записью или добавьте в закладки |
Полезные публикации |