VB6-MouseWheel With Any Control

Note: The most up-to-date version of the code is in post #1. WheelHookAllControls.zip includes MSFlexGrid example


It was brought to my attention that controls that already responded to the MouseWheel (combobox, textbox, etc.), would prevent MouseWheel events passing to form, so even if you were over a grid, it would be the combobox that scrolled, and you would have to remove focus from the control before it would work :mad:

I have fixed this so that you can Hook the controls, and if a WM_MOUSEWHEEL event occurs and the mouse is not over the control, it triggers the MouseWheel sub on the form.

The code for scrolling the grid if it's the activecontrol will work fine regardless of other controls responding to scroll events.



EDIT: This was recovered from the original post. The original two attachments are the links WheelHook-NestedControls and WheelHook-AllControls:

These example projects demonstrate enabling the MouseWheel for any control (multiple controls / multiple forms).

Examples

• Enabling MouseWheel Support with any control - attached to post #1
https://www.vbforums.com/images/ieim...chmentid=4668514/03/06: Slight correction to code
https://www.vbforums.com/images/ieim...chmentid=4668520/04/06: Minor modification to code (more info: post #9)
https://www.vbforums.com/images/ieim...chmentid=4668512/01/07: Nested Controls example created allowing the mousewheel to work with controls nested to any depth - incorporates fixes from other posts (1, 2) - attached to post #1

• Scrolling the MSFlexGrid that the mouse is over - attached to post #2
https://www.vbforums.com/images/ieim...chmentid=4668521/02/06: Small bug fix

• Scrolling if the MSFlexGrid is the active control - attached in post #13 of original thread


The hooking code was modified from here.
Original thread, with suggestions from other members.

Note:
These codes use subclassing which can cause your IDE to crash if your code is incorrectly ended (e.g. via the stop button).
See here for adding in code to detect if your program is running in the IDEAttachment 187449Attachment 187450

Excellent work - thanks!

Very good!!

Nice job! :thumb:

New example to demonstrate enabling the MouseWheel for any control (multiple controls / multiple forms) - see post #1

Slight error in my Select Case code - corrected. See Post #1

Hi, nice code and one correction:

VB Code:

Public Sub MouseWheel(ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long)
 
bOver = (ctl.Visible And IsOver(ctl.HWnd, Xpos, Ypos) [B]And ctl.Enabled = True[/B])

Thanks for pointing that out. Rather than checking there I would recommend checking within the Select Case clause, that way it allows the program to deal with it on a per-control basis. For example, you may want to scroll the grid even though it is disabled.

I would therefore make the below change instead, and indeed have done so to the code in post #1

VB Code:

Case TypeOf ctl Is ListBox, TypeOf ctl Is TextBox, TypeOf ctl Is ComboBox
          ' These controls already handle the mousewheel themselves, so allow them to:
          [B]If ctl.Enabled Then[/B] ctl.SetFocus

Your solution is better!

I wrote one universal MouseWheel function for all forms. Sometimes controls are disabled like Textbox and .setFocus crashed.

VB Code:

'added frm, just different solution
Public Sub MouseWheel(frm As Form, ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long)
 
For Each ctl In frm.Controls
'...

Great work but...

I do not like individually testing for min and max for each control, so I extracted those lines into a function in the module:
Public Function MouseWheelChange(CurrentValue As Variant, DeltaValue As Variant, MinValue As Variant, MaxValue As Variant) As Variant
Dim newvalue As Variant
newvalue = CurrentValue + DeltaValue
If newvalue < MinValue Then
newvalue = MinValue
ElseIf newvalue > MaxValue Then
newvalue = MaxValue
End If
MouseWheelChange = newvalue
End Function

The MouseWheel() sub now looks like:
Public Sub MouseWheel(ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long)
On Error Resume Next
If TypeOf Me.ActiveControl Is VScrollBar Then
With VScroll1
.Value = MouseWheelChange(.Value, Sgn(Rotation) * .LargeChange, .Min, .Max)
End With
ElseIf TypeOf Me.ActiveControl Is TextBox Then
Text1.Text = MouseWheelChange(Text1.Text, Rotation, -1000, 1000)
End If
End Sub

Just my 2 cents.

Great code, bushmobile, but is there any way to add support for a tilt wheel (Microsoft IntelliMouse Explorer 5.0). Thanx! :wave:

:sick: I don't know.

In Vista there's going to be a WM_MOUSEHWHEEL message - but i think it might be interpreted as a WM_HSCROLL message pre-vista.

Try adding the constant in the declarations:

VB Code:

Private Const WM_HSCROLL = &H114

then in the WindowProc sub add another case:

VB Code:

Case WM_HSCROLL
        Debug.Print "HSCROLL Message to " & Lwnd

and see what happens.

Hi, this is great piece of code.(exactly what I have been looking for) That being said I’m having some trouble implementing it into one of my projects. I have a form with a Sstab. On the tab I have a combo box and an MsFlexgrid.

I’m getting an error in the module when ever I use Hook Controls to be ignored: Call WheelHook(Combo1.hWnd) ( if I don’t hook the Combo1 then I don’t get the error. But then the msflexgrid has to have focus for the mouse scroll to work)

I get an Object Variable or with block variable not set Error. And VB highlights this line in the module: GetForm(GetParent(Lwnd)).MouseWheel MouseKeys, Rotation, Xpos, Ypos (I’m not familiar at all with API calls so I’m at a loss)

I get this error when I have used the mouse scroll 1st over the combo box and then use the mouse scroll over the form or over the flexgrid.

Any help would be greatly appreciated.( Just being able to mouse scroll all the controls is great, but you spoiled me with sample using the mouse over)

in the module, replace the GetParent API declaration with this one:

VB Code:

Private Declare Function GetAncestor Lib "user32.dll" ( _
                ByVal hwnd As Long, _
                ByVal gaFlags As Long) As Long

add a constant

VB Code:

Private Const GA_ROOT = 2

and then change the line that errors with this one:

VB Code:

GetForm(GetAncestor(Lwnd, GA_ROOT)).MouseWheel MouseKeys, Rotation, Xpos, Ypos

should work.

I tried your solution and it crashed, so I went back and looked at the module
And saw there was still a reference to GetParent:

' it's not a form
If Not IsOver(Lwnd, Xpos, Ypos) And IsOver(GetParent(Lwnd), Xpos, Ypos) Then
' it's not over the control and is over the form,

So instead of of Replacing the GetParent API declaration with the GetAncestor API declaration you must keep the GetParent API and
Add the GetAncestor API

Anyway you put me on the right path and it works like a charm. Thanks
so much

i forgot about that GetParent. you could also replace that one with GetAncestor if you want.

I tested it, and it seems you are correct again. Thanks

Ok so here's the situation. I have a mdi container with a child form inside of it. The child forms is longer than the mdi container which creates a vertical scroll bar.

Is there any way to scroll the mdi container with the mouse wheel. Can this code accomplish what I want to do??

Thanks! Any help would be appreciated!

Use the same idea, but use the mousewheel movement to change the value of the scrollbar.

REMOVED: nvm, my topic is being helped here

This code is great but I need a small help:
How can I use the wheel when the control is (or controls are) contained in a picturebox? :ehh:

Thanks

Does what is mentioned in posts #14, #15, #16, #17 solve your problem?

I've already follow those suggests without any result.
I uploaded your example with all the controls included in a picturebox.
As you can see, that picturebox is always onfocus.

Truely I'm not an API expert :duck:

What should I do? :blush:

hmmm, i've had a look at the brief look at the code but couldn't see anything glaringly wrong.

Unfortunately I don't think i'll have access to VB until Sunday, so you'll probably have to wait until then before i can give you a proper answer.

It means I'm not compleately a newbie :)
oki, I'll work around something else.
Thank you alot :afrog:

ok, was fairly simple when managed to get my hands on VB :)

Don't call the PictureBox 'Picture' - it's a reserved word - i renamed it picMain and then changed this part of the Select Case:

VB Code:

Case TypeOf ctl Is PictureBox
            If Not ctl Is picMain Then
                PictureBoxZoom ctl, MouseKeys, Rotation, Xpos, Ypos
            Else
                bHandled = False
            End If

GREAT :thumb:
I think I have still to study and practise alot :sick:

Thank you very much Bushmobile! :)

Hi bushmobile,

I used your mousewheel code in an existing VB6 app and it worked fine. I altered it slightly because I'm using an MSHFlexgrid instead of an MSFlexgrid. I'm running into another problem though. In my MSHFlexgrid I list rows of invoices, some billed and some unbilled. The user has options to list all invoices, only billed invoices or only unbilled invoices. When the user takes the option to list only billed invoices, the program loops through the grid row by row and sets the .rowheight = 0 for those rows that are unbilled and and sets the .rowheight = -1 for rows that are billed. This code works great for hiding rows but for whatever reason, once the routine completes, the mousewheel no longer works on the grid. I tried all kinds of things to figure out where the problem is and everything seems to point to setting the rowheight to 0. I tried setting the rowheight to like 50 and that worked but it looked ugly. Any thoughts?

Thanks.

Great Job

Quote:

---

Originally Posted by qvqnytowl

everything seems to point to setting the rowheight to 0. I tried setting the rowheight to like 50 and that worked but it looked ugly. Any thoughts?

---

How about not loading the grid with the records you don't want displayed? Are you loading it from a database? If so, the solution is simple - a Where clause in your select statement.

@qvqnytowl:

whoops, sorry - i completely forgot about your question. This version should work fine for you:

VB Code:

Public Sub FlexGridScroll(ByRef FG As MSFlexGrid, ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long)
    Dim lNewVal As Long, lStep As Long
    
    With FG
        lStep = .Height \ .RowHeight(0)
        If .Rows < lStep Then Exit Sub
        
        If Rotation > 0 Then
            lNewVal = .TopRow - lStep
            If lNewVal < .FixedRows Then lNewVal = .FixedRows
            Do While .RowHeight(lNewVal) = 0 And lNewVal > .FixedRows
                lNewVal = lNewVal - 1
            Loop
        Else
            
            lNewVal = .TopRow + lStep
            If lNewVal > .Rows - 1 Then lNewVal = .Rows - 1
            Do While .RowHeight(lNewVal) = 0 And lNewVal < .Rows - 1
                lNewVal = lNewVal + 1
            Loop
        End If
        .TopRow = lNewVal
    End With
End Sub

Worked great - thanks!

Unexpected problem:

Running WinHook2 example (project1):
Stick a dummy event on form1
Click Run Tool Button - all okay
Click Stop Tool Button - all okay
Put a breakpoint on the dummy event
Run - VB6 freezes when it hits the breakpoint
ctlBreak has no effect - must be ended with
Task Manager

In my own project:
When WheelHook has been called, and a breakpoint (anywhere
in the project) has been hit, VB6 proceeds normally but
clicking the Stop tool button causes VB6 to close immediately.

Commenting out the WheelHook call results in normal behavior.

Any thoughts?

Thanks,
John

You cannot have subclassing when in the IDE - it causes the IDE to blow up (like you just discovered!).

Look at posts 36 and 37 in this thread of a way around this problem:

http://www.vbforums.com/showthread.php?t=388077

Quote:

---

Originally Posted by Me in post #1

These codes use subclassing which can cause your IDE to crash if your code is incorrectly ended (e.g. via the stop button).

---

subclassing works fine in the IDE (and the exe) unless the normal program flow is interrupted - for example, by pressing the stop button or attempting any runtime debugging.

Thanks guys!
I've learned sooo much these last few days.
Lucky to have found this site!!

Added an example that works with nested controls - see post #1 for details

There appears to be an error with the code that works by hovering over a flexgrid.
You can end up with an invalid row value.
Isn't it easier to just do something like this?

vb Code:

Public Sub FlexGridScroll(ByRef FG As MSFlexGrid, ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long)
  Dim NewValue As Long
  Dim Lstep As Single
 
  On Error Resume Next
  With FG
'    Lstep = .Height / .RowHeight(0)
'    Lstep = Int(Lstep)
'    If .Rows < Lstep Then Exit Sub
'    Do While Not (.RowIsVisible(.TopRow + Lstep))
'      Lstep = Lstep - 1
'    Loop
'    If Rotation > 0 Then
'        NewValue = .TopRow - Lstep
'        If NewValue < 1 Then
'            NewValue = 1
'        End If
'    Else
'        NewValue = .TopRow + Lstep
'        If NewValue > .Rows - 1 Then
'            NewValue = .Rows - 1
'        End If
'    End If
 
    If Rotation > 0 Then
        NewValue = .TopRow - 5
        If NewValue < 1 Then
            NewValue = 1
        End If
    Else
        NewValue = .TopRow + 5
        If NewValue > .Rows - 1 Then
            NewValue = .Rows - 1
        End If
    End If
    .TopRow = NewValue
  End With
End Sub

This also doesn't scroll so much either.
I put in 5 as it is my preferred number of rows to scroll.
There is a setting in the control panel which lets you specify number of lines to scroll at a time
It would good if the code could pick this up and insert it.

Hello everyone,

For the last couple of years, I used the code listed in the above posts to do my mouse scrolling and it worked fairly well. One thing I didn't like was that if I was debugging my program and the program hit a break point, VB would close with the dreaded "VB must shutdown now..." message. If I had made a couple of changes but forgotten to hit the save button prior, oh well. Small inconvenience I suppose.

The other day I found this zip file in one of my folders and wondered why I had never tried it. Maybe it's been mentioned on this board before and if so, I apologize. I unzipped it and loaded it and I swear, it couldn't work more perfectly for me. The only setting I changed that wasn't a default was on the Settings tab where I checked the "Scroll the window underneath the mouse pointer" option. I had concerns that it might not work for Vista but I loaded it on a Vista machine and it worked perfectly. It even overrides the MouseWheel code if you leave it in your application. (I commented out all my code so I wouldn't have the debug problem anymore.)

Oh, did I mention it's free?

http://www.geocities.com/SiliconVall...freewheel.html

Anyway, I hope this is helpful to someone.

Quote:

---

Originally Posted by Elroy

I'll stand by both of those quotes until I'm shown some specific code that contradicts them. I subclass all kinds of stuff in my primary project (with 100s of module and 100s of forms), and I don't have any problems at all with crashing the IDE.

---

If you really want to experience the crash yourself, it's very easy to replicate. Slap a "Microsoft InkEdit Control" on a form, subclass it with your favorite method, don't even need to write any additional code, press F5 to run the project, close the form, the IDE will crash. To avoid the crash, unsubclass it explicitly.

Just because unsubclassing on "WM_DESTROY" works for most controls doesn't mean it's a good practice but to each his own I guess...

Quote:

---

Originally Posted by VanGoghGaming

If you really want to experience the crash yourself, it's very easy to replicate. Slap a "Microsoft InkEdit Control" on a form, subclass it with your favorite method, don't even need to write any additional code, press F5 to run the project, close the form, the IDE will crash. To avoid the crash, unsubclass it explicitly.

Just because unsubclassing on "WM_DESTROY" works for most controls doesn't mean it's a good practice but to each his own I guess...

---

I did spend a bit of time looking at the InkEdit control, and apparently it doesn't issue a DestroyWindow call when the form it's on is destroyed. IMO, that's a bug in the InkEdit control, and a possible memory leak. I Googled, and apparently there some degree of discussion about this bug in the InkEdit control. Furthermore, this is the first time I've seen such a bug in a user control (as destroying any created hWnd is sort of a "first order of business" when writing such controls).

----------

So, a couple of thoughts:

1) I don't see a reason to generally change my style of subclassing because of a bug in one specific control. I've never used the InkEdit control, but, if I ever do, and I also wish to subclass it, I'll try and remember this.

2) We're getting pretty far afield from the subject of this thread. So, if you (or anyone) wishes to discuss this further, I'd recommend starting a new thread over in the regular Q&A area.

Quote:

---

Originally Posted by bushmobile

subclassing works fine in the IDE (and the exe) unless the normal program flow is interrupted - for example, by pressing the stop button or attempting any runtime debugging.

---

Is it not possible to capture the events of pressing the stop button or attempting any runtime debugging that does to remove hook at that moment?

Some message or event has to happen when the stop or debug button is pressed.

Page 2 of this thread has been damaged in some way. The posts on page 1 are accessible, as are the posts on this page, but those on page 2 will probably never be. Whether or not this can be cleaned up remains to be seen.

In an attempt to clean up the corrupted portion of page 2, I managed to screw up the entire thread. Fortunately, it was still in the buffer, so I moved all the posts that were good over to a new thread. I couldn't move the original post, as that would effectively move the entire thread...including the corruption, which then spread to the entire thread.

Therefore, I moved the contents of the first post of the old thread into the first post of the current thread, which was the second post of the old thread.

The posts that were on the second page are now lost, and almost certainly will remain so. Hopefully, there was nothing too important on there.

Thanks Shaggy. We (or definitely I) absolutely appreciate all you do. :)

Quote:

---

Originally Posted by James Reynolds

Is it not possible to capture the events of pressing the stop button or attempting any runtime debugging that does to remove hook at that moment?

Some message or event has to happen when the stop or debug button is pressed.

---

I think I find the answer, is in a code of VbAccelerator, here I put code of VBAccelerator and Work perfect, not crash the IDE when Pres Stop Button and also Permit Debug, and is very Flexible and Easy to implement in Any Form or Control, you can subclass what you want with the messages you want to intercept, and the funny thing is that the code is from VBAccelerator from 2004!!!

Here I put the VBAccelerator codes:
https://www.vbforums.com/showthread....60#post5602660
(In the message #53)

Sorry, not find how erase a message