buttonex.ctl

在线ZIP在线ZIP在线ZIP在线ZIP在线ZIP在线ZIP

VERSION 5.00
Begin VB.UserControl ButtonEx 
   AutoRedraw      =   -1  'True
   BackStyle       =   0  'Transparent
   ClientHeight    =   1815
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3345
   DefaultCancel   =   -1  'True
   ScaleHeight     =   121
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   223
   ToolboxBitmap   =   "ButtonEx.ctx":0000
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   720
      Top             =   120
   End
End
Attribute VB_Name = "ButtonEx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'**************************************************************
'*  Copyright (C) TREEV Inc. 2000 - All Rights Reserved       *
'*                                                            *
'*  FILE:  ButtonEx.ctl                                       *
'*                                                            *
'*  DESCRIPTION:                                              *
'*      Provides a enhanced CommandButton control, including  *
'*      custom graphics as well MouseOver event, etc.         *
'*                                                            *
'*  CHANGE HISTORY:                                           *
'*      Aug 2000    J. Pearson      Initial code              *
'**************************************************************

'//---------------------------------------------------------------------------------------
'// Windows API constants
'//---------------------------------------------------------------------------------------
Private Const BLACKNESS = &H42              '(DWORD) dest = BLACK
Private Const NOTSRCCOPY = &H330008         '(DWORD) dest = (NOT source)
Private Const NOTSRCERASE = &H1100A6        '(DWORD) dest = (NOT src) AND (NOT dest)
Private Const SRCAND = &H8800C6             '(DWORD) dest = source AND dest
Private Const SRCCOPY = &HCC0020            '(DWORD) dest = source
Private Const SRCERASE = &H440328           '(DWORD) dest = source AND (NOT dest )
Private Const SRCINVERT = &H660046          '(DWORD) dest = source XOR dest
Private Const SRCPAINT = &HEE0086           '(DWORD) dest = source OR dest
Private Const WHITENESS = &HFF0062          '(DWORD) dest = WHITE

Private Const BDR_RAISEDINNER = &H4
Private Const BDR_RAISEDOUTER = &H1
Private Const BDR_SUNKENINNER = &H8
Private Const BDR_SUNKENOUTER = &H2

Private Const BDR_RAISED = &H5
Private Const BDR_OUTER = &H3
Private Const BDR_INNER = &HC

Private Const BF_ADJUST = &H2000        'Calculate the space left over.
Private Const BF_FLAT = &H4000          'For flat rather than 3-D borders.
Private Const BF_MONO = &H8000          'For monochrome borders.
Private Const BF_SOFT = &H1000          'Use for softer buttons.
Private Const BF_BOTTOM = &H8
Private Const BF_LEFT = &H1
Private Const BF_RIGHT = &H4
Private Const BF_TOP = &H2
Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)

Private Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
Private Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
Private Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
Private Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)

Private Const DT_CENTER = &H1
Private Const DT_RTLREADING = &H20000
Private Const DT_SINGLELINE = &H20
Private Const DT_VCENTER = &H4

Private Const DST_COMPLEX = &H0
Private Const DST_TEXT = &H1
Private Const DST_PREFIXTEXT = &H2
Private Const DST_ICON = &H3
Private Const DST_BITMAP = &H4

Private Const DSS_NORMAL = &H0
Private Const DSS_UNION = &H10                   '/* Gray string appearance */
Private Const DSS_DISABLED = &H20
Private Const DSS_RIGHT = &H8000

'//---------------------------------------------------------------------------------------
'// Windows API types
'//---------------------------------------------------------------------------------------
Private Type POINTAPI
    X As Long
    Y As Long
End Type

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

'//---------------------------------------------------------------------------------------
'// Windows API declarations
'//---------------------------------------------------------------------------------------
Private Declare Function BitBlt Lib "gdi32" (ByVal hdcDest As Long, ByVal xDest As Long, ByVal yDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hdcSrc As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop 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 CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Private Declare Function DrawState Lib "user32" Alias "DrawStateA" (ByVal hdc As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As Long, ByVal wParam As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un As Long) As Long
Private Declare Function DrawStateText Lib "user32" Alias "DrawStateA" (ByVal hdc As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As String, ByVal wParam As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un 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 Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long

'//---------------------------------------------------------------------------------------
'// Private enumerations
'//---------------------------------------------------------------------------------------
Private Enum StateConstants
    btDown = 0
    btUp = 1
    btOver = 2
    btDisabled = 3
    btFocus = 4
End Enum

Private Enum RasterOperationConstants
    roNotSrcCopy = NOTSRCCOPY
    roNotSrcErase = NOTSRCERASE
    roSrcAnd = SRCAND
    roSrcCopy = SRCCOPY
    roSrcErase = SRCERASE
    roSrcInvert = SRCINVERT
    roSrcPaint = SRCPAINT
End Enum

'//---------------------------------------------------------------------------------------
'// Private constants
'//---------------------------------------------------------------------------------------
Private Const clTop As Long = 6
Private Const clLeft As Long = 6
Private Const clFocusOffset As Long = 4
Private Const clDownOffset As Long = 1

'//---------------------------------------------------------------------------------------
'// Private variables
'//---------------------------------------------------------------------------------------
Private tPrevEvent As String
Private lState As StateConstants
Private bLeftFocus As Boolean
Private bHasFocus As Boolean

'//---------------------------------------------------------------------------------------
'// Public constants
'//---------------------------------------------------------------------------------------
Public Enum AppearanceConstants
    Flat = 0
    [3D] = 1
    Skin = 2
End Enum

Public Enum StyleConstants
    Default = 0
    ButtonGroup = 1
End Enum

Public Enum ValueConstants
    Down = 0
    Up = 1
End Enum

'//---------------------------------------------------------------------------------------
'// Control property constants
'//---------------------------------------------------------------------------------------
Private Const m_def_Appearance = Skin
Private Const m_def_BackColor = vbButtonFace
Private Const m_def_Caption = "ButtonEx1"
Private Const m_def_CaptionOffsetX = 0
Private Const m_def_CaptionOffsetY = 0
Private Const m_def_Enabled = True
Private Const m_def_ForeColor = vbButtonText
Private Const m_def_HighlightColor = vbButtonText
'Private Const m_def_HighlightPicture = False
Private Const m_def_MousePointer = vbDefault
'Private Const m_def_PictureOffsetX = 0
'Private Const m_def_PictureOffsetY = 0
Private Const m_def_RightToLeft = False
Private Const m_def_Style = 0
Private Const m_def_ToolTipText = ""
Private Const m_def_TransparentColor = vbBlue
Private Const m_def_Value = Up
Private Const m_def_WhatsThisHelpID = 0

'//---------------------------------------------------------------------------------------
'// Control property variables
'//---------------------------------------------------------------------------------------
Private m_Appearance As AppearanceConstants
Private m_BackColor As OLE_COLOR
Private m_Caption As String
Private m_CaptionOffsetX As Long
Private m_CaptionOffsetY As Long
Private m_Enabled As Boolean
Private m_ForeColor As OLE_COLOR
Private m_Font As Font
Private m_HighlightColor As OLE_COLOR
'Private m_HighlightPicture As Boolean
Private m_MouseIcon As Picture
Private m_MousePointer As MousePointerConstants
'Private m_Picture As Picture
'Private m_PictureDisabled As Picture
'Private m_PictureDown As Picture
'Private m_PictureFocus As Picture
'Private m_PictureOffsetX As Long
'Private m_PictureOffsetY As Long
'Private m_PictureOver As Picture
Private m_RightToLeft As Boolean
Private m_SkinDisabled As Picture
Private m_SkinDown As Picture
Private m_SkinFocus As Picture
Private m_SkinOver As Picture
Private m_SkinUp As Picture
Private m_Style As StyleConstants
Private m_ToolTipText As String
Private m_TransparentColor As OLE_COLOR
Private m_Value As ValueConstants
Private m_WhatsThisHelpID As Long

'//---------------------------------------------------------------------------------------
'// Control property events
'//---------------------------------------------------------------------------------------
Public Event Click()
Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over the control."
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Attribute KeyDown.VB_Description = "Occurs when the user presses a key while the control has the focus."
Public Event KeyPress(KeyAscii As Integer)
Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Attribute KeyUp.VB_Description = "Occurs when the user releases a key while the control has the focus."
Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while the control has the focus."
Public Event MouseEnter()
Attribute MouseEnter.VB_Description = "Occurs when the user moves the mouse over the control after MouseExit event."
Public Event MouseExit()
Attribute MouseExit.VB_Description = "Occurs when the user moves the mouse out of the control after MouseEnter event."
Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while the control has the focus."
Public Event Resize()
Attribute Resize.VB_Description = "Occurs when a form is first displayed or the size of the control changes."

'//---------------------------------------------------------------------------------------
'// Control properties
'//---------------------------------------------------------------------------------------

Public Property Get Appearance() As AppearanceConstants
Attribute Appearance.VB_Description = "Returns/sets whether or not the control is painted with 3-D effects."
    Appearance = m_Appearance
End Property

Public Property Let Appearance(ByVal NewValue As AppearanceConstants)
    m_Appearance = NewValue
        
    Call DrawButton(lState)
    
    PropertyChanged "Appearance"
End Property

Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in the control."
    BackColor = m_BackColor
End Property

Public Property Let BackColor(ByVal NewValue As OLE_COLOR)
    m_BackColor = NewValue
    UserControl.BackColor = NewValue
   ' imgPicture.BackColor = NewValue
    
    Call DrawButton(lState)
    
    PropertyChanged "BackColor"
End Property

Public Property Get Caption() As String
Attribute Caption.VB_Description = "Returns/sets the text displayed in the control."
    Caption = m_Caption
End Property

Public Property Let Caption(ByVal NewValue As String)
    Dim lPlace As Long
    
    m_Caption = NewValue
    
    'set access key
    lPlace = 0
    lPlace = InStr(lPlace + 1, NewValue, "&", vbTextCompare)
    Do While lPlace <> 0
        If Mid$(NewValue, lPlace + 1, 1) <> "&" Then
            UserControl.AccessKeys = Mid$(NewValue, lPlace + 1, 1)
            Exit Do
        Else
            lPlace = lPlace + 1
        End If
    
        lPlace = InStr(lPlace + 1, NewValue, "&", vbTextCompare)
    Loop
    
    Call DrawButton(lState)
    
    PropertyChanged "Caption"
End Property

Public Property Get CaptionOffsetX() As Long
Attribute CaptionOffsetX.VB_Description = "Returns/sets the horizontal offset for displaying the caption."
    CaptionOffsetX = m_CaptionOffsetX
End Property

Public Property Let CaptionOffsetX(ByVal NewValue As Long)
    m_CaptionOffsetX = NewValue
    
    Call DrawButton(lState)
    
    PropertyChanged "CaptionOffsetX"
End Property

Public Property Get CaptionOffsetY() As Long
Attribute CaptionOffsetY.VB_Description = "Returns/sets the vertical offset for displaying the caption."
    CaptionOffsetY = m_CaptionOffsetY
End Property

Public Property Let CaptionOffsetY(ByVal NewValue As Long)
    m_CaptionOffsetY = NewValue
    
    Call DrawButton(lState)
    
    PropertyChanged "CaptionOffsetY"
End Property

Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
    Enabled = m_Enabled
End Property

Public Property Let Enabled(ByVal NewValue As Boolean)
    m_Enabled = NewValue
    UserControl.Enabled = NewValue
   ' imgPicture.Enabled = NewValue
    
    If m_Enabled Then
        lState = btUp
    End If
    Call DrawButton(lState)
    
    PropertyChanged "Enabled"
End Property

Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in the control."
    ForeColor = m_ForeColor
End Property

Public Property Let ForeColor(ByVal NewValue As OLE_COLOR)
    m_ForeColor = NewValue
    UserControl.ForeColor = NewValue
   ' imgPicture.ForeColor = NewValue
    
    Call DrawButton(lState)
    
    PropertyChanged "ForeColor"
End Property

Public Property Get Font() As Font
Attribute Font.VB_Description = "Returns/sets a Font object used to display text in the control."
    Set Font = m_Font
End Property

Public Property Set Font(ByVal NewValue As Font)
    Set m_Font = NewValue
    Set UserControl.Font = NewValue
   ' Set imgPicture.Font = NewValue
    
    Call DrawButton(lState)
    
    PropertyChanged "Font"
End Property

Public Property Get HighlightColor() As OLE_COLOR
Attribute HighlightColor.VB_Description = "Returns/sets the highlight color used to display text and graphics when the mouse is over the control."
    HighlightColor = m_HighlightColor
End Property