comd.ctl

引用枕善居网站上的职工工资系统

VERSION 5.00
Begin VB.UserControl Comd 
   BackColor       =   &H80000009&
   ClientHeight    =   2775
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2955
   ScaleHeight     =   2775
   ScaleWidth      =   2955
   Begin VB.PictureBox Picture1 
      BackColor       =   &H80000009&
      BorderStyle     =   0  'None
      Height          =   300
      Left            =   0
      ScaleHeight     =   300
      ScaleWidth      =   1125
      TabIndex        =   0
      Top             =   0
      Width           =   1125
      Begin VB.PictureBox ImgUp 
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   240
         Left            =   860
         Picture         =   "Comd.ctx":0000
         ScaleHeight     =   207.059
         ScaleMode       =   0  'User
         ScaleWidth      =   240
         TabIndex        =   2
         Top             =   30
         Width           =   240
      End
      Begin VB.TextBox TxtSpin 
         Appearance      =   0  'Flat
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         Height          =   180
         Left            =   40
         TabIndex        =   1
         Top             =   40
         Width           =   780
      End
      Begin VB.Shape ShapeBorder 
         BorderColor     =   &H80000001&
         Height          =   300
         Left            =   0
         Top             =   0
         Width           =   1125
      End
   End
   Begin VB.Image Img 
      Height          =   255
      Index           =   0
      Left            =   1740
      Picture         =   "Comd.ctx":03B6
      Top             =   240
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Image Img 
      Height          =   255
      Index           =   1
      Left            =   1740
      Picture         =   "Comd.ctx":076C
      Top             =   510
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Image Img 
      Height          =   255
      Index           =   2
      Left            =   1710
      Picture         =   "Comd.ctx":0B22
      Top             =   810
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Image Img 
      Height          =   255
      Index           =   3
      Left            =   1680
      Picture         =   "Comd.ctx":0ED8
      Top             =   1140
      Visible         =   0   'False
      Width           =   255
   End
End
Attribute VB_Name = "Comd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'缺省属性值:
Const m_def_imige = 0
Const m_def_Locked = 0
'属性变量:
Dim m_imige As Variant
Dim m_Locked As Boolean
'事件声明:
Event Click() 'MappingInfo=ImgUp,ImgUp,-1,Click
Event DblClick() 'MappingInfo=ImgUp,ImgUp,-1,DblClick
Event KeyPress(KeyAscii As Integer) 'MappingInfo=ImgUp,ImgUp,-1,KeyPress
Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyDown

Private Sub RePos()
Dim i As Integer
    If Width < 400 Then Width = 400
    ShapeBorder.Width = Width
    Picture1.Width = Width
    ImgUp.Left = Width - 270
    TxtSpin.Width = Width - 360
    Height = 300
    TxtSpin.Top = 60
        If TxtSpin.FontSize > 8 Then
        i = TxtSpin.FontSize - 8
        i = i * 15
        TxtSpin.Top = TxtSpin.Top - i
    End If
End Sub
Sub ResetPic()
    If ImgUp.Picture <> Img(0).Picture Then
        ImgUp.Picture = Img(0).Picture
    End If
End Sub

Private Sub ImgUp_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ImgUp.Picture = Img(2).Picture
    ImgUp_Click
End Sub

Private Sub ImgUp_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If ImgUp.Picture <> Img(1).Picture Then ImgUp.Picture = Img(1).Picture
    
End Sub




Private Sub TxtSpin_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If ImgUp.Picture <> Img(1).Picture Then ImgUp.Picture = Img(1).Picture
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
ResetPic
End Sub

Private Sub UserControl_Resize()
RePos
End Sub
'注意！不要删除或修改下列被注释的行！
'MappingInfo=TxtSpin,TxtSpin,-1,Text
Public Property Get Text() As String
    Text = TxtSpin.Text
End Property

Public Property Let Text(ByVal New_Text As String)
    TxtSpin.Text() = New_Text
    PropertyChanged "Text"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=ShapeBorder,ShapeBorder,-1,BorderColor
Public Property Get BorderColor() As OLE_COLOR
    BorderColor = ShapeBorder.BorderColor
End Property

Public Property Let BorderColor(ByVal New_BorderColor As OLE_COLOR)
    ShapeBorder.BorderColor() = New_BorderColor
    PropertyChanged "BorderColor"
End Property

Private Sub ImgUp_Click()
    RaiseEvent Click
End Sub

Private Sub ImgUp_DblClick()
    RaiseEvent DblClick
End Sub

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,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
    TxtSpin.Enabled = New_Enabled
    ImgUp.Enabled = New_Enabled
        If New_Enabled = False Then
        ImgUp.Picture = Img(3).Picture
        ShapeBorder.BorderColor = &HC0C0C0
    Else
        ResetPic
        ShapeBorder.BorderColor = &HB99D7F
    End If
    PropertyChanged "Enabled"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=TxtSpin,TxtSpin,-1,Font
Public Property Get Font() As Font
    Set Font = TxtSpin.Font
End Property

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


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

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


'注意！不要删除或修改下列被注释的行！
'MemberInfo=0,0,0,0
Public Property Get Locked() As OLE_OPTEXCLUSIVE
    Locked = m_Locked
End Property

Public Property Let Locked(ByVal New_Locked As OLE_OPTEXCLUSIVE)
    m_Locked = New_Locked
    PropertyChanged "Locked"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=14


'为用户控件初始化属性
Private Sub UserControl_InitProperties()
    m_Locked = m_def_Locked
    m_imige = m_def_imige
End Sub

'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    TxtSpin.Text = PropBag.ReadProperty("Text", "")
    ShapeBorder.BorderColor = PropBag.ReadProperty("BorderColor", &HB99D7F)
    UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
    Set TxtSpin.Font = PropBag.ReadProperty("Font", Ambient.Font)
   ' TxtSpin.ForeColor = PropBag.ReadProperty("ForeColor", UserControl.ForeColor)
    m_Locked = PropBag.ReadProperty("Locked", m_def_Locked)
    TxtSpin.FontSize = PropBag.ReadProperty("FontSize", UserControl.FontSize)
    TxtSpin.ForeColor = PropBag.ReadProperty("FillColor", &H80000008)
    Set DataFormat = PropBag.ReadProperty("DataFormat", Nothing)
    Set DataSource = PropBag.ReadProperty("DataSource", Nothing)
    TxtSpin.DataMember = PropBag.ReadProperty("DataMember", "")
    TxtSpin.DataMember = PropBag.ReadProperty("DataMember", "")
    m_imige = PropBag.ReadProperty("imige", m_def_imige)
End Sub

'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("Text", TxtSpin.Text, "")
    Call PropBag.WriteProperty("BorderColor", ShapeBorder.BorderColor, &HB99D7F)
    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
    Call PropBag.WriteProperty("Font", TxtSpin.Font, Ambient.Font)
    'Call PropBag.WriteProperty("ForeColor", TxtSpin.ForeColor, UserControl.ForeColor)
    Call PropBag.WriteProperty("Locked", m_Locked, m_def_Locked)
    Call PropBag.WriteProperty("FontSize", TxtSpin.FontSize, UserControl.FontSize)
    Call PropBag.WriteProperty("FillColor", TxtSpin.ForeColor, &H80000008)
    Call PropBag.WriteProperty("DataFormat", DataFormat, Nothing)
    Call PropBag.WriteProperty("DataMember", TxtSpin.DataMember, "")
    Call PropBag.WriteProperty("imige", m_imige, m_def_imige)
End Sub

'注意！不要删除或修改下列被注释的行！
'MappingInfo=TxtSpin,TxtSpin,-1,FontSize
Public Property Get FontSize() As Single
    FontSize = TxtSpin.FontSize
End Property

Public Property Let FontSize(ByVal New_FontSize As Single)
    TxtSpin.FontSize() = New_FontSize
    PropertyChanged "FontSize"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=TxtSpin,TxtSpin,-1,ForeColor
Public Property Get FillColor() As OLE_COLOR
    FillColor = TxtSpin.ForeColor
End Property

Public Property Let FillColor(ByVal New_FillColor As OLE_COLOR)
    TxtSpin.ForeColor() = New_FillColor
    PropertyChanged "FillColor"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=TxtSpin,TxtSpin,-1,DataFormat
Public Property Get DataFormat() As IStdDataFormatDisp
    Set DataFormat = TxtSpin.DataFormat
End Property

Public Property Set DataFormat(ByVal New_DataFormat As IStdDataFormatDisp)
    Set TxtSpin.DataFormat = New_DataFormat
    PropertyChanged "DataFormat"
End Property
'
''注意！不要删除或修改下列被注释的行！
''MappingInfo=TxtSpin,TxtSpin,-1,DataSource
''Public Property Get DataSource() As DataSource
'    'Set DataSource = TxtSpin.DataSource
''End Property
'
''Public Property Set DataSource(ByVal New_DataSource As DataSource)
'   ' Set TxtSpin.DataSource = New_DataSource
'   ' PropertyChanged "DataSource"
''End Property
'
''注意！不要删除或修改下列被注释的行！
''MappingInfo=TxtSpin,TxtSpin,-1,DataMember
'Public Property Get DataMember() As String
'    DataMember = TxtSpin.DataMember
'End Property
'
'Public Property Let DataMember(ByVal New_DataMember As String)
'    TxtSpin.DataMember() = New_DataMember
'    PropertyChanged "DataMember"
'End Property
'
'注意！不要删除或修改下列被注释的行！
'MappingInfo=TxtSpin,TxtSpin,-1,DataMember
Public Property Get DataMember() As String
    DataMember = TxtSpin.DataMember
End Property

Public Property Let DataMember(ByVal New_DataMember As String)
    TxtSpin.DataMember() = New_DataMember
    PropertyChanged "DataMember"
End Property


'注意！不要删除或修改下列被注释的行！
'MemberInfo=14,0,0,0
Public Property Get imige() As Boolean
    imige = m_imige
End Property

Public Property Let imige(ByVal New_imige As Boolean)
    m_imige = New_imige
    If New_imige = True Then
       ResetPic
     ElseIf New_imige = False Then
      ImgUp.Picture = Img(1).Picture
    End If
    PropertyChanged "imige"
End Property