Das Menü-System der Forms, UserControls usw. in Visual Basic
bietet leider keine hierarchische Struktur. Alle Menü-Elemente sind
als gleichberechtigte Steuerelemente neben allen anderen
Steuerelementen in der Controls-Collection enthalten. Sie bieten von
einem gegebenen Menü-Element ausgehend selbst keinerlei
Möglichkeit, über- oder untergeordnete Menü-Elemente zu ermitteln
oder die gesamte Struktur in irgend einer Weise zu durchlaufen.
Ein klein wenig Disziplin bei der Namensgebung der
Menü-Steuerelemente vorausgesetzt, lässt sich dennoch eine
hierarchische Struktur erstellen. Dies geht mittels einer
Hilfsklasse, die sowohl die Menü-Elemente aufnimmt als auch die
notwendige Funktionalität zur Verwaltung der Struktur bietet. Diese
Klasse clsMenuItem bildet einerseits einen Knoten in der Struktur
und andererseits zugleich ein Collection-Objekt zur Verwaltung der
Unterelemente, die selbst wieder vom gleichen Typ sind.
Das Prinzip beruht darauf, dass Sie Ihre gewohnten Menü-Namen
(Namen der Steuerelemente, nicht die Captions) um einen Schlüssel
erweitern, der durch ein Trennzeichen vom ansonsten weiterhin
beliebig wählbaren Namen trennt. Standardmäßig habe ich das
Paragraphen-Zeichen "§" vorgesehen - es ist markant und
wird von Visual Basic anstandslos als Namensbestandteil akzeptiert.
Sie können aber auch jedes andere erlaubte Zeichen wählen.
Der Schlüssel besteht aus einer einfachen Zeichenfolge, bei der
jedes Zeichen eine Ebene der Struktur darstellt, zum Beispiel: "A",
"AA", "AB", "ABA",
"B", "BA", "BAA",
"BAB" usw. Das erste Zeichen repräsentiert
die oberste Ebene, also die Menü-Steuerelemente der Menüleiste.
Die Elemente eines Datei-Menüs einer Anwendung, in der Regel das
erste Menü, könnten beispielsweise wie folgt bezeichnet werden:
mnuDatei§A
mnuDateiNeu§AA
mnuDateiOeffnen§AB
mnuDateiSpeichern§AC
mnuDateiImportieren§AD
mnuDateiImportierenExcel§ADA
mnuDateiImportierenAccess§ADB
mnuDrucken§AE
...
Um etwa ein oder mehrere Popup-Menü(s), dessen bzw.
deren Elemente ja auch in der gleichen Controls-Collection enthalten
sind, aus der Hierarchie herauszunehmen und gegebenenfalls in einer
eigenen Hierarchie zu verwalten, wählen Sie bei diesen einfach ein
anderes Trennzeichen. Im Prinzip können Sie sogar die Menüs
verschiedener Container (etwa Form und von darauf platzierten
UserControls) mischen, solange Sie ein einheitliches Trennzeichen
verwenden und gewährleisten, dass die Schlüssel eindeutig sind.
Zwei Einschränkungen dieser (ersten) Version der
Menü-Hierarchie gibt es allerdings. Sie können als Control-Array
angelegte Menü-Steuerelemente nur eingeschränkt verwenden. Die in
die Hierarchie integrierte Ereignisverwaltung funktioniert nicht, da
ein Control-Array-Element nicht einer Ereignisempfänger-Variablen
zugewiesen werden kann. Die zweite Einschränkung ist, dass Sie die
Struktur nur einlesen können, aber keine Elemente daraus entfernen
können. In Anbetracht der Einschränkung bei als Control-Array
angelegten Menü-Steuerelementen würden dynamische Änderungen der
Hierarchie nicht sonderlich sinnvoll sein.
Die Klasse clsMenuItem verfügt als Repräsentant eines
Menü-Elements über die Eigenschaften Menu, LevelKey, HasSubItems,
Parent, IsRoot, ID und TagVariant. Die Eigenschaft Menu das von
einer clsMenuItem-Instanz repräsentierte Menü-Steuerelement
zurück. LevelKey liefert dessen Namensbestandteil hinter dem
Trennzeichen. HasSubItems informiert Sie darüber, ob es
Unterelemente gibt. Und Parent gibt das in der Hierarchie darüber
liegende Element zurück. Da das oberste Element keinen Parent hat,
und damit Sie die umständlichere Prüfung mit "Is
Nothing" sparen, meldet nur das oberste Element, das
WurzelElement, in IsRoot den Wert True. ID ist eine
für die Funktionalität nicht benötigte Zusatzeigenschaft, in der
Sie einen eigenen, beliebigen Schlüssel ablegen können. Diesen
Schlüssel können Sie dazu verwenden, in den beim Wurzelelement
auflaufenden Click-Ereignissen (mehr dazu weiter unten) das feuernde
Menü-Element zu identifizieren. Schließlich gibt es noch die
TagVariant-Eigenschaft. Dies ist eine Erweiterung der
Tag-Eigenschaft, die tatsächlich jeden beliebigen Variant-Inhalt
annehmen kann, also auch Objekte.
Als Collection verfügt die Klasse clsMenuItem über die
Eigenschaften Count und SubItem. Count liefert wie üblich die
Anzahl der Unterelemente. Über die Eigenschaft SubItem greifen Sie
zum einen anhand eines LevelKey-Schlüssels auf eines der
Unterlemente zu. Zum anderen können Sie aber auch jeden beliebigen
Schlüssel (LevelKey) eines Menüelements nehmen (oder den Namen
eines Menü-Steuerelements) und dazu angeben, ob das Element auch
innerhalb des gleichen Astes oder innerhalb der gesamten Struktur
gesucht werden soll.
Die Methoden der Klasse sind Add, Init und Destroy. Dazu kommt
noch die Funktion NewEnum, die es erlaubt, mittels einer
For...Each-Schleife alle Unterelemente der jeweiligen Instanz zu
durchlaufen. Die Add-Methode rufen Sie nur beim Wurzelelement der
Hierarchie auf, das Sie auch nur als einziges instanzieren, am
besten im Form_Load-Ereignis. Die Init-Methode wird nur intern von
der Add-Methode aufgerufen - Sie selbst sollten sie nicht aufrufen.
Die Destroy-Methode rufen Sie ebenfalls nur beim Wurzelelement auf,
am besten im Form_Unload-Ereignis.
Wenn Sie wollen, können Sie die Click-Ereignisse der
Menü-Steuerelemente wie gewohnt in den üblichen Ereignisprozeduren
bearbeiten. Da Sie aber von der Add-Methode des Wurzelelements die
jeweils für ein Menü-Steuerelement in die Hierarchie eingefügte
Klassen-Instanz zurückbekommen, können Sie diese auch einer
Ereignisempfänger-Variablen (mit "WithEvents" deklariert)
an beliebiger Stelle in Ihrem Projekt zuweisen und so die
Click-Ereignisse dieser einen Instanz in passendem Kontext
bearbeiten. Sie können aber auch die Variable, der Sie das
Wurzelelement zuweisen, als Ereignisempfänger deklarieren und die
Click-Ereignisse aller Menü-Steuerelemente zentral in einer
einzigen Ereignisprozedur (SubItemClick) auflaufen lassen - sie
werden von jedem Element aufwärts weiter gereicht (so genanntes
"Event-Bubbling"). Und als letztes besteht ebenfalls noch
Möglichkeit, einen solchen Sammelpunkt für jeden beliebigen Knoten
der Hierarchie zu installieren. Sowohl bei den Click-Ereignissen als
auch bei den SubItemClick-Ereignissen können Sie im Parameter Done
den Wert True zurückgeben - das Ereignis wird dann nicht weiter
aufwärts weiter gereicht, sondern als erledigt betrachtet.
Private WithEvents eMenu As Menu
Private mSubItems As Collection
Public Enum MenuItemIDSourceConstants
midsUser
midsName
midsTag
End Enum
Public Enum MenuItemSearchConstants
misNone
misBelow
misTree
End Enum
Public Event Click(Done As Boolean)
Public Event SubItemClick(SubItem As clsMenuItem, Done As Boolean)
Private pID As Variant
Private pLevelKey As String
Private pMenu As Menu
Private pParent As clsMenuItem
Private pSeparator As String
Private pTagVariant As Variant
Public Property Get Count() As Long
Count = mSubItems.Count
End Property
Public Property Get HasSubItems() As Boolean
HasSubItems = CBool(mSubItems.Count)
End Property
Public Property Get ID() As Variant
If IsObject(pID) Then
Set ID = pID
Else
ID = pID
End If
End Property
Public Property Let ID(New_ID As Variant)
zSetID New_ID
End Property
Public Property Set ID(New_ID As Variant)
zSetID New_ID
End Property
Private Sub zSetID(New_ID As Variant)
If IsObject(New_ID) Then
Set pID = New_ID
Else
pID = New_ID
End If
End Sub
Public Property Get IsRoot() As Boolean
IsRoot = CBool(pMenu Is Nothing)
End Property
Public Property Get LevelKey() As String
LevelKey = pLevelKey
End Property
Public Property Get Menu() As Menu
Set Menu = pMenu
End Property
Public Property Get Parent() As clsMenuItem
Set Parent = pParent
End Property
Public Property Get SubItem(LevelKey As String, _
Optional Search As MenuItemSearchConstants) As clsMenuItem
Dim nSubItem As clsMenuItem
Dim nCompareLevelKey As String
Dim nLevelKey As String
Dim nPos As Integer
nPos = InStr(LevelKey, pSeparator)
If nPos Then
nLevelKey = Mid$(LevelKey, nPos + 1)
Else
nLevelKey = LevelKey
End If
If Search Then
If Len(pLevelKey) = 0 Then
If Len(nLevelKey) = 1 Then
On Error Resume Next
Set SubItem = mSubItems(nLevelKey)
Else
On Error Resume Next
Set nSubItem = mSubItems(Left$(nLevelKey, 1))
On Error GoTo 0
If Not (nSubItem Is Nothing) Then
Set SubItem = nSubItem.SubItem(nLevelKey, Search)
End If
End If
ElseIf Len(nLevelKey) = 1 Then
On Error Resume Next
Set SubItem = mSubItems(pLevelKey & nLevelKey)
ElseIf Left$(nLevelKey, Len(pLevelKey)) = pLevelKey Then
If Len(nLevelKey) = Len(pLevelKey) + 1 Then
On Error Resume Next
Set SubItem = mSubItems(nLevelKey)
Else
On Error Resume Next
Set nSubItem = mSubItems(Left$(nLevelKey, Len(pLevelKey) + 1))
On Error GoTo 0
If Not (nSubItem Is Nothing) Then
Set SubItem = nSubItem.SubItem(nLevelKey, Search)
End If
End If
ElseIf Search = misTree Then
Set SubItem = pParent.SubItem(nLevelKey, Search)
End If
Else
On Error Resume Next
Set SubItem = mSubItems(nLevelKey)
End If
End Property
Public Property Get TagVariant() As Variant
If IsObject(pTagVariant) Then
Set TagVariant = pTagVariant
Else
TagVariant = pTagVariant
End If
End Property
Public Property Let TagVariant(New_TagVariant As Variant)
If IsObject(New_TagVariant) Then
Set pTagVariant = New_TagVariant
Else
pTagVariant = New_TagVariant
End If
End Property
Public Property Set TagVariant(New_TagVariant As Object)
Set pTagVariant = New_TagVariant
End Property
Public Function Add(SubMenu As Menu, Optional ID As Variant, _
Optional TagVariant As Variant, _
Optional Separator As String = "§", _
Optional IDSource As MenuItemIDSourceConstants) As clsMenuItem
Dim nSubItem As clsMenuItem
Dim nName As String
Dim nLevelKey As String
Dim nSubItems As clsMenuItem
Dim nPos As Integer
If Len(Separator) = 0 Then
Exit Sub
End If
pSeparator = Left$(Separator, 1)
nName = SubMenu.Name
nPos = InStr(nName, pSeparator) + 1
If nPos Then
nLevelKey = Mid$(nName, nPos)
If Left$(nLevelKey, Len(nLevelKey) - 1) = pLevelKey Then
Set nSubItem = New clsMenuItem
nSubItem.Init SubMenu, nLevelKey, Me, ID, TagVariant, _
pSeparator, IDSource
mSubItems.Add nSubItem, nLevelKey
Set Add = nSubItem
Else
nLevelKey = Left$(nLevelKey, Len(pLevelKey) + 1)
On Error Resume Next
Set nSubItems = mSubItems(nLevelKey)
On Error GoTo 0
If Not (nSubItems Is Nothing) Then
Set Add = nSubItems.Add(SubMenu, ID, TagVariant, _
pSeparator, IDSource)
End If
End If
End If
End Function
Public Function NewEnum() As stdole.IUnknown
Set NewEnum = mSubItems.[_NewEnum]
End Function
Public Sub SubItemClick(SubItem As clsMenuItem, Done As Boolean)
RaiseEvent SubItemClick(SubItem, Done)
If Not (pParent Is Nothing) Then
If Not Done Then
pParent.SubItemClick SubItem, Done
End If
End If
End Sub
Public Sub Init(Menu As Menu, LevelKey As String, _
Parent As clsMenuItem, Optional ID As Variant, _
Optional TagVariant As Variant, Optional Separator As String, _
Optional IDSource As MenuItemIDSourceConstants)
Dim nName As String
Set pMenu = Menu
nName = pMenu.Name
On Error Resume Next
Set eMenu = pMenu
On Error GoTo 0
Set pParent = Parent
Select Case IDSource
Case midsUser
pID = ID
Case midsName
pID = nName
Case midsTag
pID = pMenu.Tag
End Select
Me.TagVariant = TagVariant
pSeparator = Separator
pLevelKey = LevelKey
End Sub
Public Sub Destroy()
zDestroy
End Sub
Private Sub eMenu_Click()
Dim nDone As Boolean
RaiseEvent Click(nDone)
If Not nDone Then
pParent.SubItemClick Me, nDone
End If
End Sub
Private Sub Class_Initialize()
Set mSubItems = New Collection
End Sub
Private Sub Class_Terminate()
zDestroy
End Sub
Private Sub zDestroy()
Dim nSubItem As clsMenuItem
If Not (mSubItems Is Nothing) Then
For Each nSubItem In mSubItems
nSubItem.Destroy
Next
End If
Set mSubItems = Nothing
Set pParent = Nothing
Set pMenu = Nothing
Set eMenu = Nothing
Set Me.TagVariant = Nothing
End Sub
|