'==================================================================
'           限制文本框只能输入0~99.99之间的数字
'                                       企鹅     2005-05-26
'==================================================================

'在删除小数点后出现3位以上连续数字的情况时将DELETE屏蔽掉
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next
    If KeyCode = 46 And ((Mid(Me.Text1.Text, Me.Text1.SelStart + 1, 1) = ".") And Len(Me.Text1.Text) > 3) Then
        KeyCode = 0
    End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
On Error Resume Next
    '限制只能输入0~9，小数点和Backspace
    Select Case KeyAscii
    Case 48 To 57, 46, 8
    Case Else
        KeyAscii = 0
        Exit Sub
    End Select
   
    '判断是否存在小数点
    If cz(Me.Text1.Text) = True Then
        Select Case KeyAscii
        '只能有一个小数点
        Case 46
            KeyAscii = 0
            Exit Sub
        '输入数字时
        Case 48 To 57
            '判断光标是否在小数点前
            If pdx(Me.Text1.Text, Me.Text1.SelStart) = True Then
                '判断小数点之前数字是否为连续2位
                If pdnum1(Me.Text1.Text) = True Then
                    KeyAscii = 0
                End If
            Else
                '判断小数点后数字是否为连续2位
                If pdnum2(Me.Text1.Text) = True Then
                    KeyAscii = 0
                End If
            End If
        '输入Backspace时
        Case 8
            '判断光标位置是否在小数后一位，及不让将小数点删除后出现三位连续数字
            If (Mid(Me.Text1.Text, Me.Text1.SelStart, 1) = ".") And Len(Me.Text1.Text) > 3 Then
                KeyAscii = 0
            End If
        End Select
    Else
        '输入是否为小数点和Backspace
        If KeyAscii <> 46 And KeyAscii <> 8 Then
            '判断小数点前2位是否为连续数字
            If pdnum1(Me.Text1.Text) = True Then
                KeyAscii = 0
            End If
        End If
    End If
   
End Sub

'查找字符串中是否有小数点
Function cz(chrstr As String) As Boolean
    For i = 1 To Len(chrstr)
        If Mid(chrstr, i, 1) = "." Then
            cz = True
            Exit Function
        End If
    Next i
    cz = False
End Function

'判断小数点前是否2位数字连续
Function pdnum1(chrstr As String) As Boolean
    Select Case Len(chrstr)
    Case 0, 1
    Case Else
        If (Mid(chrstr, 1, 1) >= "0" And Mid(chrstr, 1, 1) <= "9") And (Mid(chrstr, 2, 1) >= "0" And Mid(chrstr, 2, 1) <= "9") Then
            pdnum1 = True
            Exit Function
        Else
            pdnum1 = False
        End If
    End Select
End Function

'判断小数点后是否2位数字连续
Function pdnum2(chrstr As String) As Boolean
    Dim y As Integer
    For i = 1 To Len(chrstr)
        If Mid(chrstr, i, 1) = "." Then
            y = i
            Exit For
        Else
            y = i
        End If
    Next i
    If Len(chrstr) - y = 2 Then
        Select Case Len(chrstr)
        Case 0, 1
        Case Else
            For i = Len(chrstr) To y Step -1
                If (Mid(chrstr, i, 1) >= "0" And Mid(chrstr, i, 1) <= "9") And (Mid(chrstr, i - 1, 1) >= "0" And Mid(chrstr, i - 1, 1) <= "9") Then
                    pdnum2 = True
                    Exit Function
                End If
            Next i
            pdnum2 = False
        End Select
    Else
        pdnum2 = False
    End If
End Function

'判断光标位置是否在小数点之前
Function pdx(chrstr As String, x As Integer) As Boolean
    Dim y As Integer
    For i = 1 To Len(chrstr)
        If Mid(chrstr, i, 1) = "." Then
            y = i
            Exit For
        Else
            y = i
        End If
    Next i
    If x < y Then
        pdx = True
    Else
        pdx = False
    End If
End Function