ccxpbutton.ctl

VB开发的自动更新程序

VERSION 5.00
Begin VB.UserControl ccXPButton 
   AutoRedraw      =   -1  'True
   ClientHeight    =   405
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1230
   DefaultCancel   =   -1  'True
   Enabled         =   0   'False
   BeginProperty Font 
      Name            =   "Verdana"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ScaleHeight     =   27
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   82
End
Attribute VB_Name = "ccXPButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'-------------------------------------------------------------------------------------------------
' Module    : ccXPButton
' Updated   : Dec 22 2004
' OS Req    : Windows 98/NT 4.0 (Win95 Excluded by TrackMouseEvent call to User32 Library)
' Author    : Chris Cochran
' Purpose   : My goal with this button is to create an efficient and reliable XP button
'             that is appropriate for 99% of the apps I write, a single line button without all
'             the overhead of multiple visual styles. I painstakingly tested this control to
'             ensure it never draws twice unessasarily, or freaks when the user doesn't release
'             the mouse button when expected, or when the parent form loses the Windows focus.
'             If all you want is an efficient XP button that works solid, this one may be for you.
'
' One Issue : The button does not work well when used on MDI child forms. There is an issue with
'             the MouseLeave subclassing that I have not yet nailed down. All else good.
'
' Credits   : The subclassing routines included below are the work of Paul Caton. Thanks Paul.
'
' PSC Post  : http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=57148&lngWId=1
'-------------------------------------------------------------------------------------------------
Option Explicit

'//Subclasser declarations
Private Enum eMsgWhen
  MSG_AFTER = 1                                                                         'Message calls back after the original (previous) WndProc
  MSG_BEFORE = 2                                                                        'Message calls back before the original (previous) WndProc
  MSG_BEFORE_AND_AFTER = MSG_AFTER Or MSG_BEFORE                                        'Message calls back before and after the original (previous) WndProc
End Enum
Private Type tSubData                                                                   'Subclass data type
  hWnd                               As Long                                            'Handle of the window being subclassed
  nAddrSub                           As Long                                            'The address of our new WndProc (allocated memory).
  nAddrOrig                          As Long                                            'The address of the pre-existing WndProc
  nMsgCntA                           As Long                                            'Msg after table entry count
  nMsgCntB                           As Long                                            'Msg before table entry count
  aMsgTblA()                         As Long                                            'Msg after table array
  aMsgTblB()                         As Long                                            'Msg Before table array
End Type
Private sc_aSubData()                As tSubData                                        'Subclass data array
Private Const ALL_MESSAGES           As Long = -1                                       'All messages added or deleted
Private Const GMEM_FIXED             As Long = 0                                        'Fixed memory GlobalAlloc flag
Private Const GWL_WNDPROC            As Long = -4                                       'Get/SetWindow offset to the WndProc procedure address
Private Const PATCH_04               As Long = 88                                       'Table B (before) address patch offset
Private Const PATCH_05               As Long = 93                                       'Table B (before) entry count patch offset
Private Const PATCH_08               As Long = 132                                      'Table A (after) address patch offset
Private Const PATCH_09               As Long = 137                                      'Table A (after) entry count patch offset
Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

'//Mouse tracking declares
Private Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENT_STRUCT) As Long
Private Enum TRACKMOUSEEVENT_FLAGS
    TME_HOVER = &H1&
    TME_LEAVE = &H2&
    TME_QUERY = &H40000000
    TME_CANCEL = &H80000000
End Enum
Private Type TRACKMOUSEEVENT_STRUCT
    cbSize                              As Long
    dwFlags                             As TRACKMOUSEEVENT_FLAGS
    hwndTrack                           As Long
    dwHoverTime                         As Long
End Type
Private Const WM_MOUSELEAVE             As Long = &H2A3

'//DrawText declares
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Const DT_VCENTER                As Long = &H4
Private Const DT_SINGLELINE             As Long = &H20
Private Const DT_FLAGS                  As Long = DT_VCENTER + DT_SINGLELINE
Private Const DT_CENTER                 As Long = &H1
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long

'//Gradient Fill Declares
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Type POINT
   x As Long
   y As Long
End Type
Private Type RGBColor
    R As Single
    G As Single
    B As Single
End Type

'//Misc and multi-use declares
Private Const WM_NCACTIVATE As Long = &H86
Private Const WM_ACTIVATE   As Long = &H6
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function SetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINT) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINT) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long

'//Button states
Private Enum enumStates
    eDISABLE = 0
    eIDLE = 1
    eFOCUS = 2
    eHOT = 3
    eDOWN = 4
End Enum

Public Enum WindowState
    InActive = 0
    Active = 1
End Enum

'//Button colors
Private Type typeColors
    cBorders(0 To 4)        As Long
    cTopLine1(0 To 4)       As Long
    cTopLine2(0 To 4)       As Long
    cBottomLine1(0 To 4)    As Long
    cBottomLine2(0 To 4)    As Long
    cCornerPixel1(0 To 4)   As Long
    cCornerPixel2(0 To 4)   As Long
    cCornerPixel3(0 To 4)   As Long
    cSideGradTop(1 To 3)    As Long
    cSideGradBottom(1 To 3) As Long
End Type

'//Public Events
Public Event Click()
Public Event DblClick()
Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event FormActivate(State As WindowState)

'//Private variables
Private iDownButton         As Integer '------- Down mouse button (for DblClick event)
Private bSkipDrawing        As Boolean '------- Pauses drawing when needed
Private bButtonIsDown       As Boolean '------- Tracks button down state
Private bHasFocus           As Boolean '------- Tracks button focus state
Private bMouseInControl     As Boolean '------- Tracks when mouse is in or out of the button
Private tColors             As typeColors '---- Enum declare for typeColors
Private bParentActive       As Boolean '------- Tracks when parent form has the Windows focus
Private bSpaceBarIsDown     As Boolean '------- Tracks state of spacebar for KeyUp/Down events
Private bMouseButtonIsDown  As Boolean '------- Tracks state of mousebutton for KeyUp/Down events
Private bDisplayAsDefault   As Boolean '------- USed for ambient default property changes
Private lParentHwnd         As Long '---------- Stores the parents window handle
Private eSTATE              As enumStates '---- Enum declare for enumStates

'//Propbag variables
Private pHWND               As Long
Private pCAPTION            As String
Private pENABLED            As Boolean
Private pFORECOLOR          As OLE_COLOR
Private pFOCUSRECT          As Boolean
Private WithEvents pFONT    As StdFont
Attribute pFONT.VB_VarHelpID = -1

Private Sub DrawButton(ByVal State As enumStates)
On Error Resume Next
Dim lw          As Long
Dim lh          As Long
Dim lHdc        As Long
Dim R           As RECT
Dim hRgn        As Long

If bSkipDrawing Then Exit Sub Else eSTATE = State '--------------------- Bolt if desired

With UserControl: lw = .ScaleWidth: lh = .ScaleHeight: .Cls: End With
lHdc = UserControl.hdc

With tColors
    LineApi 3, 0, lw - 3, 0, .cBorders(eSTATE) '------------------------ Draw border lines
    LineApi 0, 3, 0, lh - 3, .cBorders(eSTATE)
    LineApi 3, lh - 1, lw - 3, lh - 1, .cBorders(eSTATE)
    LineApi lw - 1, 3, lw - 1, lh - 3, .cBorders(eSTATE)
    If eSTATE = eDISABLE Or eSTATE = eDOWN Then '----------------------- Fill the back color (DISABLE, DOWN)
        SetRect R, 1, 1, lw - 1, lh - 1
        If eSTATE = eDISABLE Then
            Call DrawFilled(R, 15398133)
        Else
            Call DrawFilled(R, 14607335)
        End If
    Else
        SetRect R, 1, 3, lw - 1, lh - 2 '------------------------------- Draw side gradients
        Call DrawGradient(R, .cSideGradTop(eSTATE), .cSideGradBottom(eSTATE))
        SetRect R, 3, 3, lw - 3, lh - 3 '------------------------------- Draw background gradient (IDLE, HOT, FOCUS)
        Call DrawGradient(R, 16514300, 15133676)
        LineApi 1, 1, lw, 1, .cTopLine1(eSTATE) '----------------------- Draw fade at the top
        LineApi 1, 2, lw, 2, .cTopLine2(eSTATE)
        LineApi 1, lh - 3, lw, lh - 3, .cBottomLine1(eSTATE) '---------- Draw fade at the bottom
        LineApi 2, lh - 2, lw - 1, lh - 2, .cBottomLine2(eSTATE)
    End If
    SetPixel lHdc, 0, 1, .cCornerPixel2(eSTATE) '----------------------- Top left Corner
    SetPixel lHdc, 0, 2, .cCornerPixel1(eSTATE)
    SetPixel lHdc, 1, 0, .cCornerPixel2(eSTATE)
    SetPixel lHdc, 1, 1, .cCornerPixel3(eSTATE)
    SetPixel lHdc, 2, 0, .cCornerPixel1(eSTATE)
    SetPixel lHdc, (lw - 1), 1, .cCornerPixel2(eSTATE) '---------------- Top right corner
    SetPixel lHdc, lw - 1, 2, .cCornerPixel1(eSTATE)
    SetPixel lHdc, lw - 2, 0, .cCornerPixel2(eSTATE)
    SetPixel lHdc, lw - 2, 1, .cCornerPixel3(eSTATE)
    SetPixel lHdc, lw - 3, 0, .cCornerPixel1(eSTATE)
    SetPixel lHdc, 0, lh - 2, .cCornerPixel2(eSTATE) '------------------ Bottom left corner
    SetPixel lHdc, 0, lh - 3, .cCornerPixel1(eSTATE)
    SetPixel lHdc, 1, lh - 1, .cCornerPixel2(eSTATE)
    SetPixel lHdc, 1, lh - 2, .cCornerPixel3(eSTATE)
    SetPixel lHdc, 2, lh - 1, .cCornerPixel1(eSTATE)