ucgraphicbutton.ctl

管理电子相片 可以进行上传 评价 浏览 等操作

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
'------------------------------------------------------------------------------

Option Explicit



'-- Enumerated constants
Public Enum ColorConstants
    [cGreen]
    [cBlue]
End Enum

'-- Private variables
Private p_MouseDown As Boolean

'-- Property Variables
Private m_Color As Long

'-- Default Property Values
Private Const m_def_Color = 0

'-- Event Declarations
Public Event Click()
Public Event MouseDown(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)

'------------------------------------------------------------------------------
' 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 * Screen.TwipsPerPixelX, 12 * Screen.TwipsPerPixelY
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
    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
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