My program uses a scrollbar on one form. Is it possible to link this scrollbar to the center-wheel on the mouse?
Printable View
My program uses a scrollbar on one form. Is it possible to link this scrollbar to the center-wheel on the mouse?
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)
You need to subclass and catch the WM_MOUSEWHEEL message.
Here are a couple of apps that demo the mouse wheel.
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:
Code: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
Minor but useful enhancement:
Code: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
Found another issue with the PictureBox losing focus, so I added that fix and the refinement above and reposted the attachment.
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).
@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.
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.
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.
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
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.Code: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
@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
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.Code: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
cheers,
</wqw>
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...
So true. The funniest thing about this behavior is that it's in direct violation of Microsoft's own guidelines.Quote:
Originally Posted by wqweto
:rolleyes:Quote:
- 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.
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.
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.Quote:
Originally Posted by Bonnie West
SetWindowSubclass
RemoveWindowSubclass
DefSubclassProc
GetWindowSubclass
Edited: GetWindowSubclass was exported as #411 prior to v6 of comctl32.dll