Here's a workaround. (PB 6.12 x64 only, sometimes it also works on x86)
But the program freezing looks like a bug to me. Seeing different execution results for x86 and x64, maybe memory corruption?
Code: Select all
EnableExplicit
#WINDOW_MAIN = 0
#CANVAS_MAIN = 0
Global window_width = 800
Global window_height = 600
Declare BindInputEvents()
Declare UnbindInputEvents()
Procedure OnInput_Empty()
EndProcedure
Procedure OnInput()
Debug "OnInput()"
EndProcedure
Procedure OnKeyUp()
Debug "OnKeyUp()"
Define char = GetGadgetAttribute(#CANVAS_MAIN, #PB_Canvas_Key)
Select char
Case #PB_Shortcut_Escape
End
Case #PB_Shortcut_Return
UnbindInputEvents()
EndSelect
EndProcedure
Procedure OnKeyDown()
Debug "OnKeyDown()"
EndProcedure
Procedure BindInputEvents()
BindGadgetEvent(#CANVAS_MAIN, @OnInput(), #PB_EventType_Input)
BindGadgetEvent(#CANVAS_MAIN, @OnInput_Empty(), #PB_EventType_Input)
BindGadgetEvent(#CANVAS_MAIN, @OnKeyUp(), #PB_EventType_KeyUp)
BindGadgetEvent(#CANVAS_MAIN, @OnKeyDown(), #PB_EventType_KeyDown)
EndProcedure
Procedure UnbindInputEvents()
UnbindGadgetEvent(#CANVAS_MAIN, @OnInput(), #PB_EventType_Input)
UnbindGadgetEvent(#CANVAS_MAIN, @OnInput_Empty(), #PB_EventType_Input)
UnbindGadgetEvent(#CANVAS_MAIN, @OnKeyUp(), #PB_EventType_KeyUp)
UnbindGadgetEvent(#CANVAS_MAIN, @OnKeyDown(), #PB_EventType_KeyDown)
EndProcedure
OpenWindow(#WINDOW_MAIN, 0, 0, window_width, window_height, "")
CanvasGadget(#CANVAS_MAIN, 0, 0, window_width, window_height, #PB_Canvas_Keyboard)
SetActiveGadget(#CANVAS_MAIN)
BindInputEvents()
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
Edit:
One more dummy procedure is required for x86.
Code: Select all
EnableExplicit
#WINDOW_MAIN = 0
#CANVAS_MAIN = 0
Global window_width = 800
Global window_height = 600
Declare BindInputEvents()
Declare UnbindInputEvents()
Procedure OnInput_Empty2()
EndProcedure
Procedure OnInput_Empty()
EndProcedure
Procedure OnInput()
Debug "OnInput()"
EndProcedure
Procedure OnKeyUp()
Debug "OnKeyUp()"
Define char = GetGadgetAttribute(#CANVAS_MAIN, #PB_Canvas_Key)
Select char
Case #PB_Shortcut_Escape
End
Case #PB_Shortcut_Return
UnbindInputEvents()
EndSelect
EndProcedure
Procedure OnKeyDown()
Debug "OnKeyDown()"
EndProcedure
Procedure BindInputEvents()
BindGadgetEvent(#CANVAS_MAIN, @OnInput(), #PB_EventType_Input)
BindGadgetEvent(#CANVAS_MAIN, @OnInput_Empty(), #PB_EventType_Input)
BindGadgetEvent(#CANVAS_MAIN, @OnInput_Empty2(), #PB_EventType_Input)
BindGadgetEvent(#CANVAS_MAIN, @OnKeyUp(), #PB_EventType_KeyUp)
BindGadgetEvent(#CANVAS_MAIN, @OnKeyDown(), #PB_EventType_KeyDown)
EndProcedure
Procedure UnbindInputEvents()
UnbindGadgetEvent(#CANVAS_MAIN, @OnInput(), #PB_EventType_Input)
UnbindGadgetEvent(#CANVAS_MAIN, @OnInput_Empty(), #PB_EventType_Input)
UnbindGadgetEvent(#CANVAS_MAIN, @OnInput_Empty2(), #PB_EventType_Input)
UnbindGadgetEvent(#CANVAS_MAIN, @OnKeyUp(), #PB_EventType_KeyUp)
UnbindGadgetEvent(#CANVAS_MAIN, @OnKeyDown(), #PB_EventType_KeyDown)
EndProcedure
OpenWindow(#WINDOW_MAIN, 0, 0, window_width, window_height, "")
CanvasGadget(#CANVAS_MAIN, 0, 0, window_width, window_height, #PB_Canvas_Keyboard)
SetActiveGadget(#CANVAS_MAIN)
BindInputEvents()
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
Edit 2:
The following two will crash.
However, if the bind and unbind order is the same, it will not crash.
Code: Select all
Procedure BindInputEvents()
BindGadgetEvent(#CANVAS_MAIN, @OnInput(), #PB_EventType_Input)
BindGadgetEvent(#CANVAS_MAIN, @OnInput_Empty(), #PB_EventType_Input)
; ...
EndProcedure
Procedure UnbindInputEvents()
UnbindGadgetEvent(#CANVAS_MAIN, @OnInput_Empty(), #PB_EventType_Input)
UnbindGadgetEvent(#CANVAS_MAIN, @OnInput(), #PB_EventType_Input)
; ...
EndProcedure
Code: Select all
Procedure BindInputEvents()
BindGadgetEvent(#CANVAS_MAIN, @OnInput_Empty(), #PB_EventType_Input)
BindGadgetEvent(#CANVAS_MAIN, @OnInput(), #PB_EventType_Input)
; ...
EndProcedure
Procedure UnbindInputEvents()
UnbindGadgetEvent(#CANVAS_MAIN, @OnInput(), #PB_EventType_Input)
UnbindGadgetEvent(#CANVAS_MAIN, @OnInput_Empty(), #PB_EventType_Input)
; ...
EndProcedure