Attribute VB_Name = "ModWheelHook"
' ModWheelHook.bas

' Various sources

' Calling eg:
'Private Sub chkHookWheel_Click()
'   If chkHookWheel.Value = Checked Then
'      ModWheelHook.HookWheel
'      aHookWheel = True
'      Form1.picDRAW.SetFocus
'   Else
'      ModWheelHook.UnhookWheel
'      aHookWheel = False
'   End If
'End Sub


Option Explicit

Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" _
   (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private 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 GWL_WNDPROC   As Long = -4
Private Const WM_MOUSEWHEEL As Long = &H20A

Private OldWindowProc As Long
Private LocalhWnd As Long


Public Sub HookWheel()
On Error Resume Next
    LocalhWnd = Form1.picDRAW.hwnd
    OldWindowProc = SetWindowLong(LocalhWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub UnhookWheel()
Dim ret As Long
On Error Resume Next
   ret = SetWindowLong(LocalhWnd, GWL_WNDPROC, OldWindowProc)
End Sub

Private Function WindowProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' Public aZoomMode, aPick
' Zoom scroll limits 1 to 59
   If wMsg = WM_MOUSEWHEEL Then
      If aZoomMode And Not aPick Then
         
'         Select Case wParam
'         Case Is > 0   ' wheel forward
'            If Form1.scrZoom.Value < 59 Then Form1.scrZoom.Value = Form1.scrZoom.Value + 1
'         Case Else     ' wheel backward
'            If Form1.scrZoom.Value > 1 Then Form1.scrZoom.Value = Form1.scrZoom.Value - 1
'         End Select
      
      
         Select Case wParam
         Case Is > 0   ' wheel forward
            If frmZoom.scrZoom.Value < 59 Then frmZoom.scrZoom.Value = frmZoom.scrZoom.Value + 1
         Case Else     ' wheel backward
            If frmZoom.scrZoom.Value > 1 Then frmZoom.scrZoom.Value = frmZoom.scrZoom.Value - 1
         End Select
      
      
      End If
   End If
   WindowProc = CallWindowProc(OldWindowProc, hwnd, wMsg, wParam, lParam)
End Function

