ftextbox.ctl

超市销售管理系统 4) 文档里面有完整的需求说明书

VERSION 5.00
Begin VB.UserControl FTextBox 
   ClientHeight    =   300
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2325
   ScaleHeight     =   300
   ScaleWidth      =   2325
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   50
      Left            =   0
      Top             =   0
   End
   Begin VB.TextBox Text1 
      BorderStyle     =   0  'None
      Height          =   210
      Left            =   45
      TabIndex        =   0
      Top             =   45
      Width           =   1335
   End
   Begin VB.PictureBox Sh1 
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      Height          =   270
      Left            =   15
      ScaleHeight     =   270
      ScaleWidth      =   255
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   15
      Width           =   255
   End
End
Attribute VB_Name = "FTextBox"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'超市销售系统
'程序开发：lc_mtt
'CSDN博客：http://blog.csdn.net/lc_mtt/
'个人主页：http://www.3lsoft.com
'邮箱：[e-mail]
'注：此代码禁止用于商业用途。有修改者发我一份，谢谢！
'---------------- 开源世界，你我更进步 ----------------

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Const CB_SHOWDROPDOWN = &H14F
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
    x As Long
    y As Long
End Type
Dim IfOn As Boolean
Dim onX As Long
Dim onY As Long
Dim sX As Long
Dim sY As Long
'事件声明:
Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=Text1,Text1,-1,KeyDown
Event KeyPress(KeyAscii As Integer) 'MappingInfo=Text1,Text1,-1,KeyPress
Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=Text1,Text1,-1,KeyUp
Event Change() 'MappingInfo=Text1,Text1,-1,Change
Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=Text1,Text1,-1,MouseDown
Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=Text1,Text1,-1,MouseMove
Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=Text1,Text1,-1,MouseUp
Event Click() 'MappingInfo=Text1,Text1,-1,Click
'缺省属性值:
Const m_def_afterdecimal = 2
Const m_def_isNumber = False
Const m_def_AutoSelAll = False
'属性变量:
Dim m_afterdecimal As Long
Dim m_isNumber As Boolean
Dim m_AutoSelAll As Boolean


Private Sub Text1_GotFocus()
On Error Resume Next
    If m_AutoSelAll Then
        Text1.SelStart = 0
        Text1.SelLength = Len(Text1)
    End If
End Sub

Private Sub Text1_LostFocus()
    UserControl.Cls
End Sub

Private Sub UserControl_Resize()
    UserControl.Height = 300
    Sh1.Width = UserControl.Width - 30
    Text1.Width = UserControl.Width - 90
End Sub
'注意！不要删除或修改下列被注释的行！
'MappingInfo=Text1,Text1,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
    BackColor = Text1.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    Text1.BackColor() = New_BackColor
    Sh1.BackColor() = New_BackColor
    PropertyChanged "BackColor"
End Property

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

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

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

Public Property Let FontBold(ByVal New_FontBold As Boolean)
    Text1.FontBold() = New_FontBold
    PropertyChanged "FontBold"
End Property

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

Public Property Let FontItalic(ByVal New_FontItalic As Boolean)
    Text1.FontItalic() = New_FontItalic
    PropertyChanged "FontItalic"
End Property

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

Public Property Let FontName(ByVal New_FontName As String)
    Text1.FontName() = New_FontName
    PropertyChanged "FontName"
End Property

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

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

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

Public Property Let FontStrikethru(ByVal New_FontStrikethru As Boolean)
    Text1.FontStrikethru() = New_FontStrikethru
    PropertyChanged "FontStrikethru"
End Property

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

Public Property Let FontUnderline(ByVal New_FontUnderline As Boolean)
    Text1.FontUnderline() = New_FontUnderline
    PropertyChanged "FontUnderline"
End Property

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

Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
    Text1.ForeColor() = New_ForeColor
    PropertyChanged "ForeColor"
End Property

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

Private Sub Text1_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
    If m_isNumber Then
        If KeyAscii = 8 Or KeyAscii = vbKeyReturn Then
        Else
            If m_afterdecimal = 0 And KeyAscii = 46 Then
                KeyAscii = 0
                Exit Sub
            End If
            If KeyAscii < 46 Or KeyAscii > 58 Or KeyAscii = 47 Then
                KeyAscii = 0
            Else
                If KeyAscii = 46 Then
                    If InStr(Text1.Text, ".") > 0 Then
                        KeyAscii = 0
                        Exit Sub
                    End If
                    If Len(Text1.Text) - Text1.SelStart > m_afterdecimal Then
                        KeyAscii = 0
                        Exit Sub
                    End If
                End If
                im = InStr(Text1.Text, ".")
                If im > 0 Then
                    ix = Text1.SelStart
                    If im <= ix Then
                        If (ix - im) + 1 > m_afterdecimal Or Len(Text1.Text) + 1 - im > m_afterdecimal Then
                            KeyAscii = 0
                            Exit Sub
                        End If
                    End If
                Else
                    If KeyAscii = 46 And Len(Text1.Text) = (Text1.MaxLength - m_afterdecimal - 1) Then
                        Exit Sub
                    End If
                    If Text1.SelLength = Len(Text1.Text) And Text1.SelStart = 0 Then Exit Sub
                    If Len(Text1.Text) >= (Text1.MaxLength - m_afterdecimal - 1) Then KeyAscii = 0
                End If
                If Text1.SelLength = Len(Text1.Text) And Text1.SelStart = 0 Then Exit Sub
                If Len(Text1) >= Text1.MaxLength Then KeyAscii = 0
            End If
        End If
    End If
End Sub

Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyUp(KeyCode, Shift)