Mit dem nachfolgende Tipp stellen wir Ihnen eine universelle Undo/Redo Funktion vor. Die Collection-Klasse nimmt den Datentype Variant auf. Daher kann jeder beliebige Variablentype an die Collection übergeben werden, so z.B. auch Arrays. Die Beschreibungen der Methoden und Eigenschaften entnehmen Sie bitte dem Quellcode. Erstellen Sie ein neues Projekt und legen Sie ein leeres Klassenmodul an. Benennen Sie die Klasse clsUndo. Fügen Sie den nachfolgenden Code in das Klassenmodul ein: ' **************************************************************** ' * ' * clsUndo - VB6 Collection Klasse ' * ' * Universelle Undo/Redo Funktion. Die Collection nimmt den ' * Datentype Variant auf. Daher kann jeder beliebige ' * Variablentype, so z.B. auch Arrays, an die Undo Klasse ' * übergeben werden. ' * ' * Folgende Methoden stehen zur Verfügung: ' * Add : speichert das übergebene Item ' * Undo : liefert das Item(UndoPointer - 1) ' * Redo : liefert das Item(UndoPointer + 1) ' * UndoOut : liefert das letzte Item der Collection. ' * Dabei wird das Item automatisch aus der ' * Collection gelöscht. Der Pointer wird ' * ggf. korrigiert. ' * UndoClear: Löscht die gesamte Undo-Collection ' * ' * Erleuterung: Es wird intern ein Pointer (UndoPointer) ' * auf das aktuelle Item der Collection mitgeführt. ' * ' * Folgende Eigenschaften stehen zur Verfügung: ' * UndoCount: liefert die Anzahl Items aus der Collection ' * UndoItem : liefert das Item(Index) aus der Collection ' * UndoMax : legt die maximale Undo-Tiefe fest. Default 10 ' * Wert 0 = unbegrenzt. ' * ' * September 2004 VB-Power.net www.vb-power.net ' * ' **************************************************************** Option Explicit Private colUndo As Collection Private UndoPointer As Long Private uMax As Long Private Sub Class_Initialize() Set colUndo = New Collection UndoPointer = 0 uMax = 10 End Sub Private Sub Class_Terminate() Set colUndo = Nothing End Sub Public Sub Add(ByVal cItem As Variant) ' speichert das übergebene Item in die Collection If (colUndo.Count < uMax) Or (uMax = 0) Then With colUndo .Add cItem ' Pointer auf letztes Item setzen UndoPointer = .Count End With End If End Sub Public Function Undo() As Variant ' kein Item in der Collection, dann raus. If colUndo.Count <= 0 Then Exit Function ' Pointer verschieben If UndoPointer > 1 Then UndoPointer = UndoPointer - 1 ' Rückgabewert setzen Undo = colUndo.Item(UndoPointer) End Function Public Function Redo() As Variant ' kein Item in der Collection, dann raus. If colUndo.Count <= 0 Then Exit Function ' Pointer verschieben If UndoPointer < colUndo.Count Then UndoPointer = UndoPointer + 1 ' Rückgabewert setzen Redo = colUndo.Item(UndoPointer) End Function Public Sub UndoClear() ' löscht die gesamte Collection Do While colUndo.Count > 0 colUndo.Remove 1 UndoClear Loop End Sub Public Property Get UndoCount() As Long ' liefert die Anzahl Items aus der Collection UndoCount = colUndo.Count End Property Public Property Get UndoItem(ByVal Index As Long) As Variant ' liefert Item(Index) aus der Collection UndoItem = colUndo(Index) End Property Public Property Let UndoMax(ByVal vCount As Long) ' legt die Undo-Tiefe fest uMax = vCount End Property Public Function UndoOut() As Variant ' liefert das letzte Item aus der Collection ' und entfernt es dann. If colUndo.Count > 0 Then With colUndo ' Rückgabewert setzen UndoOut = .Item(.Count) ' und Item löschen. .Remove .Count ' ggf. Pointer anpassen If UndoPointer > .Count Then UndoPointer = .Count End With Else ' Wenn keine Item mehr in der Collection ' ist, dann wird NULL zurückgegeben UndoOut = Null End If End Function Nachfolgend ein Beispiel wie Sie die Klasse nutzen können. Es wird gezeigt, wie die Eingaben in einer Textbox an die Collection übergeben werden. Über den Undo- bzw. Redo Button lassen sich die Eingaben wieder herstellen. Platzieren Sie auf der Form eine TextBox und zwei Command Buttons. Fügen Sie den nachfolgenden Code in das Codefenster der Form ein: Option Explicit ' Verweis auf die Klasse clsUndo Private MyUndoBox As clsUndo Private Sub Form_Load() ' clsUndo Klasse instanzieren Set MyUndoBox = New clsUndo ' Max. Undo-Tiefe auf 20 setzen MyUndoBox.UndoMax = 20 Text1.Text = "" Command1.Caption = "Undo" Command2.Caption = "Redo" End Sub Private Sub Text1_KeyPress(KeyAscii As Integer) ' Enter-Taste gedrückt? If KeyAscii = 13 Then ' Den Text aus der Textbox ' an die Collection übergeben MyUndoBox.Add Text1.Text Text1.Text = "" KeyAscii = 0 End If End Sub Private Sub Command1_Click() ' Undo-Item an die Textbox zurückgeben Text1.Text = MyUndoBox.Undo End Sub Private Sub Command2_Click() ' Redo-Item an die Textbox zurückgeben Text1.Text = MyUndoBox.Redo End Sub Nutzen Sie die Klasse auch z.B. um beliebige Berechnungen kurzfristig zwischenzuspeichern. Damit ersparen Sie sich eine oder mehrere Kopien der Berechnungen in verschiedene Hilfsvariablen oder dynamischen Arrays abzulegen Die Möglichkeiten dieser Klasse sind vielfältig. Dieser Tipp wurde bereits 17.498 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats Juni 2024 Microsys Kramer Mausrad im Formular abschalten (Access) Deaktiviert das Mausrad in Access-Formularen. Neu! sevCommand 4.0 Professionelle Schaltflächen im modernen Design! Mit nur wenigen Mausklicks statten auch Sie Ihre Anwendungen ab sofort mit grafischen Schaltflächen im modernen Look & Feel aus (WinXP, Office, Vista oder auch Windows 8), inkl. große Symbolbibliothek. |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |