Menu

[PITBULLCJR]

I know there is the menu editor but what happens if you want to create a menu intirely in code. I have seen it done before but i can't remember where or how can you please help me thanks!!!

Use API.

'code from Megatron

Private 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
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, ByVal lprc As Any) As Long
Const MF_STRING = &H0&
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private hMenu As Long
Private PT As POINTAPI

Private Sub Form_Load()
    hMenu = CreatePopupMenu()
    AppendMenu hMenu, MF_STRING, 0, "New Menu"
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call GetCursorPos(PT)
    If Button = 2 Then
        TrackPopupMenu hMenu, 0, PT.x, PT.y, 0, hwnd, 0&
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    DestroyMenu hMenu
End Sub

You may also want to check http://www.planet-source-code.com .

Use the AppendMenu function.

This will add a SubMenu on top of the previous subMenu.

Private 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
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Const MF_BYPOSITION = &H400&

Private Sub Command1_Click()
    Dim hMenu As Integer
    Dim hSubMenu As Integer
    hMenu = GetMenu(hwnd)
    hSubMenu = GetSubMenu(hMenu, 0)
    AppendMenu hSubMenu, MF_BYPOSITION, 1, "New Item"
End Sub

[Matt McGuire]

do you have a copy of Dan AppleMans win32 api? if so, there is a good size section on just menus, and event how to add icons to them. if you don't have this book, i say get it, it's invaluable.

this will by pass visual basics way to build menus. the code my be a little longer then you might expect but it is worth it. say for instance, you would like to make a popup menu that has icons but not visible on the form, impossible under VB, you see a VB menu is destroyed and recreated every time the visible property gets played with. the win32 api code can be long and cumbersom but it is worth it.

-Matt McGuire
VB6 sp4
Kold Solutions Software

[henrikf]

I have tried this code, but not have had any luck with submenus. The code that should append the submenus does not do anything (GetMenu(hwnd) returns 0 wich I think means that there is no menu...). I get the first items, but not the others.
Is there anyone who knows how to make it work?

This is what I tried to run

Private 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
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, ByVal lprc As Any) As Long
Const MF_STRING = &H0&
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private hMenu As Long
Private PT As POINTAPI

Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Const MF_BYPOSITION = &H400&

Private Sub Form_Load()
    hMenu = CreatePopupMenu()
    AppendMenu hMenu, MF_STRING, 0, "New Menu0"
    AppendMenu hMenu, MF_STRING, 1, "New Menu1"
    AppendMenu hMenu, MF_STRING, 2, "New Menu2"
    
    addSubMenu
End Sub

Private Sub addSubMenu()
    Dim hMenu As Integer
    Dim hSubMenu As Integer
    hMenu = GetMenu(hwnd)
    hSubMenu = GetSubMenu(hMenu, 0)
    AppendMenu hSubMenu, MF_BYPOSITION, 1, "New Item"
End Sub


Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call GetCursorPos(PT)
    If Button = 2 Then
        TrackPopupMenu hMenu, 0, PT.x, PT.y, 0, hwnd, 0&
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    DestroyMenu hMenu
End Sub