PureBasic Forums - English

Code: Select all

OpenWindow(1,0,0,320,200,"Test",#PB_Window_ScreenCentered | #PB_Window_SystemMenu)
TextGadget(10,10,60,320,200,"Close this window",#PB_Text_Center)
ButtonGadget(20,238,170,75,23,"Close")
Repeat
		event=WaitWindowEvent()
		If event=#PB_Event_Gadget
			eventgadget=EventGadget()
			If eventgadget
				Debug eventgadget
			EndIf
		EndIf
Until event=#PB_Event_CloseWindow Or eventgadget=20
CloseWindow(1)
End

Code: Select all

; works on mac
; on linux, clicking 0 toggles 1
; on win, 0 is hidden but appears if you hover above it
OpenWindow(0, 0, 0, 300, 100, "", #PB_Window_SystemMenu)
CheckBoxGadget(0, 40, 5, 50, 14, "0")
CheckBoxGadget(1, 5, 5, 85, 14,  "1") ; note: created later!
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow

Code: Select all

AddGadgetEventType(#Gadget,#PB_EventType_Something)

Code: Select all

RegisterEventType(#PB_GadgetType_Button,#PB_EventType_Something)

Code: Select all

;-TOP

; Comment : Module SetGadgetCallback (Windows Only)
; Author  : mk-soft
; Version : v0.05.2
; Created : 10.06.2018
; 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

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

CompilerIf #PB_Compiler_IsMainFile
  
  ;- Example
  
  EnableExplicit
  
  UseModule GadgetCallback
  
  Enumeration #PB_EventType_FirstCustomValue
    #MyEventType_ButtonRightClick
  EndEnumeration
  
  ; ----
  
  Procedure GadgetButtonCallback(hWnd, uMsg, wParam, lParam)
    Protected Gadget
    Select uMsg
      Case #WM_RBUTTONUP
        Gadget = GetProp_(hwnd, "PB_ID")
        PostEvent(#PB_Event_Gadget, GetActiveWindow(), Gadget, #MyEventType_ButtonRightClick)
    EndSelect
    ProcedureReturn CallGadgetProc(hWnd,uMsg,wParam,lParam)
  EndProcedure
  
  ; ----
  
  Procedure Main()
    If OpenWindow(0, 10, 10, 320, 200, "Window", #PB_Window_SystemMenu)
      ButtonGadget(1, 10, 10, 120, 25, "Button 1")
      
      SetGadgetCallback(1, @GadgetButtonCallback())
      
      Repeat
        Select WaitWindowEvent()
          Case #PB_Event_CloseWindow
            Break
          Case #PB_Event_Gadget
            Select EventGadget()
              Case 1
                Select EventType()
                  Case #PB_EventType_LeftClick
                    Debug "Left Click Button 1"
                  Case #MyEventType_ButtonRightClick
                    Debug "Right Click Button 1"
                EndSelect
                
            EndSelect
            
        EndSelect
      ForEver
    EndIf
    
  EndProcedure : Main()
  
CompilerEndIf