Bay Six Software - WMLiberty Demos

Bay Six Software
Beyond the Basics

Profile

Bay Six Software Forum Index

WMLiberty Demos - Mouse Scroll Wheel

WMLiberty -> Demos -> Window Enhancements -> Mouse scroll wheel (Download)

Code:

' Mouse Scroll Wheel Demo
' By Brent D. Thorn, 1/2008
' Updated 10/2009: changed SendMessage to PostMessage
' Updated 12/2011: Rewritten to be more standardized
' PUBLIC DOMAIN

NoMainWin

' Open DLLs.
Open "WMLiberty" For DLL As #wmlib

' Declare global variables.
Global g.deltaPerLine ' A base unit for scrolling

' Initialize variables.
g.deltaPerLine = GetDeltaPerLine()

' Open main window.
Open "Mouse Wheel Demo" For Graphics As #demo

#demo "TrapClose [quit]"
'' #demo "HorizScrollbar Off" ' BUG: Causes text to disappear
#demo "SetFocus"

' Draw something on it.
#demo "Down; Font Arial 24; Place 8 0;\"
For lin = 1 to 50
#demo "\";lin
Next
#demo "Flush"

' Trap WM_MOUSEWHEEL messages.
Callback lpfnCB, OnMouseWheel( ULong, ULong, ULong, ULong ), Long

ret = SetWMHandler(HWnd(#demo), 522, _ ' WM_MouseWheel
lpfnCB, 0)

[wait] ' Must use a Scan loop.
Scan
CallDLL #kernel32, "Sleep", 50 As Long, ret As Void
GoTo [wait]

[quit]
' Must close windows first.
Close #demo

' Then close WMLiberty.
Close #wmlib

End

Function OnMouseWheel( hWnd, uMsg, wParam, lParam )
' Callback function to process WM_MouseWheel messages.

If g.deltaPerLine = 0 Then Exit Function

delta = GET.WHEEL.DELTA.WPARAM(wParam)

If delta > 0 _
Then cmd = _SB_LineUp _ ' scroll up
Else cmd = _SB_LineDown ' scroll down

delta = Abs(delta)

While delta >= g.deltaPerLine
CallDLL #user32, "PostMessageA", _
hWnd As ULong, _
_WM_VSCROLL As ULong, _
cmd As ULong, _
0 As ULong, _
ret As Long
delta = delta - g.deltaPerLine
Wend
End Function

Function GET.WHEEL.DELTA.WPARAM( wParam )
delta = Int((wParam And 4294901760) / 65536)
If delta > 32767 Then delta = delta - 65536
GET.WHEEL.DELTA.WPARAM = delta
End Function

Function GetDeltaPerLine()
Struct local1, n As ULong
CallDLL #user32, "SystemParametersInfoA", _
104 As ULong, _ ' SPI_GetWheelScrollLines
0 As Long, _
local1 As Struct, _
0 As Long, _
ret As Long
scrollLines = local1.n.struct
If scrollLines Then GetDeltaPerLine = Int(120 / scrollLines)
End Function

Function SetWMHandler( hWnd, uMsg, lpfnCB, lSuccess )
CallDLL #wmlib, "SetWMHandler", _
hWnd As ULong, uMsg As ULong, _
lpfnCB As ULong, lSuccess As Long, _
SetWMHandler As Long
End Function