脖子上起红疙瘩:textbox限制输入

来源:百度文库 编辑:偶看新闻 时间:2024/04/27 21:30:47


‘************************************
‘函数名:    DataLength_Limit()
‘参数  :    obj :需处理的TEXTBOX对象

‘返回值:    无

‘说明  :    处理中文字符长度,限制输入byte数超过Text.MaxLength的中文字符
‘************************************

Public Sub DataLength_Limit(obj As TextBox) ‘, MaxLen as Integer)
    Dim iLenUnicode As Integer
    Dim i As Integer
    Dim MaxLen As Integer
    Dim sText As String
    Dim j As Integer
   
    j = obj.SelStart
    sText = obj.text
    MaxLen = obj.MaxLength
   
   
    If sText = "" Or MaxLen = 0 Then
        Exit Sub
    End If
   
    iLenUnicode = Len(sText)
   
    For i = 1 To iLenUnicode
        If lstrlen(sText) > MaxLen Then
            iLenUnicode = iLenUnicode - 1
            sText = Left(sText, iLenUnicode)
        Else
            Exit For
        End If
    Next i
   
    obj.text = sText
    obj.SelStart = j
End Sub

‘************************************
‘函数名:    NumKeyPress()
‘参数  :    obj :需处理的TEXTBOX对象
‘           Keyascii:需处理的ascii字符
‘           IntPlaces:最大整数位
‘           DecPlaces:最大小数位
‘返回值:    数字字符

‘说明  :    限制输入非数字字符,确保输入的为允许有效数字
‘************************************

Public Function NumKeyPress(obj As TextBox, KeyAscii As Integer, IntPlaces As Integer, DecPlaces As Integer) As Integer
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim ilen As Integer

    NumKeyPress = KeyAscii

    i = obj.SelStart
    j = InStr(obj.text, ".")
    k = obj.SelLength
    ilen = Len(obj.text)

    If KeyAscii = vbKeyBack Then
        If k = 0 Then
            If i = j Then
                If ilen - 1 > IntPlaces Then
                    NumKeyPress = 0
                End If
               
            End If
        Else
            If InStr(obj.SelText, ".") > 0 Then
                If ilen - k > IntPlaces Then
                    NumKeyPress = 0
                End If
            End If
        End If

    End If


    If KeyAscii >= 33 Then
        If (KeyAscii < vbKey0 Or KeyAscii > vbKey9) And KeyAscii <> 46 Then
            NumKeyPress = 0
        Else
            If KeyAscii = 46 Then
                If InStr(obj.text, ".") > 0 Then
                    NumKeyPress = 0
                End If
            Else
                    If j > 0 Then
                        If i >= j And (ilen - j) >= DecPlaces Then
                            NumKeyPress = 0
                        ElseIf i < j And j >= IntPlaces + 1 Then
                            NumKeyPress = 0
                        End If
                    Else
                        If ilen >= IntPlaces Then
                            NumKeyPress = 0
                        End If
                    End If
           
            End If
        End If
    End If

End Function

‘************************************
‘函数名:    NumKeyDown()
‘参数  :    obj :需处理的TEXTBOX对象
‘           KeyCode:需处理的KeyCode字符
‘           IntPlaces:最大整数位
‘           DecPlaces:最大小数位
‘返回值:    数字字符

‘说明  :    限制输入非数字字符,确保输入的为允许有效数字,主要响应“Delete”健
‘************************************

Public Function NumKeyDown(obj As TextBox, KeyCode As Integer, IntPlaces As Integer, DecPlaces As Integer) As Integer
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim ilen As Integer

    NumKeyDown = KeyCode

    i = obj.SelStart
    j = InStr(obj.text, ".")
    k = obj.SelLength
    ilen = Len(obj.text)

    If KeyCode = 46 Then
        If k = 0 Then
            If i + 1 = j Then
                If ilen - 1 > IntPlaces Then
                    NumKeyDown = 0
                End If
               
            End If
        Else
            If InStr(obj.SelText, ".") > 0 Then
                If ilen - k > IntPlaces Then
                    NumKeyDown = 0
                End If
            End If
        End If

    End If
End Function

Public Function pbCheckChar(intKeyascii As Integer) As Integer
    If intKeyascii = 37 Or intKeyascii = 34 Or intKeyascii = 39 Or intKeyascii = 63 Then
        pbCheckChar = 0
    Else
        pbCheckChar = 1
    End If
End Function