字符串操作

'************************************
'函数名:    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 IfEnd 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
'************************************
'函数名:    pbCheckChar
'参数  :   intKeyascii:需处理的Keyascii字符
''返回值:    数字字符
'
'说明  :    限制输入字符，确保输入的为允许字符
'************************************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