inputnumber.ctl

来自「很好！ 很实用！ 免费！」· CTL 代码 · 共 341 行

VERSION 5.00
Begin VB.UserControl InputNumber 
   ClientHeight    =   1650
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4530
   ScaleHeight     =   1650
   ScaleWidth      =   4530
   Begin VB.TextBox txtNumber 
      Alignment       =   1  'Right Justify
      Height          =   285
      Left            =   480
      TabIndex        =   0
      Text            =   "0"
      Top             =   120
      Width           =   1935
   End
End
Attribute VB_Name = "InputNumber"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'Default Property Values:
Const m_def_Genre = "+"
Const m_def_DecimalDigits = 0
'Property Variables:
Dim m_Genre As String
Dim m_DecimalDigits As Integer
'Event Declarations:
Event Click() 'MappingInfo=txtNumber,txtNumber,-1,Click
Event DblClick() 'MappingInfo=txtNumber,txtNumber,-1,DblClick
Attribute DblClick.VB_Description = "Occurs when the user presses and releases a mouse button and then presses and releases it again over an object."
Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=txtNumber,txtNumber,-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=txtNumber,txtNumber,-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=txtNumber,txtNumber,-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=txtNumber,txtNumber,-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=txtNumber,txtNumber,-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=txtNumber,txtNumber,-1,MouseUp
Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."
Event Change() 'MappingInfo=txtNumber,txtNumber,-1,Change
Attribute Change.VB_Description = "Occurs when the contents of a control have changed."

Private Sub txtNumber_Change()
    RaiseEvent Change
End Sub

Private Sub txtNumber_GotFocus()
    SendKeys "{HOME}+{END}"
End Sub
Public Sub SetFocus()
    txtNumber.SetFocus
End Sub

Private Sub txtNumber_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
        Case 8
        Case 45
            If InStr(txtNumber.Text, "-") > 0 Then
                txtNumber.ForeColor = SystemColorConstants.vbInfoText
                m_Genre = "+"
                txtNumber.Text = Replace(txtNumber.Text, "-", "")
            Else
                txtNumber.ForeColor = vbRed
                m_Genre = "-"
                txtNumber.Text = "-" + txtNumber.Text
            End If
            KeyAscii = 0
        Case 46
            If InStr(txtNumber.Text, ".") > 0 Then
                KeyAscii = 0
            End If
        Case 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 67, 68
        Case Else
            KeyAscii = 0
    End Select
    RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub txtNumber_LostFocus()
    If Not IsNumeric(txtNumber.Text) Then txtNumber.Text = "0"
        
    txtNumber.Text = Round(txtNumber.Text, m_DecimalDigits)

End Sub

Private Sub UserControl_Resize()
    txtNumber.Left = 0
    txtNumber.Top = 0
    txtNumber.Width = UserControl.Width
    txtNumber.Height = UserControl.Height
End Sub
''WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
''MappingInfo=UserControl,UserControl,-1,BackColor
'Public Property Get BackColor() As OLE_COLOR
'    BackColor = UserControl.BackColor
'End Property
'
'Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
'    UserControl.BackColor() = New_BackColor
'    PropertyChanged "BackColor"
'End Property

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

Public Property Let ForeColor(ByVal New_ForeColor As ColorConstants)
    txtNumber.ForeColor = New_ForeColor
    PropertyChanged "ForeColor"
End Property

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

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

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

Public Property Set Font(ByVal New_Font As Font)
    Set txtNumber.Font = New_Font
    PropertyChanged "Font"
End Property
'
''WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
''MappingInfo=UserControl,UserControl,-1,BackStyle
'Public Property Get BackStyle() As Integer
'    BackStyle = UserControl.BackStyle
'End Property
'
'Public Property Let BackStyle(ByVal New_BackStyle As Integer)
'    UserControl.BackStyle = New_BackStyle
'    PropertyChanged "BackStyle"
'End Property

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

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

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

Private Sub txtNumber_Click()
    RaiseEvent Click
End Sub

Private Sub txtNumber_DblClick()
    RaiseEvent DblClick
End Sub

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

Private Sub txtNumber_KeyUp(KeyCode As Integer, Shift As Integer)
    If InStr(txtNumber.Text, "-") > 0 Then
       txtNumber.Text = "-" + Replace(txtNumber.Text, "-", "")
    End If
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub

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

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

Private Sub txtNumber_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!
'MappingInfo=txtNumber,txtNumber,-1,Locked
Public Property Get Locked() As Boolean
Attribute Locked.VB_Description = "Determines whether a control can be edited."
    Locked = txtNumber.Locked
End Property

Public Property Let Locked(ByVal New_Locked As Boolean)
    txtNumber.Locked = New_Locked
    PropertyChanged "Locked"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Size
Public Sub Size(ByVal Width As Single, ByVal Height As Single)
Attribute Size.VB_Description = "Changes the width and height of a User Control."
    UserControl.Size Width, Height
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=txtNumber,txtNumber,-1,Text
Public Property Get Text() As String
Attribute Text.VB_Description = "Returns/sets the text contained in the control."
    Text = txtNumber.Text
End Property

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

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,0
Public Property Get Genre() As String
    Genre = m_Genre
End Property

Public Property Let Genre(ByVal New_Genre As String)
    m_Genre = New_Genre
    PropertyChanged "Genre"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,0
Public Property Get DecimalDigits() As Integer
    DecimalDigits = m_DecimalDigits
End Property

Public Property Let DecimalDigits(ByVal New_DecimalDigits As Integer)
    m_DecimalDigits = New_DecimalDigits
    PropertyChanged "DecimalDigits"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=txtNumber,txtNumber,-1,MaxLength
Public Property Get MaxLength() As Long
Attribute MaxLength.VB_Description = "Returns/sets the maximum number of characters that can be entered in a control."
    MaxLength = txtNumber.MaxLength
End Property

Public Property Let MaxLength(ByVal New_MaxLength As Long)
    txtNumber.MaxLength = New_MaxLength
    PropertyChanged "MaxLength"
End Property

'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    m_Genre = m_def_Genre
    m_DecimalDigits = m_def_DecimalDigits
End Sub

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

'    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    txtNumber.ForeColor = PropBag.ReadProperty("ForeColor", &H80000008)
    txtNumber.Enabled = PropBag.ReadProperty("Enabled", True)
    Set txtNumber.Font = PropBag.ReadProperty("Font", Ambient.Font)
'    UserControl.BackStyle = PropBag.ReadProperty("BackStyle", 1)
    txtNumber.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
    txtNumber.Locked = PropBag.ReadProperty("Locked", False)
    txtNumber.Text = PropBag.ReadProperty("Text", "0")
    m_Genre = PropBag.ReadProperty("Genre", m_def_Genre)
    m_DecimalDigits = PropBag.ReadProperty("DecimalDigits", m_def_DecimalDigits)
    txtNumber.MaxLength = PropBag.ReadProperty("MaxLength", 0)
    txtNumber.Appearance = PropBag.ReadProperty("Appearance", 1)
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

'    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
    Call PropBag.WriteProperty("ForeColor", txtNumber.ForeColor, &H80000008)
    Call PropBag.WriteProperty("Enabled", txtNumber.Enabled, True)
'    Call PropBag.WriteProperty("Font", txtNumber.Font, Ambient.Font)
'    Call PropBag.WriteProperty("BackStyle", UserControl.BackStyle, 1)
    Call PropBag.WriteProperty("BorderStyle", txtNumber.BorderStyle, 0)
    Call PropBag.WriteProperty("Locked", txtNumber.Locked, False)
    Call PropBag.WriteProperty("Text", txtNumber.Text, "0")
    Call PropBag.WriteProperty("Genre", m_Genre, m_def_Genre)
    Call PropBag.WriteProperty("DecimalDigits", m_DecimalDigits, m_def_DecimalDigits)
    Call PropBag.WriteProperty("MaxLength", txtNumber.MaxLength, 0)
    Call PropBag.WriteProperty("Appearance", txtNumber.Appearance, 1)
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=txtNumber,txtNumber,-1,BackColor
Public Property Get BackColor() As ColorConstants
    BackColor = txtNumber.BackColor
End Property
Public Property Let BackColor(vData As ColorConstants)
     txtNumber.BackColor = vData
End Property

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

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=txtNumber,txtNumber,-1,Appearance
Public Property Get Appearance() As Integer
Attribute Appearance.VB_Description = "Returns/sets whether or not an object is painted at run time with 3-D effects."
    Appearance = txtNumber.Appearance
End Property

Public Property Let Appearance(ByVal New_Appearance As Integer)
    txtNumber.Appearance() = New_Appearance
    PropertyChanged "Appearance"
End Property