# VBForums CodeBank > CodeBank - Visual Basic 6 and earlier >  VB6 - MouseWheel with Any Control (originally just MSFlexGrid Scrolling)

## bushmobile

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
_14/03/06:_ Slight correction to code
_20/04/06:_ Minor modification to code (more info: post #9)
_12/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
_21/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 IDE

----------


## bushmobile

*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.

----------


## szlamany

Excellent work - thanks!

----------


## |2eM!x

Very good!!

----------


## Hack

Nice job!  :Thumb:

----------


## bushmobile

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

----------


## bushmobile

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

----------


## darki

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])

----------


## bushmobile

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

----------


## darki

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
'...

----------


## VBcannon

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.

----------


## ididntdoit

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

----------


## bushmobile

:Sick:  I don't know.

In Vista there's going to be a WM_MOUSE*H*WHEEL 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.

----------


## Budro

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)

----------


## bushmobile

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.

----------


## Budro

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

----------


## bushmobile

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

----------


## Budro

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

----------


## adamm83

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!

----------


## Al42

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

----------


## adamm83

*REMOVED:* nvm, my topic is being helped here

----------


## Bri0

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

----------


## bushmobile

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

----------


## Bri0

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:

----------


## bushmobile

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.

----------


## Bri0

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

----------


## bushmobile

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

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

----------


## Bri0

GREAT   :Thumb:  
I think I have still to study and practise alot   :Sick:  

Thank you very much Bushmobile!   :Smilie:

----------


## qvqnytowl

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.

----------


## shakti5385

Great Job

----------


## Al42

> 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.

----------


## bushmobile

@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

----------


## jm1248

Worked great - thanks!

----------


## jm1248

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

----------


## szlamany

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

----------


## bushmobile

> 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.

----------


## jm1248

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

----------


## bushmobile

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

----------


## agmorgan

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.

----------


## qvqnytowl

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.

----------


## Al42

> 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.


It's simple enough to set a variable in Form_Load to tell whether you're in the IDE.  (Debug.Print 1/0 and set the variable to "I'm in the IDE" in the error trap, then resume next.)

If you're NOT in the IDE, set up the subclassing for the mousewheel.  Same thing in Form_Unload - only reset the subclassing if you're not in the IDE.  For the few times you actually need to work on the scrolling you can comment out the line that sets the variable.

----------


## JJkok

Hi, I'm using VB6. I used the WheelHook-NestedControls reference code from post 1 in my exe project and it works very well. 

However, when I ported the code into a ActiveX project, the mouse wheel was no longer working on the flexgrid. I'm guessing I cannot simply use GetParent for the ocx code, but my understanding in this area is weak. Can someone help? Thank you.

----------


## taigovinda

Hi,

I know very little about code and don't follow most of this thread, but I get the idea that your code can solve my problem and am hoping that someone can give me a little bit of help with it.

I am using Excel 2003 and whenever a listbox has the focus and you use the mousewheel, Excel crashes completely.  Will the code in this thread fix that problem?  Can someone tell me where to paste it in (sheetcode?) so that it will work?

Thanks!!!

Tai

----------


## si_the_geek

Welcome to VBForums  :wave: 

Adding code (whether from here or elsewhere) will not do you any good.

There might be existing code that runs, in which case temporarily removing it might remove the problem too (but perhaps cause other issues).  Alternatively there may be corruption in Excel or your mouse driver, or some other issue.


It would be best to post a new thread about your problem in our General PC forum (or perhaps the Office Development forum instead).

----------


## manik726

Thank you soo much Bushmobile...  this code has helped me a lot  :Smilie:

----------


## alMubarmij

How can I use it with *DataGrid* ?

----------


## DROB

Original post by *qvqnytowl*

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. 


Sounds useful, as has been this excellent thread.   Unfortunately, the link no longer works.  Anyone have any suggestions?   Thanks..

----------


## _Wired_

2nd emotion to alMubarmij post... how can we use it to DataGrid?

----------


## RCox

This is a very interesting thread and I hope that there are still some veterans of this thread lurking about.  One of the final code revisions concerned using the mouse wheel with any depth of nested controls.

My problem is just the opposite.  I have several MDI forms, all of which have a PictureBox which acts as a container for an array of over 250 TextBox controls, over 20 CheckBox controls, and various and sundry other stuff.  The only thing I need to scroll is the PictureBox (which has scrollbars) on the form that has control, regardless of which control on the form has the focus.  Is there an efficient way to hook the WM_MOUSEWHEEL message for all of the controls and pass it to the VScroll without having to call WheelHook and WheelUnHook on all of the controls in the form?

Ray

----------


## si_the_geek

I haven't checked the code, but I suspect you do need to hook/unhook all of them - which wont be too hard because you can use a For Each loop, eg:


```
Dim objControl as Control
For Each objControl In Me.Controls
  Select Case TypeName(objControl)
  Case "TextBox", "PictureBox"
     'hook/unhook here using objControl
  End Select
Next objControl
```

----------


## LaVolpe

> ... Is there an efficient way to hook the WM_MOUSEWHEEL message for all of the controls and pass it to the VScroll without having to call WheelHook and WheelUnHook on all of the controls in the form?
> Ray


I am not knocking the original code, but personally I would have done it differently.  Wouldn't use subclassing, instead would use a windows hook:  SetWindowsHookEx with the WH_GETMESSAGE hook type. Hooks are for the entire thread; not a single window. It not only passed the window message  but which hWnd the message was intended for. So this can be used as is, or overridden with custom code to form a chain....

This change would be a change in logic for the entire project uploaded in post #1.  So it isn't a simple change.  To enable only a single window at a time to get the mousewheel message, a public variable can be used that contains the active hWnd.  To allow a chain of windows, then more creativity would be required.  

That's my two-cents worth.  Doesn't directly answer your question, I know.

----------


## RCox

OK...I'm trying to make this work with the SetWindowsHookEx method and am having no luck in vb6.  Code is as follows:



```
Form Code_______


Private Sub Form_Activate()
   ...
  IMWheel_Hook
   ...
End Sub

Private Sub Form_Deactivate()
   ...
  IMWheel_Unhook
   ...
End Sub

Public Sub WheelMoved(ByVal delta As Long, X As Long, Y As Long)
 ' this just to tell me when it is basically working...functional code later!
  response = MsgBox("Mouse wheel moved", vbOKOnly, "Mouse")
End Sub


End Form Code___________


Module Code ___________

Public Const WH_GETMESSAGE = 3
Public Const MSH_MOUSEWHEEL = "MSWHEEL_ROLLMSG"
Public IMWHEEL_MSG&
Public HWND_HOOK&

Public Type WH_MSG
  hwnd As Long
  Message As Long
  wParam As Long
  lParam As Long
  time As Long
  pt As POINTAPI
End Type

Public Declare Function RegisterWindowMessage& Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String)
Public Declare Function SetWindowsHookEx& Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long)
Public Declare Function UnhookWindowsHookEx& Lib "user32" (ByVal hHook As Long)
Public Declare Function CallNextHookEx& Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Integer, lParam As Any)
Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Public Function IMWheel_Hook() As Long
  IMWHEEL_MSG& = RegisterWindowMessage(MSH_MOUSEWHEEL)
  HWND_HOOK& = SetWindowsHookEx(WH_GETMESSAGE, AddressOf IMWheel, 0, GetCurrentThreadId)
End Function

Public Sub IMWheel_Unhook()
  UnhookWindowsHookEx HWND_HOOK&
End Sub

Public Function IMWheel(ByVal nCode As Long, ByVal wParam As Long, lParam As WH_MSG) As Long
   If lParam.Message = IMWHEEL_MSG& Then
     SARUniv.WheelMoved lParam.wParam, lParam.pt.X, lParam.pt.Y
   End If
  IMWheel = CallNextHookEx(HWND_HOOK&, nCode, wParam, lParam)
End Function
```


When run in the environment, nothing happens with the scrollwheel.  When the app is ended, the MsgBox will pop up however many times the  scrollwheel was moved while the app was running.  When compiled (pcode) and run, nothing at all happens with the scrollwheel.

Anyone spot anything wrong?

R.

----------


## LaVolpe

Don't only look for IMWHEEL_MSG (primarily used for older O/S), also look for WM_MOUSEWHEEL (and in Vista+, WM_MOUSEHWHEEL for horizontal mousewheel messaes).  Read the msdn documentation for more information

----------


## capn-jack

I joined just for this thread!  Wow, if I can figure out how this works, there are a number of cool uses for the wheel.....

----------


## silkvb

Hey there,

I like this, works like a charm. 

However once the form has loaded, I'm finding debug doesn't work correctly - once you hit a breakpoint the VB6 IDE doesn't respond to any mouse clicks. 

You can use F-keys to navigate debugging but you can't get focus on your debug window or immediate window. And if your app form happens to be in front you can't see the code you're debugging either.

----------


## si_the_geek

Welcome to VBForums  :wave: 

Unfortunately that behaviour is expected (or rather, it is _better_ than expected) because this code uses hooking.  What normally happens when you try to debug code that uses hooking is that VB crashes completely, and it wouldn't be surprising if it happens to you at some point.

There are ways to avoid the crashes if you really need to debug the hooking code itself, but the simplest solution is to not use hooking while you are running code in VB. To make that easier use code like this InIDE routine, and make these changes:


```
Private Sub Form_Activate()
   ...
  If Not InIDE Then IMWheel_Hook
   ...
End Sub

Private Sub Form_Deactivate()
   ...
  If Not InIDE Then IMWheel_Unhook
   ...
End Sub
```

----------


## silkvb

Thanks for that si,

What I don't understand is why "non hook" code also has this issue. e.g. putting some code on the click event of a control, and debugging that, is doing the same thing.

I'm new to the concept of hooking and not really sure when "the windows function" gets called or even what it is (as it is only ever unhelpfully referred to as "the windows function" in msdn). If I take a wild guess that it gets called for all events of the form and it's controls, then in effect none of the app is de-buggable. 

I guess there's no way to have hooking enabled AND debug then - which is a shame because you might one day want to debug some of the mousewheel stuff.

----------


## si_the_geek

Does the same thing happen for a brand new project?  If not then my fix above is incomplete (I wasn't thorough!)

As for the term "the windows function", I would have to see the article that uses it to be sure, but unless you have the need to write your own hooking code I recommend simply using this code as a black-box that "just works".

In terms of debugging the hooking code, it is possible as I implied above... but it takes more effort, and is unlikely to be needed because this has been well tested by many people already.

----------


## silkvb

Sorry, my bad - I meant "the window procedure"

http://allapi.mentalis.org/apilist/SetWindowLong.shtml
http://msdn.microsoft.com/en-us/libr...8VS.85%29.aspx

It's nice that I can set a new address to it, but what is it? Or am I just being thick  :Wink: 

As for your fix - I thought that was just a blanket "turn it all off or on" depending what mode you're in. I haven't tried it yet but it's good to know it's there.

What I was saying is that with hooking turned on, I can't debug *any* code. So lets say I add a new control to the form, and on click put up a messagebox - debug that line of code and it still gets "stuck" behind the app window. It's no big deal if you turn the hooking off in debug anyway (as per your solution) - I was just being curious  :Smilie:

----------


## si_the_geek

If you look at post #52 above, the window procedure is the _IMWheel_ function.  Hooking causes it to be run automatically by Windows when particular things happen (such as the mouse wheel moving).

Hooking does cause problems for debugging the entire project, which is why my suggestion disables the hooking when running in VB.

----------


## Malisk

I'm using an AdobePDF view control which does not have a hWnd method. Doesn't look like there is any discussion about controls without that method. 

Any way to get it to work without it?

I have attached a sample project so you know what I'm working with (youll have to have adobe reader 8 or above). The user needs to scroll the pdf viewer while focus is on the text box (though they could leave the mouse over the adobe control like in the examples in this thread).

----------


## Heravar

There's no need to say this is a Great code.
I've used it mostly for MSHFlexgrids, and now I wanted to use it for VScrolls, searching this thread someone mentioned them and gave me the idea to modify the code a little:



```
Private Sub MouseWheel(ByVal MouseKeys As Long, _
                       ByVal Rotation As Long, _
                       ByVal Xpos As Long, _
                       ByVal Ypos As Long, _
                       ByVal frm As Form)
Dim ctl As Control
Dim bHandled As Boolean
Dim bOver As Boolean
Dim ctlDefaultVScroll As Control
   
   Set ctlDefaultVScroll = Nothing
  
   For Each ctl In frm.Controls
      ' Is the mouse over the control
      On Error Resume Next
      bOver = (ctl.Visible And IsOver(ctl.hWnd, Xpos, Ypos))
      On Error GoTo 0
      
      If bOver Or TypeOf ctl Is VScrollBar Then
         ' If so, respond accordingly
      
         If bOver Then bHandled = True
      
         Select Case True
            
            Case TypeOf ctl Is MSHFlexGrid
               FlexGridScroll ctl, MouseKeys, Rotation, Xpos, Ypos
                
            Case TypeOf ctl Is PictureBox, TypeOf ctl Is Image
               PictureBoxZoom ctl, MouseKeys, Rotation, Xpos, Ypos
                  
            Case TypeOf ctl Is ListBox, TypeOf ctl Is TextBox, TypeOf ctl Is ComboBox
               ' These controls already handle the mousewheel themselves, so allow them to:
               If ctl.Enabled Then ctl.SetFocus
            
            Case TypeOf ctl Is VScrollBar
               Set ctlDefaultVScroll = ctl
            
            Case Else
                bHandled = False
   
         End Select
         If bHandled Then Exit Sub
      End If
      bOver = False
   Next ctl
   
   ' Scroll was not handled by any controls, so treat as a general message send to the form
   
   'º Instead, I check if it has a VScroll, and if it has, I use it
   ' Me.Caption = "Form Scroll " & IIf(Rotation < 0, "Down", "Up")
   If Not ctlDefaultVScroll Is Nothing Then
      With ctlDefaultVScroll
         .Value = MouseWheelChange(.Value, -1 * Sgn(Rotation) * .LargeChange, .Min, .Max)
      End With
   End If
  
End Sub

Private 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
```

That way, if no control is selected, and the form has a VScroll, it will use it.

 :wave:

----------


## Shenware

WARNING ABOUT THIS CODE

 I just spent the last two months trying to figure out why my Visual Basic 6 IDE froze on both my Windows 7 and XP computers. Even reformatted the hard drive in the XP and reloaded Windows, drivers, updates, etc. IDE still froze. I finally traced it down to this mouse wheel module. It work fine for a year. Not any more!

Just now I noticed the fine print: "These codes use subclassing which can cause your IDE to crash".

I sure did for me.

Beware of this code!!!!!

----------


## badialsoft

Dear's can anybody help 

I want to implement mouse scroll inside Active x Control in VB6.
Please guide me.

----------


## Peekay

bushmobile,
If you are still an active member ...

I implemented this code (post 1) a few years ago and it did not work me. I have tried it now again and it does not work for me.
There is not error thrown in the code.
I have an idea it is because I have a MSHFlexgrid. Could that be a problem?

Thanks
PK

----------


## Schmidt

> I have an idea it is because I have a MSHFlexgrid. Could that be a problem?


Just use the (nearly fully) compatible alternative from Krool (VBFlexGrid)...
It comes with MouseWheel-support built-in.

Olaf

----------


## Peekay

Thanks Olaf,

I will study it.

PK

----------


## Black_Storm

> 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
> _14/03/06:_ Slight correction to code
> _20/04/06:_ Minor modification to code (more info: post #9)
> _12/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
> 
> ...


if i change combo1.style to simple combo scroll  or if i change text1.scrollbars to none  ,mousewheel not will be work,how can fix them or like these?
maybe i need use mousewheel without scrollbars of controls like as 2 sample i told.

----------

