Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0742: Ein MenuHandler mit OOP

VB 5/6-Tipp 0742: Ein MenuHandler mit OOP

 von Oliver Meyer

Schwierigkeitsgrad:

Verwendete API-Aufrufe: keine

Download: Download des Beispielprojektes [3,59 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Textfeld "Text1"
' Steuerelement: Schaltfläche "BtnRemoveMenuItem"
' Steuerelement: Schaltfläche "BtnAddMenuItem"
' Steuerelement: Menü "mnuFile"
' Steuerelement: Menü "mnuNew" auf mnuFile
' Steuerelement: Menü "mnuSep1" auf mnuFile
' Steuerelement: Menü "mnuErweiterbar00" auf mnuFile
' Steuerelement: Menü "mnuErweiterbar01" auf mnuFile
' Steuerelement: Menü "mnuErweiterbar02" auf mnuFile
' Steuerelement: Menü "mnuErweiterbar03" auf mnuFile
' Steuerelement: Menü "mnuErweiterbar04" auf mnuFile
' Steuerelement: Menü "mnuErweiterbar05" auf mnuFile
' Steuerelement: Menü "mnuErweiterbar06" auf mnuFile
' Steuerelement: Menü "mnuErweiterbar07" auf mnuFile
' Steuerelement: Menü "mnuErweiterbar08" auf mnuFile
' Steuerelement: Menü "mnuErweiterbar09" auf mnuFile
Option Explicit
Private WithEvents mMenuHandler As MyMenuHandler
Private Const MaxErweiterbar As Long = 9

Private Sub Form_Load()
    Set mMenuHandler = New MyMenuHandler
End Sub

Private Sub BtnAddMenuItem_Click()
    If mMenuHandler.Count <= MaxErweiterbar Then
        Dim m As MyMenuItem
        Set m = mMenuHandler.Add(GetNextMenuItem)
        If Len(Text1.Text) Then
            m.Menu.Caption = Text1.Text
        End If
    End If
End Sub
Private Function GetNextMenuItem() As Menu
    Set GetNextMenuItem = _
        Me.Controls("mnuErweiterbar0" & mMenuHandler.Count)
End Function
Private Sub BtnRemoveMenuItem_Click()
    Call mMenuHandler.RemoveLastMenuItem
End Sub

Private Sub mMenuHandler_Click(aMenuItem As MyMenuItem)
   MsgBox aMenuItem.ToString
End Sub

Private Sub mnuNew_Click()
  MsgBox "FileNew"
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'----- Anfang Klasse "MyMenuItem" alias MyMenuItem.cls  -----
Option Explicit
Private mHandler As MyMenuHandler
Private WithEvents mMenuItem As Menu
Private mIndex As Long

Public Sub NewC(aHandler As MyMenuHandler, _
                aMenu As Menu, _
                ByVal aIndex As Long)
    Set mHandler = aHandler
    Set mMenuItem = aMenu
    mIndex = aIndex
    mMenuItem.Visible = True
End Sub

Private Sub mMenuItem_Click()
    Call mHandler.ItemClick(Me)
End Sub
Public Property Get Menu() As Menu
    Set Menu = mMenuItem
End Property

Public Function ToString() As String
    ToString = "MyMenuHandler::mMenuItem_Click " & CStr(mIndex) & vbCrLf & _
                mMenuItem.Name & "  " & mMenuItem.Caption
End Function

'------ Ende Klasse "MyMenuItem" alias MyMenuItem.cls  ------
'--- Anfang Klasse "MyMenuHandler" alias MyMenuHandler.cls  ---
Option Explicit
Private mCol As Collection 'speichert MyMenuItem-Objekte
Public Event Click(aMenuItem As MyMenuItem)

Private Sub Class_Initialize()
    Call Clear
End Sub
Public Sub Clear()
    Set mCol = New Collection
End Sub

Public Function Add(aMenu As Menu) As MyMenuItem
    Set Add = New_MyMenuItem(Me, aMenu, Count + 1)
    Call mCol.Add(Add)
End Function
Public Sub RemoveLastMenuItem()
    Dim i As Long
    Dim m As MyMenuItem
    i = mCol.Count
    If i > 0 Then
        Set m = MyMenuItems(i)
        m.Menu.Visible = False
        Call mCol.Remove(i)
    End If
End Sub
Public Property Get Count() As Long
    Count = mCol.Count
End Property

Friend Sub ItemClick(aMenuItem As MyMenuItem)
    RaiseEvent Click(aMenuItem)
End Sub

Public Property Get MyMenuItems(ByVal Index As Long) As MyMenuItem
    Set MyMenuItems = mCol.Item(Index)
End Property

Public Property Get Menu(ByVal Index As Long) As Menu
    Set Menu = MyMenuItems(Index).Menu
End Property

'--- Ende Klasse "MyMenuHandler" alias MyMenuHandler.cls  ---
'--- Anfang Modul "ModConstructors" alias ModConstructors.bas ---
Option Explicit

Public Function New_MyMenuItem(aHandler As MyMenuHandler, _
                               aMenu As Menu, _
                               ByVal aIndex As Long) As MyMenuItem
  Set New_MyMenuItem = New MyMenuItem
  Call New_MyMenuItem.NewC(aHandler, aMenu, aIndex)
End Function
'--- Ende Modul "ModConstructors" alias ModConstructors.bas ---
'-------------- Ende Projektdatei Projekt1.vbp --------------