Hope you find it useful and usable too (and easy to understand it, by fact there are few wrappers over PB functions with similar logic).
Code: Select all
; SimplePopupMenu.pb
; (c) Lunasole, 2016/02/25
EnableExplicit ; don't even try write something >2048 without this :3
;{ App data }
Global WINDOW_ID
;}
;{ Menu }
;{ Menu subsystem ex }
; Adds new item to current menu
; RETURN: none
Procedure MenuItemEx (ItemID, Text$, Enabled = 1, Visible = 1, Checked = 0, ImageID = 0)
Global MENU_CURRENT, MENU_CURRENT_HANDLER ; here to decrease arguments count by 2 ^^
If Visible And IsMenu(MENU_CURRENT)
MenuItem(ItemID, Text$, ImageID)
DisableMenuItem(MENU_CURRENT, ItemID, Bool(Not Enabled))
SetMenuItemState(MENU_CURRENT, ItemID, Bool(Checked))
UnbindMenuEvent(MENU_CURRENT, ItemID, MENU_CURRENT_HANDLER) ; this looks strange, but I think generally good enough, instead of loop clearing all callbacks from __MENU to __END after menu closes
BindMenuEvent(MENU_CURRENT, ItemID, MENU_CURRENT_HANDLER)
EndIf
EndProcedure
; Creates popup menu selecting it as current and assigning callback procedure on success
; RETURN: handle to created menu on success
Procedure CreatePopupMenuEx (MenuID, *Handler)
Protected *hMnu = CreatePopupMenu(MenuID)
If *hMnu ; switch current menu
MENU_CURRENT = MenuID : MENU_CURRENT_HANDLER = *Handler
Else
MENU_CURRENT = 0 : MENU_CURRENT_HANDLER = 0
EndIf
ProcedureReturn *hMnu
EndProcedure
; Used to create nested menus
; RETURN: submenu handle on success, 0 on fail or when submenu is not visible
Procedure OpenSubMenuEx (Text$, Enabled = 1, Visible = 1, Checked = 0, ImageID = 0)
If Visible And IsMenu(MENU_CURRENT)
Protected *hSub = OpenSubMenu(Text$, ImageID)
If *hSub
DisableMenuItem(MENU_CURRENT, *hSub, Bool(Not Enabled))
SetMenuItemState(MENU_CURRENT, *hSub, Bool(Checked))
ProcedureReturn *hSub
EndIf
EndIf
EndProcedure
;}
;=======================;
; 1. Menu descriptions ;
;=======================;
; Menus are declared this way: you just setting enum constants you need, then starting value - keep it not overlapped with other menus. #PB_Compiler_EnumerationValue looks perfect to auto-assign
Enumeration #PB_Compiler_EnumerationValue
#MAIN__MENU ; menu start index. also used as menu ID. should not assign some menu items to it
#MAIN_TEST ; common item
#MAIN_SUB1 ; submenu item
#MAIN__END ; menu last index, should not assign menu items to it too
EndEnumeration
Enumeration #PB_Compiler_EnumerationValue
#AUX__MENU
#AUX_TEST
#AUX_SUB1
#AUX__END
EndEnumeration
;=======================;
; 2. Menu callbacks ;
;=======================;
; that one is unified for 2 menus, instead of using separated funcs
Procedure MNU_callback()
Select EventMenu()
Case #MAIN__MENU To #MAIN__END : ; this check is required only if few different menus binded to one callback function
Select EventMenu() ;
Case #MAIN_TEST: Debug "#MAIN_TEST"
Case #MAIN_SUB1: Debug "#MAIN_sub1"
EndSelect
Case #AUX__MENU To #AUX__END : ; this check is required only if few different menus binded to one callback function
Select EventMenu() ;
Case #AUX_TEST: Debug "#AUX_TEST"
Case #AUX_SUB1: Debug "#AUX_sub1"
EndSelect
EndSelect
EndProcedure
;=======================;
; 3. Menu constructors ;
;=======================;
Procedure MNU_MAIN_raise ()
If IsMenu(#MAIN__MENU) : FreeMenu(#MAIN__MENU) : EndIf
If CreatePopupMenuEx(#MAIN__MENU, @MNU_callback())
; add regular item
MenuItemEx (#MAIN_TEST, "MAIN TEST", 1, 1, 0)
MenuBar()
; add sub menu
If OpenSubMenuEx ("TestSubMenu", 1, 1, 1)
MenuItemEx (#MAIN_SUB1, "submenu", 1, 1, 1)
CloseSubMenu()
EndIf
; showmnu
DisplayPopupMenu(#MAIN__MENU, WindowID(WINDOW_ID))
EndIf
EndProcedure
Procedure MNU_AUX_raise ()
If IsMenu(#AUX__MENU) : FreeMenu(#AUX__MENU) : EndIf
If CreatePopupMenuEx(#AUX__MENU, @MNU_callback())
; add regular item
MenuItemEx (#AUX_TEST, "AUX TEST", 1, 1, 0)
MenuBar()
; add sub menu
If OpenSubMenuEx ("TestSubMenu-2", 1, 1, 0)
MenuItemEx (#AUX_SUB1, "submenu-2", 0, 1, 0)
CloseSubMenu()
EndIf
; showmnu
DisplayPopupMenu(#AUX__MENU, WindowID(WINDOW_ID))
EndIf
EndProcedure
;}
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; TEST. creates window and continues handling it's events
; Use LMB and RMB to raise test menus
Procedure window_loop (ID)
If OpenWindow(ID, 0, 0, 100, 100, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow: Break ; fin
Case #PB_Event_LeftClick:
MNU_MAIN_raise ()
Case #PB_Event_RightClick
MNU_AUX_raise ()
EndSelect
ForEver
EndIf
EndProcedure
;;;;;;;;;;;;;;;;;;;;;;;;;
window_loop(WINDOW_ID)