Untermenüs über Programmierung dynamisch einfügen

Kraah

Mitglied
Hab momentan das Problem, das ich ein kleines TrayProgramm baue, welches eine dynamische Anzahl von Untermenüs haben soll.
Habe es bis jetzt nur geschafft weitere Hauptmenüpunkte einzufügen.
Siehe hier:
Beispiel und momentanes Resultat
Alles soll in diesem Fall unter Test eingefügt werden können, damit ich später ein solches Ergeniss erreiche wie es das Testmenü zeigt.

Edit:
Habe es jetzt erstmal soweit geschafft, das ich Menüpunte unter dem Hauptmenüpunkt einfügen kann.
Hatte vergessen das ich für Load einen vorgefertigten Untermenüpunkt als Anker brauche.
Menü mit dynamischen Einträgen | Menü ohne Einträge
Nur kann ich für die dynamischen Untermenüs ja keinen vorgefertigten Untereintrag haben und hab auch leider nichts im Netz gefunden.

Edit #2:
Hab's gelöst. Musste doch den Weg gehen, was neues zu lernen und hab die APi-Call Methode gewählt ... blieb ja auch nichts anderes übrig.
Wer mehr dazu wissen möchte: Ex-Desingz - 20 Menu APi Funktionen

Ansonsten hier mein AlphaCode, für alle die es interessiert (unoptimiert da ich noch den optimalen Weg suche, aber er funktioniert erstmal):

Modul:
Code:
Dim Hauptindex As Integer
Dim Subindex As Integer
Dim SpielPfad As String
Dim SpielName As String
Dim Exist As String

Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CreateMenu Lib "user32" () As Long
Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Public Declare Function SetMenu Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function CreatePopupMenu Lib "user32" () As Long
Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Declare Function SetMenuDefaultItem Lib "user32" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPos As Long) As Long
Public Declare Function GetMenuDefaultItem Lib "user32" (ByVal hMenu As Long, ByVal fByPos As Long, ByVal gmdiFlags As Long) As Long
Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long

Public Const MF_ENABLED = &H0&
Public Const MF_POPUP = &H10&
Public Const MF_SEPARATOR = &H800&
Public Const MF_STRING = &H0&
Public Const WM_MENUSELECT = &H11F
Public Const WM_WINDOWPOSCHANGING = &H46
Private Const WM_NCPAINT = &H85
Public Const GWL_WNDPROC = (-4)
Public lPrevWnd As Long
Public hSysMenu As Long
Public hMainMenu As Long
Public frm As Object
Private NichtAbarbeiten As Boolean

Public Sub ErstelleMenue(f As Object)
    Dim hPopupMenu As Long, hPopupSubMenu As Long
    Dim lRes As Long
    Set frm = f
    Hauptindex = 1
    Subindex = 0
    
    hMainMenu = CreateMenu
    hPopupMenu = CreatePopupMenu
    
    Exist = Dir(App.Path & "\MOFO3.LST")
    If Exist = "" Then
        'Registrierung einlesen um eine neue MOFO3.LST zu erstellen
        MsgBox App.Path & "\MOFO3.LST nicht gefunden."
    Else
        Open App.Path & "\MOFO3.LST" For Input As #1
            Do Until EOF(1)
                Input #1, SpielPfad, SpielName
                hPopupSubMenu = CreatePopupMenu
                lRes = AppendMenu(hPopupMenu, MF_POPUP Or MF_STRING, hPopupSubMenu, ByVal Hauptindex & ". " & SpielName)
                Hauptindex = Hauptindex + 1
                Exist = Dir(SpielPfad & "\FallOutLauncher.EXE")
                If Not Exist = "" Then
                    lRes = AppendMenu(hPopupSubMenu, MF_STRING, Hauptindex, ByVal Hauptindex & ". Launcher")
                    Hauptindex = Hauptindex + 1
                    Subindex = Subindex + 1
                End If
                Exist = Dir(SpielPfad & "\FallOut3.EXE")
                If Not Exist = "" Then
                    lRes = AppendMenu(hPopupSubMenu, MF_STRING, Hauptindex, ByVal Hauptindex & ". Spiel")
                    Hauptindex = Hauptindex + 1
                    Subindex = Subindex + 1
                Else
                    Exist = Dir(SpielPfad & "\FallOut3NG.EXE")
                    If Not Exist = "" Then
                        lRes = AppendMenu(hPopupSubMenu, MF_STRING, Hauptindex, ByVal Hauptindex & ". Spiel")
                        Hauptindex = Hauptindex + 1
                        Subindex = Subindex + 1
                    End If
                End If
                lRes = AppendMenu(hPopupSubMenu, MF_SEPARATOR, 0, "-")
                lRes = AppendMenu(hPopupSubMenu, MF_STRING, Hauptindex, ByVal Hauptindex & ". " & SpielPfad)
                Hauptindex = Hauptindex + 1
                Subindex = Subindex + 1
            Loop
        Close #1
        lRes = AppendMenu(hPopupMenu, MF_SEPARATOR, 0, "-")
    End If

    lRes = AppendMenu(hPopupMenu, MF_STRING, Hauptindex, ByVal Hauptindex & ". M.O.FO3 verwalten")
    Hauptindex = Hauptindex + 1
    lRes = AppendMenu(hPopupMenu, MF_SEPARATOR, 0, "-")
    lRes = AppendMenu(hPopupMenu, MF_STRING, Hauptindex, ByVal Hauptindex & ". Hilfe")
    Hauptindex = Hauptindex + 1
    lRes = AppendMenu(hPopupMenu, MF_STRING, Hauptindex, ByVal Hauptindex & ". über...")
    Hauptindex = Hauptindex + 1
    lRes = AppendMenu(hPopupMenu, MF_STRING, Hauptindex, ByVal Hauptindex & ". beenden")
    Hauptindex = Hauptindex + 1
    lRes = SetMenuDefaultItem(hPopupMenu, Hauptindex - 4, False)
        
    lRes = AppendMenu(hMainMenu, MF_STRING Or MF_POPUP, hPopupMenu, ByVal "M.O.FO3 Menü (" & Subindex & ")")

    lRes = SetMenu(frm.hwnd, hMainMenu)
    lRes = DrawMenuBar(frm.hwnd)
End Sub

Public Function SubClassedForm(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Static lLastItemSelected As Long

    If NichtAbarbeiten = True Then GoTo lblLast

    If Msg = &H105A Then
        Call SetMenu(frm.hwnd, hMainMenu)
        Call DrawMenuBar(frm.hwnd)
    ElseIf Msg = WM_WINDOWPOSCHANGING Then
        NichtAbarbeiten = True
        If GetMenu(frm.hwnd) <> hwnd Then
            SetMenu frm.hwnd, hMainMenu
        DrawMenuBar frm.hwnd
        End If
        NichtAbarbeiten = False
    ElseIf Msg = WM_MENUSELECT And lParam <> hSysMenu Then
        If lParam Then
            lLastItemSelected = wParam And 255
            Call MenuEvent(lLastItemSelected, 1)
    Else
            Call MenuEvent(lLastItemSelected, 2)
            lLastItemSelected = 0
        End If
    End If
lblLast:
  SubClassedForm = CallWindowProc(lPrevWnd, hwnd, Msg, wParam, lParam)
End Function

Public Sub MenuEvent(ByVal MenuItem As Long, Optional EventType As Integer = 1)
    'Hier arbeite ich noch dran, aber ein einfacher Weg führt über eine Textdatei die zur Zeit der Menüerstellung geschrieben wird
    Select Case MenuItem
        Case 9
            strMsg = "verwalten"
        Case 12
            strMsg = "beenden" & EventDesc
            If EventType = 2 Then Unload frm
        Case Else
            Exit Sub
    End Select

    If GetMenuDefaultItem(GetSubMenu(hMainMenu, 0), 0&, 0&) = MenuItem Then
        strMsg = strMsg & " (Standartmenüeintrag)"
    End If

    If EventType = 2 Then
        MsgBox strMsg
    End If
End Sub

Form1:
Code:
Private Sub Form_Activate()
  If hMainMenu = 0 Then
    hSysMenu = GetSystemMenu(hwnd, 0)
    lPrevWnd = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf SubClassedForm)

    Dim f As Object
    Set f = Form1

    ErstelleMenue f
  End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Call SetWindowLong(hwnd, GWL_WNDPROC, lPrevWnd)
End Sub

Private Sub Timer1_Timer()
    'Wenn die Form den Fokus verliert, verschwindet das Menü leider, sodaß ich erstmal einen Timer mit einem Wert von 64 nutze um Sie wieder zu zeichnen
    If GetMenu(Form1.hwnd) < hwnd Then
        Dim lRes As Long
        lRes = SetMenu(Form1.hwnd, hMainMenu)
        lRes = DrawMenuBar(Form1.hwnd)
    End If
End Sub

MOFO3.LST:
Code:
"G:\Morrowind", "TES III: Morrowind"
"G:\Oblivion", "TES IV: Oblivion"
"G:\FallOut 3 Original", "FallOut 3 ungemoddet"
"G:\FallOut 3 Modded", "FallOut 3 gemoddet"

Später werden die Programme über ihren Registrierungseintrag erfasst oder über die Programmeigene Liste, falls Sie über die Verwaltung hinzugefügt wurden.
 
Zuletzt bearbeitet:

Neue Beiträge

Zurück