usercontrol1.ctl

一个用于开关状态显示的控件

VERSION 5.00
Begin VB.UserControl SquarSwitch 
   ClientHeight    =   480
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   795
   FillColor       =   &H80000012&
   MaskColor       =   &H8000000D&
   ScaleHeight     =   480
   ScaleWidth      =   795
   ToolboxBitmap   =   "UserControl1.ctx":0000
End
Attribute VB_Name = "SquarSwitch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private Const m_constClassName          As String = "SwitchBar"
Private Const m_def_BackColor           As Long = &HC0
'Private Const m_def_ForeColor           As Long = &H80000012
Private Const m_def_Visible             As Integer = 0
Private Const m_def_SwitchName          As String = "Switch1"

Private m_BackColor                     As OLE_COLOR
Private m_SwitchName                    As String
'Private m_ForeColor                     As OLE_COLOR
Private m_Visible                       As Boolean
Public Event Click()
Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)


Private Sub UserControl_Click()
    RaiseEvent Click
End Sub

Private Sub UserControl_Initialize()
  Const constSource As String = m_constClassName & ".UserControl_Initialize"

    On Error GoTo Err_UserControl_Initialize
    'Set m_DockedForms = New TDockForms
    'Set m_Panels = New TTabDockHosts

Exit Sub

Err_UserControl_Initialize:
    Err.Raise Description:="Unexpected Error: " & Err.Description, Number:=Err.Number, Source:=constSource
End Sub

Private Sub UserControl_InitProperties()
    m_BackColor = m_def_BackColor
    'm_ForeColor = m_def_ForeColor
    
    UserControl.BackColor = m_def_BackColor
    'UserControl.ForeColor = m_def_ForeColor
    m_Visible = m_def_Visible
    m_SwitchName = m_def_SwitchName
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)
    ' Set MouseMove Properties
    RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Set MouseUp Properties
    RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Private Sub UserControl_Paint()

  Const constSource As String = m_constClassName & ".UserControl_Paint"
  Dim Edge          As RECT                                         ' Rectangle edge of control
  
    On Error GoTo Err_UserControl_Paint
    Edge.Left = 0                                   ' Set rect edges to outer
    Edge.Top = 0                                    ' most position in pixels
    Edge.Bottom = ScaleHeight 'UserControl.Height  'ScaleHeight
    Edge.Right = ScaleWidth 'UserControl.Width  ' ScaleWidth
    DrawEdge hdc, Edge, 0, BF_RECT Or BF_SOFT  ' Draw Edge...

Exit Sub

Err_UserControl_Paint:
    Err.Raise Description:="Unexpected Error: " & Err.Description, Number:=Err.Number, Source:=constSource
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor)
    'ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
    m_Visible = PropBag.ReadProperty("Visible", m_def_Visible)
    m_SwitchName = PropBag.ReadProperty("SwitchName", m_def_SwitchName)
    

End Sub

'Private Sub UserControl_Resize()
'
'  Const constSource As String = m_constClassName & ".UserControl_Resize"

'    On Error GoTo Err_UserControl_Resize
    ' set the control to 32 pixels wide
    'UserControl.Width = 32 * Screen.TwipsPerPixelX
    'UserControl.Height = 32 * Screen.TwipsPerPixelY

'Exit Sub

'Err_UserControl_Resize:
'    Err.Raise Description:="Unexpected Error: " & Err.Description, Number:=Err.Number, Source:=constSource

'End Sub


Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  'Write property values to storage

    Call PropBag.WriteProperty("BackColor", m_BackColor, m_def_BackColor)
    'Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
    Call PropBag.WriteProperty("Visible", m_Visible, m_def_Visible)
    Call PropBag.WriteProperty("SwitchName", m_SwitchName, m_def_SwitchName)
    
End Sub

Public Property Get BackColor() As OLE_COLOR
    BackColor = m_BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)

    m_BackColor = New_BackColor
    UserControl.BackColor = New_BackColor
    PropertyChanged "BackColor"
    UserControl.Refresh

End Property

Public Property Get SwitchName() As String
    SwitchName = m_SwitchName
End Property

Public Property Let SwitchName(ByVal New_SwitchName As String)

    m_SwitchName = New_SwitchName
    'UserControl.BackColor = New_BackColor
    PropertyChanged "SwitchName"
    UserControl.Refresh
End Property
'Public Property Get ForeColor() As OLE_COLOR
'    ForeColor = m_ForeColor
'End Property

'Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
'
'    m_ForeColor = New_ForeColor
'    UserControl.ForeColor = New_ForeColor
'    PropertyChanged "ForeColor"
'   UserControl.Refresh'
'End Property