如何在RichTextBox中实现Undo功能(4)

'Change子程序
Public Function Change(ByVal lParam1 As String, ByVal lParam2 As String, startSearch As Long) As String
Dim tempParam$
Dim d&
If Len(lParam1) > Len(lParam2) Then '交换
tempParam$ = lParam1
lParam1 = lParam2
lParam2 = tempParam$
End If
d& = Len(lParam2) - Len(lParam1)
Change = Mid(lParam2, startSearch - d&, d&)
End Function

'Undo子程序
Public Sub Undo()
Dim chg$, X&
Dim DeleteFlag As Boolean '标志删除或添加变量
Dim objElement As Object, objElement2 As Object
If UndoStack.Count > 1 And trapUndo Then
trapUndo = False
DeleteFlag = UndoStack(UndoStack.Count - 1).TextLen < UndoStack(UndoStack.Count).TextLen
If DeleteFlag Then '删除
'cmdDummy.SetFocus '改变焦点
X& = SendMessage(RichTextBox1.hWnd, EM_HIDESELECTION, 1&, 1&)
Set objElement = UndoStack(UndoStack.Count)
Set objElement2 = UndoStack(UndoStack.Count - 1)
RichTextBox1.SelStart = objElement.SelStart - (objElement.TextLen - objElement2.TextLen)
RichTextBox1.SelLength = objElement.TextLen - objElement2.TextLen
RichTextBox1.SelText = ""
X& = SendMessage(RichTextBox1.hWnd, EM_HIDESELECTION, 0&, 0&)
Else '添加
Set objElement = UndoStack(UndoStack.Count - 1)
Set objElement2 = UndoStack(UndoStack.Count)
chg$ = Change(objElement.Text, objElement2.Text, _
objElement2.SelStart + 1 + Abs(Len(objElement.Text) - Len(objElement2.Text)))
RichTextBox1.SelStart = objElement2.SelStart
RichTextBox1.SelLength = 0
RichTextBox1.SelText = chg$
RichTextBox1.SelStart = objElement2.SelStart
If Len(chg$) > 1 And chg$ <> vbCrLf Then
RichTextBox1.SelLength = Len(chg$)
Else
RichTextBox1.SelStart = RichTextBox1.SelStart + Len(chg$)
End If
End If
RedoStack.Add Item:=UndoStack(UndoStack.Count)
UndoStack.Remove UndoStack.Count
End If
EnableControls
trapUndo = True
RichTextBox1.SetFocus
End Sub

'Redo子程序
Public Sub Redo()
Dim chg$
Dim DeleteFlag As Boolean '标志删除或添加文本的变量
Dim objElement As Object
If RedoStack.Count > 0 And trapUndo Then
trapUndo = False
DeleteFlag = RedoStack(RedoStack.Count).TextLen < Len(RichTextBox1.Text)
If DeleteFlag Then '为真则删除
Set objElement = RedoStack(RedoStack.Count)
RichTextBox1.SelStart = objElement.SelStart
RichTextBox1.SelLength = Len(RichTextBox1.Text) - objElement.TextLen
RichTextBox1.SelText = ""
Else '反之则添加
Set objElement = RedoStack(RedoStack.Count)
chg$ = Change(RichTextBox1.Text, objElement.Text, objElement.SelStart + 1)
RichTextBox1.SelStart = objElement.SelStart - Len(chg$)
RichTextBox1.SelLength = 0
RichTextBox1.SelText = chg$
RichTextBox1.SelStart = objElement.SelStart - Len(chg$)
If Len(chg$) > 1 And chg$ <> vbCrLf Then
RichTextBox1.SelLength = Len(chg$)
Else
RichTextBox1.SelStart = RichTextBox1.SelStart + Len(chg$)
End If
End If
UndoStack.Add Item:=objElement
RedoStack.Remove RedoStack.Count
End If
EnableControls
trapUndo = True
RichTextBox1.SetFocus
End Sub