I've hacked this up in order to get some custom notification of other events from gadgets (well, one in particular that does not need to keep it's existing behaviour). I've tried to keep it hidden from the end programmer, while maintaining the feel of a normal PB event loop/handler. I'd like to be cross platform, but that could be done with the lower levels being wrapped in compiler directives.
It has some Windows specific parts (inside compiler directives) - can anyone suggest Linux/Mac equivalents? Would it be possible and how much work would it be?
Other suggestions are welcome too, such as alternative methods. I've read Foz's post at http://www.purebasic.fr/english/viewtop ... tom+events and my code is similar, although all his custom events go through the list whereas mine are taken through the normal windows queue (which I'd prefer for this case - gadget events would remain in the order they happened, Foz's code allows events to be processed in parallel).
Thanks.
Code: Select all
EnableExplicit
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Import ""
PB_Gadget_SendGadgetCommand.l(Window.l, EventType.l)
EndImport
CompilerEndIf
Define.l event
Define.l quit : quit = 0
Define img_id.l
Enumeration
#WindowMain
EndEnumeration
Enumeration
#ImageMain
EndEnumeration
Enumeration
#PB_CustomEvent_LeftMouseDown = $69000000
#PB_CustomEvent_LeftMouseUp
#PB_CustomEvent_MouseMove
EndEnumeration
Structure CustomEventData
event_type.l
mouse_x.l
mouse_y.l
EndStructure
Global NewList CustomEventsSent.CustomEventData()
Define *custom_event_data.CustomEventData
Define extracted_event.l
Define extracted_event_type.l
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Structure MyGadgetUserData
previous_wndproc.l
EndStructure
Procedure UnsubclassGadget(hwnd.l)
Protected *user_data.MyGadgetUserData
*user_data = GetWindowLong_(hwnd, #GWL_USERDATA)
SetWindowLong_(hwnd, #GWL_WNDPROC, *user_data\previous_wndproc)
SetWindowLong_(hwnd, #GWL_USERDATA, 0)
FreeMemory(*user_data)
EndProcedure
Procedure.l MyGadgetProc(hwnd.l, message.l, wparam.l, lparam.l)
Protected result.l
Protected *user_data.MyGadgetUserData
Protected old_wndproc.l
*user_data = GetWindowLong_(hwnd, #GWL_USERDATA)
If *user_data <> #Null
Select message
Case #WM_NCDESTROY
UnsubclassGadget(hwnd)
Case #WM_LBUTTONDOWN
AddElement(CustomEventsSent())
CustomEventsSent()\event_type = #PB_CustomEvent_LeftMouseDown
PB_Gadget_SendGadgetCommand(hwnd, @CustomEventsSent())
Case #WM_LBUTTONUP
AddElement(CustomEventsSent())
CustomEventsSent()\event_type = #PB_CustomEvent_LeftMouseUp
PB_Gadget_SendGadgetCommand(hwnd, @CustomEventsSent())
Case #WM_MOUSEMOVE
AddElement(CustomEventsSent())
CustomEventsSent()\event_type = #PB_CustomEvent_MouseMove
CustomEventsSent()\mouse_x = PeekW(@lparam);
CustomEventsSent()\mouse_y = PeekW(@lparam+2);
PB_Gadget_SendGadgetCommand(hwnd, @CustomEventsSent())
Default
; You could move this after the Select...EndSelect in order to maintain
; existing behaviour but also get notification of the other events
result = CallWindowProc_(*user_data\previous_wndproc, hwnd, message, wparam, lparam)
EndSelect
Else
Debug "Calling default window procedure"
result = DefWindowProc_(hwnd, message, wparam, lparam)
EndIf
ProcedureReturn result
EndProcedure
Procedure SubclassGadget(GadgetNumber.l)
Protected *user_data.MyGadgetUserData
*user_data = AllocateMemory(SizeOf(MyGadgetUserData))
*user_data\previous_wndproc = GetWindowLong_(GadgetID(GadgetNumber), #GWL_WNDPROC)
SetWindowLong_(GadgetID(GadgetNumber), #GWL_USERDATA, *user_data)
SetWindowLong_(GadgetID(GadgetNumber), #GWL_WNDPROC, @MyGadgetProc())
EndProcedure
CompilerElse
Procedure SubclassGadget(GadgetNumber.l)
EndProcedure
CompilerEndIf
CreateImage(#ImageMain, 200, 200)
If StartDrawing(ImageOutput(#ImageMain))
Box(0, 0, 200, 200, RGB(Random(256), Random(256), Random(256)))
StopDrawing()
EndIf
Procedure.l IsCustomEventType(event_type.l)
Protected is_custom.l = #False
ResetList(CustomEventsSent())
While NextElement(CustomEventsSent()) And is_custom = #False
If event_type = @CustomEventsSent()
is_custom = #True
EndIf
Wend
ProcedureReturn is_custom
EndProcedure
Procedure ExtractEventData()
Shared *custom_event_data.CustomEventData
Shared extracted_event.l
Shared extracted_event_type.l
If extracted_event = #False
extracted_event_type = EventType()
If IsCustomEventType(extracted_event_type)
*custom_event_data = extracted_event_type
extracted_event_type = *custom_event_data\event_type
Debug "Custom event type = "+RSet(Hex(*custom_event_data\event_type), 8, "0")
Else
*custom_event_data = #Null
EndIf
extracted_event = #True
EndIf
EndProcedure
Procedure.l CustomEventType()
Shared extracted_event_type.l
ExtractEventData()
ProcedureReturn extracted_event_type
EndProcedure
Procedure.l CustomEventMouseX()
Shared *custom_event_data
Protected mouse_x.l
ExtractEventData()
If *custom_event_data <> #Null
mouse_x = *custom_event_data\mouse_x
EndIf
ProcedureReturn mouse_x
EndProcedure
Procedure.l CustomEventMouseY()
Shared *custom_event_data
Protected mouse_y.l
ExtractEventData()
If *custom_event_data <> #Null
mouse_y = *custom_event_data\mouse_y
EndIf
ProcedureReturn mouse_y
EndProcedure
Procedure CustomEventHandlerComplete()
Shared *custom_event_data.CustomEventData
Shared extracted_event.l
Shared extracted_event_type.l
ExtractEventData()
If *custom_event_data<>#Null
ChangeCurrentElement(CustomEventsSent(), *custom_event_data)
DeleteElement(CustomEventsSent())
EndIf
*custom_event_data = #Null
extracted_event = #False
extracted_event_type = 0
EndProcedure
Procedure HandleImageMain()
Select CustomEventType()
Case #PB_EventType_LeftClick
Debug "Left mouse clicked"
Case #PB_CustomEvent_LeftMouseDown
Debug "Left mouse down"
Case #PB_CustomEvent_LeftMouseUp
Debug "Left mouse up"
Case #PB_CustomEvent_MouseMove
Debug "Mouse move to "+Str(CustomEventMouseY())+", "+Str(CustomEventMouseX())
EndSelect
CustomEventHandlerComplete()
EndProcedure
If OpenWindow(#WindowMain, 0, 0, 800, 600, "foo", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
If CreateGadgetList(WindowID(#WindowMain))
img_id = ImageGadget(#PB_Any, 10, 10, 200, 200, ImageID(#ImageMain))
EndIf
SubclassGadget(img_id)
While Not(quit)
event = WaitWindowEvent()
Select event
Case #PB_Event_CloseWindow
quit = 1
Case #PB_Event_Gadget
Debug "Gadget event"
If EventGadget()=img_id : HandleImageMain()
EndIf
EndSelect
Wend
CloseWindow(#WindowMain)
EndIf
End
