Click to See Complete Forum and Search --> : VB6 - MouseWheel with Any Control (originally just MSFlexGrid Scrolling)
bushmobile
Feb 18th, 2006, 04:22 PM
These example projects demonstrate enabling the MouseWheel for any control (multiple controls / multiple forms).
Examples
• Enabling MouseWheel Support with any control (http://www.vbforums.com/attachment.php?attachmentid=47024) - attached to post #1
http://www.vbforums.com/attachment.php?attachmentid=4668514/03/06: Slight correction to code
http://www.vbforums.com/attachment.php?attachmentid=4668520/04/06: Minor modification to code (more info: post #9 (http://www.vbforums.com/showthread.php?p=2361787#post2440032))
http://www.vbforums.com/attachment.php?attachmentid=4668512/01/07: Nested Controls (http://www.vbforums.com/attachment.php?attachmentid=53828) example created allowing the mousewheel to work with controls nested to any depth - incorporates fixes from other posts (1 (http://www.vbforums.com/showthread.php?p=2526373#post2526373), 2 (http://www.vbforums.com/showthread.php?p=2747791#post2747791)) - attached to post #1
• Scrolling the MSFlexGrid that the mouse is over (http://www.vbforums.com/attachment.php?attachmentid=45461) - attached to post #2
http://www.vbforums.com/attachment.php?attachmentid=4668521/02/06: Small bug fix
• Scrolling if the MSFlexGrid is the active control (http://www.vbforums.com/attachment.php?attachmentid=45408) - attached in post #13 of original thread
The hooking code was modified from here (http://www.adit.co.uk/html/mousewheelsupport.html).
Original thread (http://www.vbforums.com/showthread.php?t=388077), 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 (http://www.vbforums.com/showthread.php?t=231468) for adding in code to detect if your program is running in the IDE
bushmobile
Feb 19th, 2006, 11:51 AM
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
Feb 19th, 2006, 12:40 PM
Excellent work - thanks!
|2eM!x
Feb 20th, 2006, 01:26 PM
Very good!!
Hack
Feb 23rd, 2006, 06:04 AM
Nice job! :thumb:
bushmobile
Mar 10th, 2006, 08:43 AM
New example to demonstrate enabling the MouseWheel for any control (multiple controls / multiple forms) - see post #1
bushmobile
Mar 14th, 2006, 01:54 PM
Slight error in my Select Case code - corrected. See Post #1
darki
Apr 20th, 2006, 04:48 AM
Hi, nice code and one correction:
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) And ctl.Enabled = True)
bushmobile
Apr 20th, 2006, 05:11 AM
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 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
darki
Apr 20th, 2006, 06:19 AM
Your solution is better!
I wrote one universal MouseWheel function for all forms. Sometimes controls are disabled like Textbox and .setFocus crashed.
'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
Apr 26th, 2006, 04:14 PM
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
Jun 22nd, 2006, 07:09 PM
Great code, bushmobile, but is there any way to add support for a tilt wheel (Microsoft IntelliMouse Explorer 5.0). Thanx! :wave:
bushmobile
Jun 22nd, 2006, 07:32 PM
: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:Private Const WM_HSCROLL = &H114then in the WindowProc sub add another case: Case WM_HSCROLL
Debug.Print "HSCROLL Message to " & Lwndand see what happens.
Budro
Jun 27th, 2006, 11:43 AM
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
Jun 27th, 2006, 12:42 PM
in the module, replace the GetParent API declaration with this one:Private Declare Function GetAncestor Lib "user32.dll" ( _
ByVal hwnd As Long, _
ByVal gaFlags As Long) As Longadd a constantPrivate Const GA_ROOT = 2and then change the line that errors with this one:GetForm(GetAncestor(Lwnd, GA_ROOT)).MouseWheel MouseKeys, Rotation, Xpos, Ypos
should work.
Budro
Jun 27th, 2006, 03:55 PM
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
Jun 27th, 2006, 03:59 PM
i forgot about that GetParent. you could also replace that one with GetAncestor if you want.
Budro
Jun 27th, 2006, 04:56 PM
I tested it, and it seems you are correct again. Thanks
adamm83
Jul 5th, 2006, 03:45 PM
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
Jul 5th, 2006, 03:49 PM
Use the same idea, but use the mousewheel movement to change the value of the scrollbar.
adamm83
Jul 6th, 2006, 02:26 PM
REMOVED: nvm, my topic is being helped here (http://vbforums.com/showthread.php?p=2536172#post2536172)
Bri0
Aug 16th, 2006, 12:11 PM
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
Aug 16th, 2006, 12:28 PM
Does what is mentioned in posts #14, #15, #16, #17 solve your problem?
Bri0
Aug 16th, 2006, 01:01 PM
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
Aug 16th, 2006, 02:07 PM
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
Aug 16th, 2006, 03:07 PM
It means I'm not compleately a newbie :)
oki, I'll work around something else.
Thank you alot :afrog:
bushmobile
Aug 20th, 2006, 02:26 PM
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: Case TypeOf ctl Is PictureBox
If Not ctl Is picMain Then
PictureBoxZoom ctl, MouseKeys, Rotation, Xpos, Ypos
Else
bHandled = False
End If
Bri0
Aug 20th, 2006, 06:20 PM
GREAT :thumb:
I think I have still to study and practise alot :sick:
Thank you very much Bushmobile! :)
qvqnytowl
Aug 25th, 2006, 02:44 PM
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
Sep 7th, 2006, 06:56 AM
Great Job
Al42
Sep 7th, 2006, 03:26 PM
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
Sep 7th, 2006, 04:35 PM
@qvqnytowl:
whoops, sorry - i completely forgot about your question. This version should work fine for you: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
Jan 2nd, 2007, 08:56 AM
Worked great - thanks!
jm1248
Jan 3rd, 2007, 03:46 PM
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
Jan 3rd, 2007, 03:53 PM
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
Jan 3rd, 2007, 05:56 PM
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
Jan 4th, 2007, 01:01 PM
Thanks guys!
I've learned sooo much these last few days.
Lucky to have found this site!!
bushmobile
Jan 12th, 2007, 08:07 AM
Added an example that works with nested controls - see post #1 for details
agmorgan
May 4th, 2007, 06:29 AM
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?
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 SubThis 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
May 4th, 2007, 06:53 AM
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/SiliconValley/2060/freewheel.html
Anyway, I hope this is helpful to someone.
Al42
May 4th, 2007, 05:36 PM
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
Sep 18th, 2008, 02:13 PM
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
May 29th, 2009, 01:15 PM
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
May 29th, 2009, 01:27 PM
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 (http://www.vbforums.com/forumdisplay.php?f=32) (or perhaps the Office Development forum (http://www.vbforums.com/forumdisplay.php?f=37) instead).
manik726
Oct 3rd, 2009, 05:02 AM
Thank you soo much Bushmobile... this code has helped me a lot :)
alMubarmij
Nov 13th, 2009, 09:36 PM
How can I use it with DataGrid ?
DROB
Nov 18th, 2009, 08:19 PM
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_
Jan 13th, 2010, 02:43 AM
2nd emotion to alMubarmij post... how can we use it to DataGrid?
RCox
Apr 20th, 2010, 10:42 PM
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
Apr 21st, 2010, 03:34 AM
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
Apr 21st, 2010, 10:44 AM
... 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
Apr 30th, 2010, 10:03 PM
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
May 3rd, 2010, 01:52 PM
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 (http://msdn.microsoft.com/en-us/library/ms645617(VS.85).aspx) for more information
capn-jack
Jun 29th, 2010, 03:02 PM
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
Sep 27th, 2010, 04:25 AM
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
Sep 27th, 2010, 08:02 AM
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 (http://www.vbforums.com/showthread.php?t=231468), 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
Sep 27th, 2010, 08:15 AM
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
Sep 27th, 2010, 08:38 AM
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
Sep 27th, 2010, 08:57 AM
Sorry, my bad - I meant "the window procedure"
http://allapi.mentalis.org/apilist/SetWindowLong.shtml
http://msdn.microsoft.com/en-us/library/ms633591%28VS.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 ;)
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 :)
si_the_geek
Sep 27th, 2010, 09:24 AM
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
Aug 10th, 2011, 02:02 PM
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
Aug 20th, 2011, 10:33 AM
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:
vbforums.com
Copyright Internet.com Inc., All Rights Reserved.