ccxpbutton.ctl

VB开发的自动更新程序

    SetPixel lHdc, lw - 1, lh - 2, .cCornerPixel2(eSTATE) '------------- Bottom right corner
    SetPixel lHdc, lw - 1, lh - 3, .cCornerPixel1(eSTATE)
    SetPixel lHdc, lw - 2, lh - 1, .cCornerPixel2(eSTATE)
    SetPixel lHdc, lw - 2, lh - 2, .cCornerPixel3(eSTATE)
    SetPixel lHdc, lw - 3, lh - 1, .cCornerPixel1(eSTATE)
    hRgn = CreateRoundRectRgn(0, 0, lw + 1, lh + 1, 3, 3) '------------- Clip extreme corner pixels
    Call SetWindowRgn(UserControl.hWnd, hRgn, True)
    DeleteObject hRgn
End With
bSkipDrawing = True '--------------------------------------------------- Draw caption
SetRect R, 3, 3, lw - 3, lh - 3
UserControl.ForeColor = IIf(pENABLED, pFORECOLOR, 9609633)
Call DrawText(lHdc, pCAPTION, -1, R, DT_FLAGS + DT_CENTER)
If bHasFocus And pFOCUSRECT And (eSTATE > 1) Then '--------------------- Draw focus rect
    UserControl.ForeColor = 0
    Call DrawFocusRect(lHdc, R)
End If
bSkipDrawing = False

End Sub

Private Sub DrawGradient(R As RECT, ByVal StartColor As Long, ByVal EndColor As Long)
Dim s       As RGBColor '--- Start RGB colors
Dim e       As RGBColor '--- End RBG colors
Dim i       As RGBColor '--- Increment RGB colors
Dim x       As Long
Dim lSteps  As Long
Dim lHdc    As Long
    lHdc = UserControl.hdc
    lSteps = R.Bottom - R.Top
    s.R = (StartColor And &HFF)
    s.G = (StartColor \ &H100) And &HFF
    s.B = (StartColor And &HFF0000) / &H10000
    e.R = (EndColor And &HFF)
    e.G = (EndColor \ &H100) And &HFF
    e.B = (EndColor And &HFF0000) / &H10000
    With i
        .R = (s.R - e.R) / lSteps
        .G = (s.G - e.G) / lSteps
        .B = (s.B - e.B) / lSteps
        For x = 0 To lSteps
            Call LineApi(R.Left, (lSteps - x) + R.Top, R.Right, (lSteps - x) + R.Top, RGB(e.R + (x * .R), e.G + (x * .G), e.B + (x * .B)))
        Next x
    End With
End Sub

Private Sub DrawFilled(tR As RECT, ByVal cBackColor As Long)
Dim hBrush As Long
    hBrush = CreateSolidBrush(cBackColor) '----------------- Fill with solid brush
    FillRect UserControl.hdc, tR, hBrush
    DeleteObject hBrush
End Sub

Private Sub LineApi(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal Color As Long)
Dim pt      As POINT
Dim hPen    As Long
Dim hPenOld As Long
Dim lHdc    As Long
    lHdc = UserControl.hdc
    hPen = CreatePen(0, 1, Color)
    hPenOld = SelectObject(lHdc, hPen)
    MoveToEx lHdc, X1, Y1, pt
    LineTo lHdc, X2, Y2
    SelectObject lHdc, hPenOld
    DeleteObject hPen
End Sub

Private Sub FillColorScheme()
    With tColors
        .cBorders(0) = 12240841 '--------- Store Disabled Colors
        .cTopLine1(0) = 15726583
        .cTopLine2(0) = 15726583
        .cCornerPixel1(0) = 9220548
        .cCornerPixel2(0) = 12437454
        .cCornerPixel3(0) = 9220548
        .cBorders(1) = 7617536 '---------- Store Idle Colors
        .cTopLine1(1) = 16777215
        .cTopLine2(1) = 16711422
        .cBottomLine1(1) = 14082018
        .cBottomLine2(1) = 12964054
        .cCornerPixel1(1) = 8672545
        .cCornerPixel2(1) = 11376251
        .cCornerPixel3(1) = 10845522
        .cSideGradTop(1) = 16514300
        .cSideGradBottom(1) = 15133676
        .cBorders(2) = 7617536 '---------- Store Focus Colors
        .cTopLine1(2) = 16771022
        .cTopLine2(2) = 16242621
        .cBottomLine1(2) = 15183500
        .cBottomLine2(2) = 15696491
        .cCornerPixel1(2) = 8672545
        .cCornerPixel2(2) = 11376251
        .cCornerPixel3(2) = 10845522
        .cSideGradTop(2) = 16241597
        .cSideGradBottom(2) = 15183500
        .cBorders(3) = 7617536 '---------- Store Hot Colors
        .cTopLine1(3) = 13562879
        .cTopLine2(3) = 9231359
        .cBottomLine1(3) = 3257087
        .cBottomLine2(3) = 38630
        .cCornerPixel1(3) = 8672545
        .cCornerPixel2(3) = 11376251
        .cCornerPixel3(3) = 10845522
        .cSideGradTop(3) = 10280929
        .cSideGradBottom(3) = 3192575
        .cBorders(4) = 7617536 '---------- Store Down Colors.
        .cTopLine1(4) = 14607335
        .cTopLine2(4) = 14607335
        .cBottomLine1(4) = 13289407
        .cCornerPixel1(4) = 8672545
        .cCornerPixel2(4) = 11376251
        .cCornerPixel3(4) = 10845522
    End With
End Sub

Private Function GetAccessKey() As String
'//Extracts and returns the AccessKey appropriate for passed caption
'..Function provided by LiTe Templer (Guenter Wirth)
Dim lPos    As Long
Dim lLen    As Long
Dim lSearch As Long
Dim sChr    As String
    lLen = Len(pCAPTION)
    If lLen = 0 Then Exit Function
    lPos = 1
    Do While lPos + 1 < lLen
        lSearch = InStr(lPos, pCAPTION, "&")
        If lSearch = 0 Or lSearch = lLen Then Exit Do
        sChr = LCase$(Mid$(pCAPTION, lSearch + 1, 1))
        If sChr = "&" Then
            lPos = lSearch + 2
        Else
            GetAccessKey = sChr
            Exit Do
        End If
    Loop
End Function

Private Sub TrackMouseLeave(ByVal lng_hWnd As Long)
On Error GoTo Errs
Dim tme As TRACKMOUSEEVENT_STRUCT
    With tme
        .cbSize = Len(tme)
        .dwFlags = TME_LEAVE
        .hwndTrack = lng_hWnd
    End With
    Call TrackMouseEvent(tme) '---- Track the mouse leaving the indicated window via subclassing
Errs:
End Sub

'Subclass handler - MUST be the first Public routine in this file. That includes public properties also
Public Sub zSubclass_Proc(ByVal bBefore As Boolean, ByRef bHandled As Boolean, ByRef lReturn As Long, ByRef lng_hWnd As Long, ByRef uMsg As Long, ByRef wParam As Long, ByRef lParam As Long)
    Select Case uMsg
        Case WM_MOUSELEAVE
            bMouseInControl = False
            If bSpaceBarIsDown Then Exit Sub
            If eSTATE <> eDISABLE Then
                If bHasFocus Or bDisplayAsDefault Then
                    If eSTATE = eDOWN Then
                        If bButtonIsDown Then
                            Call DrawButton(eFOCUS)
                        Else
                            If eSTATE <> eIDLE Then Call DrawButton(eIDLE)
                        End If
                    Else
                        If eSTATE <> eFOCUS Then
                            If bParentActive Then Call DrawButton(eFOCUS)
                        End If
                    End If
                Else
                    If eSTATE <> eIDLE Then Call DrawButton(eIDLE)
                End If
            End If
            
        Case WM_NCACTIVATE, WM_ACTIVATE
            If wParam Then  '----------------------------------- Activated
                bParentActive = True
                If pENABLED Then
                    If bMouseInControl Then
                        If eSTATE <> eHOT Then Call DrawButton(eHOT)
                    Else
                        If (bHasFocus Or bDisplayAsDefault) Then Call DrawButton(eFOCUS)
                    End If
                End If
                RaiseEvent FormActivate(Active)
            Else            '----------------------------------- Deactivated
                bParentActive = False
                bButtonIsDown = False
                bMouseButtonIsDown = False
                bSpaceBarIsDown = False
                If pENABLED Then If eSTATE <> eIDLE Then Call DrawButton(eIDLE)
                RaiseEvent FormActivate(InActive)
            End If
    End Select
End Sub

Public Sub SnapMouseTo()
On Error Resume Next
Dim pt As POINT
    With UserControl
        '//Get screen coordinates of button
        Call ClientToScreen(.hWnd, pt)
        '//Move mouse to center of button
        Call SetCursorPos(pt.x + .ScaleX(.ScaleWidth / 2, .ScaleMode, vbPixels), _
            pt.y + .ScaleY(.ScaleHeight / 2, .ScaleMode, vbPixels))
    End With
End Sub

Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
    If pENABLED Then
        If bSpaceBarIsDown Then
            bSpaceBarIsDown = False
            bButtonIsDown = False
            If bMouseInControl Then
                If eSTATE <> eHOT Then Call DrawButton(eHOT)
            Else
                Call DrawButton(eFOCUS)
            End If
        Else
            DoEvents '------------------ Process "GotFocus" before Click event
            RaiseEvent Click
        End If
    End If
End Sub

Private Sub UserControl_AmbientChanged(PropertyName As String)
    bDisplayAsDefault = Ambient.DisplayAsDefault
    If Not pENABLED Or bMouseInControl Then Exit Sub
    If PropertyName = "DisplayAsDefault" Then
        If bDisplayAsDefault Then
            Call DrawButton(eFOCUS)
        Else
            If eSTATE <> eIDLE Then Call DrawButton(eIDLE)
        End If
    End If
End Sub

Private Sub UserControl_Initialize()
    bSkipDrawing = 1
    Call FillColorScheme '-------------- Assign color variables for all states
    Set pFONT = UserControl.Font
    pHWND = UserControl.hWnd
End Sub