浮点数运算

浮点数的加法和减法运算是计算机中最常见也是最复杂的运算之一。由于浮点数的内部表示由符号(Sign)、指数(Exponent)和尾数(Mantissa)三部分组成,浮点数的加减法运算必须处理这些部分之间的复杂关系。以下是浮点数相加或相减的详细运算步骤:

1. 浮点数表示的回顾

  • 符号位(Sign):表示浮点数的正负。
  • 指数位(Exponent):表示浮点数的指数部分,经过偏移量调整(即偏置)。
  • 尾数位(Mantissa):表示浮点数的有效数字,通常以二进制形式表示。

2. 浮点数相加/相减的步骤

2.1 对阶操作(Aligning the Exponents)

  • 首先比较两个浮点数的指数部分。如果指数不相同,则需要对它们进行对齐:
    • 将较小指数的那个浮点数的尾数右移,并相应地增加它的指数,直到两个浮点数的指数相同。
    • 右移操作可能会导致尾数的精度损失,但这是必须的以便能够对两个数进行相加或相减。

例如,如果两个浮点数分别为 (2.5 \times 10^3) 和 (3.75 \times 10^2),需要将 (3.75 \times 10^2) 转换为 (0.375 \times 10^3) 以便与 (2.5 \times 10^3) 进行运算。

2.2 尾数相加或相减(Adding or Subtracting the Mantissas)

  • 在对阶操作后,两数的指数部分已经对齐,可以直接对它们的尾数进行加法或减法运算。
  • 尾数运算的符号决定于两个浮点数的符号位:
    • 加法:如果两个浮点数符号相同,则进行尾数的相加。
    • 减法:如果两个浮点数符号不同,则进行尾数的相减(这相当于符号不同的加法)。

2.3 规格化结果(Normalizing the Result)

  • 尾数相加或相减后,结果可能需要规格化,即调整尾数和指数,使尾数的范围符合标准(通常在 1 ≤ 尾数 < 2 的范围内)。
  • 规格化可能包括:
    • 左移尾数并减小指数:如果尾数的最高有效位为 0,则需要左移尾数,直到最高有效位为 1,同时指数减 1。
    • 右移尾数并增加指数:如果尾数的位数超过标准的有效位,则需要右移尾数并增加指数。

2.4 舍入操作(Rounding the Result)

  • 在规格化后,可能需要对尾数进行舍入以满足浮点数的精度要求。
  • IEEE 754 标准提供了几种舍入方式,最常用的是就近舍入(Round to nearest, ties to even),即选择最接近的数值,如果刚好在中间,则选择偶数方向。

2.5 溢出和下溢处理(Handling Overflow and Underflow)

  • 规格化和舍入后,需要检查结果是否出现溢出(Overflow)或下溢(Underflow)。
    • 溢出:如果指数超出浮点数表示范围,结果通常设置为正无穷或负无穷。
    • 下溢:如果指数太小,结果可能被设置为零或一个次正规数(即指数为极小值时的数)。

3. 组合最终结果(Combining the Final Result)

  • 最后,将处理后的符号位、指数位和尾数位重新组合成一个符合IEEE 754标准的浮点数,并作为最终结果返回。

总结

浮点数的加减法运算包括多个步骤:对阶、尾数相加或相减、结果规格化、舍入以及溢出/下溢处理。这一系列操作确保了浮点数运算的精度和稳定性。硬件中的浮点运算单元(FPU)专门优化了这些操作,以提高计算效率。

浮点数的乘法和除法运算在计算机中也遵循IEEE 754标准。与浮点数加法和减法相比,乘法和除法的运算过程相对简单一些。以下是浮点数相乘和相除的具体运算细节:

1. 浮点数的表示回顾

  • 符号位(Sign):1 位,用于表示正负号。
  • 指数位(Exponent):表示浮点数的指数部分,经过偏移量调整。
  • 尾数位(Mantissa):表示浮点数的有效数字,通常隐藏了一个隐含的最高位 1(对于规范化数)。

2. 浮点数相乘运算的细节

2.1 符号位的处理

  • 浮点数乘法的符号位由两个浮点数的符号位决定。如果两个浮点数符号相同(都为正或都为负),乘积的符号为正;如果符号不同,乘积的符号为负。
  • 计算方法是简单的异或运算:sign_result = sign_a XOR sign_b

2.2 指数的相加

  • 乘法的指数部分由两个浮点数的指数部分相加,然后减去偏移量(Bias)。这个偏移量是因为浮点数的指数部分在存储时是经过一个偏移量调整的(例如,IEEE 754 单精度浮点数的偏移量为127)。
  • 计算公式:exponent_result = (exponent_a + exponent_b) - Bias

2.3 尾数的相乘

  • 在乘法中,两个浮点数的尾数部分(包括隐含的最高位1)直接相乘。
  • 结果可能包含比标准尾数多出的一些位,需要进行规格化处理。

2.4 规格化结果

  • 乘积的尾数可能需要规格化(如果乘积的最高有效位是2位而不是1位),这通常需要对尾数进行右移一位,同时增加指数。

2.5 舍入和溢出处理

  • 对乘积的尾数进行适当的舍入以符合精度要求。
  • 检查是否发生指数溢出或下溢,并根据需要处理溢出为无穷大,或下溢为零或次正规数。

3. 浮点数相除运算的细节

3.1 符号位的处理

  • 与乘法类似,浮点数除法的符号位由被除数和除数的符号位决定。符号相同则商为正,符号不同则商为负
  • 计算方法仍然是符号位的异或运算:sign_result = sign_a XOR sign_b

3.2 指数的相减

  • 除法的指数部分由被除数的指数减去除数的指数,再加上偏移量(Bias)。
  • 计算公式:exponent_result = (exponent_a - exponent_b) + Bias

3.3 尾数的相除

  • 被除数的尾数除以除数的尾数,计算商的尾数。
  • 与乘法不同的是,除法可能会产生一个需要左移的结果尾数,因此需要处理尾数规格化。

3.4 规格化结果

  • 规格化过程确保结果的尾数在标准范围内。如果除法结果尾数的最高有效位小于1,则需要对尾数进行左移,同时减少指数。

3.5 舍入和溢出处理

  • 尾数进行适当的舍入。
  • 检查是否发生指数溢出或下溢,并根据需要处理。

4. 组合最终结果

  • 最终的符号、指数和尾数经过处理后重新组合成一个符合IEEE 754标准的浮点数,并返回这个结果。

总结

浮点数的乘法和除法运算虽然相对加法和减法来说简单一些,但仍然涉及符号位处理、指数计算、尾数运算、规格化和舍入等多个步骤。计算机通过硬件浮点运算单元(FPU)实现这些运算的高效处理,使得这些复杂的操作在实际应用中能够快速完成。

NotePad 函数系列之二

Public Sub TampNotePad(ByVal sTxtFile As String, Optional ByVal bTrimRow As Variant = True) ‘对文本文件消除空行, bTrimRow 为真, 则行 ” ” 视为空行 “”
On Error Resume Next
Dim I As Integer, J As Integer
Dim Lines() As String
Dim LineContent As String
Dim iLineCount As Integer
Dim TxtFileNumber As Integer
TxtFileNumber = FreeFile
If Not FileExist(sTxtFile) Then Exit Sub
Open sTxtFile For Input As TxtFileNumber
Do While Not EOF(TxtFileNumber) ‘把文本读至数组
Line Input #TxtFileNumber, LineContent
iLineCount = iLineCount + 1
ReDim Preserve Lines(1 To iLineCount)
Lines(iLineCount) = LineContent
Loop
Close TxtFileNumber
Open sTxtFile For Output As TxtFileNumber
For I = 1 To iLineCount ‘把数组写入文本
If bTrimRow Then Lines(I) = Trim(Lines(I))
If Not Lines(I) = “” Then Print #TxtFileNumber, Lines(I)
Next I
Close TxtFileNumber
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Sub


Public Sub TrimNotePad(ByVal sTxtFile As String, Optional ByVal bTrimRow As Variant = True) ‘对文本文件消除前后空行, 中间空行不管, bTrimRow 为真, 则行 ” ” 视为空行 “”
On Error Resume Next
Dim I As Integer, J As Integer
Dim Lines() As String
Dim LineContent As String
Dim iLineCount As Integer
Dim TxtFileNumber As Integer
TxtFileNumber = FreeFile
If Not FileExist(sTxtFile) Then Exit Sub
Open sTxtFile For Input As TxtFileNumber
Do While Not EOF(TxtFileNumber) ‘把文本读至数组
Line Input #TxtFileNumber, LineContent
iLineCount = iLineCount + 1
ReDim Preserve Lines(1 To iLineCount)
Lines(iLineCount) = LineContent
Loop
Close TxtFileNumber
Dim iBegin As Integer, iEnd As Integer
For I = 1 To iLineCount
If bTrimRow Then Lines(I) = Trim(Lines(I))
If Not Lines(I) = “” Then
iBegin = I
Exit For
End If
Next I
For I = iLineCount To 1 Step -1
If bTrimRow Then Lines(I) = Trim(Lines(I))
If Not Lines(I) = “” Then
iEnd = I
Exit For
End If
Next I
Open sTxtFile For Output As TxtFileNumber
For I = iBegin To iEnd ‘把数组写入文本
Print #TxtFileNumber, Lines(I)
Next I
Close TxtFileNumber
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Sub


Public Sub CleanNotePad(ByVal sTxtFile As String) ‘对文本文件消除重复行
On Error Resume Next
Dim I As Integer, J As Integer
Dim Lines() As String
Dim LineContent As String
Dim iLineCount As Integer
Dim TxtFileNumber As Integer
TxtFileNumber = FreeFile
If Not FileExist(sTxtFile) Then Exit Sub
Open sTxtFile For Input As TxtFileNumber
Do While Not EOF(TxtFileNumber) ‘把文本读至数组
Line Input #TxtFileNumber, LineContent
iLineCount = iLineCount + 1
ReDim Preserve Lines(1 To iLineCount)
Lines(iLineCount) = LineContent
Loop
Close TxtFileNumber
Call CleanUpArray(Lines) ‘去除重复元素
iLineCount = UBound(Lines) – LBound(Lines) + 1
Open sTxtFile For Output As TxtFileNumber
For I = 1 To iLineCount
Print #TxtFileNumber, Lines(I)
Next I
Close TxtFileNumber
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Sub


Public Sub SortNotePad(ByVal sTxtFile As String, ByVal bAscending As Boolean) ‘对文本文件按行排序
On Error Resume Next
Dim I As Integer, J As Integer
Dim Lines() As String
Dim LineContent As String
Dim iLineCount As Integer
Dim TxtFileNumber As Integer
TxtFileNumber = FreeFile
If Not FileExist(sTxtFile) Then Exit Sub
Open sTxtFile For Input As TxtFileNumber
Do While Not EOF(TxtFileNumber) ‘把文本读至数组
Line Input #TxtFileNumber, LineContent
iLineCount = iLineCount + 1
ReDim Preserve Lines(1 To iLineCount)
Lines(iLineCount) = LineContent
Loop
Close TxtFileNumber
If iLineCount = 0 Then Exit Sub ‘LBound 会出错
Dim iBest As Integer
Dim sBest As String
For I = 1 To iLineCount – 1 ‘对数组进行有序处理
iBest = I
sBest = Lines(I)
For J = I + 1 To iLineCount
If StrComp(Lines(J), sBest, vbTextCompare) < 0 Then sBest = Lines(J) iBest = J End If Next J Lines(iBest) = Lines(I) Lines(I) = sBest Next I Open sTxtFile For Output As TxtFileNumber If bAscending = True Then ‘把数组写入文本 ‘Ascending order For I = 1 To iLineCount Print #TxtFileNumber, Lines(I) Next I Else ‘Descending order For I = iLineCount To 1 Step -1 Print #TxtFileNumber, Lines(I) Next I End If Close TxtFileNumber If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Sub


Public Sub ClearNotePad(ByVal sTxtFile As String) ‘保留文本文件但清空其内容
On Error Resume Next
Dim I As Integer, J As Integer
Dim Lines() As String
Dim TxtFileNumber As Integer
TxtFileNumber = FreeFile
Open sTxtFile For Output As TxtFileNumber
For I = LBound(Lines) To UBound(Lines) ‘把数组写入文本
Print #TxtFileNumber, Lines(I)
Next I
Close TxtFileNumber
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Sub

NotePad 函数系列之一

Public Function FindNotePadText(ByVal sTxtFile As String, ByVal sData As String) As Boolean
FindNotePadText = False
On Error Resume Next
Dim TxtFileNumber As Integer
Dim LineContent As String
TxtFileNumber = FreeFile
If Not FileExist(sTxtFile) Then Exit Function
Open sTxtFile For Input As TxtFileNumber
Do While Not EOF(TxtFileNumber) ‘把文本读至数组
Line Input #TxtFileNumber, LineContent
If InStr(1, LineContent, sData, vbTextCompare) > 0 Then
FindNotePadText = True
Exit Do
End If
Loop
Close TxtFileNumber
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Function


Public Function GetNotePadRowNo(ByVal sTxtFile As String, ByVal sData As String, Optional ByVal bFirst As Boolean = False) As Integer
‘sData 出现在 sTxtFile 的行号,无 sData 为 0,bFirst = True 取第一次,bFirst = False 取最后一次
On Error Resume Next
GetNotePadRowNo = 0
If Not FileExist(sTxtFile) Then Exit Function
Dim TxtFileNumber As Integer
Dim LineContent As String
Dim LineArray() As Integer
Dim LineCount As Integer
Dim LineNumber As Integer
LineCount = 0
LineNumber = 0
TxtFileNumber = FreeFile
Open sTxtFile For Input As TxtFileNumber
Do While Not EOF(TxtFileNumber) ‘读文本
Line Input #TxtFileNumber, LineContent
LineNumber = LineNumber + 1
If InStr(1, LineContent, sData, vbTextCompare) > 0 Then ‘出现
LineCount = LineCount + 1
ReDim Preserve LineArray(1 To LineCount)
LineArray(LineCount) = LineNumber
End If
Loop
Close TxtFileNumber
If IsEmptyArray(LineArray) Then Exit Function ‘0
If bFirst Then
GetNotePadRowNo = LineArray(LBound(LineArray))
Else
GetNotePadRowNo = LineArray(UBound(LineArray))
End If
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Function


Public Sub ReplaceNotePadText(ByVal sTxtFile As String, ByVal sOld As String, ByVal sNew As String)
On Error Resume Next
Dim I As Integer, J As Integer
Dim Lines() As String
Dim LineContent As String
Dim iLineCount As Integer
Dim TxtFileNumber As Integer
TxtFileNumber = FreeFile
If Not FileExist(sTxtFile) Then Exit Sub
Open sTxtFile For Input As TxtFileNumber
Do While Not EOF(TxtFileNumber) ‘把文本读至数组
Line Input #TxtFileNumber, LineContent
LineContent = Replace(LineContent, sOld, sNew, 1, -1, vbTextCompare)
iLineCount = iLineCount + 1
ReDim Preserve Lines(1 To iLineCount)
Lines(iLineCount) = LineContent
Loop
Close TxtFileNumber
If iLineCount = 0 Then Exit Sub ‘LBound 会出错
Open sTxtFile For Output As TxtFileNumber
For I = 1 To iLineCount
Print #TxtFileNumber, Lines(I)
Next I
Close TxtFileNumber
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Sub


Public Sub TurnNotePadCursor(ByVal sTxtFile As String, ByVal iRow As Integer, Optional ByVal iColumn As Integer = 1, Optional bOpen As Boolean = False) ‘把文本文件光标移到某行某列
On Error Resume Next
Dim I As Integer, J As Integer
Dim oShell As Object
Set oShell = CreateObject(“WScript.Shell”)
If bOpen Then
‘新打开文件
Dim lPid As Long
lPid = Shell(“notepad.exe ” & sTxtFile, vbNormalFocus)
AppActivate (lPid)
Else
‘须紧跟 OpenFile 之后,以保证 sTxtFile 为当前窗体
‘Debug.Print sTxtFile
‘Debug.Print GetShortName(sTxtFile)
For I = 1 To GetNotePadRowCount(sTxtFile, False)
DoEvents
oShell.SendKeys “{UP}” ‘回到首行
Next I
For J = 1 To GetNotePadColumnCount(sTxtFile, False)
DoEvents
oShell.SendKeys “{LEFT}” ‘回到首列
Next J
End If
For I = 1 To iRow – 1
oShell.SendKeys “{DOWN}”
Next I
For J = 1 To iColumn – 1
oShell.SendKeys “{RIGHT}”
Next J
ERR_NORUNNING:
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Sub


Public Function GetNotePadRowCount(ByVal sTxtFile As String, Optional ByVal bTrimRow As Variant = True) As Integer ‘获取 txt 文件行数, bTrimRow 为真, 则空行 “” 及空格行 ” ” 不计
On Error Resume Next
GetNotePadRowCount = 0
Dim TxtFileNumber As String
TxtFileNumber = FreeFile
If bTrimRow Then
Dim LineContent As String
Open sTxtFile For Input As TxtFileNumber
Do While Not EOF(TxtFileNumber) ‘把文本读至数组
Line Input #TxtFileNumber, LineContent
LineContent = Trim(LineContent)
If Not LineContent = “” Then GetNotePadRowCount = GetNotePadRowCount + 1
Loop
Close TxtFileNumber
Else
Open sTxtFile For Binary As #TxtFileNumber
GetNotePadRowCount = UBound(Split(Input(LOF(1), #1), vbCrLf)) + 1
Close #TxtFileNumber
End If
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Function


Public Function GetNotePadColumnCount(ByVal sTxtFile As String, Optional ByVal bTrimRow As Variant = True) As Integer ‘获取 txt 文件列数(最大列数)), bTrimRow 为真, 则每行两端的 ” ” 不计
On Error Resume Next
Dim I As Integer, J As Integer
GetNotePadColumnCount = 0
Dim LineContent As String
Dim TxtFileNumber As Integer
TxtFileNumber = FreeFile
If Not FileExist(sTxtFile) Then Exit Function
Open sTxtFile For Input As TxtFileNumber
Do While Not EOF(TxtFileNumber)
Line Input #TxtFileNumber, LineContent
If bTrimRow Then LineContent = Trim(LineContent)
If Len(LineContent) > GetNotePadColumnCount Then GetNotePadColumnCount = Len(LineContent)
Loop
Close TxtFileNumber
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Function
Public Function GetNotePadColumnCountAtRow(ByVal sTxtFile As String, ByVal iRow As Integer, Optional ByVal bTrimRow As Variant = True) As Integer ‘获取 txt 文件某行列数, bTrimRow 为真, 则行两端的 ” ” 不计
On Error Resume Next
Dim I As Integer, J As Integer
GetNotePadColumnCountAtRow = 0
Dim LineContent As String
Dim TxtFileNumber As Integer
Dim iCount As Integer
TxtFileNumber = FreeFile
If Not FileExist(sTxtFile) Then Exit Function
Open sTxtFile For Input As TxtFileNumber
Do While Not EOF(TxtFileNumber)
Line Input #TxtFileNumber, LineContent
iCount = iCount + 1
If bTrimRow Then LineContent = Trim(LineContent)
If iCount = iRow Then
GetNotePadColumnCountAtRow = Len(LineContent)
Exit Do
End If
Loop
Close TxtFileNumber
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Function


Public Function GetNotePadRowText(ByVal sTxtFile As String, ByVal iLineNumber As Integer) As String ‘获取 txt 文件某行内容
On Error Resume Next
Dim I As Integer, J As Integer
GetNotePadRowText = “”
If iLineNumber > GetNotePadRowCount(sTxtFile, False) Then Exit Function
Dim oFSO As Object, oFile As Object, oStream As Object
Set oFSO = CreateObject(“Scripting.FileSystemObject”)
Set oFile = oFSO.GetFile(sTxtFile)
Set oStream = oFile.OpenAsTextStream(1, 0)
‘ 读取指定行
For I = 1 To iLineNumber
GetNotePadRowText = oStream.ReadLine
Next
oStream.Close
Set oStream = Nothing
Set oFile = Nothing
Set oFSO = Nothing
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
End Function

Word 的回车

word里有软回车和硬回车两种回车,其实中间还有个“薛定谔换行”。

软回车是按Shift+Enter产生的,当在word里打开显示所有标记,就会发现一个向下箭头,可以达到换行的效果,但是上下文还是同一个段落,在设置样式的时候上下还是一个整体。软回车在word里的符号是^l,它的ASCII编码是chr(11)。

在word的“查找”和“替换”窗口无论是否勾选“使用通配符”,既可以用^l也可以用^11,注意,是(1)查找和(2)替换时无论(3)勾选通配符和(4)取消使用通配符,这几种情况分别都可以用^l或^11,这很重要,因为不是所有符号都支持。

硬回车是按下回车键产生的,同时作为段落标记和回车,可以把上下文分为两个段落(Paragraph),可以设置不同的样式(大纲级别、行距之类的),它在ASCII里的编码是chr(13),在word里的符号是^p。

和软回车不同的是,查找、替换、使用通配符这几种情况下,^13和^P不是都支持的,简单的说,只有在“查找+使用通配符”这一种情况下才能使用^13。

为什么会这样?^13和^p有什么区别?

这就要提到下边“薛定谔换行”。

当需要把软回车替换为硬回车时,通过替换框中将^11替换为^13,发现向下箭头变成了普通的硬回车符号,但是,这个回车符和普通回车符不同,光标可以放在回车符后边,这本来是不可能的。

这时如果改变上下段落的样式,会发现相邻的段落样式也改变了,为什么呢?

因为它是个假的段落标记“薛定谔换行”,也就是^13和^p的差别。

^13和^p既有区别又有联系,它们在VBA中的VBA.ASC值都是13,word会把^13自动转换为^p,但是当从文本文件等其他地方把包含^13的文字直接复制进word,它就出现了,在排版过程中尤其是通过VBA操作word文档时候可能掉进这个陷阱,包括上边提到的把^11替换为^13时,这时候需要通过复制、选择性粘贴,word才会把^13转换为正常的^p。

TextBox 函数系列之一

Public Declare Function SendMessage Lib “user32” Alias “SendMessageA” (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const EM_GETSEL = &HB0
Public Const EM_LINEFROMCHAR = &HC9
Public Const EM_LINEINDEX = &HBB

Public Function GetTextBoxRowText(ByVal oTextBox As TextBox, ByVal iLine As Integer) As String ‘获取 TextBox 某行文字
On Error Resume Next
Dim TempArray As Variant
TempArray = Split(oTextBox.Text, vbCrLf, -1, vbTextCompare)
GetTextBoxRowText = TempArray(iLine – 1)
On Error GoTo 0
End Function

Public Function GetTextBoxRowCount(ByVal oTextBox As TextBox) As Integer ‘获取 TextBox 文字行数
On Error Resume Next
GetTextBoxRowCount = 0
Dim TempArray As Variant
TempArray = Split(oTextBox.Text, vbCrLf, -1, vbTextCompare)
GetTextBoxRowCount = UBound(TempArray) – LBound(TempArray) + 1
On Error GoTo 0
End Function

Public Function GetTextBoxColumnCount(ByVal oTextBox As TextBox) As Integer ‘获取 TextBox 文字最大列数
On Error Resume Next
Dim I As Integer, J As Integer
GetTextBoxColumnCount = 0
Dim TempArray As Variant
TempArray = Split(oTextBox.Text, vbCrLf, -1, vbTextCompare)
For I = LBound(TempArray) To UBound(TempArray)
‘Debug.Print Len(TempArray(I)); I
If GetTextBoxColumnCount < Len(TempArray(I)) Then GetTextBoxColumnCount = Len(TempArray(I))
Next I
On Error GoTo 0
End Function

Public Function GetTextBoxColumnCountAtRow(ByVal oTextBox As TextBox, ByVal iRow As Integer) As Integer ‘获取 TextBox 某行文字最大列数
On Error Resume Next
Dim I As Integer, J As Integer
GetTextBoxColumnCountAtRow = 0
Dim TempArray As Variant
TempArray = Split(oTextBox.Text, vbCrLf, -1, vbTextCompare)
Dim iCount As Integer
For I = LBound(TempArray) To UBound(TempArray)
‘Debug.Print Len(TempArray(I)); I
iCount = iCount + 1
If iCount = iRow Then
GetTextBoxColumnCountAtRow = Len(TempArray(I))
Exit For
End If
Next I
On Error GoTo 0
End Function

Public Function GetTextBoxCharCount(ByVal oTextBox As TextBox) As Long’获取 TextBox 文字数
On Error Resume Next
GetTextBoxCharCount = 0
Dim lCount As Long, lRow As Long, lCol As Long
Dim lParam As Long, wParam As Long
‘首先向文本框传递EM_GETSEL消息以获取从起始位置到光标所在位置的字符数
lRet = SendMessage(oTextBox.hwnd, EM_GETSEL, wParam, lParam)
lCount = lRet / 2 ^ 16
‘再向文本框传递EM_LINEFROMCHAR消息根据获得的字符数确定光标以获取所在行数
lRow = SendMessage(oTextBox.hwnd, EM_LINEFROMCHAR, lCount, 0)
lRow = lRow + 1
‘扣除 VbCrlf
GetTextBoxCharCount = lCount – (lRow – 1) * 2
‘向文本框传递EM_LINEINDEX消息以获取所在列数
‘lRet = SendMessage(oTextBox.hWnd, EM_LINEINDEX, -1, 0)
‘lCol = lCount – lRet + 1
On Error GoTo 0
End Function

Public Function GetTextBoxCursorRow(ByVal oTextBox As TextBox) As Long’获取 TextBox 光标所在行
On Error Resume Next
GetTextBoxCursorRow = 0
Dim lCount As Long, lRow As Long, lCol As Long
Dim lParam As Long, wParam As Long
‘首先向文本框传递EM_GETSEL消息以获取从起始位置到光标所在位置的字符数
lRet = SendMessage(oTextBox.hwnd, EM_GETSEL, wParam, lParam)
lCount = lRet / 2 ^ 16
‘再向文本框传递EM_LINEFROMCHAR消息根据获得的字符数确定光标以获取所在行数
lRow = SendMessage(oTextBox.hwnd, EM_LINEFROMCHAR, lCount, 0)
lRow = lRow + 1
GetTextBoxCursorRow = lRow
‘向文本框传递EM_LINEINDEX消息以获取所在列数
‘lRet = SendMessage(oTextBox.hWnd, EM_LINEINDEX, -1, 0)
‘lCol = lCount – lRet + 1
On Error GoTo 0
End Function

Public Function GetTextBoxCursorColumn(ByVal oTextBox As TextBox) As Long’获取 TextBox 光标所在列
On Error Resume Next
GetTextBoxCursorColumn = 0
Dim lCount As Long, lRow As Long, lCol As Long
Dim lParam As Long, wParam As Long
‘首先向文本框传递EM_GETSEL消息以获取从起始位置到光标所在位置的字符数
lRet = SendMessage(oTextBox.hwnd, EM_GETSEL, wParam, lParam)
lCount = lRet / 2 ^ 16
‘再向文本框传递EM_LINEFROMCHAR消息根据获得的字符数确定光标以获取所在行数
lRow = SendMessage(oTextBox.hwnd, EM_LINEFROMCHAR, lCount, 0)
lRow = lRow + 1
‘向文本框传递EM_LINEINDEX消息以获取所在列数
lRet = SendMessage(oTextBox.hwnd, EM_LINEINDEX, -1, 0)
lCol = lCount – lRet + 1
GetTextBoxCursorColumn = lCol
On Error GoTo 0
End Function

Public Sub TurnTextBoxCursor(ByVal oTextBox As TextBox, ByVal iRow As Integer, Optional ByVal iColumn As Integer = 1) ‘把文本文件光标移到某行某列
On Error Resume Next
Dim I As Integer, J As Integer
Dim oShell As Object
Set oShell = CreateObject(“WScript.Shell”)
oTextBox.SetFocus
Dim iCurRow As Integer, iCurColumn As Integer
iCurRow = GetTextBoxCursorRow(oTextBox) ‘当前行
iCurColumn = GetTextBoxCursorColumn(oTextBox) ‘当前列
‘Debug.Print iCurRow; iCurColumn
If iCurRow < iRow Then
For I = iCurRow To iRow – 1
oShell.SendKeys “{DOWN}”
Next I
Else
For I = iRow To iCurRow – 1
oShell.SendKeys “{UP}”
Next I
End If
Wait 50
iCurRow = GetTextBoxCursorRow(oTextBox) ‘当前行
iCurColumn = GetTextBoxCursorColumn(oTextBox) ‘目标行的当前列
‘Debug.Print iCurRow; iCurColumn
If iCurColumn < iColumn Then
For J = iCurColumn To iColumn – 1
oShell.SendKeys “{RIGHT}”
Next J
Else
For J = iColumn To iCurColumn – 1
oShell.SendKeys “{LEFT}”
Next J
End If
Wait 50
iCurRow = GetTextBoxCursorRow(oTextBox) ‘当前行
iCurColumn = GetTextBoxCursorColumn(oTextBox) ‘目标行的当前列
‘Debug.Print iCurRow; iCurColumn
ERR_NORUNNING:
On Error GoTo 0
End Sub