usercontrol1.ctl

一款非常适用的按钮控件

  m_ForePressedColor = m_def_ForePressedColor
  m_ForeLineColor = m_def_ForeLineColor
  m_ForeStyle = m_def_ForeStyle
  m_PressValue = m_def_PressValue
  
End Sub

'Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
'    RaiseEvent KeyDown(KeyCode, Shift)
'End Sub
'
'Private Sub UserControl_KeyPress(KeyAscii As Integer)
' RaiseEvent KeyPress(KeyAscii)
'End Sub
'
'Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
' RaiseEvent KeyUp(KeyCode, Shift)
'End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 RaiseEvent MouseDown(Button, Shift, X, Y)
 If PressValue Then Exit Sub
 Timer1.Enabled = False
 makebutton 3
 MouseDown = True
 If Style = Pressed Then PressDown = True: PressValue = True
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Timer1.Enabled = True
  If PressValue Then Exit Sub
  RaiseEvent MouseMove(Button, Shift, X, Y)
  Mousein = True
  If X < 0 Or Y < 0 Or X > UserControl.ScaleWidth Or Y > UserControl.ScaleHeight Then
   Timer1.Enabled = False
   Mousein = False
  ElseIf Not PressDown Then
       makebutton 1
  End If
  'Debug.Print X & "     " & Y
End Sub
Private Sub makebutton(flag As Integer)
 Dim Color As Long
 With UserControl
 If flag = 3 And m_Style_MouseDown Then Exit Sub
 .DrawWidth = 3
        If flag = 3 Then
             .BackColor = ForePressedColor
        ElseIf flag = 1 Then
             .BackColor = ForeGroundColor
        ElseIf flag = 2 Then
             .BackColor = StaticColor
        Else
             .BackColor = StaticColor
        End If
 Color = UserControl.BackColor
 UserControl.Line (UserControl.ScaleWidth, 0)-(0, 0), Choose(flag, vbWhite, vbWhite, vbBlack, ForeLineColor)
 UserControl.Line (0, .ScaleHeight)-(0, 0), Choose(flag, vbWhite, vbWhite, vbBlack, ForeLineColor)
 .DrawWidth = 4
 UserControl.Line (.ScaleWidth, .ScaleHeight)-(.ScaleWidth, 0), Choose(flag, vbBlack, vbBlack, vbWhite, ForeLineColor)
 UserControl.Line (.ScaleWidth, .ScaleHeight)-(0, .ScaleHeight), Choose(flag, vbBlack, vbBlack, vbWhite, ForeLineColor)
 If flag = 3 Then
  'Debug.Print 3
 End If
 End With
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  RaiseEvent MouseUp(Button, Shift, X, Y)
  If Not Mousein And Not PressDown Then
    If m_ForeStyle = flat Then makebutton 4 Else makebutton 2
  ElseIf Not PressDown Then
    makebutton 1
  End If
  MouseDown = False
 'm_Style_MouseDown = False
 Timer1.Enabled = True
End Sub

Private Sub UserControl_Paint()
If m_ForeStyle = flat Then makebutton 4 Else makebutton 2
If PressValue Then makebutton 3
End Sub


'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  m_Enabled = PropBag.ReadProperty("Enabled", m_def_Enabled)
  m_BackStyle = PropBag.ReadProperty("BackStyle", m_def_BackStyle)
  m_BorderStyle = PropBag.ReadProperty("BorderStyle", m_def_BorderStyle)
  m_Style = PropBag.ReadProperty("Style", m_def_Style)
  m_ForeStyle = PropBag.ReadProperty("ForeStyle", m_def_ForeStyle)
  Label1.Caption = PropBag.ReadProperty("Caption", "XnButton")
'  m_BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor)
  m_ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
  m_ForeGroundColor = PropBag.ReadProperty("ForeGroundColor", m_def_ForeGroundColor)
  m_ForePressedColor = PropBag.ReadProperty("ForePressedColor", m_def_ForePressedColor)
  Label1.ForeColor = m_ForeColor
  m_ForeLineColor = PropBag.ReadProperty("ForeLineColor", m_def_ForeLineColor)

  Set Label1.Font = PropBag.ReadProperty("Font", Ambient.Font)
  Label1.AutoSize = PropBag.ReadProperty("AutoSize", True)
  m_PressValue = PropBag.ReadProperty("PressValue", m_def_PressValue)
  UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000A)
  StaticColor = PropBag.ReadProperty("BackColor", &H8000000A)
End Sub

Private Sub UserControl_Resize()
  
  If Not AutoSize Then
   If UserControl.ScaleWidth > 10 And UserControl.ScaleHeight > 10 Then
    Label1.Width = UserControl.ScaleWidth - 10
    Label1.Height = UserControl.ScaleHeight - 10
   End If
  End If
  Label1.Left = (UserControl.ScaleWidth - Label1.Width) / 2
  Label1.Top = (UserControl.ScaleHeight - Label1.Height) / 2
  
End Sub

'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Enabled", m_Enabled, m_def_Enabled)
'    Call PropBag.WriteProperty("Font", m_Font, Ambient.Font)
    Call PropBag.WriteProperty("BackStyle", m_BackStyle, m_def_BackStyle)
    Call PropBag.WriteProperty("BorderStyle", m_BorderStyle, m_def_BorderStyle)
    Call PropBag.WriteProperty("Caption", Label1.Caption, "Label1")
    Call PropBag.WriteProperty("Style", m_Style, m_def_Style)
'  Call PropBag.WriteProperty("BackColor", m_BackColor, m_def_BackColor)
  Call PropBag.WriteProperty("ForeStyle", m_ForeStyle, m_def_ForeStyle)
  Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
  Call PropBag.WriteProperty("ForeGroundColor", m_ForeGroundColor, m_def_ForeGroundColor)
  Call PropBag.WriteProperty("ForePressedColor", m_ForePressedColor, m_def_ForePressedColor)
  Call PropBag.WriteProperty("ForeLineColor", m_ForeLineColor, m_def_ForeLineColor)

  Call PropBag.WriteProperty("Font", Label1.Font, Ambient.Font)
  Call PropBag.WriteProperty("AutoSize", Label1.AutoSize, True)
  Call PropBag.WriteProperty("PressValue", m_PressValue, m_def_PressValue)
 Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000A)
End Sub
'
''注意！不要删除或修改下列被注释的行！
''MemberInfo=10,0,0,0
'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
'  PropertyChanged "BackColor"
 
'End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=10,0,0,0
Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "返回/设置对象中文本和图形的前景色。"
  ForeColor = m_ForeColor
  Label1.ForeColor = ForeColor
End Property

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

'注意！不要删除或修改下列被注释的行！
'MemberInfo=10,0,0,0
Public Property Get ForeGroundColor() As OLE_COLOR
  ForeGroundColor = m_ForeGroundColor
End Property

Public Property Let ForeGroundColor(ByVal New_ForeGroundColor As OLE_COLOR)
  m_ForeGroundColor = New_ForeGroundColor
  If m_ForeStyle = Solid Then makebutton 2 Else makebutton 4
  PropertyChanged "ForeGroundColor"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=10,0,0,0
Public Property Get ForePressedColor() As OLE_COLOR
  ForePressedColor = m_ForePressedColor
End Property

Public Property Let ForePressedColor(ByVal New_ForePressedColor As OLE_COLOR)
  m_ForePressedColor = New_ForePressedColor
  PropertyChanged "ForePressedColor"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=10,0,0,0
Public Property Get ForeLineColor() As OLE_COLOR
  ForeLineColor = m_ForeLineColor
End Property

Public Property Let ForeLineColor(ByVal New_ForeLineColor As OLE_COLOR)
  m_ForeLineColor = New_ForeLineColor
  If m_ForeStyle = Solid Then makebutton 2 Else makebutton 4
  PropertyChanged "ForeLineColor"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=14,0,0,0
Public Property Get ForeStyle() As style_Fore
  
  ForeStyle = m_ForeStyle
End Property

Public Property Let ForeStyle(ByVal New_ForeStyle As style_Fore)
  m_ForeStyle = New_ForeStyle
  If m_ForeStyle = Solid Then makebutton 2 Else makebutton 4
  
  PropertyChanged "ForeStyle"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=Label1,Label1,-1,Font
Public Property Get Font() As Font
Attribute Font.VB_Description = "返回一个 Font 对象。"
Attribute Font.VB_UserMemId = -512
  Set Font = Label1.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
  Set Label1.Font = New_Font
  PropertyChanged "Font"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=Label1,Label1,-1,AutoSize
Public Property Get AutoSize() As Boolean
Attribute AutoSize.VB_Description = "决定控件是否能自动调整大小以显示所有的内容。"
  AutoSize = Label1.AutoSize
End Property

Public Property Let AutoSize(ByVal New_AutoSize As Boolean)
  Label1.AutoSize() = New_AutoSize
  PropertyChanged "AutoSize"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=0,0,0,0
Public Property Get PressValue() As Boolean
  PressValue = m_PressValue
End Property

Public Property Let PressValue(ByVal New_PressValue As Boolean)
  m_PressValue = New_PressValue
 If Style = Pressed Then
  If m_PressValue Then
     makebutton 3
  Else
     If m_ForeStyle = flat Then makebutton 4 Else makebutton 2
  End If
 End If
  PropertyChanged "PressValue"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "返回/设置对象中文本和图形的背景色。"
  BackColor = UserControl.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  UserControl.BackColor() = New_BackColor
  StaticColor = New_BackColor
  If ForeStyle = flat Then
   makebutton 4
  Else
   makebutton 2
  End If
  PropertyChanged "BackColor"
End Property