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

Dim newElement As New UndoElement '创建新的undo集合
Dim c%, l&

'移除所有的Redo项目
For c% = 1 To RedoStack.Count
RedoStack.Remove 1
Next c%

'给新集合赋值
newElement.SelStart = RichTextBox1.SelStart
newElement.TextLen = Len(RichTextBox1.Text)
newElement.Text = RichTextBox1.Text

'将其加入 undo 堆栈
UndoStack.Add Item:=newElement
'设置窗体控件的属性
EnableControls
End Sub

Private Sub RichTextBox1_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 2 Then
KeyCode = 0
End If
End Sub

Private Sub RichTextBox1_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeySpace Then
RichTextBox1.SelFontName = "宋体" '定义字体
End If
End Sub

Private Sub RichTextBox1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then '显示
PopupMenu mnuEdit
End If
End Sub

'菜单属性设置
Private Sub RichTextBox1_SelChange()
Dim ln&
If Not trapUndo Then Exit Sub
ln& = RichTextBox1.SelLength
mnuCut.Enabled = ln& '不选择文本则禁用
mnuCopy.Enabled = ln& '同上
mnuPaste.Enabled = Len(Clipboard.GetText(1)) '剪贴版为空则禁用
mnuDelete.Enabled = ln& '不选择文本则禁用
mnuSelectAll.Enabled = CBool(Len(RichTextBox1.Text)) '文本框无内容则禁用
End Sub

'设置按钮、菜单属性
Private Sub EnableControls()
Command1.Enabled = UndoStack.Count > 1
Command2.Enabled = RedoStack.Count > 0
mnuUndo.Enabled = Command1.Enabled
mnuRedo.Enabled = Command2.Enabled
RichTextBox1_SelChange
End Sub