wwbutton.ctl

一个自写的VB按钮控件

    PropertyChanged "OfficeXpFrameColor"
End Property
Public Property Get OfficeXpMousemoveFillColor() As OLE_COLOR
    OfficeXpMousemoveFillColor = m_OfficeXpMousemoveFillColor
End Property

Public Property Let OfficeXpMousemoveFillColor(ByVal New_OfficeXpMousemoveFillColor As OLE_COLOR)
    m_OfficeXpMousemoveFillColor = New_OfficeXpMousemoveFillColor
    'Call SetColors
    Call Redraw(lastStat, True)
    PropertyChanged "OfficeXpMousemoveFillColor"
End Property
Public Property Get OfficeXpMousemoveFrameColor() As OLE_COLOR
    OfficeXpMousemoveFrameColor = m_OfficeXpMousemoveFrameColor
End Property

Public Property Let OfficeXpMousemoveFrameColor(ByVal New_OfficeXpMousemoveFrameColor As OLE_COLOR)
    m_OfficeXpMousemoveFrameColor = New_OfficeXpMousemoveFrameColor
    'Call SetColors
    Call Redraw(lastStat, True)
    PropertyChanged "OfficeXpMousemoveFrameColor"
End Property
'**********************************************************************************
'**************************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=0,0,0,0
Public Property Get Enabled() As Boolean
    Enabled = isEnabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    isEnabled = New_Enabled
    'Call Redraw(lastStat, True)                                           '####(0, True)
    UserControl.Enabled = isEnabled
    UserControl_Resize
    PropertyChanged "Enabled"
End Property
'********************************************************************************

'********************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=6,0,0,0
Public Property Get Font() As StdFont
    Set Font = TextFont
End Property

Public Property Set Font(ByVal New_Font As StdFont)
With TextFont
      .Bold = New_Font.Bold
      .Italic = New_Font.Italic
      .Name = New_Font.Name
      .Size = New_Font.Size
End With
    Set TextFont = New_Font
    Set UserControl.Font = TextFont
    Call Redraw(lastStat, True)                                         '####(0, True)
    PropertyChanged "Font"
End Property

'*********************************************************************************
Private Sub UserControl_Initialize()
LastButton = 1
rc2.Left = 2: rc2.Top = 2
Call SetColors
'Set TextFont = New StdFont
'Set UserControl.Font = TextFont
End Sub
'**********************************************************************************
'************************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=8,0,0,0
Public Property Get hWnd() As Long
    hWnd = UserControl.hWnd
End Property
'
Public Property Let hWnd(ByVal New_hWnd As Long)
    If Ambient.UserMode = False Then Err.Raise 387
    If Ambient.UserMode Then Err.Raise 382
    m_hWnd = New_hWnd
    PropertyChanged "hWnd"
End Property
''***********************************************************************************

''**************************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=21,0,0,0
Public Property Get ButtonType() As ButtonTypes
    ButtonType = MyButtonType
End Property

Public Property Let ButtonType(ByVal New_ButtonType As ButtonTypes)
    MyButtonType = New_ButtonType
    Call SetColors
    If MyButtonType = 4 Then
                m_Percent = 53
                m_MidColor = RGB(124, 171, 255)
                m_EndColor = RGB(191, 211, 255)
                m_MouseMoveMidColor = RGB(157, 203, 255)
                m_MouseMoveEndColor = RGB(209, 231, 255)
                m_MouseDownMidColor = RGB(100, 153, 255)
                m_MouseDownEndColor = RGB(191, 211, 255)
    End If
    Call UserControl_Resize
    'Call Redraw(lastStat, True)                                         '####(0, True)
    PropertyChanged "ButtonType"
End Property

'**************************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,0,0,0
Public Property Get Caption() As String
    Caption = m_Caption
End Property

Public Property Let Caption(ByVal New_Caption As String)
    m_Caption = New_Caption
    Call SetAccessKeys
    Call Redraw(lastStat, True)                                         '####(0, True)
    PropertyChanged "Caption"
End Property
'******************************************************************************************
'

''*********************************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=22,0,0,0
Public Property Get ColorScheme() As ColorTypes
    ColorScheme = MyColorType
End Property

Public Property Let ColorScheme(ByVal New_ColorScheme As ColorTypes)
    MyColorType = New_ColorScheme
    Call SetColors
    Call Redraw(lastStat, True)                                        '####(0, True)
    PropertyChanged "ColorScheme"
End Property


Public Property Get XpType() As XpTypes
    XpType = MyXpType
End Property

Public Property Let XpType(ByVal New_XpType As XpTypes)
    MyXpType = New_XpType
    'Call SetColors
    Call Redraw(lastStat, True)                                                '####Call Redraw(0, True)
    PropertyChanged "XpType"
End Property
'*********************************************************************************************


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

Public Property Let rectcolor(ByVal New_rectcolor As OLE_COLOR)
    m_rectcolor = New_rectcolor
    PropertyChanged "rectcolor"
End Property
'***********************************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=0,0,0,0
Public Property Get ShowFocusRect() As Boolean
    ShowFocusRect = showFocusR
End Property

Public Property Let ShowFocusRect(ByVal New_ShowFocusRect As Boolean)
    showFocusR = New_ShowFocusRect
    Call Redraw(lastStat, True)
    PropertyChanged "ShowFocusRect"
End Property
'***********************************************************************************************
'为用户控件初始化属性
Private Sub UserControl_InitProperties()

    BackC = GetSysColor(COLOR_BTNFACE)
    ForeC = GetSysColor(COLOR_BTNTEXT)
    isEnabled = m_def_Enabled
   ' Set TextFont = Ambient.Font
    Set TextFont = UserControl.Font
    m_hWnd = m_def_hWnd
    MyButtonType = m_def_ButtonType
    m_Caption = Extender.Name                          ' m_def_Caption
    MyColorType = m_def_ColorScheme
    MyXpType = [银色风格]
    showFocusR = m_def_ShowFocusRect
    m_rectcolor = m_def_rectcolor
    lastStat = 0
    
    m_Percent = m_def_Percent
    m_MidColor = m_def_MidColor
    m_EndColor = m_def_EndColor
    m_MouseMoveMidColor = m_def_MouseMoveMidColor
    m_MouseMoveEndColor = m_def_MouseMoveEndColor
    m_MouseDownMidColor = m_def_MouseDownMidColor
    m_MouseDownEndColor = m_def_MouseDownEndColor
    m_OfficeXpFillColor = m_def_OfficeXpFillColor
    m_OfficeXpFrameColor = m_def_OfficeXpFrameColor
    m_OfficeXpMousemoveFillColor = m_def_OfficeXpMousemoveFillColor
    m_OfficeXpMousemoveFrameColor = m_def_OfficeXpMousemoveFrameColor
    'm_TwoState = m_def_TwoState
    'm_Value = m_def_Value
End Sub

'***********************************************************************************************
'***********************************************************************************************
'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    BackC = PropBag.ReadProperty("BackColor", GetSysColor(COLOR_BTNFACE))
    ForeC = PropBag.ReadProperty("ForeColor", GetSysColor(COLOR_BTNTEXT))
    isEnabled = PropBag.ReadProperty("Enabled", m_def_Enabled)
    Set TextFont = PropBag.ReadProperty("Font", Ambient.Font)
    m_hWnd = PropBag.ReadProperty("hWnd", m_def_hWnd)
    'm_Value = PropBag.ReadProperty("Value", m_def_Value)
    MyButtonType = PropBag.ReadProperty("ButtonType", m_def_ButtonType)
    MyXpType = PropBag.ReadProperty("XpType", m_def_XpType)
    m_Caption = PropBag.ReadProperty("Caption", m_def_Caption)
    MyColorType = PropBag.ReadProperty("ColorScheme", m_def_ColorScheme)
    showFocusR = PropBag.ReadProperty("ShowFocusRect", m_def_ShowFocusRect)
    UserControl.Enabled = isEnabled
    Set UserControl.Font = TextFont
    Call SetColors
    Call SetAccessKeys
   
    m_rectcolor = PropBag.ReadProperty("rectcolor", m_def_rectcolor)
    m_Percent = PropBag.ReadProperty("Percent", m_def_Percent)
    m_MidColor = PropBag.ReadProperty("MidColor", m_def_MidColor)
    m_EndColor = PropBag.ReadProperty("EndColor", m_def_EndColor)
    m_MouseMoveEndColor = PropBag.ReadProperty("MouseMoveEndColor", m_def_MouseMoveEndColor)
    m_MouseMoveMidColor = PropBag.ReadProperty("MouseMoveMidColor", m_def_MouseMoveMidColor)
    m_MouseDownEndColor = PropBag.ReadProperty("MouseDownEndColor", m_def_MouseDownEndColor)
    m_MouseDownMidColor = PropBag.ReadProperty("MouseDownMidColor", m_def_MouseDownMidColor)
    m_OfficeXpFillColor = PropBag.ReadProperty("OfficeXpFillColor", m_def_OfficeXpFillColor)
    m_OfficeXpFrameColor = PropBag.ReadProperty("OfficeXpFrameColor", m_def_OfficeXpFrameColor)
    m_OfficeXpMousemoveFillColor = PropBag.ReadProperty("OfficeXpMousemoveFillColor", m_def_OfficeXpMousemoveFillColor)
    m_OfficeXpMousemoveFrameColor = PropBag.ReadProperty("OfficeXpMousemoveFrameColor", m_def_OfficeXpMousemoveFrameColor)

       lastStat = 0

    Call Redraw(lastStat, True)                                   '####(0,true)
    
End Sub
'***********************************************************************************************
'************************************************************************************************
'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("BackColor", BackC, GetSysColor(COLOR_BTNFACE))
    Call PropBag.WriteProperty("ForeColor", ForeC, GetSysColor(COLOR_BTNTEXT))
    Call PropBag.WriteProperty("Enabled", isEnabled, m_def_Enabled)
    Call PropBag.WriteProperty("Font", TextFont, Ambient.Font)
    Call PropBag.WriteProperty("hWnd", m_hWnd, m_def_hWnd)
    Call PropBag.WriteProperty("ButtonType", MyButtonType, m_def_ButtonType)
    Call PropBag.WriteProperty("XpType", MyXpType, m_def_XpType)
    Call PropBag.WriteProperty("Caption", m_Caption, m_def_Caption)
    Call PropBag.WriteProperty("ColorScheme", MyColorType, m_def_ColorScheme)
    Call PropBag.WriteProperty("ShowFocusRect", showFocusR, m_def_ShowFocusRect)

    Call PropBag.WriteProperty("rectcolor", m_rectcolor, m_def_rectcolor)
    Call PropBag.WriteProperty("Percent", m_Percent, m_def_Percent)
    Call PropBag.WriteProperty("MidColor", m_MidColor, m_def_MidColor)
    Call PropBag.WriteProperty("EndColor", m_EndColor, m_def_EndColor)
    Call PropBag.WriteProperty("MouseMoveMidColor", m_MouseMoveMidColor, m_def_MouseMoveMidColor)
    Call PropBag.WriteProperty("MouseMoveEndColor", m_MouseMoveEndColor, m_def_MouseMoveEndColor)
    Call PropBag.WriteProperty("MouseDownMidColor", m_MouseDownMidColor, m_def_MouseDownMidColor)
    Call PropBag.WriteProperty("MouseDownEndColor", m_MouseDownEndColor, m_def_MouseDownEndColor)
    Call PropBag.WriteProperty("OfficeXpFillColor", m_OfficeXpFillColor, m_def_OfficeXpFillColor)
    Call PropBag.WriteProperty("OfficeXpFrameColor", m_OfficeXpFrameColor, m_def_OfficeXpFrameColor)
    Call PropBag.WriteProperty("OfficeXpMousemoveFillColor", m_OfficeXpMousemoveFillColor, m_def_OfficeXpMousemoveFillColor)
    Call PropBag.WriteProperty("OfficeXpMousemoveFrameColor", m_OfficeXpMousemoveFrameColor, m_def_OfficeXpMousemoveFrameColor)

End Sub
'*****************************************************************************************************
'*************************************************************************************************
Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
    Call UserControl_Click
End Sub

Private Sub UserControl_AmbientChanged(PropertyName As String)
'Debug.Print PropertyName
Call Redraw(lastStat, True)
End Sub


'******************************************************************************************************
Private Sub UserControl_DblClick()
If isEnabled = True Then
   If LastButton = 1 Then
      Call UserControl_MouseDown(1, 1, 1, 1)
   End If
End If
End Sub

Private Sub UserControl_GotFocus()
hasFocus = True
Call Redraw(lastStat, True)
End Sub
'*********************************************************************************************
Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
If isEnabled = True Then
   RaiseEvent KeyDown(KeyCode, Shift)

   LastKeyDown = KeyCode
   If KeyCode = 32 Then 'spacebar pressed
       Call UserControl_MouseDown(1, 1, 1, 1)
   ElseIf (KeyCode = 39) Or (KeyCode = 40) Then 'right and down arrows
       SendKeys "{Tab}"