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.394 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. |
sevZIP40 Pro DLL Zippen und Unzippen wie die Profis! Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. TOP Entwickler-Paket TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
||||||||||||||||
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. |