VB icon

A Better Multiple Undo

Email
Submitted on: 1/16/2015 2:16:00 PM
By: Taras Young (from psc cd)  
Level: Advanced
User Rating: By 5 Users
Compatibility: VB 5.0, VB 6.0
Views: 1917
 
     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.
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: A Better Multiple Undo
' Description: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.
' By: Taras Young (from psc cd)
'
' 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


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Advanced category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.