Only one callback per window?

[BarryG]

Can a window have only one callback? The manual doesn't say, but it seems so from my experience. I'm using some code from ChrisR but his callback overrides mine, thus breaking my app. What would you do if this happened to you? Do I have to somehow mix them together into one? This is a big job (my callback is huge and tests for a LOT of messages for specific situations) and will just break the next time ChrisR updates his code, as it will require manual re-mixing of his callback into mine again.

[Bisonte]

Multiple callbacks are possible.
Possibly there is an "EventEater" in the callback which deletes the event...
So that the other one cannot be called anymore.

Furthermore "FiLo" is valid ... the first callback you define is the last one that will be called.

At least it was like that until now I mean....

[BarryG]

Hmm, I just directly called my Callback from the end of his, and it seems to work? Because when I put in a "Debug" in my callback, it was never shown, so my callback was never used. But by doing the below, my app is functioning again and the debug output is shown to confirm it.

Code: Select all

  ; ...
  AppCallback(hWnd, uMsg, wParam, lParam) ; My existing callback.
  ProcedureReturn Result ; End line of ChrisR's callback.
EndProcedure

Is there any issue with this, do you think?

[Rinzwind]

https://www.purebasic.fr/english/viewto ... 36#p576236

[ChrisR]

Interested topic, I thought it was not possible

Hmm, I just directly called my Callback from the end of his, and it seems to work?

Be careful when doing this, the procedure return can be done before the end of the CallBack, ex for #WM_CTLCOLORSTATIC message with ProcedureReturn hBrush

[BarryG]

the procedure return can be done before the end of the CallBack, ex for #WM_CTLCOLORSTATIC message with ProcedureReturn hBrush

Oh yeah, I missed that. I've now coded around it with the below. Thanks!

Code: Select all

Macro ProcReturn(value)
  If darkmode
    AppCallback(hWnd, uMsg, wParam, lParam)
  EndIf
  ProcedureReturn value
EndMacro

[mk-soft]

Maybe a multiple SetWindowCallback as a list helps.
The last assigned callback is executed first. If the return value is not changed, the previous return value is used.

If a window is specified, it works like the original with only one callback.

Try it out ...

Code: Select all

;-TOP by mk-soft, v1.01.0, 08.05.2022

; Multi SetWindowCallback.
; With parameter window set only one callback

Prototype _Invoke4(hWnd, uMsg, wParam, lParam)

Structure _udtWindowCallback
  *Callback._Invoke4
EndStructure

Macro _PB_(Function)
  Function
EndMacro

Global NewList _ListWindowCallback._udtWindowCallback()

Procedure _DoWindowCallback(hWnd, uMsg, wParam, lParam) 
  Protected result, result_save
  
  result = #PB_ProcessPureBasicEvents
  ForEach _ListWindowCallback()
    result_save = result
    result = _ListWindowCallback()\Callback(hWnd, uMsg, wParam, lParam)
    If result = #PB_ProcessPureBasicEvents
      result = result_save
    EndIf
  Next
  ProcedureReturn result
EndProcedure 

Procedure AddWindowCallback(*ProcedureName, Window = -1)
  If Window >= 0
    _PB_(SetWindowCallback)(*ProcedureName, Window)
  Else
    If *ProcedureName
      FirstElement(_ListWindowCallback())
      InsertElement(_ListWindowCallback())
      _ListWindowCallback()\Callback = *ProcedureName
    EndIf
  EndIf
EndProcedure

Procedure RemoveWindowCallback(*ProcedureName)
  ForEach _ListWindowCallback()
    If _ListWindowCallback()\Callback = *ProcedureName
      DeleteElement(_ListWindowCallback())
    EndIf
  Next
EndProcedure

SetWindowCallback(@_DoWindowCallback())

Macro SetWindowCallback(ProcedureName, Window = -1)
  AddWindowCallback(ProcedureName, Window)
EndMacro

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

CompilerIf #PB_Compiler_IsMainFile
  
  Enumeration Windows
    #Main
  EndEnumeration
  
  Enumeration MenuBar
    #MainMenu
  EndEnumeration
  
  Enumeration MenuItems
    
  EndEnumeration
  
  Enumeration Gadgets
    
  EndEnumeration
  
  Enumeration StatusBar
    #MainStatusBar
  EndEnumeration
  
  Procedure WinCallback_1(hWnd, uMsg, wParam, lParam) 
    
    If uMsg = #WM_SIZE 
      Select wParam 
        Case #SIZE_MINIMIZED 
          Debug ("Size minimized")
        Case #SIZE_RESTORED 
          Debug ("Size restored")
        Case #SIZE_MAXIMIZED 
          Debug ("Size maximized")
      EndSelect 
    EndIf 
    
    ProcedureReturn #PB_ProcessPureBasicEvents 
  EndProcedure 
  
  Procedure WinCallback_2(hWnd, uMsg, wParam, lParam) 
    
    If uMsg = #WM_MOVE
      Debug ("Move")
    EndIf 
    
    ProcedureReturn #PB_ProcessPureBasicEvents 
  EndProcedure 
  
  SetWindowCallback(@WinCallback_1())
  SetWindowCallback(@WinCallback_2())
  
  Procedure UpdateWindow()
    Protected dx, dy
    dx = WindowWidth(#Main)
    dy = WindowHeight(#Main) - StatusBarHeight(#MainStatusBar)
    ; Resize gadgets
  EndProcedure
  
  Procedure Main()
    Protected dx, dy
    
    #MainStyle = #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget
    
    If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, 800, 600, "Window" , #MainStyle)
      ; Menu
      CreateMenu(#MainMenu, WindowID(#Main))
      
      ; StatusBar
      CreateStatusBar(#MainStatusBar, WindowID(#Main))
      AddStatusBarField(#PB_Ignore)
      
      ; Gadgets
      dx = WindowWidth(#Main)
      dy = WindowHeight(#Main) - StatusBarHeight(#MainStatusBar)
      
      ; Bind Events
      BindEvent(#PB_Event_SizeWindow, @UpdateWindow(), #Main)
      
      Repeat
        Select WaitWindowEvent()
          Case #PB_Event_CloseWindow
            Break
            
          Case #PB_Event_Menu
            Select EventMenu()
                CompilerIf #PB_Compiler_OS = #PB_OS_MacOS   
                Case #PB_Menu_About
                  
                Case #PB_Menu_Preferences
                  
                Case #PB_Menu_Quit
                  PostEvent(#PB_Event_CloseWindow, #Main, #Null)
                  
                CompilerEndIf
                
            EndSelect
            
          Case #PB_Event_Gadget
            Select EventGadget()
                
            EndSelect
            
        EndSelect
      ForEver
      
    EndIf
    
  EndProcedure : Main()
  
CompilerEndIf

;- BOTTOM

[BarryG]

Nice tip, mk-soft! Works great.

[Axolotl]

may be too late, because you found your solution ....

I use the subclass mechanism of windows like this. (this is just a basic 'framework' to start with. Adjustments are still required for certain tasks )

Code: Select all

CompilerIf #PB_Compiler_IsMainFile 
Declare Logout(Message$) 
CompilerEndIf 

CompilerIf Not Defined(Logout, #PB_Procedure) ;{ ... 
  Procedure Logout(Message$) 
    Debug "LOGOUT: " + Message$ 
  EndProcedure 
CompilerEndIf ;} 


Procedure ApplicationWindowSubclassProc(hWnd, uMsg, wParam, lParam)  ;' standard windows interface for message event  
  Static s_hPrevWndProc = 0 
  Protected hPrevWndProc 

  hPrevWndProc = s_hPrevWndProc ;' use the 
  Select uMsg 
    Case -1                                                          :Logout("subclass: INTERNAL: init ") 
      If wParam = ('I' << 24) | ('N' << 16) | ('I' << 8) | 'T' 
        s_hPrevWndProc = GetWindowLongPtr_(hWnd, #GWLP_WNDPROC)                   ;' keep the window procedure address 
        SetWindowLongPtr_(hWnd, #GWLP_WNDPROC, @ApplicationWindowSubclassProc())  ;' set window procedure to my callback procedure 
        hPrevWndProc = s_hPrevWndProc 
      EndIf 

    Case #WM_NCDESTROY                                               :Logout("subclass: WM_NCDESTROY ") 
      SetWindowLongPtr_(hWnd, #GWLP_WNDPROC, hPrevWndProc)  ;' necessary ? 
      s_hPrevWndProc = 0 
  
    Case #WM_DESTROY                                                 :Logout("subclass: WM_DESTROY --> do nothing ") 
CompilerIf Defined(OnMessage_Destroy, #PB_Procedure) 
      OnMessage_Destroy() 
CompilerEndIf 

    Case #WM_ACTIVATE                                                  :Logout("subclass: WM_ACTIVATE, ")
    Case #WM_MOVE                                                      :Logout("subclass: WM_MOVE --> do nothing ") 
    Case #WM_SIZE                                                      :Logout("subclass: WM_SIZE --> do nothing ") 
    Case #WM_CLOSE                                                     :Logout("subclass: WM_CLOSE --> do nothing ") 

  EndSelect ;' 
  ProcedureReturn CallWindowProc_(hPrevWndProc, hWnd, uMsg, wParam, lParam)  ;' use stored window procedure address 
EndProcedure ;() 


Procedure.i SetApplicationWindow(WndID)  ;' returns hWnd Or zero  
  Protected hWnd, hMenu, hSubMenu, tmp$   

  If IsWindow(WndID) 
    hWnd = WindowID(WndID) 
    ApplicationWindowSubclassProc(hWnd, -1, ('I' << 24) | ('N' << 16) | ('I' << 8) | 'T', 0)  ; wParam = 'INIT' 
  Else 
    Logout("ERROR: wrong Window ID = 0x"+Hex(WndID)+" ("+WndID+")") 
   ;Debug "ERROR: wrong Window ID = 0x"+Hex(WndID)+" ("+WndID+")" 
  EndIf 
  ProcedureReturn hWnd 
EndProcedure ;() 


CompilerIf #PB_Compiler_IsMainFile 

#WINDOW_Main = 1 
#GADGET_btnClose  = 1  
#GADGET_lstOutput = 2 

Procedure Logout(Message$) 
  Debug "LOGOUT: " + Message$ 
  If IsGadget(#GADGET_lstOutput) 
    AddGadgetItem(#GADGET_lstOutput, -1, Message$) 
    SetGadgetState(#GADGET_lstOutput, CountGadgetItems(#GADGET_lstOutput) - 1) 
  EndIf 
EndProcedure 


;:: callback 

Procedure MyWindowCallback(hWnd, uMsg, wParam, lParam)
  Protected result = #PB_ProcessPureBasicEvents 

  Select uMsg 
    Case #WM_NCDESTROY                           :Logout("callback: WM_NCDESTROY ") ;' wParam, lParam .. not used. 
    Case #WM_DESTROY                             :Logout("callback: WM_DESTROY --> do nothing ") ;' wParam, lParam .. not used. 
    Case #WM_CLOSE                               :Logout("callback: WM_CLOSE --> do nothing ") 
    Case #WM_ACTIVATE                            :Logout("callback: WM_ACTIVATE, ")
    Case #WM_MOVE                                :Logout("callback: WM_MOVE --> do nothing ") 
    Case #WM_SIZE                                :Logout("callback: WM_SIZE --> do nothing ") 
  EndSelect ; uMsg  
  ProcedureReturn result 
EndProcedure ;() 

;:: OnEvent ... 

Procedure OnSizeWindow()
  Protected WndW, WndH        :Logout("OnEvent: SizeWindow ... ")

  WndW = WindowWidth(#WINDOW_Main)
  WndH = WindowHeight(#WINDOW_Main) 
  ResizeGadget(#GADGET_lstOutput, #PB_Ignore, #PB_Ignore, WndW, WndH-34)  ;' no selection 
EndProcedure 


;:: Main 

Procedure main() 
  Protected WndW, WndH, ev, boolExit  

  WndW = 400 : WndH = 400 

  If OpenWindow(#WINDOW_Main, 0, 0, WndW, WndH, "Test Application", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget) ;' #PB_Window_TitleBar is not enough 
    ButtonGadget(#GADGET_btnClose, 2, 2, 80, 24, "Close") 
    ListViewGadget(#GADGET_lstOutput, 0, 34, WndW, WndH-34, $4000)  ;' no selection 

    Logout("INFO: Move or Size the Window, and see what happend ... ") 

    ; activate the subclassing of the main window 
    SetApplicationWindow(#WINDOW_Main)  

    ; use the default PB way of callback 
    SetWindowCallback(@MyWindowCallback(), #WINDOW_Main)    ; activate the callback 

    BindEvent(#PB_Event_SizeWindow, @OnSizeWindow(), #WINDOW_Main) 

    Repeat 
      ev = WaitWindowEvent() 
      Select ev ;WaitWindowEvent() 
        Case #PB_Event_CloseWindow 
          boolExit = #True  

        Case #PB_Event_ActivateWindow      :Logout("mainloop: PB_Event_ActivateWindow ") 
        Case #PB_Event_MoveWindow          :Logout("mainloop: PB_Event_MoveWindow ") 

        Case #PB_Event_SizeWindow          :Logout("mainloop: PB_Event_SizeWindow ") 
          WndW = WindowWidth(#WINDOW_Main) : WndH = WindowHeight(#WINDOW_Main) 
          ResizeGadget(#GADGET_lstOutput, #PB_Ignore, #PB_Ignore, WndW, WndH-34)  ;' no selection 

        Case #PB_Event_Gadget 
          If EventGadget() = #GADGET_btnClose 
            boolExit = #True 
          EndIf 

        Case #WM_QUERYENDSESSION           :Logout("mainloop: WM_QUERYENDSESSION, wParam, ... ")

        Case #WM_ENDSESSION                :Logout("mainloop: WM_ENDSESSION, ...") 
        Case #WM_CLOSE                     :Logout("mainloop: WM_CLOSE, ...") 

      EndSelect
    Until boolExit <> #False ; ForEver 
  EndIf 
  ProcedureReturn 0 
EndProcedure ;() 

; --- start now 
End main() 

CompilerEndIf