Hi all, i know this was discussed a lot, but i made a class for undo / redo in a project (using code from everywhere).
It's working for textboxes and for Vbflexgrid, but it's easy to add more controls.
I think it's working fine, but all the improvements are welcome xD
Class CUndoRedoEntry
Class UndoRedoManager
Using it:
In a Form:
Dim it.
Set it in Form_Load
And to save the value, you can call in:
VbFlexgrid
vbflexgrid_beforedit:
Vbflexgrid_afteredit:
Textbox
in _lostfocus (for example)
Call an undo (in a button for example)
call a redo (in a button for example)
And.. destroying it:
It's working for textboxes and for Vbflexgrid, but it's easy to add more controls.
I think it's working fine, but all the improvements are welcome xD
Class CUndoRedoEntry
Code:
Option Explicit
Public FormName As String
Public ControlName As String
Public OldValue As Variant
Public NewValue As Variant
Public ControlType As String
Public ControlTag As Variant
Public ControlText As Variant
Public Row As Long
Public Col As LongClass UndoRedoManager
Code:
Option Explicit
Private UndoStack As Collection
Private RedoStack As Collection
Private Sub Class_Initialize()
Set UndoStack = New Collection
Set RedoStack = New Collection
End Sub
Private Sub Class_Terminate()
Set UndoStack = Nothing
Set RedoStack = Nothing
End Sub
Public Sub AddUndo(FormName As String, ControlName As String, ControlTag As Variant, ControlText As Variant, ControlType As String, Optional Row As Long = -1, Optional Col As Long = -1)
Dim Entry As CUndoRedoEntry
Set Entry = New CUndoRedoEntry
Entry.FormName = FormName
Entry.ControlName = ControlName
'Entry.ControlTag = ControlTag
Entry.OldValue = ControlTag
Entry.NewValue = ControlText
'Entry.ControlText = ControlText
Entry.ControlType = ControlType
Entry.Row = Row
Entry.Col = Col
' Agregar la entrada al stack de undo
UndoStack.Add Entry
Set RedoStack = New Collection
End Sub
Public Sub Undo()
' Verifica que haya elementos en UndoStack
If UndoStack.Count = 0 Then
MsgBox "No hay más acciones para deshacer.", vbInformation
Exit Sub
End If
Dim Entry As CUndoRedoEntry
Set Entry = UndoStack(UndoStack.Count)
' Aplica el cambio usando el valor en OldValue
ApplyChange Entry, Entry.OldValue
' Mueve el elemento de UndoStack a RedoStack
RedoStack.Add Entry
UndoStack.Remove UndoStack.Count
End Sub
Public Sub Redo()
' Verifica que haya elementos en RedoStack
If RedoStack.Count = 0 Then
MsgBox "No hay más acciones para rehacer.", vbInformation
Exit Sub
End If
Dim Entry As CUndoRedoEntry
Set Entry = RedoStack(RedoStack.Count)
' Aplica el cambio usando el valor en NewValue
ApplyChange Entry, Entry.NewValue
' Mueve el elemento de RedoStack a UndoStack
UndoStack.Add Entry
RedoStack.Remove RedoStack.Count
End Sub
Private Sub ApplyChange(ByRef Entry As CUndoRedoEntry, ByVal Value As Variant)
Dim ctl As Control 'Object
Dim Frm As Form
For Each Frm In Forms
If Frm.Name = Entry.FormName Then
' Encontrar el control
For Each ctl In Frm.Controls
If ctl.Name = Entry.ControlName Then
' Aplicar el cambio dependiendo del tipo de control
Select Case Entry.ControlType
Case "TextBox"
ctl.Text = Value
Case "VBFlexgrid"
ctl.TextMatrix(Entry.Row, Entry.Col) = Value
End Select
Exit For
End If
Next ctl
Exit For
End If
Next Frm
End Sub
Private Function GetControl(FormName As String, ControlName As String, ControlType As String) As Object
Dim Frm As Form
On Error Resume Next
Set Frm = Forms(FormName)
If Not Frm Is Nothing Then
If ControlType = "TextBox" Then
Set GetControl = Frm.Controls(ControlName)
ElseIf ControlType = "VBFlexgrid" Then
Set GetControl = Frm.Controls(ControlName)
End If
End If
End FunctionUsing it:
In a Form:
Dim it.
Code:
Dim xUndoRedo As UndoRedoManagerCode:
Set xUndoRedo = New UndoRedoManagerVbFlexgrid
vbflexgrid_beforedit:
Code:
vbflexgrid.Tag = vbflexgrid.TextMatrix(Row, Col)Code:
xUndoRedo.AddUndo Me.Name, vbflexgrid.name, vbflexgrid.Tag, vbflexgrid.TextMatrix(Row, Col), "VBFlexgrid", Row, Colin _lostfocus (for example)
Code:
xUndoRedo.AddUndo Me.Name, "Text1", Text1.Tag, Text1.Text, "TextBox"
Text1.Tag = Text1.TextCode:
xUndoRedo.UndoCode:
xUndoRedo.RedoCode:
Private Sub Form_Unload(Cancel As Integer)
Set xUndoRedo = Nothing
End Sub