tonypecaobuton.ctl

用vb做的防vista的登录界面

VERSION 5.00
Begin VB.UserControl TonyPecaoButon 
   AutoRedraw      =   -1  'True
   ClientHeight    =   1035
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1215
   DefaultCancel   =   -1  'True
   PropertyPages   =   "TonyPecaoButon.ctx":0000
   ScaleHeight     =   69
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   81
   ToolboxBitmap   =   "TonyPecaoButon.ctx":0035
   Begin VB.Timer OverTimer 
      Enabled         =   0   'False
      Interval        =   3
      Left            =   0
      Top             =   0
   End
End
Attribute VB_Name = "TonyPecaoButon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'Download by http://www.codefans.net
Option Explicit

#Const isOCX = False

Private Const cbVersion As String = "2.0.6 B"



Private Declare Function SetPixel Lib "gdi32" Alias "SetPixelV" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function GetNearestColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long

Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
 Private Const COLOR_HIGHLIGHT = 13
  Private Const COLOR_BTNFACE = 15
    Private Const COLOR_BTNSHADOW = 16
     Private Const COLOR_BTNTEXT = 18
        Private Const COLOR_BTNHIGHLIGHT = 20
             Private Const COLOR_BTNDKSHADOW = 21
Private Const COLOR_BTNLIGHT = 22

          Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long
       Private Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
     Private Declare Function GetTextColor Lib "gdi32" (ByVal hdc As Long) As Long
 Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
 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
Private Const DT_CALCRECT = &H400
Private Const DT_WORDBREAK = &H10
Private Const DT_CENTER = &H1 Or DT_WORDBREAK Or &H4

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor 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 FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, 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 POINTAPI) 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 Const PS_SOLID = 0

Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Const RGN_DIFF = 4

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function InflateRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function CopyRect Lib "user32" (lpDestRect As RECT, lpSourceRect As RECT) As Long

Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Private Type RGBTRIPLE
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
End Type

Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBTRIPLE
End Type

Public Enum ButtonTypes
    [Windows 16-bit] = 1
    [Windows 32-bit] = 2
    [Windows XP] = 3
    [Mac] = 4
    [Java metal] = 5
    [Netscape 6] = 6
    [Simple Flat] = 7
    [Flat Highlight] = 8
    [Office XP] = 9
   
    [transparent] = 11
    [3D Hover] = 12
    [Oval Flat] = 13
    [KDE 2] = 14
End Enum

Public Enum ColorTypes
    [Use Windows] = 1
    [Custom] = 2
    [Force Standard] = 3
    [Use Container] = 4
End Enum

Public Enum PicPositions
    cbLeft = 0
    cbRight = 1
    cbTop = 2
    cbBottom = 3
    cbBackground = 4
End Enum

Public Enum fx
    cbNone = 0
    cbEmbossed = 1
    cbEngraved = 2
    cbShadowed = 3
End Enum

Private Const FXDEPTH As Long = &H28

'events
Public Event Click()
Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event KeyPress(KeyAscii As Integer)
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Public Event MouseOver()
Public Event MouseOut()


Private MyButtonType As ButtonTypes
Private MyColorType As ColorTypes
Private PicPosition As PicPositions
Private SFX As fx

Private He As Long
Private Wi As Long
Private BackC As Long
Private BackO As Long
Private ForeC As Long
Private ForeO As Long
Private MaskC As Long
Private OXPb As Long, OXPf As Long
Private useMask As Boolean, useGrey As Boolean
Private useHand As Boolean

Private picNormal As StdPicture, picHover As StdPicture
Private pDC As Long, pBM As Long, oBM As Long

Private elTex As String

Private rc As RECT, rc2 As RECT, rc3 As RECT, fc As POINTAPI
Private picPT As POINTAPI, picSZ As POINTAPI
Private rgnNorm As Long

Private LastButton As Byte, LastKeyDown As Byte
Private isEnabled As Boolean, isSoft As Boolean
Private HasFocus As Boolean, showFocusR As Boolean

Private cFace As Long, cLight As Long, cHighLight As Long, cShadow As Long, cDarkShadow As Long, cText As Long, cTextO As Long, cFaceO As Long, cMask As Long, XPFace As Long

Private lastStat As Byte, TE As String, isShown As Boolean
Private isOver As Boolean, inLoop As Boolean

Private Locked As Boolean

Private captOpt As Long
Private isCheckbox As Boolean, cValue As Boolean

Private Sub OverTimer_Timer()

    If Not isMouseOver Then
        OverTimer.Enabled = False
        isOver = False
        Call Redraw(0, True)
        RaiseEvent MouseOut
    End If

End Sub

Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)

    LastButton = 1
    Call UserControl_Click

End Sub

Private Sub UserControl_AmbientChanged(PropertyName As String)

    Call SetColors
    Call Redraw(lastStat, True)

End Sub

Private Sub UserControl_Click()

    If LastButton = 1 And isEnabled Then
        If isCheckbox Then cValue = Not cValue
        Call Redraw(0, True)
        UserControl.Refresh
        RaiseEvent Click
    End If

End Sub

Private Sub UserControl_DblClick()

    If LastButton = 1 Then
        Call UserControl_MouseDown(1, 0, 0, 0)
        SetCapture hwnd
    End If

End Sub

Private Sub UserControl_GotFocus()

    HasFocus = True
    Call Redraw(lastStat, True)

End Sub

Private Sub UserControl_Hide()

    isShown = False

End Sub

Private Sub UserControl_Initialize()
    isShown = True

End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)

    RaiseEvent KeyDown(KeyCode, Shift)

    LastKeyDown = KeyCode
    Select Case KeyCode
    Case 32
        Call Redraw(2, False)
    Case 39, 40
        SendKeys "{Tab}"
    Case 37, 38
        SendKeys "+{Tab}"
    End Select

End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)

    RaiseEvent KeyPress(KeyAscii)

End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)

    RaiseEvent KeyUp(KeyCode, Shift)

    If (KeyCode = 32) And (LastKeyDown = 32) Then
        If isCheckbox Then cValue = Not cValue
        Call Redraw(0, False)
        UserControl.Refresh
        RaiseEvent Click
    End If

End Sub

Private Sub UserControl_LostFocus()

    HasFocus = False
    Call Redraw(lastStat, True)

End Sub

Private Sub UserControl_InitProperties()

    isEnabled = True: showFocusR = True: useMask = True
    elTex = Ambient.DisplayName
    Set UserControl.Font = Ambient.Font
    MyButtonType = [Windows 32-bit]
    MyColorType = [Use Windows]
    Call SetColors
    BackC = cFace: BackO = BackC
    ForeC = cText: ForeO = ForeC
    MaskC = &HC0C0C0
    Call CalcTextRects

End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    RaiseEvent MouseDown(Button, Shift, X, Y)
    LastButton = Button
    If Button <> 2 Then Call Redraw(2, False)

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 < 2 Then
        If Not isMouseOver Then
           
            Call Redraw(0, False)
        Else
           
            If Button = 0 And Not isOver Then
                OverTimer.Enabled = True
                isOver = True
                Call Redraw(0, True)
                RaiseEvent MouseOver
            ElseIf Button = 1 Then
                isOver = True
                Call Redraw(2, False)
                isOver = False
            End If
        End If
    End If

End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    RaiseEvent MouseUp(Button, Shift, X, Y)
    If Button <> 2 Then Call Redraw(0, False)