by Taras Young (1 Submission)
Category: Miscellaneous
Compatability: Visual Basic 3.0
Difficulty: Advanced
Date Added: Wed 3rd February 2021
Rating: (5 Votes)
This code adds a multiple undo/redo function to any textbox or RichTextBox. Easy to set up and use, and doesn't require any extra controls or use of the API. Simple and effective.
Inputs
A textbox (Text1) and two buttons (cmdUndo and cmdRedo).
Side Effects
No side-effects.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' A BETTER MULTIPLE UNDO
''' Copyright (C) 2001 Taras Young
''' http://www.snowblind.net/
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''
''' Paste this code into a form, and add a Textbox (Text1) and
''' two command buttons (cmdUndo and cmdRedo).
'''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''
''' If you want to use a RichTextBox, uncomment the lines
''' marked "for richtextboxes" and comment out the lines
''' marked "for normal textboxes" (obviously).
'''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim UndoStack() As String, UndoStage, Undoing
Private Sub cmdRedo_Click()
Undoing = True
UndoStage = UndoStage + 1
Text1.Text = UndoStack(UndoStage) 'for normal textboxes
' Text1.rtfText = UndoStack(UndoStage) 'for richtextboxes
Undoing = False
End Sub
Private Sub cmdUndo_Click()
Undoing = True 'prevent doubling-up
UndoStage = UndoStage - 1 'go back a stage
If UndoStage <= 0 Then UndoStage = 0 'protection from errors
'For normal textboxes, use:
Text1.Text = UndoStack(UndoStage) 'replace current text with
'new text
''For richtextboxes, use:
' Text1.rtfText = UndoStack(UndoStage) 'replace current text with
' 'new text
Undoing = False
End Sub
Private Sub Form_Load()
ReDim UndoStack(0) 'must be redimmed for UBound to work
End Sub
Private Sub Text1_Change()
' Records the last changes made
ReDim Preserve UndoStack(UBound(UndoStack) + 1) 'increase the stack size
'For normal textboxes:
UndoStack(UBound(UndoStack)) = Text1.Text 'add the current state
''For richtextboxes:
'UndoStack(UBound(UndoStack)) = rtfText1.Text 'add the current state
If Not Undoing Then UndoStage = UndoStage + 1 'change the current stage
End Sub