程序实现功能：使用RichTextBox控件提供用户编辑功能，加入类似word的“撤销”和“恢复”功能。
'***********************************************************************
'本程序是在拜读了《电脑报》2005.4.4天津张志鑫发表的文章的基础上改进而成的,
'您在应用下面这些代码时，请务必保留两行“*”之间的内容不要修改,
'主要改进有两点：
'1.增加一个控制可恢复次数的变量，以限制对内存的无限制使用，以免造成内存溢出
'2.修正一个原代码错误，避免用户进行恢复时出错的问题
'对报纸上原程序存在错误的测试可以通过连续输入0123456789试验,
'会发现撤销输入时是正确的，但恢复时就会出错,
'虚线之间的内容是我新加的，加入这些代码后，本程序将更加完美,
'在此对张志鑫先生一并表示感谢,
'修改之后的源程序可用以下连接下载：http://qdgoj.nease.net/vbundo.rar
' 或：http://www.68ceo.com/software/vbundo.rar
' 青岛 许家国 2005.4.7
'***********************************************************************
运行VB6，新建一标准.exe工程，点“工程/部件”菜单，选中“Microsoft Rich Textbox Control
6.0”前的“√”，在工具箱中就出出现“RichTextBox”控件，在窗体中建立一“RichTextBox”控件，命名为“rtbText”，再建立两个按钮
，分别命名为“cmdUndo”和“cmdRedo”，把下列代码依次输入即可。
本程序在VB6+WIN2000 Server环境下运行通过。
Option Explicit
Dim rtbUndoStack() As String '撤销堆栈
Dim rtbRedoStack() As String '恢复堆栈
Dim bChg As Boolean '记录富文本框内容是否发生变化
'----------------------------------------------------
'对原程序修改，增加一个控制可恢复次数的变量，以限制对内存的无限制使用，以免造成内存溢出
Dim UndoNum As Long
'----------------------------------------------------
Private Sub cmdUndo_Click()
If UBound(rtbUndoStack) > 1 Then
bChg = True
ReDim Preserve rtbRedoStack(UBound(rtbRedoStack) + 1) As String
rtbRedoStack(UBound(rtbRedoStack)) = RTBText.TextRTF
RTBText.TextRTF = rtbUndoStack(UBound(rtbUndoStack) - 1)
ReDim Preserve rtbUndoStack(UBound(rtbUndoStack) - 1) As String
End If
'----------------------------------------------------
'增加对Undo次数的判断与限制功能
If UBound(rtbRedoStack) > UndoNum Then
cmdUndo.Enabled = False
MsgBox ("只允许撤销 " & UndoNum & " 次")
End If
'----------------------------------------------------
End Sub
Private Sub Form_Load()
ReDim Preserve rtbUndoStack(1) As String
ReDim Preserve rtbRedoStack(1) As String
rtbUndoStack(1) = RTBText.TextRTF '初始化撤销堆栈元素
rtbRedoStack(1) = RTBText.TextRTF '初始化恢复堆栈元素
bChg = False
'----------------------------------------------------
'增加部分初始化代码
UndoNum = 3 '限定可恢复的次数为3
cmdRedo.Enabled = False
cmdUndo.Enabled = False
'----------------------------------------------------
End Sub
Private Sub RTBText_Change()
Dim N As Long
Dim M As Long
If bChg = False Then '判断富文本框内容是否首次被修改
ReDim Preserve rtbUndoStack(UBound(rtbUndoStack) + 1) As String
M = UBound(rtbUndoStack)
rtbUndoStack(M) = RTBText.TextRTF
ReDim Preserve rtbRedoStack(1) As String '清除恢复堆栈内容
'----------------------------------------------------
'报纸上的原程序的两个缺陷之一：如果没有限制，将可能造成内存溢出
If M > UndoNum + 1 Then '限制可恢复的次数
For N = 1 To M
rtbUndoStack(N - 1) = rtbUndoStack(N)
Next N
ReDim Preserve rtbUndoStack(M - 1) As String
End If
'----------------------------------------------------
Else
bChg = False
End If
'判断并设置恢复按钮是否可用
If UBound(rtbUndoStack) > 1 Then
cmdUndo.Enabled = True
Else
cmdUndo.Enabled = False
End If
If UBound(rtbRedoStack) > 1 Then
cmdRedo.Enabled = True
Else
cmdRedo.Enabled = False
End If
End Sub
Private Sub cmdRedo_Click()
If UBound(rtbRedoStack) > 1 Then
bChg = True
ReDim Preserve rtbUndoStack(UBound(rtbUndoStack) + 1) As String
'rtbUndoStack(UBound(rtbUndoStack)) = RTBText.TextRTF '报纸上程序的原位置，删除后放到下面的位置
RTBText.TextRTF = rtbRedoStack(UBound(rtbRedoStack))
ReDim Preserve rtbRedoStack(UBound(rtbRedoStack) - 1) As String
'报纸上的原程序两个缺陷之二：如果放在原位置，将造成恢复失败
rtbUndoStack(UBound(rtbUndoStack)) = RTBText.TextRTF
End If
'----------------------------------------------------
'增加对Redo次数的判断与限制功能
If UBound(rtbRedoStack) <= 1 Then
cmdRedo.Enabled = False
End If
'----------------------------------------------------
End Sub
