A small but very useful code which emulates exactly, but more flexible,
the progressive MouseWheel as it is realized in MacOS, for all OS at the same.
Once you've used it, you won't want it any other way.
Code: Select all
EnableExplicit
; Progressive speed MouseWheel - Adjustable - DPI aware - by Saki
Define window_ID=OpenWindow(#PB_Any, 0, 0, 300, 650, "Move the MouseWheel", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
If window_ID
Define canvas_ID=CanvasGadget(#PB_Any, 10, 10, WindowWidth(window_ID)-20, WindowHeight(window_ID)-20)
If canvas_ID
Define win_event, get_wheel, step_result, stepwidth.f, time.q, DR.f=DesktopResolutionX()
Define timeout=400 ; Here you can adjust the progression
Define max_step_width=50 ; Here you can adjust the max step width
Define pos_y=GadgetHeight(canvas_ID)/2*DR
max_step_width*DR
SetGadgetColor(canvas_ID, #PB_Gadget_BackColor, #Black)
If StartDrawing(CanvasOutput(canvas_ID))
Box(0, GadgetHeight(canvas_ID)/2*DR, GadgetWidth(canvas_ID)*DR, 20*DR, #White)
Box(20*DR, pos_y, (GadgetWidth(canvas_ID)-40)*DR, 20*DR, #Red)
StopDrawing()
EndIf
Repeat
win_event=WaitWindowEvent()
If ElapsedMilliseconds()>time+timeout : stepwidth=1 : EndIf
If win_event=#PB_Event_Gadget And EventGadget()=canvas_ID
If EventType()=#PB_EventType_MouseWheel
time=ElapsedMilliseconds()
get_wheel=GetGadgetAttribute(canvas_ID, #PB_Canvas_WheelDelta)
If get_wheel>0 : step_result=-stepwidth
ElseIf get_wheel<0
step_result=stepwidth
EndIf
stepwidth+DR
If stepwidth>max_step_width
stepwidth=max_step_width
ElseIf stepwidth<-max_step_width
stepwidth=-max_step_width
EndIf
pos_y+step_result
If StartDrawing(CanvasOutput(canvas_ID))
Box(0, 0, GadgetWidth(canvas_ID)*DR, GadgetHeight(canvas_ID)*DR, #Black)
Box(0, GadgetHeight(canvas_ID)/2*DR, GadgetWidth(canvas_ID)*DR, 20*DR, #White)
Box(20*DR, pos_y, (GadgetWidth(canvas_ID)-40)*DR, 20*DR, #Red)
StopDrawing()
EndIf
EndIf
EndIf
Until win_event=#PB_Event_CloseWindow
EndIf
EndIf