I have successfully tested the example with the following operating systems:
- MacOS X 10.6.8 (Snow Leopard) with PB 5.30 x86 and x64 in ASCII and Unicode mode
- Ubuntu 12.04 x64 with KDE and Unity with PB 5.30 x64 in ASCII and Unicode mode
- Windows 7 SP1 x64 with PB 5.30 x86 and x64 in ASCII and Unicode mode
You should be aware of a shortcoming of the current solution: each up and down doesn't necessarily mean an up or down of a complete row because this may be configurable by the user on some operating systems. These are my current settings of the tested operating systems for one up/down:
- MacOS X 10.6.8 (Snow Leopard): 1/10th of a row
- Ubuntu 12.04 x64 with KDE and Unity: 1 row
- Windows 7: 3 rows
Code: Select all
EnableExplicit
#ListIcon = 0
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Linux ; --------------------------------------------------
ProcedureC MouseWheelEventHandler(*Event.GdkEventScroll, *UserData)
Protected *ListView.GtkWidget = GadgetID(#ListIcon)
If *ListView\window = gdk_window_get_parent_(*Event\window)
If *Event\type = #GDK_SCROLL
Select *Event\direction
Case #GDK_SCROLL_UP
Debug "Up"
Case #GDK_SCROLL_DOWN
Debug "Down"
EndSelect
EndIf
EndIf
gtk_main_do_event_(*Event)
EndProcedure
CompilerCase #PB_OS_MacOS ; --------------------------------------------------
#NSScrollWheel = 22
Procedure ScanVerticalMouseWheel()
Protected CurrentEvent.I
Protected DeltaY.F
Protected EventType.I
Protected SharedApplication.I = CocoaMessage(0, 0,
"NSApplication sharedApplication")
CurrentEvent = CocoaMessage(0, SharedApplication, "currentEvent")
If CurrentEvent
EventType = CocoaMessage(0, CurrentEvent, "type")
If EventType = #NSScrollWheel
If WindowMouseX(0) >= GadgetX(0) And
WindowMouseX(0) <= GadgetX(0) + GadgetWidth(0)
If WindowMouseY(0) >= GadgetY(0) And
WindowMouseY(0) <= GadgetY(0) + GadgetHeight(0)
CocoaMessage(@DeltaY, currentEvent, "deltaY")
If DeltaY < 0.0
Debug "Up"
Else
Debug "Down"
EndIf
EndIf
EndIf
EndIf
EndIf
EndProcedure
CompilerCase #PB_OS_Windows ; ------------------------------------------------
Define DefaultListIconCallback.I
Procedure CustomListIconCallback(WindowHandle.I, Msg.I, WParam.I, LParam.I)
Shared DefaultListIconCallback.I
If Msg = #WM_MOUSEWHEEL
If (WParam >> 16) & $8000
Debug "Down"
Else
Debug "Up"
EndIf
EndIf
ProcedureReturn CallWindowProc_(DefaultListIconCallback, WindowHandle,
Msg, WParam, LParam)
EndProcedure
CompilerEndSelect
Define i.I
OpenWindow(0, 200, 100, 300, 140, "Detect mouse wheel scrolling")
ListIconGadget(#ListIcon, 10, 10, 280, 120, "Column 1", 100)
For i = 1 To 20
AddGadgetItem(0, -1, "Line " + Str(i))
Next i
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Linux
gdk_event_handler_set_(@MouseWheelEventHandler(), 0, 0)
CompilerCase #PB_OS_Windows
DefaultListIconCallback = GetWindowLongPtr_(GadgetID(#ListIcon), #GWL_WNDPROC)
SetWindowLongPtr_(GadgetID(0), #GWL_WNDPROC, @CustomListIconCallback())
CompilerEndSelect
SetActiveGadget(#ListIcon)
Repeat
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
ScanVerticalMouseWheel()
CompilerEndIf
Until WaitWindowEvent() = #PB_Event_CloseWindow
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
gdk_event_handler_set_(0, 0, 0)
CompilerEndIf