|
Листинг 5
Indicator: Ind Option Explicit 'Default Property Values: Const m_def_Entries = "1111111" Const m_def_Thickness = 2 'Property Variables: Dim m_Entries As String Dim m_Thickness As Long 'Event Declarations: Event Click() 'MappingInfo=UserControl,UserControl,-1,Click Event DblClick() 'MappingInfo=UserControl,UserControl,-1,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 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 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 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 'Initialize Properties for User Control Private Sub UserControl_InitProperties() m_Entries = m_def_Entries m_Thickness = m_def_Thickness End Sub 'Load property values from storage 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 'Write property values to storage 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 Indicator: Num Option Explicit 'Default Property Values: Const m_def_Numeric = 0 'Property Variables: Dim m_Numeric As Integer 'Event Declarations: Event Click() 'MappingInfo=Ind1,Ind1,-1,Click Event DblClick() 'MappingInfo=Ind1,Ind1,-1,DblClick Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'MappingInfo=Ind1,Ind1,-1,MouseDown Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'MappingInfo=Ind1,Ind1,-1,MouseMove Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'MappingInfo=Ind1,Ind1,-1,MouseUp Public Property Get Numeric() As Integer Numeric = m_Numeric End Property Public Property Let Numeric(ByVal New_Numeric As Integer) 'если не число If Not IsNumeric(New_Numeric) Then Exit Property m_Numeric = New_Numeric Select Case m_Numeric Case 0 Ind1.Entries = "1111101" Case 1 Ind1.Entries = "0011000" Case 2 Ind1.Entries = "0110111" Case 3 Ind1.Entries = "0011111" Case 4 Ind1.Entries = "1011010" Case 5 Ind1.Entries = "1001111" Case 6 Ind1.Entries = "1101111" Case 7 Ind1.Entries = "0011100" Case 8 Ind1.Entries = "1111111" Case 9 Ind1.Entries = "1011111" Case Else Ind1.Entries = "0000000" End Select PropertyChanged "Numeric" End Property Public Property Get BackColor() As OLE_COLOR BackColor = Ind1.BackColor End Property Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR) Ind1.BackColor() = New_BackColor PropertyChanged "BackColor" End Property Public Property Get ForeColor() As OLE_COLOR ForeColor = Ind1.ForeColor End Property Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR) Ind1.ForeColor() = New_ForeColor PropertyChanged "ForeColor End Property Public Property Get Thickness() As Long Thickness = Ind1.Thickness End Property Public Property Let Thickness(ByVal New_Thickness As Long) Ind1.Thickness() = New_Thickness PropertyChanged "Thickness" End Property Private Sub Ind1_Click() RaiseEvent Click End Sub Private Sub Ind1_DblClick() RaiseEvent DblClick End Sub Private Sub Ind1_MouseDown(Button As Integer, Shift As Integer, X As Single,
Y As Single) RaiseEvent MouseDown(Button, Shift, X, Y) End Sub Private Sub Ind1_MouseMove(Button As Integer, Shift As Integer, X As Single,
Y As Single) RaiseEvent MouseMove(Button, Shift, X, Y) End Sub Private Sub Ind1_MouseUp(Button As Integer, Shift As Integer, X As Single,
Y As Single) RaiseEvent MouseUp(Button, Shift, X, Y) End Sub 'Initialize Properties for User Control Private Sub UserControl_InitProperties() m_Numeric = m_def_Numeric End Sub 'Load property values from storage Private Sub UserControl_ReadProperties(PropBag As PropertyBag) Ind1.BackColor = PropBag.ReadProperty("BackColor", &H8000000F) Ind1.ForeColor = PropBag.ReadProperty("ForeColor", &HFF0000) Ind1.Thickness = PropBag.ReadProperty("Thickness", 0) m_Numeric = PropBag.ReadProperty("Numeric", m_def_Numeric) End Sub Private Sub UserControl_Resize() Ind1.Move 0, 0, ScaleWidth, ScaleHeight End Sub Private Sub UserControl_Show() Numeric = m_Numeric End Sub 'Write property values to storage Private Sub UserControl_WriteProperties(PropBag As PropertyBag) Call PropBag.WriteProperty("BackColor", Ind1.BackColor, &H8000000F) Call PropBag.WriteProperty("ForeColor", Ind1.ForeColor, &HFF0000) Call PropBag.WriteProperty("Thickness", Ind1.Thickness, 0) Call PropBag.WriteProperty("Numeric", m_Numeric, m_def_Numeric) End Sub
|
