usrpicbutton.ctl

一个功能强大、程序条理分明的学生学籍管理系统

VERSION 5.00
Begin VB.UserControl UsrCtrPicButton 
   ClientHeight    =   765
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3375
   ScaleHeight     =   765
   ScaleWidth      =   3375
   ToolboxBitmap   =   "UsrpicButton.ctx":0000
   Begin VB.PictureBox picContain 
      BorderStyle     =   0  'None
      Height          =   735
      Left            =   0
      ScaleHeight     =   735
      ScaleWidth      =   3375
      TabIndex        =   0
      Top             =   0
      Width           =   3375
      Begin VB.PictureBox PicUsrCmd 
         AutoRedraw      =   -1  'True
         AutoSize        =   -1  'True
         BorderStyle     =   0  'None
         Height          =   480
         Left            =   120
         ScaleHeight     =   480
         ScaleWidth      =   480
         TabIndex        =   2
         Top             =   120
         Width           =   480
      End
      Begin VB.CommandButton UsrCtrlPicButton 
         Height          =   735
         Left            =   0
         TabIndex        =   1
         Top             =   0
         Width           =   3375
      End
   End
End
Attribute VB_Name = "UsrCtrPicButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'Default Property Values:
Const m_def_ForeColor = 0
Const m_def_BackColor = 0
'Const m_def_ForeColor = 0
'Const m_def_Enabled = 0
Const m_def_BackStyle = 0
Const m_def_BorderStyle = 0
'Property Variables:
Dim m_ForeColor As Long
Dim m_BackColor As Long
'Dim m_ForeColor As Long
'Dim m_Enabled As Boolean
'Dim m_Font As Font
Dim m_BackStyle As Integer
Dim m_BorderStyle As Integer
'Event Declarations:
Event Click() 'MappingInfo=cmdUsrPic,cmdUsrPic,-1,Click
Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
Event DblClick()
Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=cmdUsrPic,cmdUsrPic,-1,KeyDown
Attribute KeyDown.VB_Description = "Occurs when the user presses a key while an object has the focus."
Event KeyPress(KeyAscii As Integer) 'MappingInfo=cmdUsrPic,cmdUsrPic,-1,KeyPress
Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=cmdUsrPic,cmdUsrPic,-1,KeyUp
Attribute KeyUp.VB_Description = "Occurs when the user releases a key while an object has the focus."
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=cmdUsrPic,cmdUsrPic,-1,MouseDown
Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=cmdUsrPic,cmdUsrPic,-1,MouseMove
Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=cmdUsrPic,cmdUsrPic,-1,MouseUp
Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=8,0,0,0
Public Property Get BackColor() As Long
Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
Attribute BackColor.VB_MemberFlags = "3c"
    BackColor = m_BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As Long)
    m_BackColor = New_BackColor
    PropertyChanged "BackColor"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,0
Public Property Get BackStyle() As Integer
Attribute BackStyle.VB_Description = "Indicates whether a Label or the background of a Shape is transparent or opaque."
    BackStyle = m_BackStyle
End Property

Public Property Let BackStyle(ByVal New_BackStyle As Integer)
    m_BackStyle = New_BackStyle
    PropertyChanged "BackStyle"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,0
Public Property Get BorderStyle() As Integer
Attribute BorderStyle.VB_Description = "Returns/sets the border style for an object."
    BorderStyle = m_BorderStyle
End Property

Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
    m_BorderStyle = New_BorderStyle
    PropertyChanged "BorderStyle"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=5
Public Sub Refresh()
Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
     
End Sub

'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    m_BackColor = m_def_BackColor
'    m_ForeColor = m_def_ForeColor
'    m_Enabled = m_def_Enabled
'    Set m_Font = Ambient.Font
    m_BackStyle = m_def_BackStyle
    m_BorderStyle = m_def_BorderStyle
    m_ForeColor = m_def_ForeColor
End Sub

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    m_BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor)
    m_BackStyle = PropBag.ReadProperty("BackStyle", m_def_BackStyle)
    m_BorderStyle = PropBag.ReadProperty("BorderStyle", m_def_BorderStyle)
    Set Picture = PropBag.ReadProperty("Picture", Nothing)
    cmdUsrPic.Caption = PropBag.ReadProperty("Caption", "")
    cmdUsrPic.Enabled = PropBag.ReadProperty("Enabled", True)
    m_ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
    Set cmdUsrPic.Font = PropBag.ReadProperty("Font", Ambient.Font)
End Sub

Private Sub UserControl_Resize()
    '限制位图按钮的高度
    If UserControl.ScaleHeight <= 530 Then
        UserControl.Enabled = False
        UserControl.Height = 530
        UserControl.Enabled = True
    End If
    picContain.Height = UserControl.ScaleHeight
    
    If UserControl.ScaleWidth - picContain.Left > 0 Then
        picContain.Width = UserControl.ScaleWidth - picContain.Left
    End If
    
    cmdUsrPic.Height = picContain.Height
    cmdUsrPic.Width = picContain.Width
    '设置图片高度始终居中
    PicUsrCmd.Move cmdUsrPic.Left + 50, (cmdUsrPic.Height - PicUsrCmd.Height) / 2
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("BackStyle", m_BackStyle, m_def_BackStyle)
    Call PropBag.WriteProperty("BorderStyle", m_BorderStyle, m_def_BorderStyle)
    Call PropBag.WriteProperty("Picture", Picture, Nothing)
    Call PropBag.WriteProperty("Caption", cmdUsrPic.Caption, "")
    Call PropBag.WriteProperty("Enabled", cmdUsrPic.Enabled, True)
    Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
    Call PropBag.WriteProperty("Font", cmdUsrPic.Font, Ambient.Font)
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=PicUsrCmd,PicUsrCmd,-1,Picture
Public Property Get Picture() As Picture
Attribute Picture.VB_Description = "Returns/sets a graphic to be displayed in a control."
    Set Picture = PicUsrCmd.Picture
End Property

Public Property Set Picture(ByVal New_Picture As Picture)
    Set PicUsrCmd.Picture = New_Picture
    PropertyChanged "Picture"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=cmdUsrPic,cmdUsrPic,-1,Caption
Public Property Get Caption() As String
Attribute Caption.VB_Description = "Returns/sets the text displayed in an object's title bar or below an object's icon."
    Caption = cmdUsrPic.Caption
End Property

Public Property Let Caption(ByVal New_Caption As String)
    cmdUsrPic.Caption() = Space$(10) & New_Caption
    PropertyChanged "Caption"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=cmdUsrPic,cmdUsrPic,-1,Enabled
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 = cmdUsrPic.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    cmdUsrPic.Enabled() = New_Enabled
    PropertyChanged "Enabled"
End Property

Private Sub cmdUsrPic_Click()
    RaiseEvent Click
End Sub

Private Sub cmdUsrPic_KeyDown(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub cmdUsrPic_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub cmdUsrPic_KeyUp(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub cmdUsrPic_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub cmdUsrPic_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub cmdUsrPic_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=8,0,0,0
Public Property Get ForeColor() As Long
Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
    ForeColor = m_ForeColor
End Property

Public Property Let ForeColor(ByVal New_ForeColor As Long)
    m_ForeColor = New_ForeColor
    PropertyChanged "ForeColor"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=cmdUsrPic,cmdUsrPic,-1,Font
Public Property Get Font() As Font
Attribute Font.VB_Description = "Returns a Font object."
Attribute Font.VB_UserMemId = -512
    Set Font = cmdUsrPic.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
    Set cmdUsrPic.Font = New_Font
    PropertyChanged "Font"
End Property