ccxpbutton.ctl

VB开发的自动更新程序

Private Sub UserControl_InitProperties()
Dim s   As String
Dim c   As Control
    s = "|" '---------------------------- Try to assume new buttons caption
    For Each c In Parent.Controls       ' This saves me time on most forms :-)
        If TypeOf c Is ccXPButton Then s = s & c.Caption & "|"
    Next c
    If InStr(1, s, "|&OK|") = 0 Then
        Caption = "&OK"
    ElseIf InStr(1, s, "|&Cancel|") = 0 Then
        Caption = "&Cancel"
    ElseIf InStr(1, s, "|&Apply|") = 0 Then
        Caption = "&Apply"
    Else
        Caption = Extender.name
    End If
    ForeColor = &H0
    Enabled = True
    FocusRect = True
End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 32 And Not bMouseButtonIsDown Then '---------- Spacebar
        If bMouseInControl Then
            If eSTATE <> eHOT Then Call DrawButton(eHOT)
        Else
            Call DrawButton(eFOCUS)
        End If
        If bButtonIsDown Then RaiseEvent Click
        bSpaceBarIsDown = False
        bButtonIsDown = False
    End If
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    With UserControl
        If x > .ScaleWidth Or x < 0 Or y > .ScaleHeight Or y < 0 Then
            bMouseInControl = False
        Else
            bMouseInControl = True
            Call TrackMouseLeave(pHWND)
        End If
    End With
    If Not bParentActive Or bSpaceBarIsDown Then Exit Sub
    If bMouseInControl Then
        If bButtonIsDown Then
            If eSTATE <> eDOWN Then Call DrawButton(eDOWN)
        Else
            If eSTATE <> eHOT Then Call DrawButton(eHOT)
        End If
    Else
        If bHasFocus Then
            If eSTATE <> eFOCUS Then Call DrawButton(eFOCUS)
        Else
            If eSTATE <> eIDLE Then Call DrawButton(eIDLE)
        End If
    End If
    RaiseEvent MouseMove(Button, Shift, x, y)
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    iDownButton = Button '-------- Remember button pressed for DblClick event
    If Button = 1 Then
        bHasFocus = True
        bButtonIsDown = True
        bMouseButtonIsDown = True
        If eSTATE <> eDOWN Then DrawButton (eDOWN)
    End If
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
        If bParentActive Then
            If bMouseInControl Then
                If eSTATE <> eHOT Then Call DrawButton(eHOT)
            Else
                If bHasFocus Then Call DrawButton(eFOCUS)
            End If
            If bMouseInControl And bHasFocus And bButtonIsDown Then RaiseEvent Click
        End If
        bButtonIsDown = False
        bMouseButtonIsDown = False
    End If
End Sub

Private Sub UserControl_DblClick()
    If iDownButton = 1 Then '------- Only react to left mouse button
        Call DrawButton(eDOWN)
        RaiseEvent DblClick
    End If
End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case 13 '------------------- Enter key
            RaiseEvent Click
        Case 37, 38 '--------------- Left Arrow and Up keys
            SendKeys "+{TAB}"
        Case 39, 40 '--------------- Right Arrow and Down keys
            SendKeys "{TAB}"
        Case 32 '------------------- Spacebar
            If Not bMouseButtonIsDown Then
                bSpaceBarIsDown = True
                bButtonIsDown = True
                If eSTATE <> eDOWN Then Call DrawButton(eDOWN)
            End If
    End Select
End Sub

Private Sub UserControl_GotFocus()
    bHasFocus = True
    If bMouseInControl Then
        If eSTATE <> eHOT And eSTATE <> eDOWN Then Call DrawButton(eHOT)
    Else
        If Not bButtonIsDown Then Call DrawButton(eFOCUS)
    End If
End Sub

Private Sub UserControl_LostFocus()
    bHasFocus = False
    bButtonIsDown = False
    bSpaceBarIsDown = False
    If pENABLED Then
        If Not bParentActive Then
            If eSTATE <> eIDLE Then Call DrawButton(eIDLE)
        ElseIf bMouseInControl Then
            If eSTATE <> eHOT Then Call DrawButton(eHOT)
        Else
            If bDisplayAsDefault Then
                Call DrawButton(eFOCUS)
            Else
                If eSTATE <> eIDLE Then Call DrawButton(eIDLE)
            End If
        End If
    End If
End Sub

Private Sub UserControl_Resize()
    With UserControl
        If .Height < 100 Then bSkipDrawing = True: .Height = 100
        If .Width < 100 Then bSkipDrawing = True: .Width = 100
    End With
    If Not bSkipDrawing Then Call DrawButton(eSTATE)
End Sub

Private Sub UserControl_Terminate()
On Error GoTo Errs
    Set pFONT = Nothing
    Call Subclass_Stop(pHWND)
    Call Subclass_Stop(lParentHwnd)
Errs:
End Sub

Public Property Get hWnd() As Long
    hWnd = pHWND
End Property

Public Property Let Caption(ByVal NewValue As String)
    pCAPTION = NewValue
    UserControl.AccessKeys = GetAccessKey '---------- Set AccessKey property if desired
    Call DrawButton(eSTATE)
    UserControl.PropertyChanged "Caption"
End Property

Public Property Get Caption() As String
Attribute Caption.VB_UserMemId = -518
    Caption = pCAPTION
End Property

Public Property Let Enabled(ByVal NewValue As Boolean)
    pENABLED = NewValue
    UserControl.Enabled = pENABLED
    bSkipDrawing = 0
    If bMouseInControl And pENABLED Then
        Call DrawButton(eHOT)
    Else
        If bDisplayAsDefault And NewValue Then
            Call DrawButton(eFOCUS)
        Else
            If eSTATE <> Abs(NewValue) Then Call DrawButton(Abs(NewValue))
        End If
    End If
    UserControl.PropertyChanged "Enabled"
End Property

Public Property Get Enabled() As Boolean
    Enabled = pENABLED
End Property

Public Property Get Font() As StdFont
    Set Font = pFONT
End Property

Public Property Set Font(NewValue As StdFont)
    Set pFONT = NewValue
    Call pFONT_FontChanged("")
End Property

Private Sub pFONT_FontChanged(ByVal PropertyName As String)
    Set UserControl.Font = pFONT
    Call DrawButton(eSTATE)
    UserControl.PropertyChanged "Font"
End Sub

Public Property Let ForeColor(NewValue As OLE_COLOR)
    pFORECOLOR = NewValue
    UserControl.ForeColor = pFORECOLOR
    Call DrawButton(eSTATE)
    UserControl.PropertyChanged "ForeColor"
End Property

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

Public Property Let FocusRect(NewValue As Boolean)
Attribute FocusRect.VB_Description = "Displays a rect inside button border when the control has the focus."
    pFOCUSRECT = NewValue
    If bHasFocus Then Call DrawButton(eSTATE)
    UserControl.PropertyChanged "FocusRect"
End Property

Public Property Get FocusRect() As Boolean
    FocusRect = pFOCUSRECT
End Property

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    lParentHwnd = UserControl.Parent.hWnd
    With PropBag
        Caption = .ReadProperty("Caption", "&OK")
        ForeColor = .ReadProperty("ForeColor", 0)
        Set Font = .ReadProperty("Font", pFONT)
        FocusRect = .ReadProperty("FocusRect", True)
        Enabled = .ReadProperty("Enabled", True) '--- Keep as last read property for bSkipDrawing variable during initialize
    End With
    If Ambient.UserMode Then
        Call Subclass_Start(pHWND)
        Call Subclass_AddMsg(pHWND, WM_MOUSELEAVE, MSG_AFTER)
        Call Subclass_Start(lParentHwnd)
        If UserControl.Parent.MDIChild Then
            '//Capture WM_NCACTIVATE message for MDI form use
            Call Subclass_AddMsg(lParentHwnd, WM_NCACTIVATE, MSG_AFTER)