Mit in Klassen verpackten Collections
können Sie leicht einfache Speicher- und Ablage-Konzepte
realisieren. Eines der schlichtesten Konzepte dieser Art ist ein so
genannter Stack, ein Stapelspeicher. Das Prinzip kennen Sie mit
Sicherheit von Ihrem Eingangsstapel für Zeitschriften: Die neu
eintreffenden, aktuellen Exemplare landen obenauf. Und wenn Sie Zeit
zum Lesen finden, nehmen Sie die Zeitschriften von oben weg, in der
(meist trügerischen) Hoffnung, sich irgendwann einmal bis zum
ältesten Heft durchgekämpft zu haben... (das ist der Vorteil von
Online-Magazinen wie diesem: sie lassen sich nicht so leicht
stapeln!) Ein ähnliches Konzept finden Sie unter "Speicher-Schlangen".
Mit einer Collection realisieren Sie einen solchen Stapel, indem
Sie einfach neue Elemente ans Ende hinzufügen - und auch nur wieder
vom Ende her entnehmen:
MeineCollection.Add Item
und
Item = MeineCollection(MeineCollection.Count)
MeineCollection.Remove MeineCollection.Count
Haben Sie Objekt-Referenzen auf dem Stapel abgelegt, müssen Sie
beim Entnehmen noch unterscheiden:
If IsObject(MeineCollection(MeineCollection.Count)) Then
Set Item = MeineCollection(MeineCollection.Count)
Else
Item = MeineCollection(MeineCollection.Count)
End If
MeineCollection.Remove MeineCollection.Count
Sie kennen aus der Assembler-Programmierung (oder sonst woher)
die Befehle "Push" (ablegen) und "Pop"
(entnehmen) für derartige Stacks und Sie vermissen diese
eingängigen Befehle in Visual Basic? Das muss nicht länger sein -
verpacken Sie eine Collection in eine Klasse mit Methoden, denen Sie
diese Namen geben.
Und - wenn schon, denn schon: Auf die Information, wie
"hoch" der Stapel ist (Eigenschaft Count) brauchen Sie
nach wie vor genau so wenig zu verzichten, wie auf die Möglichkeit,
den Inhalt eines beliebigen abgelegten Elements zu erfragen
(Eigenschaft Item). Dazu noch eine Methode, die das
Collection-Objekt sowieso vermissen lässt, nämlich mit einem
simplen Clear den ganzen Stapel auf einen Schlag ins (Daten-)Nirwana
zu befördern.
Die Methode Pop zum Entnehmen des obersten Elements des Stapels
ist übrigens nicht als Funktion ausgeführt, wie Sie vielleicht
erwartet hätten. Wäre sie als Funktion ausgeführt, die das
entnommene Element als Rückgabewert übergibt, könnten Sie beim
Aufruf nicht feststellen, ob Ihnen gerade ein Objekt zurückgegeben
wird. Da Ihnen das Element jedoch als Rückgabe-Parameter übergeben
wird, können Sie erst mit IsObject prüfen, ob es sich um ein
Objekt handelt.
Private mItems As Collection
Public Enum StackErrorConstants
stErrUnknown = vbObjectError + 10000
stErrInvalidKeyIndex = vbObjectError + 10001
stErrKeyExists = vbObjectError + 10002
stErrStackIsEmpty = vbObjectError + 10003
End Enum
Public Property Get Count() As Long
Count = mItems.Count
End Property
Public Property Get Item(KeyIndex As Variant)
Const ProcName = "cStack.Item"
On Error GoTo Item_Error
If IsObject(mItems(KeyIndex)) Then
Set Item = mItems(KeyIndex)
Else
Item = mItems(KeyIndex)
End If
Exit Property
Item_Error:
If Err.Number = 5 Then
Err.Raise stErrInvalidKeyIndex, ProcName
Else
Err.Raise stErrUnknown, ProcName
End If
End Property
Public Sub Clear()
Set mItems = New Collection
End Sub
Public Sub Push(Item As Variant, Optional Key As String)
Const ProcName = "cStack.Push"
On Error Resume Next
If StrPtr(Key) = 0 Then
mItems.Add Item
Else
mItems.Add Item, Key
End If
Select Case Err.Number
Case 0
Case 457
On Error GoTo 0
Err.Raise stErrKeyExists, ProcName
Case Else
On Error GoTo 0
Err.Raise stErrUnknown, ProcName
End Select
End Sub
Public Sub Pop(Item As Variant)
Const ProcName = "cStack.Pop"
With mItems
If .Count Then
On Error GoTo Pop_Error
If IsObject(mItems(.Count)) Then
Set Item = mItems(.Count)
Else
Item = mItems(.Count)
End If
.Remove .Count
Else
Err.Raise stErrStackIsEmpty, ProcName
End If
End With
Exit Sub
Pop_Error:
If Err.Number = 5 Then
Err.Raise stErrInvalidKeyIndex, ProcName
Else
Err.Raise stErrUnknown, ProcName
End If
End Sub
Public Function NewEnum() As IUnknown
Set NewEnum = mItems.[_NewEnum]
End Function
Private Sub Class_Initialize()
Set mItems = New Collection
End Sub
Private Sub Class_Terminate()
Set mItems = Nothing
End Sub

|