Question

vb6怎么实现多步撤销

请问vb6怎么实现多步撤销？1个richtextbox，一个撤销按钮我用SendMessage(Me.ActiveControl.hwnd, EM_UNDO, 0, 0&)只能实现最近一步的撤销，有没有别的api或者方法可以实现多步撤销，并且在最后一次撤消后按钮Enabled改为false。求高手指导

Answer 1

给你代码(窗体的，还有模块和类模块的，我打包发给你)： 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 elementsPrivate Sub cmdRedo_Click()
Redo
End SubPrivate Sub cmdUndo_Click()
Undo
End SubPrivate Sub Form_Load()
trapUndo = True 'Enable Undo Trapping
txtEdit_Change 'Initialize First Undo
txtEdit_SelChange 'Initialize Menus
Show
DoEvents
End SubPrivate Sub mnuCopy_Click()
Clipboard.SetText txtEdit.SelText, 1
End SubPrivate Sub mnuCut_Click()
Clipboard.SetText txtEdit.SelText, 1
txtEdit.SelText = ""
End SubPrivate Sub mnuDelete_Click()
txtEdit.SelText = ""
End SubPrivate Sub mnuPaste_Click()
txtEdit.SelText = "" 'This step is crucial!!! for undoing actions
txtEdit.SelText = Clipboard.GetText(1)
End SubPrivate Sub mnuRedo_Click()
cmdRedo_Click
End SubPrivate Sub mnuSelectAll_Click()
txtEdit.SelStart = 0
txtEdit.SelLength = Len(txtEdit.Text)
End SubPrivate Sub mnuUndo_Click()
cmdUndo_Click
End SubPrivate 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 SubPrivate 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 SubPrivate 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 SubPrivate 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 SubPrivate Sub EnableControls()
cmdUndo.Enabled = UndoStack.Count > 1
cmdRedo.Enabled = RedoStack.Count > 0
mnuUndo.Enabled = cmdUndo.Enabled
mnuRedo.Enabled = cmdRedo.Enabled
txtEdit_SelChange
End SubPublic 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 FunctionPublic 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 SubPublic 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

Answer 2

前面的不会`后面的嘛if command1.enabled=true then command1.enabled=falseelsecommand1.enabled=trueend if