# VBForums CodeBank > CodeBank - Visual Basic 6 and earlier >  Easy & ingenious mousewheel scrolling

## SomeYguy

This demo shows a small, easy, stable and ingenious way to add mousewheel support to most any control such as scrollbars etc.

*Note that the included MouseScroll.bas module is not my code and was not written by me. See comments within that file for author credit & module usage notes.
*
I found this module in one of my old personal code snippet stashes and thought it too good not to re-share and so I made this simple demo.

Advantages: 

- No messy & complicated subclassing.

- Controls are easily added and removed from MW support as needed.

- Minimal code.

I am using this on a couple of projects and it works perfectly. Hope that others find it useful as well  :Smilie: .


*EDIT:* Thanks to Elroy for pointing out that this actually does use subclassing. But it is not very complicated.....

----------


## Elroy

> No messy & complicated subclassing.


Just FYI, that BAS module totally has subclassing in it:



```

HookedWindows(UBoundHookedWindows).ItsOldProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)

```

In fact, it's using the older user32.dll subclassing, rather than the newer (and safer) comctl32.dll subclassing.   :Stick Out Tongue: 

ADDED:  With the comctl32.dll approach to subclassing, there's no need to create that *HookedWindows* array, and all the corresponding *ReDim Preserve* that goes with it.

----------


## SomeYguy

> Just FYI, that BAS module totally has subclassing in it:
> 
> 
> 
> ```
> 
> HookedWindows(UBoundHookedWindows).ItsOldProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
> 
> ```
> ...


Hmm, somehow I missed that. But it is IMO far less complicated than many other methods.....

----------


## Elroy

Here's what I use (in a BAS module):



```

Option Explicit
'
Private Const WM_DESTROY As Long = &H2&
Private Declare Function SetWindowSubclass Lib "comctl32" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function GetWindowSubclass Lib "comctl32" Alias "#411" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, pdwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function NextSubclassProcOnChain Lib "comctl32" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub GetMem4 Lib "MSVBVM60" (Src As Any, Dst As Any)
'
Dim bSetWhenSubclassing_UsedByIdeStop As Boolean ' Never goes false once set by first subclassing, unless IDE Stop button is clicked.
'

Private Sub SubclassSomeWindow(hWnd As Long, AddressOf_ProcToSubclass As Long, Optional dwRefData As Long)
    bSetWhenSubclassing_UsedByIdeStop = True
    Call SetWindowSubclass(hWnd, AddressOf_ProcToSubclass, hWnd, dwRefData)
End Sub

Private Sub UnSubclassSomeWindow(hWnd As Long, AddressOf_ProcToSubclass As Long)
    Call RemoveWindowSubclass(hWnd, AddressOf_ProcToSubclass, hWnd)
End Sub

Private Function IdeStopButtonClicked() As Boolean
    IdeStopButtonClicked = Not bSetWhenSubclassing_UsedByIdeStop
End Function

Private Function ProcedureAddress(AddressOf_TheProc As Long) As Long
    ProcedureAddress = AddressOf_TheProc
End Function

Public Sub SubclassForMouseWheel(TheForm As Form)
    ' For mouse-wheel subclassing.
    SubclassSomeWindow TheForm.hWnd, AddressOf MouseWheel_Proc, ObjPtr(TheForm)
End Sub

Private Function MouseWheel_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
    ' For mouse-wheel subclassing.
    If uMsg = WM_DESTROY Then
        UnSubclassSomeWindow hWnd, AddressOf_MouseWheel_Proc
        MouseWheel_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
        Exit Function
    End If
    If IdeStopButtonClicked Then ' Protect the IDE.  Don't execute any specific stuff if we're stopping.  We may run into COM objects or other variables that no longer exist.
        MouseWheel_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
        Exit Function
    End If
    '
    Dim objStolen As Object
    Dim obj As Object
    Const WM_MOUSEWHEEL     As Long = &H20A&
    Const WM_MOUSEHWHEEL    As Long = &H20E&
    '
    If uMsg = WM_MOUSEWHEEL Or uMsg = WM_MOUSEHWHEEL Then
        GetMem4 dwRefData, objStolen    ' Steal reference.
        Set obj = objStolen             ' Make good reference.
        GetMem4 0&, objStolen           ' Un-steal reference.
        On Error Resume Next            ' In case we/they forgot to put in the MouseWheelDetected procedure.
            If uMsg = WM_MOUSEWHEEL Then
                If wParam > 0 Then
                    obj.MouseWheelDetected -1&
                Else
                    obj.MouseWheelDetected 1&
                End If
            Else ' WM_MOUSEHWHEEL
                If wParam > 0 Then
                    obj.MouseHWheelDetected -1&
                Else
                    obj.MouseHWheelDetected 1&
                End If
            End If
        On Error GoTo 0
    End If
    '
    MouseWheel_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
End Function

Private Function AddressOf_MouseWheel_Proc() As Long
    ' For mouse-wheel subclassing.
    AddressOf_MouseWheel_Proc = ProcedureAddress(AddressOf MouseWheel_Proc)
End Function


```

And to use it, something like this (in your form):



```

Private Sub Form_Load()
    SubclassForMouseWheel Me
End Sub




Public Sub MouseWheelDetected(iUpDown As Long)
    Const WheelZoomSpeed As Single = 0.2!
    moScene.Camera.Zoom iUpDown * WheelZoomSpeed
    moScene.RenderScene
End Sub

Public Sub MouseHWheelDetected(iLeftRight As Long)
    Const WheelPanSpeed As Single = 0.05!
    moScene.Camera.Pan iLeftRight * WheelPanSpeed, 0!
    moScene.RenderScene
End Sub


```

That's in a DirectX application I wrote, but it gives you the idea.  It all seems pretty straightforward to me.

Also, this is detecting horizontal (side-to-side) wheel movements.  I'm not sure if yours is doing that or not.   :Wink: 

ADDED:  Also, just FYI, no static variables (other than bSetWhenSubclassing_UsedByIdeStop, which is just used once for ALL my subclassing), no tracking of previous chain-procedure address, and no concerns about teardown order.   :Smilie: 

(FYI to others: I wrote that many moons ago before I knew about the SetAddRef call.  That's what that objStolen variable is about.)

ADDED2:  Also, just to "rub it in", you've got this in your form:



```
Private Sub Form_Unload(Cancel As Integer)
 '- This MUST be done during unload or bad things will happen.
 RemoveScrollness (Form1.hwnd)
End Sub
```

The way I've done it, there's no need for any cleanup, and it's (mostly) IDE safe, including clicking IDE's "Stop" button so long as nothing modal is showing.

I'll stop now though.   :Smilie:   SomeYguy, you have a fantastic day, and Happy New Year!

----------


## SomeYguy

> SomeYguy, you have a fantastic day, and Happy New Year!


Right back atcha, and thanks for the very good alternate approach to this  :Smilie: .

----------

