Using mouse scroll wheel with VB scrollbar

[The_Grudge]

My program uses a scrollbar on one form. Is it possible to link this scrollbar to the center-wheel on the mouse?

[Hack]

I know you have to have a special mouse wheel driver to use the mouse wheel in the VB IDE. I have no idea if that will translate into being able to use the mouse wheel on an actual compiled VB .Exe but you could go get the driver and try it out.

(I can't as I don't have any mice, at home or at work, that has a mouse wheel)

[penagate]

You need to subclass and catch the WM_MOUSEWHEEL message.

[Keithuk]

Here are a couple of apps that demo the mouse wheel.

[dilettante]

Last year's death of Windows XP is the gift that just keeps on giving. Post-XP versions of Windows offer easy access to both vertical and horizontal scrolling from a mouse supporting wheel tilt as well as roll.

Not a lot to it, and the attachment is only so big because of the sample image it contains. Here's a fragment, but there really isn't that much more involved:

Option Explicit

Private Type LONG_JOINED
    Value As Long
End Type

Private Type LONG_SPLIT
    LowValue As Integer
    HighValue As Integer
End Type

Private LONG_JOINED As LONG_JOINED
Private LONG_SPLIT As LONG_SPLIT

Public Function SubclassProc( _
    ByRef hWnd As Long, _
    ByRef uMsg As Long, _
    ByRef wParam As Long, _
    ByRef lParam As Long, _
    ByVal dwRefData As Long) As Long

    Const WM_MOUSEWHEEL As Long = &H20A&
    Const WM_MOUSEHWHEEL As Long = &H20E& 'Requires Vista or later.
    Dim Sum As Integer

    LONG_JOINED.Value = wParam
    LSet LONG_SPLIT = LONG_JOINED

    Select Case uMsg
        Case WM_MOUSEWHEEL
            With VScroll1
                If .Enabled Then
                    Sum = .Value - LONG_SPLIT.HighValue \ 12
                    If 0 <= Sum And Sum <= .Max Then .Value = Sum
                End If
            End With

        Case WM_MOUSEHWHEEL
            With HScroll1
                If .Enabled Then
                    Sum = .Value + LONG_SPLIT.HighValue \ 12
                    If 0 <= Sum And Sum <= .Max Then .Value = Sum
                End If
            End With

        Case Else
            SubclassProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
    End Select
End Function

[dilettante]

Minor but useful enhancement:

    Select Case uMsg
        Case WM_MOUSEWHEEL
            With VScroll1
                If .Enabled Then
                    Sum = .Value - LONG_SPLIT.HighValue \ 12
                    If Sum < 0 Then
                        .Value = 0
                    ElseIf Sum > .Max Then
                        .Value = .Max
                    Else
                        .Value = Sum
                    End If
                End If
            End With

        Case WM_MOUSEHWHEEL
            With HScroll1
                If .Enabled Then
                    Sum = .Value + LONG_SPLIT.HighValue \ 12
                    If Sum < 0 Then
                        .Value = 0
                    ElseIf Sum > .Max Then
                        .Value = .Max
                    Else
                        .Value = Sum
                    End If
                End If
            End With

        Case Else
            SubclassProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
    End Select

[dilettante]

Found another issue with the PictureBox losing focus, so I added that fix and the refinement above and reposted the attachment.

[dilettante]

Also see Scrollbars bart 6 - The wheel for refinement ideas you'd probably want in a real program. Just dividing the zDelta value (high word as signed integer) by 12 was a demo hack, various mouse drivers might return increments in the stock +/- 120 or any whole number divisor of 120 (such as the 30 I am getting here).

[LaVolpe]

@dilettante. every time I see the "XP Obituary" excerpt from you, I can't help but smile.

But I feel that if supporting XP can be done with very minimal effort, then do it. Though XP is officially no-longer supported by M$, I doubt it will be removed from the desktops/laptops of this world for another few to several years. The added plus is that if it does support XP, the potential customer base is quite a bit larger, for now.

[dilettante]

Hey, the code posted above, simplistic as it is, will work on XP. You just don't get the ability to horizontal scroll. Perhaps you know of a pre-Vista message supporting it though?

As for the death of XP, I see it as freeing. No longer are we stuck with pablum because Baby can't eat steak. For far too long we've seen people whining about a solution that requires Vista or later. Vista itself is now pretty long in the tooth and drops off extended support itself in 2017.

How long should we wait to start making use of newer features?

At least this example degrades gracefully.

[dilettante]

I'll admit that my attempts at wry humor usually fail.


BTW:

Anyone who wants to refine this could also take a look at Best Practices for Supporting Microsoft Mouse and Keyboard Devices.

[wqweto]

I've always wondered why WM_MOUSEWHEEL is sent to the focused window when WM_MOUSEMOVE is sent to the window that is immediately under the mouse pointer (unless SetCapture is active).

On the other hand all of the MS Office applications respond to wheel just by hovering over the UI widget. For instance in Outlook you can scroll the list of messages then point to the message preview and scroll it without clicking beforehand. The same "clickless" behavior is implemented in all modern browsers.

What I usually do to "fix" this is to implement a get message hook for the Not InIde version with something like this

    If nCode = HC_ACTION Then
        Call CopyMemory(uMsg, ByVal lParam, Len(uMsg))
        With uMsg
            If .lMessage = WM_MOUSEMOVE Then
                m_hWndLastMouseMove = .hWnd
            ElseIf .lMessage = WM_MOUSELEAVE Then
                m_hWndLastMouseMove = 0
            ElseIf .lMessage = WM_MOUSEWHEEL Then
                If .hWnd <> m_hWndLastMouseMove Then
                    Call GetCursorPos(pt)
                    If m_hWndLastMouseMove = WindowFromPoint(pt.X, pt.Y) Then
                        .hWnd = m_hWndLastMouseMove
                    Else
                        .lMessage = WM_NULL
                    End If
                    Call CopyMemory(ByVal lParam, uMsg, Len(uMsg))
                End If
                ... <<snip>>
            End If
            ... <<snip>>
        End With
    End If

This basically synchronizes WM_MOUSEWHEEL target with last WM_MOUSEMOVE target window. Works very satisfactory provided there is some more code for textbox<->up/down controls negotiation.

@dilettante: You know that ComCtl subclassing is available since NT4 (version 4.72+ of ComCtrl comes with IE 4.0 I believe). The only caveat is to access the required API functions by ordinals like this

Private Declare Function SetWindowSubclass Lib "comctl32" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
Private Declare Function DefSubclassProc Lib "comctl32" Alias "#413" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam 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

Same ordinals are used in all OS version up to Win 8.1 and will be kept forever, I'm using these in production very confidently.

cheers,
</wqw>

[dilettante]

Yep, and that's how I declared them in the demo I posted. Even good back to Windows 95 with the Desktop Update.

Of course with everything pre-Vista dead now...

[Tanner_H]

I've always wondered why WM_MOUSEWHEEL is sent to the focused window when WM_MOUSEMOVE is sent to the window that is immediately under the mouse pointer (unless SetCapture is active).

So true. The funniest thing about this behavior is that it's in direct violation of Microsoft's own guidelines.

- Make the mouse wheel affect the control, pane, or window that the pointer is currently over. Doing so avoids unintended results.
- Make the mouse wheel take effect without clicking or having input focus. Hovering is sufficient.

[Bonnie West]

The Declare aliases aren't necessary as long as the loaded ComCtl32.dll is version 6 or higher (achieved by specifying it in the app manifest). However, since it appears that many VB6 developers still aren't using manifests, subclassing code intended for sharing should therefore ensure compatibility with earlier ComCtl32.dll versions by invoking the ordinal number instead of the function name.

[LaVolpe]

The Declare aliases aren't necessary as long as the loaded ComCtl32.dll is version 6 or higher (achieved by specifying it in the app manifest).

The 1st three below do not require manifests. These were included in v5.8+, without need to alias by ordinal (else earlier version will need the ordinal aliasing). The last one does require manifesting.
SetWindowSubclass
RemoveWindowSubclass
DefSubclassProc
GetWindowSubclass

Edited: GetWindowSubclass was exported as #411 prior to v6 of comctl32.dll