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

sijpie · Oct 21, 2015

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.

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

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

' This Sub needs to be added to the clsTreeView class module ' <<< Added for mouse scrolling >>> Private Sub TreeControl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) ' intercept the mouse move events and use it to scroll the treeview HookFrameScroll Me.TreeControl.Parent, TreeControl End Sub 

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.

Private Sub frTreeControl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) ' intercept the mouse move events and use it to scroll the treeview HookFrameScroll Me, frTreeControl End Sub 

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

sijpie · Oct 21, 2015

OOps, I forgot one crucial ingredient:

Lastly we need to close any open hooks when we close the form. In the userform module add:

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) UnhookListBoxScroll End Sub

filipejrc · Nov 13, 2018

Hello Sijpie.
I know this thread goes back to 2015, but I wonder is it is possible do adapt the code to MS Access.
I've been trying, but did not managed to overcome a lot of erros that were raised.

Hope someone could help.

Best regards,
Filipe Caetano
Portugal

sijpie · Nov 13, 2018

Filipe, are you using JKP Treeview in Access?

filipejrc · Nov 13, 2018

Thank you for replying.
Yes I'm using JKP Treeview in Access.
I know it is designed to be built on an userform but with the help of Peter Thornton and Jan Karel I've been able to implement the treeview with relative success.
Do you know how can I change and what shall be changed on your code so it can be used in MS Access?

Sorry for my poor english

sijpie · Nov 15, 2018

Filipe,

I can remember I had a lot of issues initially. I just checked my code. I notice I am not using the code in the class module, but in the code for the userform I have a sub for each frame where I want to use the mouse scroll.

But I also notice that I have disabled scrolling altogether by setting a compiletime flag. So maybe in the end I did not get it to work properly either.
Anyway, I cannot test my program on my work PC, so it will have to wait over the weekend when I am at home.

filipejrc · Nov 15, 2018

Thank you very much.
I will wait anxiously and hoping that you can help me with this.

Best regards

sijpie · Nov 19, 2018

Hi Filipe, I notice I made a lot of changes to the code after i posted it here! For starters I split up the scroll function for form scroll, listbox scroll and frame scrolling. Then I made some fundamental changes to parts of code. I will post the code below, and hopefully we can make it work in your case as well.

sijpie · Nov 19, 2018

OK, after having had some issues with the code I posted at the top of this thread, I made some significant changes to the code. I will post the new code here and try to guide you through how to use it.

This code will make forms, frames and listboxes scrollable with the mouse wheel. But it hooks into the Windows operating system, and so it could get some strange results when not properly implemented. It is very important that each time it hooks into the system, it also gets unhooked!

====================================

To do this properly requires the following:

A code module renamed to MouseScroll. This module will hold the public and private functions to make the various controls scrollable.
Code in the Form module for EACH control that you want to have mouse scrolling. (And yes, a form is a control itself)

Create a new code module and rename it MouseScroll. In this code module Mousescroll paste the following code:

Option Explicit ''////////////////////////////////////////////////////////////////////' '' '' Uncomment below to disable mousescroll on form for debugging ' '' ''\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' 'Public Const bNOMOUSEDebug As Boolean = True ''\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' ' Based on code from Peter Thornton here: ' http://social.msdn.microsoft.com/Forums/en-US/7d584120-a929-4e7c-9ec2-9998ac639bea/mouse-scroll-in-userform-listbox-in-excel-2010?forum=isvvba Private Type POINTAPI X As Long Y As Long End Type Private Type MOUSEHOOKSTRUCT pt As POINTAPI hwnd As Long wHitTestCode As Long dwExtraInfo As Long End Type Private Declare Function FindWindow Lib "user32" _ Alias "FindWindowA" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Private Declare Function GetWindowLong Lib "user32.dll" _ Alias "GetWindowLongA" ( _ ByVal hwnd As Long, _ ByVal nIndex As Long) As Long Private Declare Function SetWindowsHookEx Lib "user32" _ Alias "SetWindowsHookExA" ( _ ByVal idHook As Long, _ ByVal lpfn As Long, _ ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare Function CallNextHookEx Lib "user32" ( _ ByVal hHook As Long, _ ByVal nCode As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" ( _ ByVal hHook As Long) As Long Private Declare Function WindowFromPoint Lib "user32" ( _ ByVal xPoint As Long, _ ByVal yPoint As Long) As Long Private Declare Function GetCursorPos Lib "user32.dll" ( _ ByRef lpPoint As POINTAPI) As Long Declare Function GetActiveWindow Lib "user32" () As Long Private Const WH_MOUSE_LL As Long = 14 Private Const WM_MOUSEWHEEL As Long = &H20A Private Const HC_ACTION As Long = 0 Private Const GWL_HINSTANCE As Long = (-6) Private Const cSCROLLCHANGE As Long = 24 Private mLngFoMouseHook As Long Private mLngLiMouseHook As Long Private mLngFrMouseHook As Long Private mFormHwnd As Long Private mListBoxHwnd As Long Private mFrameHwnd As Long Private mbFoHook As Boolean Private mbLiHook As Boolean Private mbFrHook As Boolean Dim mForm As Object Private mFoCtl As MSForms.Control Private mLiCtl As MSForms.Control Private mFrCtl As MSForms.Control Dim n As Long Sub HookFormScroll(oForm As Object) Dim lngAppInst As Long Dim hwndUnderCursor As Long Set mForm = oForm hwndUnderCursor = FindWindow("ThunderDFrame", oForm.Caption) ' Debug.Print "Form window: " & hwndUnderCursor If mFormHwnd <> hwndUnderCursor Then UnhookFormScroll ' Debug.Print "Unhook old proc" mFormHwnd = hwndUnderCursor lngAppInst = GetWindowLong(mFormHwnd, GWL_HINSTANCE) If Not mbFoHook Then mLngFoMouseHook = SetWindowsHookEx( _ WH_MOUSE_LL, AddressOf FormMouseProc, lngAppInst, 0) mbFoHook = mLngFoMouseHook <> 0 ' If mbFoHook Then Debug.Print "Form hooked" End If End If End Sub Sub UnhookFormScroll() If mbFoHook Then UnhookWindowsHookEx mLngFoMouseHook mLngFoMouseHook = 0 mFormHwnd = 0 mbFoHook = False End If Debug.Print "Unhook formscroll" End Sub Sub HookListBoxScroll(frm As Object, ctl As MSForms.Control) Dim lngAppInst As Long Dim hwndUnderCursor As Long Dim tPT As POINTAPI GetCursorPos tPT hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y) If Not frm.ActiveControl Is ctl Then ctl.SetFocus End If Debug.Print tPT.X & ", " & tPT.Y If mListBoxHwnd <> hwndUnderCursor Then UnhookListBoxScroll Set mLiCtl = ctl mListBoxHwnd = hwndUnderCursor lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE) If Not mbLiHook Then mLngLiMouseHook = SetWindowsHookEx( _ WH_MOUSE_LL, AddressOf ListMouseProc, lngAppInst, 0) mbLiHook = mLngLiMouseHook <> 0 End If End If End Sub Sub UnhookListBoxScroll() If mbLiHook Then Set mLiCtl = Nothing UnhookWindowsHookEx mLngLiMouseHook mLngLiMouseHook = 0 mListBoxHwnd = 0 mbLiHook = False End If End Sub Sub HookFrameScroll(frm As Object, ctl As MSForms.Control) Dim lngAppInst As Long Dim hwndUnderCursor As Long Dim tPT As POINTAPI GetCursorPos tPT hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y) If Not frm.ActiveControl Is ctl Then ' ctl.SetFocus End If If mFrameHwnd <> hwndUnderCursor Then UnhookFrameScroll Set mFrCtl = ctl mFrameHwnd = hwndUnderCursor lngAppInst = GetWindowLong(mFrameHwnd, GWL_HINSTANCE) If Not mbFrHook Then mLngFrMouseHook = SetWindowsHookEx( _ WH_MOUSE_LL, AddressOf FrameMouseProc, lngAppInst, 0) mbFrHook = mLngFrMouseHook <> 0 End If End If End Sub Sub UnhookFrameScroll() If mbFrHook Then Set mFrCtl = Nothing UnhookWindowsHookEx mLngFrMouseHook mLngFrMouseHook = 0 mFrameHwnd = 0 mbFrHook = False End If End Sub Private Function FormMouseProc( _ ByVal nCode As Long, ByVal wParam As Long, _ ByRef lParam As MOUSEHOOKSTRUCT) As Long On Error GoTo errH 'Resume Next If (nCode = HC_ACTION) Then If GetActiveWindow = mFormHwnd Then If wParam = WM_MOUSEWHEEL Then FormMouseProc = True If lParam.hwnd > 0 Then mForm.ScrollTop = Application.Max(0, mForm.ScrollTop - cSCROLLCHANGE) Else mForm.ScrollTop = Application.Min(mForm.ScrollHeight - mForm.InsideHeight, mForm.ScrollTop + cSCROLLCHANGE) End If Exit Function End If End If End If FormMouseProc = CallNextHookEx( _ mLngFoMouseHook, nCode, wParam, ByVal lParam) Exit Function errH: UnhookFormScroll End Function Private Function ListMouseProc( _ ByVal nCode As Long, ByVal wParam As Long, _ ByRef lParam As MOUSEHOOKSTRUCT) As Long Dim idx As Long On Error GoTo errH If (nCode = HC_ACTION) Then If WindowFromPoint(lParam.pt.X, lParam.pt.Y) = mListBoxHwnd Then If wParam = WM_MOUSEWHEEL Then ListMouseProc = True If lParam.hwnd > 0 Then idx = -1 Else idx = 1 idx = idx + mLiCtl.ListIndex If idx >= 0 Then mLiCtl.ListIndex = idx Exit Function End If Else UnhookListBoxScroll End If End If ListMouseProc = CallNextHookEx( _ mLngLiMouseHook, nCode, wParam, ByVal lParam) Exit Function errH: UnhookListBoxScroll End Function Private Function FrameMouseProc( _ ByVal nCode As Long, ByVal wParam As Long, _ ByRef lParam As MOUSEHOOKSTRUCT) As Long On Error GoTo errH 'Resume Next If (nCode = HC_ACTION) Then ' If GetActiveWindow = mFormHwnd Then If WindowFromPoint(lParam.pt.X, lParam.pt.Y) = mFrameHwnd Then If wParam = WM_MOUSEWHEEL Then FrameMouseProc = True If lParam.hwnd > 0 Then mFrCtl.ScrollTop = Application.Max(0, mFrCtl.ScrollTop - cSCROLLCHANGE) Else mFrCtl.ScrollTop = Application.Min(mFrCtl.ScrollHeight - mFrCtl.InsideHeight, mFrCtl.ScrollTop + cSCROLLCHANGE) End If Exit Function End If End If End If FrameMouseProc = CallNextHookEx( _ mLngFrMouseHook, nCode, wParam, ByVal lParam) Exit Function errH: UnhookFrameScroll End Function 

Now for the TreeControl, which is held in a frame, I want to refer to the HookFrameScroll function above. So in the Module for the form which holds this treeControl frame I have this code to start the hook, and to remove the hook when the form closes:

'******************************************* Private Sub frTreeControl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) ' ' Enable mouse scrolling on the frame holding ' the tree control '******************************************* HookFrameScroll Me, frTreeControl End Sub '******************************************* Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) ' ' X-button -> hand over to btnClose '******************************************* If CloseMode = 0 Then ' do what the Cancel button does btnClose_Click '>> rename this to whatever your close button sub is called << End If ' unhook mouse scroll on tree UnhookFrameScroll End Sub

filipejrc · Nov 20, 2018

Thank you very much for your help and for the new code. Unfortunately, I did not succeed in implementing it. When the mouse is over the treeview frame it moves erratically and in slow motion and after 2 seconds MS Access unexpectedly quits. If I comment, in the sub procedure "HookFrameScroll", this line:
mLngFrMouseHook = SetWindowsHookEx (_
WH_MOUSE_LL, AddressOf FrameMouseProc, lngAppInst, 0)

Then the mouse moves back normally and MS Access does not shut down, but the mouse scroll does not work either

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

sijpie

Well-known Member

Excel Facts

sijpie

Well-known Member

filipejrc

New Member

sijpie

Well-known Member

filipejrc

New Member

sijpie

Well-known Member

filipejrc

New Member

sijpie

Well-known Member

sijpie

Well-known Member

filipejrc

New Member

Similar threads

Forum statistics

Share this page

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

Well-known Member

Excel Facts

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

Well-known Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock