Листинг для Урока 5
ActiveX Control "Indicator"
'*****************************************************************
'Урок 5
'ActiveX Control - "Indicator"
'Листинг
'*****************************************************************
Option Explicit
'*****************************************************************
'Объявление констант
'*****************************************************************
Const m_def_Entries = "1111111"
Const m_def_Thickness = 2
'*****************************************************************
'Объявление внутренних переменных
'*****************************************************************
Dim m_Entries As String
Dim m_Thickness As Long
'*****************************************************************
'Объявление событий
'*****************************************************************
Event Click()
Event DblClick()
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'*****************************************************************
'Свойства контрола
'*****************************************************************
Public Property Get Entries() As String
Entries = m_Entries
End Property
Public Property Let Entries(ByVal New_Entries As String)
Dim i%, n$
If VerificationEntries(New_Entries) = True Then
m_Entries = New_Entries
For i = 0 To 6
n = Mid(m_Entries, i + 1, 1)
lblI(i).Visible = -1 * Val(n)
Next
Else
MsgBox "Error!"
Exit Property
End If
PropertyChanged "Entries"
End Property
Public Property Get BackColor() As OLE_COLOR
BackColor = UserControl.BackColor
End Property
Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
UserControl.BackColor() = New_BackColor
PropertyChanged "BackColor"
End Property
Public Property Get ForeColor() As OLE_COLOR
ForeColor = lblI(0).BackColor
End Property
Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
Dim i%
For i = 0 To 6
lblI(i).BackColor() = New_ForeColor
Next
PropertyChanged "ForeColor"
End Property
Public Property Get Thickness() As Long
Thickness = m_Thickness
End Property
Public Property Let Thickness(ByVal New_Thickness As Long)
Dim i&
m_Thickness = New_Thickness
For i = 0 To 3
lblI(i).Width = m_Thickness
Next
For i = 4 To 6
lblI(i).Height = m_Thickness
Next
PropertyChanged "Thickness"
UserControl_Resize
End Property
'*****************************************************************
'Внутренние процедуры
'*****************************************************************
Private Function VerificationEntries(sValue As String) As Boolean
Dim n%
'проверка на длину строки
If Len(sValue) <> 7 Then
VerificationEntries = False
Exit Function
End If
'проверка на вводимые значения
For n = 1 To 7
If Mid(sValue, n, 1) = "0" Or Mid(sValue, n, 1) = "1" Then
Else
VerificationEntries = False
Exit Function
End If
Next
VerificationEntries = True
End Function
'*****************************************************************
'Обработка
событий UserControl и
контрола Indicator
'*****************************************************************
Private Sub lblI_Click(Index As Integer)
RaiseEvent Click
End Sub
Private Sub lblI_DblClick(Index As Integer)
RaiseEvent DblClick
End Sub
Private Sub lblI_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub
Private Sub lblI_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub
Private Sub lblI_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub
Private Sub UserControl_InitProperties()
m_Entries = m_def_Entries
m_Thickness = m_def_Thickness
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Dim i%
UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
For i = 0 To 6
lblI(i).BackColor = PropBag.ReadProperty("ForeColor", &HFF0000)
Next
m_Entries = PropBag.ReadProperty("Entries", m_def_Entries)
m_Thickness = PropBag.ReadProperty("Thickness", m_def_Thickness)
End Sub
Private Sub UserControl_Resize()
If (ScaleHeight - 3 * m_Thickness - 8 <= 0) Or (ScaleWidth - 2 * m_Thickness - 4 <= 0) Then
Size (3 * m_Thickness + 4) * Screen.TwipsPerPixelX, (5 * m_Thickness + 8) * Screen.TwipsPerPixelY
Exit Sub
End If
lblI(0).Move 0, m_Thickness + 2, m_Thickness, ScaleHeight * 0.5 - 1.5 * m_Thickness - 4
lblI(1).Move 0, 0.5 * ScaleHeight + 0.5 * m_Thickness + 2, m_Thickness, ScaleHeight * 0.5 - 1.5 * m_Thickness - 4
lblI(2).Move ScaleWidth - m_Thickness, m_Thickness + 2, m_Thickness, ScaleHeight * 0.5 - 1.5 * m_Thickness - 4
lblI(3).Move ScaleWidth - m_Thickness, 0.5 * ScaleHeight + 0.5 * m_Thickness + 2, m_Thickness, ScaleHeight * 0.5 - 1.5 * m_Thickness - 4
lblI(4).Move m_Thickness + 2, 0, ScaleWidth - 2 * m_Thickness - 4, m_Thickness
lblI(5).Move m_Thickness + 2, 0.5 * ScaleHeight - 0.5 * m_Thickness, ScaleWidth - 2 * m_Thickness - 4, m_Thickness
lblI(6).Move m_Thickness + 2, ScaleHeight - m_Thickness, ScaleWidth - 2 * m_Thickness - 4, m_Thickness
End Sub
Private Sub UserControl_Show()
Entries = m_Entries
Thickness = m_Thickness
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Dim i%
Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
For i = 0 To 6
Call PropBag.WriteProperty("ForeColor", lblI(i).BackColor, &HFF0000)
Next
Call PropBag.WriteProperty("Entries", m_Entries, m_def_Entries)
Call PropBag.WriteProperty("Thickness", m_Thickness, m_def_Thickness)
End Sub
Private Sub UserControl_Click()
RaiseEvent Click
End Sub
Private Sub UserControl_DblClick()
RaiseEvent DblClick
End Sub
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub