64 bit MouseWheel hook for pointer xy on a User Form, key press and wheel rotation

[Tony Cheshire]

I have 32 bit routine that hooks into the Mouse wheel event and returns the x y position of the mouse pointer on a User Form plus the direction of the wheel rotation and a value for any key pressed while rolling. (Code that I can find on this site and on the web generally only returns the MouseWheel rotation.)

It was working in Excel 97 32 and I have resurrected it for a current project. I know I have to add PtrSafe to dll function calls for 64 bit Excel (which I have done) and that there may be an issue with pointer data types and maybe other data types. I have been struggling with this for some time without success (not attempted in the code below).

The code below compiles and runs in 64 bit Excel (2019, 365) but the hook code doesn't work. This call in the code below to the SetWindowsLong function returns 0.

lPrevWndProc = SetWindowLong(hControl, GWL_WNDPROC, AddressOf WindowProc

My code is below. Can anyone help with getting this working? Or an alternative? It would really be appreciated. If I can get it running I plan to use Jaafar Tribak's excellent idea to deal with any issues with unhandled errors crashing Excel. I used the code in an Addin I created that used Excel Scatter charts to create and control simple maps from Cartesian coordinates that can be zoomed, panned etc.

The Hook routine is called from the User Form Initialization routine with

Dim hwnd As Long
     hwnd = basMouseWheel.hwndFormWindow(Me.Caption)
     If hwnd <> 0 Then 
         basMouseWheel.Hook hwnd
    End If

And the basMouseWheel module contains the following.

Option Explicit

Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare PtrSafe Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long

Private Declare PtrSafe Function CallWindowProc Lib "user32.dll" 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 Declare PtrSafe Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As LongPtr) As Long

Public Const MK_CONTROL = &H8
Public Const MK_LBUTTON = &H1
Public Const MK_RBUTTON = &H2
Public Const MK_MBUTTON = &H10
Public Const MK_SHIFT = &H4

Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
Private hControl As Long
Private lPrevWndProc As Long
'*********************************************************
'Called by the las line of WidnowProc below and
'passes values to the client routine
'*********************************************************
Private Sub MouseWheel(ByVal fwKeys As Long, _
                      ByVal zDelta As Long, _
                      ByVal xPos As Long, _
                      ByVal yPos As Long)
Dim sens As Integer

   ' If UserForm2.ActiveControl.Name <> "ScrollBar1" Then Exit Sub

    'If zDelta < 0 Then sens = 1 Else sens = -1
    sens = Int(zDelta)
 '   FActiveMap.MouseWheelZoom sens 'UserForm2.ActiveControl,
    FActiveMap.MouseWheelZoom sens, xPos, yPos 'UserForm2.ActiveControl,
    ' PUT CODE TO CALL THE ROUTINE USING THE MOUSEWHEEL PARAMETERS HERE
End Sub
'*********************************************************
'This function is hooked to the Mouse event
'*********************************************************
Private Function WindowProc(ByVal lWnd As Long, _
                            ByVal lMsg As Long, _
                            ByVal wParam As Long, _
                            ByVal lParam As Long) As Long

Dim fwKeys As Long
Dim zDelta As Long, xPos As Long, yPos As Long

    If lMsg = WM_MOUSEWHEEL Then

        fwKeys = wParam And 65535
        zDelta = wParam / 65536
        xPos = lParam And 65535
        yPos = lParam / 65536
        MouseWheel fwKeys, zDelta, xPos, yPos
    End If
    WindowProc = CallWindowProc(lPrevWndProc, lWnd, lMsg, _
      wParam, lParam)
End Function

'*********************************************************
'Hook
'*********************************************************
Public Sub Hook(ByVal hControl_ As Long)
    hControl = hControl_
    lPrevWndProc = SetWindowLong(hControl, GWL_WNDPROC, AddressOf WindowProc)
End Sub

'*********************************************************
'UnHook
'*********************************************************
Public Sub UnHook()
  Call SetWindowLong(hControl, GWL_WNDPROC, lPrevWndProc)
End Sub
'*********************************************************
'Test that the Form handle is available
'*********************************************************
Function hwndFormWindow(WindowCaption As String) As Long
    hwndFormWindow = FindWindow(vbNullString, WindowCaption)
End Function