在文字处理程序的编写中,常会遇到类似于字数统计的问题,我们在 VB/VB.NET 中使用 Len() 函数来进行字符统计,但是我们可以发现一个问题,即当我们在一个允许多行输入的文本框中输入换行符后,Len() 函数所统计出的字符数要大于文本框中的字符数,这本身并不是个错误,只不过当我们输入换行符后,在 VB 中会显示为两个字符,即 Chr(13) 和 Chr(10),这样就使得 Len() 函数所统计出的数字变大了。我们解决这个问题的方法还是有不少的,以下,我用检测 ASCII 码的方式重新统计字符.我们新建一个模块并添加以下过程:
之后,我们新建一个
标准EXE 工程,并在已创建的窗体上绘制一个文本框,命名为
txtString 并将其属性
MultiLine 属性设为
True,再绘制一个按钮,命名为
cmdCheck,并在其
cmdCheck_Click() 过程中添加如下代码:
在刚绘制的文本框中输入任意内容,便可以看到我们的函数和 Len() 函数的统计区别,同时也修正了 Len() 函数的不准确性。
Public Function newLen(Expression, Optional blnMsgBox As Boolean = False) As Long
'//(C) Wei CHEN
'//参数 Expression 表示输入的内容
'//参数 blnMsgBox 表示统计完成后或发生错误时是否显示对话框, False 为不显示, True 为显示
On Error GoTo ErrHandle
Dim numCache As Integer
Dim numCH As Long
Dim numLWord As Long
Dim numUWord As Long
Dim numSymbol As Long
Dim numEnter As Long
Dim numBlank As Long
Dim numNumber As Long
For i = 1 To Len(Expression)
numCache = Asc(Mid$(Expression, i, 1))
'//Chr(10) 和 Chr(13) 可分别表示一个换行符,但如在输入过程中键入 Enter 键,则会同时输入两个字符
If numCache = 13 Then
If Asc(Mid$(Expression, i + 1, 1)) <> 10 Then numEnter = numEnter + 1
ElseIf numCache = 10 Then
numEnter = numEnter + 1
ElseIf numCache >= 65 And numCache <= 90 Then '//A-Z的 ASCII 码为65-90
numUWord = numUWord + 1
ElseIf numCache >= 97 And numCache <= 122 Then '//a-z的 ASCII 码为97-122
numLWord = numLWord + 1
ElseIf numCache >= 48 And numCache <= 57 Then '//0-9的 ASCII 码为48-57
numNumber = numNumber + 1
ElseIf numCache < 0 Then '//汉字的 ASCII 码为负数
numCH = numCH + 1
ElseIf numCache = 32 Then '//空格的 ASCII 码为32
numBlank = numBlank + 1
Else
numSymbol = numSymbol + 1
End If
Next i
newLen = numEnter + numBlank + numNumber + numLWord + _
numUWord + numCH + numSymbol
If blnMsgBox = True Then
MsgBox "共有字符数(包括换行符和空格): " & newLen & " ,其中包括:" & vbNewLine & _
" " & numEnter & " 个换行符;" & vbNewLine & " " & numBlank & " 个空格;" & _
vbNewLine & " " & numNumber & " 个数字;" & vbNewLine & " " & numLWord & _
" 个小写字母;" & vbNewLine & " " & numUWord & " 个大写字母;" & vbNewLine & _
" " & numCH & " 个汉字;" & vbNewLine & " " & numSymbol & " 个符号。" & vbNewLine & _
"Len() 函数检测到共有字符数: " & Len(Expression) & "个", vbInformation, App.Title
End If
Exit Function
ErrHandle:
newLen = -1 '//发生错误时返回值为-1
If blnMsgBox = True Then
MsgBox "发生以下错误,过程将结束:" & vbNewLine & vbNewLine & " [" & Err.Number & "] " & _
Err.Description, vbApplicationModal + vbCritical, "错误"
End If
End Function
'//(C) Wei CHEN
'//参数 Expression 表示输入的内容
'//参数 blnMsgBox 表示统计完成后或发生错误时是否显示对话框, False 为不显示, True 为显示
On Error GoTo ErrHandle
Dim numCache As Integer
Dim numCH As Long
Dim numLWord As Long
Dim numUWord As Long
Dim numSymbol As Long
Dim numEnter As Long
Dim numBlank As Long
Dim numNumber As Long
For i = 1 To Len(Expression)
numCache = Asc(Mid$(Expression, i, 1))
'//Chr(10) 和 Chr(13) 可分别表示一个换行符,但如在输入过程中键入 Enter 键,则会同时输入两个字符
If numCache = 13 Then
If Asc(Mid$(Expression, i + 1, 1)) <> 10 Then numEnter = numEnter + 1
ElseIf numCache = 10 Then
numEnter = numEnter + 1
ElseIf numCache >= 65 And numCache <= 90 Then '//A-Z的 ASCII 码为65-90
numUWord = numUWord + 1
ElseIf numCache >= 97 And numCache <= 122 Then '//a-z的 ASCII 码为97-122
numLWord = numLWord + 1
ElseIf numCache >= 48 And numCache <= 57 Then '//0-9的 ASCII 码为48-57
numNumber = numNumber + 1
ElseIf numCache < 0 Then '//汉字的 ASCII 码为负数
numCH = numCH + 1
ElseIf numCache = 32 Then '//空格的 ASCII 码为32
numBlank = numBlank + 1
Else
numSymbol = numSymbol + 1
End If
Next i
newLen = numEnter + numBlank + numNumber + numLWord + _
numUWord + numCH + numSymbol
If blnMsgBox = True Then
MsgBox "共有字符数(包括换行符和空格): " & newLen & " ,其中包括:" & vbNewLine & _
" " & numEnter & " 个换行符;" & vbNewLine & " " & numBlank & " 个空格;" & _
vbNewLine & " " & numNumber & " 个数字;" & vbNewLine & " " & numLWord & _
" 个小写字母;" & vbNewLine & " " & numUWord & " 个大写字母;" & vbNewLine & _
" " & numCH & " 个汉字;" & vbNewLine & " " & numSymbol & " 个符号。" & vbNewLine & _
"Len() 函数检测到共有字符数: " & Len(Expression) & "个", vbInformation, App.Title
End If
Exit Function
ErrHandle:
newLen = -1 '//发生错误时返回值为-1
If blnMsgBox = True Then
MsgBox "发生以下错误,过程将结束:" & vbNewLine & vbNewLine & " [" & Err.Number & "] " & _
Err.Description, vbApplicationModal + vbCritical, "错误"
End If
End Function
Private Sub cmdCheck_Click()
newLen txtString.Text, True
End Sub
newLen txtString.Text, True
End Sub