ucgraphicbutton.ctl

几个不错的VB例子

VERSION 5.00
Begin VB.UserControl ucGraphicButton 
   CanGetFocus     =   0   'False
   ClientHeight    =   540
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1335
   ClipControls    =   0   'False
   LockControls    =   -1  'True
   MouseIcon       =   "ucGraphicButton.ctx":0000
   MousePointer    =   99  'Custom
   ScaleHeight     =   36
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   89
   Begin VB.Image btnGreenDown 
      Height          =   180
      Left            =   810
      Picture         =   "ucGraphicButton.ctx":030A
      Top             =   270
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image btnBlueDown 
      Height          =   180
      Left            =   300
      Picture         =   "ucGraphicButton.ctx":0424
      Top             =   270
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image btnBlueUp 
      Height          =   180
      Left            =   45
      Picture         =   "ucGraphicButton.ctx":053E
      Top             =   270
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image btnGreenUp 
      Height          =   180
      Left            =   555
      Picture         =   "ucGraphicButton.ctx":0658
      Top             =   270
      Visible         =   0   'False
      Width           =   240
   End
End
Attribute VB_Name = "ucGraphicButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' ===================
' ucGraphicButton 1.0
'     C.P.V. 2001
' ===================




Option Explicit

'## Enumerated constants
Enum ColorConstants
     [cGreen]
     [cBlue]
End Enum

'## Private variables
Dim p_MouseDown As Boolean

'## Property Variables
Dim m_Color As Variant

'## Default Property Values
Const m_def_Color = 0

'## Event Declarations
Event Click()
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)


' =================================================================================
' Init, Read, Write properties
' =================================================================================

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
    m_Color = PropBag.ReadProperty("Color", m_def_Color)
    
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
    Call PropBag.WriteProperty("Color", m_Color, m_def_Color)
    
End Sub

' =================================================================================
' User control
' =================================================================================

Private Sub UserControl_Show()

    Refresh
    
End Sub

Private Sub UserControl_Resize()

    Size 16 * 15, 12 * 15
    
End Sub

Private Sub Refresh()

    Select Case m_Color
    
    '## Green
        Case 0: If p_MouseDown Then Picture = btnGreenDown Else Picture = btnGreenUp
    '## Blue
        Case 1: If p_MouseDown Then Picture = btnBlueDown Else Picture = btnBlueUp
            
    End Select
    
End Sub

' =================================================================================
' Properties
' =================================================================================

'## Color
Public Property Get Color() As ColorConstants

    Color = m_Color
    
End Property

Public Property Let Color(ByVal New_Color As ColorConstants)

    m_Color = New_Color
    PropertyChanged "Color"
    Refresh
    
End Property

'## Enabled
Public Property Get Enabled() As Boolean

    Enabled = UserControl.Enabled
    
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)

    UserControl.Enabled() = New_Enabled
    PropertyChanged "Enabled"
    
End Property

'## Events
'============================================================================

Private Sub UserControl_Click()

    RaiseEvent Click
    
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    p_MouseDown = True
    Refresh
    RaiseEvent MouseDown(Button, Shift, X, Y)
    
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    p_MouseDown = False
    Refresh
    RaiseEvent MouseUp(Button, Shift, X, Y)
    
End Sub