Binaryworld - How to create MenuBar, Submenu and MenuItem with events at runtime usi ... [ VB -> Menu ]

This article give you basic guideline about creating menu at runtime. I will also explain how to subclass Mouse Move and Mouse Click events of created items.

Creating Menubar

MenuBar is the main menu of your form. Any window can have only one menubar. You can use CreateMenu API to create main menu of your form. Then you can add popup menus, items, subitems to this main menu. To assign MainMenu to a form you can call SetMenu API which attach menu with your form.

Creating Submenu/Popupmenu

MainMenu can have one or morethan one popup menu (e.g. File, Edit, Help....). And each popup menu can have one or more than one menuitems and submenus. To create popup menu submenu or submenu you can use CreatePopupMenu API and then you can attach Popupmenu to parent menu using AppendMenu or InsertMenu API by specifying MF_POPUP flag. AppendMenu and InsertMenu both add new menu or menu item the only difference is InsertMenu can add menu at specified position and AppendMenu appends new item at the end of the parent menu.

Creating Menu Items

After you create submenu or popup menu you can add menuitems to them. You can call AppendMenu or InsertMenu.

Capturing Menu Events

Mostly we need to capture menu item click event but sometimes mouse move event can be helpful too. To capture API menu events you have to hook windows messages. You can look for WM_MENUSELECT message which contains all information you need to trap MouseMove or MouseClick event of menu. Check MSDN for more information.

Step-By-Step Example

- Create a standard exe project
- Add one module to the project
- Place one command button on the form1
- Add the following code to form1

Form1.frm

Click here to copy the following block

Private Sub Command1_Click()
  If hMainMenu = 0 Then
    hSysMenu = GetSystemMenu(hwnd, 0)
    lPrevWnd = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf SubClassedForm)

    Dim f As Object
    Set f = Form1

    CreateTestMenuBar f
  End If
End Sub

Private Sub Form_Load()
  '//Note don't put Menu creation code here, put it in Form_Activate event

  Command1.Caption = "Create MenuBar"
End Sub

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

- Add the following code to Module1

Module1.bas

Click here to copy the following block

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 InsertMenu Lib "user32" Alias "InsertMenuA" ( _
    ByVal hMenu As Long, _
    ByVal nPosition As Long, _
    ByVal wFlags As Long, _
    ByVal wIDNewItem As Long, _
    ByVal lpNewItem As Any) 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

'//Its good idea to define unique constants for Menu ID
Const ID_FILE_NEW = 101
Const ID_FILE_SAVE = 102
Const ID_FILE_VIEW_ZOOMIN = 104
Const ID_FILE_VIEW_ZOOMOUT = 105
Const ID_FILE_EXIT = 106

Const ID_EDIT_COPY = 201
Const ID_EDIT_PASTE = 202

Public Const GWL_WNDPROC = (-4)
Public lPrevWnd As Long
Public hSysMenu As Long
Public hMainMenu As Long
Public frm As Object
Private DontProcess As Boolean

Public Sub CreateTestMenuBar(f As Object)
  Dim hPopupMenu As Long, hPopupSubMenu As Long
  Dim lRes As Long

  Set frm = f

  hMainMenu = CreateMenu                 'Create a Menu Item

  '////////////////////////////////////////////////////////////////////
  '// File Popup Menu
  '////////////////////////////////////////////////////////////////////
  hPopupMenu = CreatePopupMenu              'Create a File Popup Menu
  'Each Item Requires a Unique ID to Identify it in our Menu Event

  lRes = AppendMenu(hPopupMenu, MF_STRING, ID_FILE_OPEN, ByVal "Open")  'File->Open
  lRes = AppendMenu(hPopupMenu, MF_STRING, ID_FILE_SAVE, ByVal "Save")  'File->Save

  lRes = SetMenuDefaultItem(hPopupMenu, ID_FILE_OPEN, False)  '//Make File->Open default

  hPopupSubMenu = CreatePopupMenu            'Create a File->View Sub Menu

  '//Method-1 using InsertMenu you can specify position of new item to be inserted
  'lRes = InsertMenu(hPopupMenu, 3, MF_POPUP Or MF_STRING Or MF_BYPOSITION, hPopupSubMenu, "View")

  '//Method-2 using AppendMenu you item will be appended to the last menu item
  lRes = AppendMenu(hPopupMenu, MF_POPUP Or MF_STRING, hPopupSubMenu, ByVal "View")  ' File->View
  lRes = AppendMenu(hPopupSubMenu, MF_STRING, ID_FILE_VIEW_ZOOMIN, ByVal "&ZoomIn")  'File->View->ZoomIn
  lRes = AppendMenu(hPopupSubMenu, MF_STRING, ID_FILE_VIEW_ZOOMOUT, ByVal "&ZoomOut")  'File->View->ZoomOut

  lRes = AppendMenu(hPopupMenu, MF_SEPARATOR, 0, "")   'File->(saparator)
  lRes = AppendMenu(hPopupMenu, MF_STRING, ID_FILE_EXIT, ByVal "&Exit")  'File->Exit

  '//Now Attach popup to MenuItem
  '//Method-1 using InsertMenu you can specify position of new item to be inserted
  'lRes = InsertMenu(hMainMenu, 0, MF_POPUP Or MF_STRING Or MF_BYPOSITION, hPopupMenu, "File")

  '//Method-2 using AppendMenu you item will be appended to the last menu item
  lRes = AppendMenu(hMainMenu, MF_STRING Or MF_POPUP, hPopupMenu, ByVal "File")

  '////////////////////////////////////////////////////////////////////
  '// Edit Popup Menu
  '////////////////////////////////////////////////////////////////////
  hPopupMenu = CreatePopupMenu              'Create a Popup Menu
  'Each Item Requires a Unique ID to Identify it in our Menu Event
  lRes = AppendMenu(hPopupMenu, MF_ENABLED Or MF_STRING, 201, ByVal "&Copy")
  lRes = AppendMenu(hPopupMenu, MF_ENABLED Or MF_STRING, 202, ByVal "&Paste")

  '//Now Attach popup to MenuItem
  lRes = AppendMenu(hMainMenu, MF_ENABLED Or MF_STRING Or MF_POPUP, hPopupMenu, ByVal "Edit")
  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 DontProcess = True Then GoTo lblLast

  If Msg = &H105A Then
    Call SetMenu(frm.hwnd, hMainMenu)
    Call DrawMenuBar(frm.hwnd)
  ElseIf Msg = WM_WINDOWPOSCHANGING Then
    DontProcess = True
    If GetMenu(frm.hwnd) <> hwnd Then
      SetMenu frm.hwnd, hMainMenu
      DrawMenuBar frm.hwnd
    End If
    DontProcess = False
  ElseIf Msg = WM_MENUSELECT And lParam <> hSysMenu Then
    If lParam Then
      'lParam : LowWord is Handle to clicked menu
      'wParam : LowWord is Menu ID if menu item, if it is submenu then returns submenu number
      lLastItemSelected = wParam And 255
      Call MenuEvent(lLastItemSelected, 1)      '//MouseMove
    Else
      Call MenuEvent(lLastItemSelected, 2)      '//Clicked
      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)
  Dim EventDesc As String, strMsg As String
  'EventType =1 means MouseMove
  'EventType =2 means Click
  If EventType = 1 Then EventDesc = " Event: MouseMove"
  If EventType = 2 Then EventDesc = " Event: Click"

  Select Case MenuItem
    Case ID_FILE_OPEN
      strMsg = "File->Open" & EventDesc
    Case ID_FILE_SAVE
      strMsg = "File->Save" & EventDesc
    Case ID_FILE_VIEW_ZOOMIN
      strMsg = "File->View->Zoomin" & EventDesc
    Case ID_FILE_VIEW_ZOOMOUT
      strMsg = "File->View->Zoomout" & EventDesc
    Case ID_FILE_EXIT
      strMsg = "File->Exit" & EventDesc
      If EventType = 2 Then Unload frm        '//If exit click then unload
    Case ID_EDIT_COPY
      strMsg = "Edit->Copy" & EventDesc
    Case ID_EDIT_PASTE
      strMsg = "Edit->Paste" & EventDesc
    Case Else
      Exit Sub
  End Select

  If GetMenuDefaultItem(GetSubMenu(hMainMenu, 0), 0&, 0&) = MenuItem Then
    strMsg = strMsg & " [ This is default menuitem ]"
  End If

  If EventType = 2 Then
    MsgBox strMsg
  ElseIf EventType = 1 Then
    frm.Caption = strMsg
  End If
End Sub

- Press F5 to run the project