请问一下实现UNDO功能

[wenti2002]

就是实现撤消功能 如Word

[LoveBH]

在Windows系统中有一条EM_UNDO消息，只要将该消息发送到文本框中，就能够取消文本框的最后一个编辑操作

Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Const EM_CANUNDO = &HC6
Private Const EM_UNDO = &HC7

Private Sub Command1_Click()
Dim i As Integer
i = SendMessage(Text1.hwnd, EM_UNDO, 0, 0)
End Sub

Private Sub Command2_Click()
End
End Sub



欢迎光临电脑爱好者论坛 bbs.cfanclub.net

[lazycat818]

如果要实现多次的undo\redo,则自己必须对每次操作所作的改动进行记录。我的实现方法是编成一个基类，有两个public的sub,redo和undo,然后派生出一系列的派生类(Cundo1,cundo2…)。有一个集合类(Cundos)，它包含一系列的Cundo1……

简单而言，就是利用类的多态。

[rainstormmaster]

窗体：两个按钮，一个richtextbox，菜单
Private trapUndo As Boolean 'flag to indicate whether actions should be trapped
Private UndoStack As New Collection 'collection of undo elements
Private RedoStack As New Collection 'collection of redo elements

Private Sub cmdRedo_Click()
Redo
End Sub

Private Sub cmdUndo_Click()
Undo
End Sub

Private Sub Form_Load()
trapUndo = True 'Enable Undo Trapping
txtEdit_Change 'Initialize First Undo
txtEdit_SelChange 'Initialize Menus
Show
DoEvents
End Sub

Private Sub mnuCopy_Click()
Clipboard.SetText txtEdit.SelText, 1
End Sub

Private Sub mnuCut_Click()
Clipboard.SetText txtEdit.SelText, 1
txtEdit.SelText = ""
End Sub

Private Sub mnuDelete_Click()
txtEdit.SelText = ""
End Sub

Private Sub mnuPaste_Click()
txtEdit.SelText = "" 'This step is crucial!!! for undoing actions
txtEdit.SelText = Clipboard.GetText(1)
End Sub

Private Sub mnuRedo_Click()
cmdRedo_Click
End Sub

Private Sub mnuSelectAll_Click()
txtEdit.SelStart = 0
txtEdit.SelLength = Len(txtEdit.Text)
End Sub

Private Sub mnuUndo_Click()
cmdUndo_Click
End Sub

Private Sub txtEdit_Change()
If Not trapUndo Then Exit Sub 'because trapping is disabled

Dim newElement As New UndoElement 'create new undo element
Dim c%, l&

'remove all redo items because of the change
For c% = 1 To RedoStack.Count
RedoStack.Remove 1
Next c%

'set the values of the new element
newElement.SelStart = txtEdit.SelStart
newElement.TextLen = Len(txtEdit.Text)
newElement.Text = txtEdit.Text

'add it to the undo stack
UndoStack.Add Item:=newElement
'enable controls accordingly
EnableControls
End Sub

Private Sub txtEdit_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 2 Then 'a control event (Ctrl + C, Ctrl + Z), etc.
KeyCode = 0
End If
End Sub

Private Sub txtEdit_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then 'do the popup menu
PopupMenu mnuEdit
End If
End Sub

Private Sub txtEdit_SelChange()
Dim ln&
If Not trapUndo Then Exit Sub
ln& = txtEdit.SelLength
mnuCut.Enabled = ln& 'disabled if length of selected text is 0
mnuCopy.Enabled = ln& 'disabled if length of selected text is 0
mnuPaste.Enabled = Len(Clipboard.GetText(1)) 'disabled if length of clipboard text is 0
mnuDelete.Enabled = ln& 'disabled if length of selected text is 0
mnuSelectAll.Enabled = CBool(Len(txtEdit.Text)) 'disabled if length of textbox's text is 0
End Sub

Private Sub EnableControls()
cmdUndo.Enabled = UndoStack.Count > 1
cmdRedo.Enabled = RedoStack.Count > 0
mnuUndo.Enabled = cmdUndo.Enabled
mnuRedo.Enabled = cmdRedo.Enabled
txtEdit_SelChange
End Sub

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 'swap
tempParam$ = lParam1
lParam1 = lParam2
lParam2 = tempParam$
End If
d& = Len(lParam2) - Len(lParam1)
Change = Mid(lParam2, startSearch - d&, d&)
End Function

Public Sub Undo()
Dim chg$, X&
Dim DeleteFlag As Boolean 'flag as to whether or not to delete text or append text
Dim objElement As Object, objElement2 As Object
If UndoStack.Count > 1 And trapUndo Then 'we can proceed
trapUndo = False
DeleteFlag = UndoStack(UndoStack.Count - 1).TextLen < UndoStack(UndoStack.Count).TextLen
If DeleteFlag Then 'delete some text
cmdDummy.SetFocus 'change focus of form
X& = SendMessage(txtEdit.hWnd, EM_HIDESELECTION, 1&, 1&)
Set objElement = UndoStack(UndoStack.Count)
Set objElement2 = UndoStack(UndoStack.Count - 1)
txtEdit.SelStart = objElement.SelStart - (objElement.TextLen - objElement2.TextLen)
txtEdit.SelLength = objElement.TextLen - objElement2.TextLen
txtEdit.SelText = ""
X& = SendMessage(txtEdit.hWnd, EM_HIDESELECTION, 0&, 0&)
Else 'append something
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)))
txtEdit.SelStart = objElement2.SelStart
txtEdit.SelLength = 0
txtEdit.SelText = chg$
txtEdit.SelStart = objElement2.SelStart
If Len(chg$) > 1 And chg$ <> vbCrLf Then
txtEdit.SelLength = Len(chg$)
Else
txtEdit.SelStart = txtEdit.SelStart + Len(chg$)
End If
End If
RedoStack.Add Item:=UndoStack(UndoStack.Count)
UndoStack.Remove UndoStack.Count
End If
EnableControls
trapUndo = True
txtEdit.SetFocus
End Sub

Public Sub Redo()
Dim chg$
Dim DeleteFlag As Boolean 'flag as to whether or not to delete text or append text
Dim objElement As Object
If RedoStack.Count > 0 And trapUndo Then
trapUndo = False
DeleteFlag = RedoStack(RedoStack.Count).TextLen < Len(txtEdit.Text)
If DeleteFlag Then 'delete last item
Set objElement = RedoStack(RedoStack.Count)
txtEdit.SelStart = objElement.SelStart
txtEdit.SelLength = Len(txtEdit.Text) - objElement.TextLen
txtEdit.SelText = ""
Else 'append something
Set objElement = RedoStack(RedoStack.Count)
chg$ = Change(txtEdit.Text, objElement.Text, objElement.SelStart + 1)
txtEdit.SelStart = objElement.SelStart - Len(chg$)
txtEdit.SelLength = 0
txtEdit.SelText = chg$
txtEdit.SelStart = objElement.SelStart - Len(chg$)
If Len(chg$) > 1 And chg$ <> vbCrLf Then
txtEdit.SelLength = Len(chg$)
Else
txtEdit.SelStart = txtEdit.SelStart + Len(chg$)
End If
End If
UndoStack.Add Item:=objElement
RedoStack.Remove RedoStack.Count
End If
EnableControls
trapUndo = True
txtEdit.SetFocus
End Sub

[rainstormmaster]

机器出问题了,下面的不能贴了,留下email,把源程序发给你吧

[Rozre]

给我一个好吗？
[e-mail]

[painache]

看设计模式。

command模式

http://www.csdn.net/develop/read_article.asp?id=13585

[liuns]

其实REDO和UNDO就是进栈出栈的问题，在word中这个可复杂多了。但是基本的编程思想是一样的。

[James0001]

不过要是按照普通的方法的话比较费内存
BTW, RichEdit 支持多重撤销/重复操作