Have created their own mouse events.
Update v0.03
- Added MouseWheel Events
Update v0.04
- Cleanup code
Code: Select all
;-TOP
; Comment : Canvas Mouse Click and Wheel Events
; Author : mk-soft
; Version : v0.04r2
; Created : 29.01.2018
; Updated : 30.01.2018
; OS : All
; ***************************************************************************************
EnableExplicit
Enumeration #PB_EventType_FirstCustomValue
#My_EventType_LeftButtonClick
#My_EventType_LeftButtonDoubleClick
#My_EventType_MiddleButtonClick
#My_EventType_MiddleButtonDoubleClick
#My_EventType_RightButtonClick
#My_EventType_RightButtonDoubleClick
#My_EventType_MouseWheelUp
#My_EventType_MouseWheelDown
EndEnumeration
; ---------------------------------------------------------------------------------------
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Import ""
PB_Object_EnumerateStart( PB_Objects )
PB_Object_EnumerateNext( PB_Objects, *ID.Integer )
PB_Object_EnumerateAbort( PB_Objects )
PB_Object_GetObject( PB_Object , DynamicOrArrayID)
PB_Window_Objects.i
PB_Gadget_Objects.i
EndImport
Procedure HoverGadget()
Protected x, y, handle, gadget
x = DesktopMouseX()
y = DesktopMouseY()
handle = WindowFromPoint_(y << 32 | x)
; Find gadget over handle
PB_Object_EnumerateStart(PB_Gadget_Objects)
While PB_Object_EnumerateNext(PB_Gadget_Objects, @gadget)
If handle = GadgetID(gadget)
PB_Object_EnumerateAbort(PB_Gadget_Objects)
ProcedureReturn gadget
EndIf
Wend
ProcedureReturn -1
EndProcedure
Procedure WinCB(hWnd, uMsg, wParam, lParam)
Protected r1 = #PB_ProcessPureBasicEvents
Protected gadget, wheel
If uMsg = #WM_MOUSEWHEEL
gadget = HoverGadget()
If gadget >= 0
wheel = wParam >> 16 / 120
If wheel > 0
PostEvent(#PB_Event_Gadget, 0, gadget, #My_EventType_MouseWheelUp, Wheel)
Else
PostEvent(#PB_Event_Gadget, 0, gadget, #My_EventType_MouseWheelDown, Wheel)
EndIf
EndIf
EndIf
ProcedureReturn r1
EndProcedure
SetWindowCallback(@WinCB())
CompilerEndIf
; ---------------------------------------------------------------------------------------
Global DoubleClickTime = DoubleClickTime() ; ms
Global ClickTime = 200 ; ms
Procedure CheckCanvasMouse()
Static left_time1, left_time2, left_diff, left_lock
Static middle_time1, middle_time2, middle_diff, middle_lock
Static right_time1, right_time2, right_diff, right_lock
Static wheel
Select EventType()
; Left Button
Case #PB_EventType_LeftButtonDown
left_time1 = ElapsedMilliseconds()
left_diff = ElapsedMilliseconds() - left_time2
If left_time2 And left_diff > 1 And left_diff < DoubleClickTime
PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_leftButtonDoubleClick)
left_time2 = ElapsedMilliseconds() + DoubleClickTime * 3
left_lock = 1
Else
left_time2 = ElapsedMilliseconds()
EndIf
Case #PB_EventType_LeftButtonUp
If Not left_lock And (ElapsedMilliseconds() - left_time1) < ClickTime
PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_leftButtonClick)
EndIf
left_lock = 0
; Middle Button
Case #PB_EventType_MiddleButtonDown
middle_time1 = ElapsedMilliseconds()
middle_diff = ElapsedMilliseconds() - middle_time2
If middle_time2 And middle_diff > 1 And middle_diff < DoubleClickTime
PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_MiddleButtonDoubleClick)
middle_time2 = ElapsedMilliseconds() + DoubleClickTime * 3
middle_lock = 1
Else
middle_time2 = ElapsedMilliseconds()
EndIf
Case #PB_EventType_MiddleButtonUp
If Not middle_lock And (ElapsedMilliseconds() - middle_time1) < ClickTime
PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_MiddleButtonClick)
EndIf
middle_lock = 0
; Right Button
Case #PB_EventType_RightButtonDown
right_time1 = ElapsedMilliseconds()
right_diff = ElapsedMilliseconds() - right_time2
If Right_time2 And right_diff > 1 And right_diff < DoubleClickTime
PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_rightButtonDoubleClick)
right_time2 = ElapsedMilliseconds() + DoubleClickTime * 3
right_lock = 1
Else
right_time2 = ElapsedMilliseconds()
EndIf
Case #PB_EventType_RightButtonUp
If Not right_lock And (ElapsedMilliseconds() - right_time1) < ClickTime
PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_rightButtonClick)
EndIf
right_lock = 0
Case #PB_EventType_MouseWheel
wheel = GetGadgetAttribute(EventGadget(), #PB_Canvas_WheelDelta)
If wheel > 0
PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_MouseWheelUp, wheel)
Else
PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_MouseWheelDown, wheel)
EndIf
EndSelect
EndProcedure
; ***************************************************************************************
CompilerIf #PB_Compiler_IsMainFile
Define Event
If OpenWindow(0, 0, 0, 220, 220, "Canvas Mouse Clicks", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CanvasGadget(0, 10, 10, 200, 200)
BindGadgetEvent(0, @CheckCanvasMouse())
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_Gadget
Select EventGadget()
Case 0
Select EventType()
Case #My_EventType_LeftButtonClick
Debug "Left Button Click"
Case #My_EventType_LeftButtonDoubleClick
Debug "Left Button DoubleClick"
Case #My_EventType_MiddleButtonClick
Debug "Middle Button Click"
Case #My_EventType_MiddleButtonDoubleClick
Debug "Middle Button DoubleClick"
Case #My_EventType_RightButtonClick
Debug "Right Button Click"
Case #My_EventType_RightButtonDoubleClick
Debug "Right Button DoubleClick"
Case #My_EventType_MouseWheelUp
Debug "MouseWheel Up: " + EventData()
Case #My_EventType_MouseWheelDown
Debug "MouseWheel Down: " + EventData()
EndSelect
EndSelect
EndIf
Until Event = #PB_Event_CloseWindow
EndIf
CompilerEndIf
