Gadget PopupMenu (Windows)

[mk-soft]

You can also assign a pop-up menu to a gadget on Windows.
To do this, you have to process the PopupMenu events in the gadget callback (#GWL_WNDPROC).

Example

Code: Select all

; Updated : 26.05.2023
; Link    : https://www.purebasic.fr/english/viewtopic.php?f=12&t=70842
;
; Description
; - A callback that has already been set is replaced by the new callback!
;
; - Syntax Callback:
;           Procedure GadgetCB(hWnd,uMsg,wParam,lParam)
;             Select uMsg
;               ;TODO
;             EndSelect
;             ; Call previous gadget procedure
;             ProcedureReturn CallGadgetProc(hWnd,uMsg,wParam,lParam)
;           EndProcedure
;
; *****************************************************************************

DeclareModule GadgetCallback
  
  Declare SetGadgetCallback(Gadget, *lpNewFunc, Parent = #False) 
  Declare CallGadgetProc(hWnd, uMsg, wParam, lParam)
  
EndDeclareModule

Module GadgetCallback
  
  EnableExplicit
  
  ; ---------------------------------------------------------------------------
  
  Procedure SetGadgetCallback(Gadget, *lpNewFunc, Parent = #False)
    Protected hWnd, *lpPrevFunc
    
    hWnd = GadgetID(Gadget)
    If Parent
      hwnd = GetParent_(hwnd)
    EndIf
    *lpPrevFunc = GetProp_(hWnd, "PB_PrevFunc")
    ; Remove exists Callback
    If *lpPrevFunc
      SetWindowLongPtr_(hWnd, #GWL_WNDPROC, *lpPrevFunc)
      RemoveProp_(hWnd, "PB_PrevFunc")
    EndIf
    ; Set new Callback  
    If *lpNewFunc
      *lpPrevFunc = SetWindowLongPtr_(hWnd, #GWL_WNDPROC, *lpNewFunc)
      SetProp_(hWnd, "PB_PrevFunc", *lpPrevFunc)
      ProcedureReturn *lpPrevFunc
    EndIf
    ProcedureReturn 0
  EndProcedure
  
  ; ---------------------------------------------------------------------------
  
  Procedure CallGadgetProc(hWnd, uMsg, wParam, lParam)
    Protected result, *lpPrevFunc
    
    If uMsg = #WM_NCDESTROY ; Last Message
      *lpPrevFunc = RemoveProp_(hWnd, "PB_PrevFunc")
    Else
      *lpPrevFunc = GetProp_(hWnd, "PB_PrevFunc")
    EndIf
    If *lpPrevFunc
      result = CallWindowProc_(*lpPrevFunc, hWnd, uMsg, wParam, lParam)
    EndIf
    ProcedureReturn result
  EndProcedure
EndModule

; *****************************************************************************

;- Gadget PopupMenu Example
;
;  * Get MenuItem over EventData() 

UseModule GadgetCallback

Enumeration CustomEventType #PB_EventType_FirstCustomValue
  #MyEventType_GadgetMenuItem
  #MyEventType_GadgetMenuExit
EndEnumeration

Procedure GadgetCallback(hWnd, uMsg, wParam, lParam) 
  Select uMsg
    Case #WM_ENTERMENULOOP
      ;Debug "Enter Menu"
      
    Case #WM_COMMAND
      ;Debug "Command"
      PostEvent(#PB_Event_Gadget, GetActiveWindow(), GetDlgCtrlID_(hWnd), #MyEventType_GadgetMenuItem, wParam)
      
    Case #WM_EXITMENULOOP
      ;Debug "Exit Menu"
      PostEvent(#PB_Event_Gadget, GetActiveWindow(), GetDlgCtrlID_(hWnd), #MyEventType_GadgetMenuExit, wParam)
      
    Case #WM_RBUTTONUP
      DisplayPopupMenu(0, hwnd)
   
  EndSelect
  
  ProcedureReturn CallGadgetProc(hWnd,uMsg,wParam,lParam)
EndProcedure

If OpenWindow(0, 200, 200, 200, 120, "Gadget Popup-Menu Example", #PB_Window_SystemMenu)
  
  If CreatePopupMenu(0)    
    MenuItem(1, "Cut")
    MenuItem(2, "Copy")
    MenuItem(3, "Paste")
  EndIf
  
  ;CanvasGadget(1, 0, 0, 200, 120, #PB_Canvas_Border)
  EditorGadget(1, 0, 0, 200, 120)
  
  SetGadgetCallback(1, @GadgetCallback())
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Break
        
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 1
            Select EventType()
              Case #MyEventType_GadgetMenuItem
                Select EventData()
                  Case 1
                    Debug "Todo Cut"
                  Case 2
                    Debug "Todo Copy"
                  Case 3
                    Debug "Todo Paste"
                EndSelect
                
              Case #MyEventType_GadgetMenuExit
                Debug "Exit Gadget PopupMenu"
                
            EndSelect
        EndSelect
    EndSelect
  ForEver
EndIf