candybutton.ctl

糖果水晶按钮,这个代码支持XP按钮,XP工具栏按钮。

End Property

Public Property Let ColorButtonDown(newValue As OLE_COLOR)
    m_ColorButtonDown = newValue
    If m_ColorScheme <> Custom Then m_ColorScheme = Custom:  PropertyChanged "m_ColorScheme"
    PropertyChanged "m_ColorButtonDown"
    DrawButton (eNormal)
End Property

Public Property Get ColorButtonDown() As OLE_COLOR
    ColorButtonDown = m_ColorButtonDown
End Property

Public Property Let ColorButtonUp(newValue As OLE_COLOR)
    m_ColorButtonUp = newValue
    If m_ColorScheme <> Custom Then m_ColorScheme = Custom:  PropertyChanged "m_ColorScheme"
    PropertyChanged "m_ColorButtonUp"
    DrawButton (eNormal)
End Property

Public Property Get ColorButtonUp() As OLE_COLOR
    ColorButtonUp = m_ColorButtonUp
End Property

Public Property Let ColorButtonHover(newValue As OLE_COLOR)
    m_ColorButtonHover = newValue
    If m_ColorScheme <> Custom Then m_ColorScheme = Custom:  PropertyChanged "m_ColorScheme"
    PropertyChanged "m_ColorButtonHover"
    DrawButton (eNormal)
End Property

Public Property Get ColorButtonHover() As OLE_COLOR
    ColorButtonHover = m_ColorButtonHover
End Property

Public Property Let ForeColor(ByVal NewForeColor As OLE_COLOR)
     m_ForeColor = NewForeColor
     Picture1.ForeColor = m_ForeColor
     PropertyChanged "ForeColor"
     DrawButton (eNormal)
End Property

Public Property Get ForeColor() As OLE_COLOR
     ForeColor = m_ForeColor
End Property

Public Property Set Picture(Value As StdPicture)
    Set m_StdPicture = Value
    PropertyChanged "Picture"
    DrawButton (eNormal)
End Property

Public Property Get Picture() As StdPicture
    Set Picture = m_StdPicture
End Property

Public Property Let Checked(Value As Boolean)
    m_Checked = Value
    If Value Then
        DrawButton (eChecked)
    Else
        If IsHover Then
            DrawButton (eHover)
        Else
            DrawButton (eNormal)
        End If
    End If
    PropertyChanged "Checked"
End Property

Public Property Get Checked() As Boolean
    Checked = m_Checked
End Property

Public Property Let Style(eVal As eStyle)
    If eVal <> m_Style Then
        m_Style = eVal
        PropertyChanged "Style"
        Init_Style
    End If
End Property

Public Property Get Style() As eStyle
    Style = m_Style
End Property

Public Property Let PictureAlignment(eVal As eAlignment)
    If eVal <> m_PictureAlignment Then
        m_PictureAlignment = eVal
        PropertyChanged "PictureAlignment"
        DrawButton (eNormal)
    End If
End Property

Public Property Get PictureAlignment() As eAlignment
    PictureAlignment = m_PictureAlignment
End Property

Public Property Let Caption(ByVal New_Caption As String)
    m_Caption = New_Caption
    PropertyChanged "Caption"
    DrawButton (eNormal)
End Property

Public Property Get Caption() As String
    Caption = m_Caption
End Property

Public Property Set Font(ByVal NewFont As StdFont)
     Set Picture1.Font = NewFont
     PropertyChanged "Font"
     DrawButton (eNormal)
End Property

Public Property Get Font() As StdFont
     Set Font = Picture1.Font
End Property

Private Sub UserControl_AmbientChanged(PropertyName As String)
    Caption = Extender.Name
End Sub

Private Sub UserControl_Initialize()
    m_Style = Style
End Sub

Private Sub UserControl_InitProperties()
    If Not Ambient.UserMode Then
        m_ColorButtonHover = &HFFC090
        m_ColorButtonUp = &HE99950
        m_ColorBright = &HFFEDB0
        m_ColorButtonDown = &HE99950
        m_Caption = UserControl.Name
        Picture1.Picture = LoadPicture("")
    End If
    m_Caption = Extender.Name
End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then UserControl_MouseDown 1, 0, 0, 0
End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then UserControl_MouseUp 1, 0, 0, 0
End Sub

Private Sub UserControl_Click()
    RaiseEvent Click
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    m_hasFocus = True
    DrawButton (ePressed)
    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)
    If Button = 1 And (x < 0 Or x > UserControl.ScaleWidth Or y < 0 Or y > UserControl.ScaleHeight) Then
        IsHover = False
        DrawButton (eNormal)
    End If
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If m_Checked = False Then If IsHover Then DrawButton (eHover) Else If m_hasFocus Then DrawButton (eFocus)
    RaiseEvent MouseUp(Button, Shift, x, y)
End Sub

Private Sub UserControl_DblClick()
    DrawButton (ePressed)
    RaiseEvent DblClick
End Sub

Private Sub UserControl_EnterFocus()
    m_hasFocus = True
    If m_Checked = False And Not IsHover Then DrawButton (eFocus)
End Sub

Private Sub UserControl_ExitFocus()
    m_hasFocus = False
    If m_Checked = False Then DrawButton (eNormal)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Font", Picture1.Font, Ambient.Font)
    Call PropBag.WriteProperty("Caption", m_Caption, UserControl.Name)
    Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
    Call PropBag.WriteProperty("Picture", m_StdPicture, Nothing)
    Call PropBag.WriteProperty("PictureAlignment", m_PictureAlignment, m_def_PictureAlignment)
    Call PropBag.WriteProperty("Style", m_Style, 0)
    Call PropBag.WriteProperty("Checked", m_Checked)
    Call PropBag.WriteProperty("ColorButtonHover", m_ColorButtonHover)
    Call PropBag.WriteProperty("ColorButtonUp", m_ColorButtonUp)
    Call PropBag.WriteProperty("ColorButtonDown", m_ColorButtonDown)
    Call PropBag.WriteProperty("BorderBrightness", m_BorderBrightness)
    Call PropBag.WriteProperty("ColorBright", m_ColorBright)
    Call PropBag.WriteProperty("DisplayHand", m_DisplayHand)
    Call PropBag.WriteProperty("ColorScheme", m_ColorScheme)
End Sub

Private Sub UserControl_Resize()
    Init_Style
End Sub

Private Sub UserControl_Show()
    DrawButton (eNormal)
End Sub

Private Sub Init_Style()
    Select Case m_Style
        Case Crystal, WMP, Mac_Variation
            CreateRoundedRegion UserControl.ScaleWidth - 1, UserControl.ScaleHeight - 1, SetBound(UserControl.ScaleHeight \ 2, 0, UserControl.ScaleWidth \ 2)
        Case Mac
            CreateRoundedRegion UserControl.ScaleWidth - 1, UserControl.ScaleHeight - 1, 12
        Case Plastic
            CreateRoundedRegion UserControl.ScaleWidth - 1, UserControl.ScaleHeight - 1, SetBound(UserControl.ScaleHeight \ 3, 0, UserControl.ScaleWidth \ 3)
        Case Else
            Call SetWindowRgn(UserControl.hwnd, 0, True)
    End Select
    Picture1.Picture = LoadPicture("")
    Picture1.Width = UserControl.ScaleWidth
    Picture1.Height = UserControl.ScaleHeight
    DrawButton (eNormal)
End Sub

Private Sub DrawButton(Optional vState As eState = eNormal)
    If m_Checked Then vState = eChecked
    Select Case m_Style
        Case XP_Button
            DrawXPButton vState
        Case Crystal, Mac, WMP, Mac_Variation
            DrawCrystalButton vState
        Case Plastic
            DrawPlasticButton vState
        Case XP_ToolBarButton
            DrawXPToolbarButton vState
    End Select
    DrawIconWCaption vState
    Picture1.Picture = LoadPicture("")
End Sub

Public Sub DrawIconWCaption(vState As eState)
    Dim pW As Long, pH As Long, lW As Long, lH As Long, uW As Long, uH As Long
    Dim StartX As Long, StartY As Long
    
    Picture1.ForeColor = m_ForeColor
    
    If Not m_StdPicture Is Nothing Then
        pW = ScaleX(m_StdPicture.Width, vbHimetric, vbPixels)
        pH = ScaleY(m_StdPicture.Height, vbHimetric, vbPixels)
    End If
    
    If Len(m_Caption) <> 0 Then
        lW = Picture1.TextWidth(m_Caption)
        lH = Picture1.TextHeight(m_Caption)
    End If
    
    uW = UserControl.ScaleWidth
    uH = UserControl.ScaleHeight
    
    Select Case m_PictureAlignment
        Case Is = PIC_TOP
            StartX = ((uW - pW) \ 2) + 1
            StartY = (uH - (pH + lH)) \ 2
            Picture1.CurrentX = Abs(uW \ 2 - lW \ 2)
            Picture1.CurrentY = Abs(uH \ 2 + pH \ 2 - lH \ 2)
        Case Is = PIC_BOTTOM
            StartX = (uW - pW) \ 2
            StartY = (uH - (pH - lH)) \ 2
            Picture1.CurrentX = Abs(uW \ 2 - lW \ 2)
            Picture1.CurrentY = Abs(uH \ 2 - (pH + lH) \ 2)