TreeView (JKP) Mouse Scrolling - Make it work with this code

sijpie

Well-known Member
Joined
Nov 1, 2008
Messages
3,734
Not a question, just some code to improve your project(s)


Jan-Karel Pieterse and Peter Thornton have some time ago developed a very nice alternative to the standard VBA TreeView, which overcomes all the issues with 32bit and 64 bit Windows and Office and looks nicer as well. And it is FREE.
An MSForms (all VBA) treeview

However the code as provided by Jan Karel and Peter does not cater for mouse scrolling; ie if your tree view extends outside the frame provided then scroll bars appear but you will need to click on the scroll bar to move the tree in the frame (The treeview is held in a Frame control).

Providing code to use the mouse scroll button means hooking into the mouse events using API codes. Peter Thornton provided a nice piece of code to scroll a combobox or listbox (http://social.msdn.microsoft.com/Fo...n-userform-listbox-in-excel-2010?forum=isvvba).
With the hard work done it was easier to adapt this to scrolling within a frame.


Note!!! Adding this code can affect the stability of your project, so test it in depth.




The code that intercepts the mouse events and tells the Frame what to do is as follows and should be stored in a standard code module.


<font face=Calibri><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN><br><SPAN style="color:#007F00">' >>>>  This code to be in a Normal Code Module (for instance modMouseScroll) <<<<</SPAN><br><br> <SPAN style="color:#007F00">' Based on code from Peter Thornton here:</SPAN><br> <SPAN style="color:#007F00">' http://social.msdn.microsoft.com/Forums/en-US/7d584120-a929-4e7c-9ec2-9998ac639bea/mouse-scroll-in-userform-listbox-in-excel-2010?forum=isvvba</SPAN><br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Type</SPAN> POINTAPI<br>    X                               <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    Y                               <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Type</SPAN><br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Type</SPAN> MOUSEHOOKSTRUCT<br>    pt                              <SPAN style="color:#00007F">As</SPAN> POINTAPI<br>    hwnd                            <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    wHitTestCode                    <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    dwExtraInfo                     <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Type</SPAN><br> <br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Declare</SPAN> <SPAN style="color:#00007F">Function</SPAN> GetWindowLong <SPAN style="color:#00007F">Lib</SPAN> "user32.dll" _<br>    Alias "GetWindowLongA" ( _<br>    <SPAN style="color:#00007F">ByVal</SPAN> hwnd <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _<br>    <SPAN style="color:#00007F">ByVal</SPAN> nIndex <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br> <br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Declare</SPAN> <SPAN style="color:#00007F">Function</SPAN> SetWindowsHookEx <SPAN style="color:#00007F">Lib</SPAN> "user32" _<br>    Alias "SetWindowsHookExA" ( _<br>    <SPAN style="color:#00007F">ByVal</SPAN> idHook <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _<br>    <SPAN style="color:#00007F">ByVal</SPAN> lpfn <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _<br>    <SPAN style="color:#00007F">ByVal</SPAN> hmod <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _<br>    <SPAN style="color:#00007F">ByVal</SPAN> dwThreadId <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br> <br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Declare</SPAN> <SPAN style="color:#00007F">Function</SPAN> CallNextHookEx <SPAN style="color:#00007F">Lib</SPAN> "user32" ( _<br>    <SPAN style="color:#00007F">ByVal</SPAN> hHook <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _<br>    <SPAN style="color:#00007F">ByVal</SPAN> nCode <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _<br>    <SPAN style="color:#00007F">ByVal</SPAN> wParam <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _<br>    lParam <SPAN style="color:#00007F">As</SPAN> Any) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br> <br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Declare</SPAN> <SPAN style="color:#00007F">Function</SPAN> UnhookWindowsHookEx <SPAN style="color:#00007F">Lib</SPAN> "user32" ( _<br>    <SPAN style="color:#00007F">ByVal</SPAN> hHook <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br> <br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Declare</SPAN> <SPAN style="color:#00007F">Function</SPAN> WindowFromPoint <SPAN style="color:#00007F">Lib</SPAN> "user32" ( _<br>    <SPAN style="color:#00007F">ByVal</SPAN> xPoint <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _<br>    <SPAN style="color:#00007F">ByVal</SPAN> yPoint <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br> <br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Declare</SPAN> <SPAN style="color:#00007F">Function</SPAN> GetCursorPos <SPAN style="color:#00007F">Lib</SPAN> "user32.dll" ( _<br>    <SPAN style="color:#00007F">ByRef</SPAN> lpPoint <SPAN style="color:#00007F">As</SPAN> POINTAPI) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Declare</SPAN> <SPAN style="color:#00007F">Function</SPAN> GetActiveWindow <SPAN style="color:#00007F">Lib</SPAN> "user32" () <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br> <br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Const</SPAN> WH_MOUSE_LL          <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN> = 14<br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Const</SPAN> WM_MOUSEWHEEL        <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN> = &H20A<br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Const</SPAN> HC_ACTION            <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN> = 0<br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Const</SPAN> GWL_HINSTANCE        <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN> = (-6)<br> <br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Const</SPAN> cSCROLLCHANGE        <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN> = 20<br> <br><SPAN style="color:#00007F">Private</SPAN> mLngMouseHook              <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br><SPAN style="color:#00007F">Private</SPAN> mFrameHwnd                 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br><SPAN style="color:#00007F">Private</SPAN> mbHook                     <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN><br><SPAN style="color:#00007F">Private</SPAN> mCtl                       <SPAN style="color:#00007F">As</SPAN> MSForms.Control<br><SPAN style="color:#00007F">Dim</SPAN> n                              <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br> <br> <br><br><SPAN style="color:#00007F">Sub</SPAN> HookFrameScroll(frm <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN>, ctl <SPAN style="color:#00007F">As</SPAN> MSForms.Control)<br>    <SPAN style="color:#00007F">Dim</SPAN> lngAppInst <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> hwndUnderCursor <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> tPT <SPAN style="color:#00007F">As</SPAN> POINTAPI<br>     GetCursorPos tPT<br>     hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)<br>     <SPAN style="color:#007F00">'>> uncomment below if you want to give the treeview focus once the user scrolls it</SPAN><br><SPAN style="color:#007F00">'     If Not frm.ActiveControl Is ctl Then</SPAN><br><SPAN style="color:#007F00">'             ctl.SetFocus</SPAN><br><SPAN style="color:#007F00">'     End If</SPAN><br>     <SPAN style="color:#00007F">If</SPAN> mFrameHwnd <> hwndUnderCursor <SPAN style="color:#00007F">Then</SPAN><br>             UnhookFrameScroll<br>             <SPAN style="color:#00007F">Set</SPAN> mCtl = ctl<br>             mFrameHwnd = hwndUnderCursor<br>             lngAppInst = GetWindowLong(mFrameHwnd, GWL_HINSTANCE)<br>             <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> mbHook <SPAN style="color:#00007F">Then</SPAN><br>                     mLngMouseHook = SetWindowsHookEx( _<br>                        WH_MOUSE_LL, AddressOf FrameMouseProc, lngAppInst, 0)<br>                     mbHook = mLngMouseHook <> 0<br>             <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>     <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br><SPAN style="color:#00007F">Sub</SPAN> UnhookFrameScroll()<br>     <SPAN style="color:#00007F">If</SPAN> mbHook <SPAN style="color:#00007F">Then</SPAN><br>                <SPAN style="color:#00007F">Set</SPAN> mCtl = <SPAN style="color:#00007F">Nothing</SPAN><br>             UnhookWindowsHookEx mLngMouseHook<br>             mLngMouseHook = 0<br>             mFrameHwnd = 0<br>             mbHook = <SPAN style="color:#00007F">False</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br><br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Function</SPAN> FrameMouseProc( _<br>            <SPAN style="color:#00007F">ByVal</SPAN> nCode <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> wParam <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _<br>            <SPAN style="color:#00007F">ByRef</SPAN> lParam <SPAN style="color:#00007F">As</SPAN> MOUSEHOOKSTRUCT) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> errH <SPAN style="color:#007F00">'Resume Next</SPAN><br>    <SPAN style="color:#00007F">If</SPAN> (nCode = HC_ACTION) <SPAN style="color:#00007F">Then</SPAN><br>        <SPAN style="color:#00007F">If</SPAN> WindowFromPoint(lParam.pt.X, lParam.pt.Y) = mFrameHwnd <SPAN style="color:#00007F">Then</SPAN><br>            <SPAN style="color:#00007F">If</SPAN> wParam = WM_MOUSEWHEEL <SPAN style="color:#00007F">Then</SPAN><br>                FrameMouseProc = <SPAN style="color:#00007F">True</SPAN><br>                <SPAN style="color:#00007F">If</SPAN> lParam.hwnd > 0 <SPAN style="color:#00007F">Then</SPAN><br>                    mCtl.ScrollTop = Application.Max(0, mCtl.ScrollTop - cSCROLLCHANGE)<br>                <SPAN style="color:#00007F">Else</SPAN><br>                    mCtl.ScrollTop = Application.Min(mCtl.ScrollHeight - mCtl.InsideHeight, mCtl.ScrollTop + cSCROLLCHANGE)<br>                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>                <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Function</SPAN><br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>         <br>    <SPAN style="color:#00007F">End</SPAN> If<br>    FrameMouseProc = CallNextHookEx( _<br>    mLngMouseHook, nCode, wParam, <SPAN style="color:#00007F">ByVal</SPAN> lParam)<br>    <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Function</SPAN><br>errH:<br>    UnhookFrameScroll<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN><br><br></FONT>



Then we need to have the frame process the mouseover events. This can be done two ways
1. Add the code to the clsTreeView class
2. Add the code to the userform module


Don't do both!


1. Add the code to the clsTreeView class
Advantage: your treeviews in any form will have automatic scroll capability
Disadvantage: when updating the classmodules with a new version, you will need to remember to copy this code. so mark it.


Add the following code to the class module, I put it (about halfway) after the TreeControl_Click() sub



<font face=Calibri><SPAN style="color:#007F00">' This Sub needs to be added to the clsTreeView class module</SPAN><br><SPAN style="color:#007F00">' <<<  Added for mouse scrolling >>></SPAN><br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> TreeControl_MouseMove(<SPAN style="color:#00007F">ByVal</SPAN> Button <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> Shift <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> X <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> Y <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN>)<br>    <SPAN style="color:#007F00">' intercept the mouse move events and use it to scroll the treeview</SPAN><br>    HookFrameScroll Me.TreeControl.Parent, TreeControl<br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>



2. Add the code to the userform module
Advantage: no messing with the class module
Disadvantage: need to add it for every treeview used


Add the following code to the Userform module where the treeview is. I have kept the framename as used in the Treeview Demo.


<font face=Calibri><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> frTreeControl_MouseMove(<SPAN style="color:#00007F">ByVal</SPAN> Button <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> Shift <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> X <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> Y <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN>)<br>    <SPAN style="color:#007F00">' intercept the mouse move events and use it to scroll the treeview</SPAN><br>    HookFrameScroll Me, frTreeControl<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>


That's it. It's wonderful to see it work.
 

sijpie

Well-known Member
Joined
Nov 1, 2008
Messages
3,734
That is a pity.
I don't have Access, so I can't test it either. I would suggest to create a small form in an Excel workbook with a simple listbox filled with enough text so that it has a scrollbar. Then test the code to see if it works on the listbox. Next create the same code in a clean access file, and see if it works there or if it crashes.
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

filipejrc

New Member
Joined
Nov 13, 2018
Messages
9
Thank you very much.
That is really a pity, but i'll try what you i'll try what you suggest.

Best regards
 

Watch MrExcel Video

Forum statistics

Threads
1,129,445
Messages
5,636,322
Members
416,912
Latest member
danluk12

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top