PureBasic Forums - English

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)