Code: Select all
EnableExplicit
#MSG_CallWindowProc = #PB_ProcessPureBasicEvents
#MSG_All = -1
Prototype MessageHandler(Gadget, hwnd, msg, wp, lp)
Global NewMap Properties()
Macro SetIDProp(ID, Name, Value)
Properties(Str(ID) + ":" + Name) = Value
EndMacro
Macro IDPropExists(ID, Name)
FindMapElement(Properties(), Str(ID) + ":" + Name)
EndMacro
Macro DeleteIDProp(ID, Name)
DeleteMapElement(Properties(), Str(ID) + ":" + Name)
EndMacro
Procedure GetIDProp(ID, Name.s)
If FindMapElement(Properties(), Str(ID) + ":" + Name)
ProcedureReturn Properties()
EndIf
EndProcedure
Procedure FreeIDProp(ID)
Protected sID.s = Str(ID) + ":"
Protected l = Len(sID)
ForEach Properties()
If Left(MapKey(Properties()), l) = sID
DeleteMapElement(Properties())
EndIf
Next
EndProcedure
Procedure _EventHandler(hwnd, msg, wp, lp)
Protected gc.MessageHandler, r = #MSG_CallWindowProc, proc = GetWindowLongPtr_(hwnd, #GWL_USERDATA); = GetIDProp(hwnd, "proc")
;Debug "" + hwnd + #TAB$ + msg
gc = GetIDProp(hwnd, Str(#MSG_All))
If Not gc
gc = GetIDProp(hwnd, Str(msg))
EndIf
If gc
r = gc(GetDlgCtrlID_(hwnd), hwnd, msg, wp, lp)
EndIf
If msg = #WM_DESTROY
SetWindowLongPtr_(hwnd, #GWL_WNDPROC, proc)
FreeIDProp(hwnd)
EndIf
If r = #MSG_CallWindowProc
r = CallWindowProc_(proc, hwnd, msg, wp, lp)
EndIf
ProcedureReturn r
EndProcedure
Procedure BindWindowMessage(window, msg, callback.MessageHandler)
Protected wid = WindowID(window), proc = GetWindowLongPtr_(wid, #GWL_USERDATA)
;If Not IDPropExists(wid, "proc")
If Not proc
proc = SetWindowLongPtr_(wid, #GWL_WNDPROC, @_EventHandler())
SetWindowLongPtr_(wid, #GWL_USERDATA, proc)
;SetIDProp(wid, "proc", proc)
EndIf
SetIDProp(wid, msg, callback)
EndProcedure
Procedure UnbindWindowMessage(window, msg)
Protected wid = WindowID(window)
DeleteIDProp(wid, msg)
EndProcedure
Procedure BindMessage(gadget, msg, callback.MessageHandler)
Protected gid = GadgetID(gadget), proc = GetWindowLongPtr_(gid, #GWL_USERDATA)
;If Not IDPropExists(gid, "proc")
If Not proc
proc = SetWindowLongPtr_(gid, #GWL_WNDPROC, @_EventHandler())
SetWindowLongPtr_(gid, #GWL_USERDATA, proc)
;SetIDProp(gid, "proc", proc)
EndIf
SetIDProp(gid, msg, callback)
EndProcedure
Procedure UnbindMessage(gadget, msg)
Protected gid = GadgetID(gadget)
DeleteIDProp(gid, msg)
EndProcedure
; //
; // Small demo
; //
Define e, i, c
OpenWindow(0, 0, 0, 400, 300, "Test")
ButtonGadget(0, 10, 10, 80, 40, "Test")
ButtonGadget(1, 100, 10, 80, 40, "Test2")
Procedure MyButtonMessage(g, hwnd, msg, wp, lp)
Debug "" + g + #TAB$ + hwnd + #TAB$ + msg + #TAB$ + wp + #TAB$ + lp
;UnbindMessage(g, #WM_RBUTTONDOWN)
ProcedureReturn #MSG_CallWindowProc
EndProcedure
Procedure MyWindowMessage(g, hwnd, msg, wp, lp)
Debug "" + g + #TAB$ + hwnd + #TAB$ + msg + #TAB$ + wp + #TAB$ + lp
If IsGadget(0)
;FreeGadget(0)
EndIf
;UnbindWindowMessage(g, #WM_LBUTTONDOWN)
ProcedureReturn #MSG_CallWindowProc
EndProcedure
;BindMessage(0, #MSG_All, @MyTest())
BindMessage(0, #WM_RBUTTONDOWN, @MyButtonMessage())
BindWindowMessage(0, #WM_LBUTTONDOWN, @MyWindowMessage())
Repeat
e = WaitWindowEvent()
Until e = #PB_Event_CloseWindow