none
How can I use touchpad on my laptop with the code scroll wheel in UserForm ListBox Excel? RRS feed

  • Question

  • I've just read this page:

    http://social.msdn.microsoft.com/Forums/en-US/7d584120-a929-4e7c-9ec2-9998ac639bea/mouse-scroll-in-userform-listbox-in-excel-2010?referrer=http://social.msdn.microsoft.com/Forums/en-US/7d584120-a929-4e7c-9ec2-9998ac639bea/mouse-scroll-in-userform-listbox-in-excel-2010?referrer=http://social.msdn.microsoft.com/Forums/en-US/7d584120-a929-4e7c-9ec2-9998ac639bea/mouse-scroll-in-userform-listbox-in-excel-2010?forum=isvvba

    With the code:

    Sub HookListBoxScroll()
    Dim lngAppInst As Long
    Dim hwndUnderCursor As Long
    Dim tPT As POINTAPI
            GetCursorPos tPT
            hwndUnderCursor = WindowFromPoint(tPT.x, tPT.y)
            If mListBoxHwnd <> hwndUnderCursor Then
                 UnhookListBoxScroll
                 mListBoxHwnd = hwndUnderCursor
                    lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
                    PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0&
                 If Not mbHook Then
                         mLngMouseHook = SetWindowsHookEx( _
                                                         WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
                         mbHook = mLngMouseHook <> 0
                 End If
         End If
    End Sub

    Sub UnhookListBoxScroll()
         If mbHook Then
                 UnhookWindowsHookEx mLngMouseHook
                 mLngMouseHook = 0
                 mListBoxHwnd = 0
                 mbHook = False
         End If
    End Sub

    Private Function MouseProc( _
                 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) = mListBoxHwnd Then
                         If wParam = WM_MOUSEWHEEL Then
                                 MouseProc = True
                                 If lParam.hwnd > 0 Then
                                         PostMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0
                                 Else
                                         PostMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
                                 End If
                                 PostMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0
                                 Exit Function
                         End If
                 Else
                         UnhookListBoxScroll
                 End If
         End If
            MouseProc = CallNextHookEx( _
                                 mLngMouseHook, nCode, wParam, ByVal lParam)
         Exit Function
    errH:
            UnhookListBoxScroll
    End Function

    I try to do it with a mouse scroll wheel is OK, but I can't use it with the touchpad on my laptop.

    Please help me in this case

    Thank you very much!


    • Edited by CangSaiGon Wednesday, April 9, 2014 3:15 PM
    Wednesday, April 9, 2014 3:11 PM

All replies

  • I developed and posted that approach to make aX controls scroll with the wheel. It was a few years ago and from memory it worked with a touchpad. However the touchpad in my current laptop is not configured to scroll so I can't test, but with a wireless mouse attached it certainly scrolls with the wheel.

    Suggest you test what if any window messages are returned with by wParam in the MouseProc. Just under the On Error -

    Debug.Print wParam

    Start by moving the mouse and seeing if WM_MOUSEMOVE (512) is returned, then try scrolling and expect to WM_MOUSEWHEEL (522). Try also mouse-downs.

    Wednesday, April 9, 2014 4:56 PM
    Moderator
  • Thank you very much.

    I try to do as you suggest, and I took result in immediate as following:

        

     512 
     512 
     512 
     512 
    513 
    514 
     512 
     512 
     512 
     512 
     512 
     512 
     512 
     512 
     512 
     512 
     512 
     512 
     512 
     512 
     512 
    513 
    514 
     512 
     512 

    But not any result is 522, how can I do with it sir?

    Thank you for your helping.

    Thursday, April 10, 2014 4:13 AM
  • Is your touchpad "Synaptics"? From a quick search there are many reports from people saying they cannot trap WM_MOUSESCROLL with touchpads and in particular Synaptics, the scroll code will not work. This is one explanation for the problem -

    http://bugs.freepascal.org/view.php?id=25209

    There appear to be some solutions out there but I can't test.

    512 is WM_MOUSEMOVE but what were you doing when 513 and 514 (&H201 & H202) were returned, I cannot find these values referring to any WM_ mouse messages.

    Thursday, April 10, 2014 9:45 AM
    Moderator
  • Yes sir, my touchpad is "Synaptics". I've just download 2 files: synaptics.patch & synaptics_new.patch, but how can I do with them sir?

    Thank you so much!

    Thursday, April 10, 2014 1:37 PM
  • I don't know anything about those synaptics patches but not sure if they will help. Where did you get them from?

    I'm looking into a slightly different approach, not sure if that will work either but keep checking back here.

    Thursday, April 10, 2014 9:24 PM
    Moderator
  • I downloaded those 2 file from the link you shared. How can I do? Because I don't know how to use *.patch file.
    • Edited by CangSaiGon Friday, April 11, 2014 9:01 AM
    Friday, April 11, 2014 9:00 AM
  • I only posted the link as it described one possible reason for the problem. As I mentioned, there are many of reports about synaptics scroll problems. I don't know anything about the patches, I didn't even notice the patches and no idea if they'll work.

    Here is a different approach, instead of hooking mouse messages it traps (subclasses) window messages. It's working with a touchpad with ALPS drivers, but so does the original MouseProc version. Try it and let me know if it works with your Synaptics. 

    ' userform code
    Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
        If gbHookSC Then HookStop
    End Sub
    
    Private Sub UserForm_MouseMove( _
            ByVal Button As Integer, ByVal Shift As Integer, _
            ByVal X As Single, ByVal Y As Single)
    If gbHookSC Then HookStop
    
    End Sub
    
    Private Sub ListBox1_MouseMove( _
            ByVal Button As Integer, ByVal Shift As Integer, _
            ByVal X As Single, ByVal Y As Single)
    ' control to be scrolled
        HookStart
    End Sub
    
    ' module code
    
    ' WARNING - DO NOT BREAK OR EDIT WHILE RUNNING OR THE APP 
    ' MAY QUIT WITHOUT WARNING
    Private Type POINTAPI
         X As Long
         Y As Long
    End Type
    
    Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" ( _
                                 ByVal hwnd As Long, _
                                 ByVal wMsg As Long, _
                                 ByVal wParam As Long, _
                                 ByVal lParam 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 SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
                                ByVal hwnd As Long, _
                                ByVal nIndex As Long, _
                                ByVal dwNewLong As Long) As Long
    
    Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _
                                ByVal lpPrevWndFunc As Long, _
                                ByVal hwnd As Long, _
                                ByVal Msg As Long, _
                                ByVal wParam As Long, _
                                ByVal lParam As Long) As Long
    
    Private Const WM_MOUSEWHEEL As Long = &H20A
    Private Const WM_MOUSEMOVE = &H200
    
    Private Const WM_KEYDOWN As Long = &H100
    Private Const WM_KEYUP As Long = &H101
    Private Const VK_UP As Long = &H26
    Private Const VK_DOWN As Long = &H28
    Private Const WM_LBUTTONDOWN As Long = &H201
    Private Const GWL_WNDPROC = (-4)
    
    Public gbHookSC As Boolean
    Private mHwndControl As Long
    Private mlPrevWinProc As Long
    
    Sub HookStart()
    ' call from the MouseMove event of the control to be scrolled, eg Listbox, combo etc
    Dim hWinUnderMouse As Long
    
        hWinUnderMouse = WinUnderMouse
        If mHwndControl <> hWinUnderMouse Then
        
            HookStop
            
            mHwndControl = hWinUnderMouse
    
            'PostMessage mHwndTreeControl, WM_LBUTTONDOWN, 0&, 0&
            If Not gbHookSC Then
    
                mlPrevWinProc = SetWindowLong(mHwndControl, GWL_WNDPROC, AddressOf WinProc)
                gbHookSC = mlPrevWinProc <> 0
    'Range("B2") = gbHookSC
            End If
        End If
    
    End Sub
    
    Sub HookStop()
        If gbHookSC Then
            Call SetWindowLong(mHwndControl, GWL_WNDPROC, mlPrevWinProc)
            mHwndControl = 0
            gbHookSC = False
            mlPrevWinProc = 0
    'Range("B2") = gbHookSC
        End If
    End Sub
    
    Public Function WinProc(ByVal hw As Long, ByVal uMsg As Long, _
                                  ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim bUp As Boolean
    
        If uMsg = WM_MOUSEWHEEL Then
            If mHwndControl <> WinUnderMouse Then
                HookStop
                Exit Function
            End If
            
            bUp = ((wParam And &HFFFF0000) / &H10000) > 0
            If bUp Then
                PostMessage mHwndControl, WM_KEYDOWN, VK_UP, 0
            Else
                PostMessage mHwndControl, WM_KEYDOWN, VK_DOWN, 0
            End If
            PostMessage mHwndControl, WM_KEYUP, VK_UP, 0
            Exit Function
        End If
    
        WinProc = CallWindowProc(mlPrevWinProc, hw, uMsg, wParam, lParam)
    End Function
    
    Private Function WinUnderMouse() As Long
    Dim tPT As POINTAPI
        GetCursorPos tPT
        WinUnderMouse = WindowFromPoint(tPT.X, tPT.Y)
    End Function
    
    This is only lightly tested and note the warning. If this makes no difference or both versions work stick with the original MouseProc version.



    Friday, April 11, 2014 12:19 PM
    Moderator
  • Thank you very very much! You are so kind!

    All the codes I copied in my file, but as the previous codes, it doesn't work with my touchpad (Synaptics V.7.0).

    Friday, April 11, 2014 4:09 PM
  • That's a shame, for the moment I'm out of ideas!.

    To be sure you set it everything up properly did you try it in a system with a normal mouse?

    You say Synaptics v7 or do you mean v17?  According to the Synaptics site v17 is the latest

    http://www.synaptics.com/en/drivers.php

    Friday, April 11, 2014 4:36 PM
    Moderator
  • Thank you, I think no code can help me in this case. So, I had to use the mouse!

    Have a nice weekend!

    Thursday, April 17, 2014 2:16 PM