[Solucionado] Evento en La "Ruedita" del Raton

hola Agrega un modulo clase con el nombre "ClsMouseWheel"

dentro de este modulo

Código

]
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare 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 Const GWL_WNDPROC As Long = -4
 
Private Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
 
Private Declare Function VirtualAlloc Lib "kernel32.dll" (ByRef lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32.dll" (ByRef lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Const MEM_COMMIT As Long = &H1000
Private Const PAGE_EXECUTE_READWRITE As Long = &H40
Private Const MEM_RELEASE As Long = &H8000&
 
Private Const WM_DESTROY As Long = &H2
Private Const WM_MOUSEWHEEL As Long = &H20A
 
 
Private pASMWrapper As Long
Private PrevWndProc As Long
Private hSubclassedWnd As Long
 
Public Event MOUSEWHEEL(ByVal wParam As Long)
 
Public Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
    WindowProc = CallWindowProc(PrevWndProc, hwnd, Msg, wParam, lParam)
 
    If Msg = WM_MOUSEWHEEL Then
        RaiseEvent MOUSEWHEEL(wParam)
    End If
 
    If Msg = WM_DESTROY Then
        Call StopSubclassing
    End If
 
End Function
 
Public Function SetSubclassing(ByVal hwnd As Long) As Boolean
 
    'Setzt Subclassing, sofern nicht schon gesetzt
 
    If PrevWndProc = 0 Then
        If pASMWrapper <> 0 Then
 
            PrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, pASMWrapper)
 
            If PrevWndProc <> 0 Then
                hSubclassedWnd = hwnd
                SetSubclassing = True
            End If
 
        End If
    End If
 
End Function
 
Public Function StopSubclassing() As Boolean
 
    'Stopt Subclassing, sofern gesetzt
 
    If hSubclassedWnd <> 0 Then
        If PrevWndProc <> 0 Then
 
            Call SetWindowLong(hSubclassedWnd, GWL_WNDPROC, PrevWndProc)
 
            hSubclassedWnd = 0
            PrevWndProc = 0
 
            StopSubclassing = True
 
        End If
    End If
 
End Function
 
Private Sub Class_Initialize()
 
    Dim ASM(0 To 103) As Byte
    Dim pVar As Long
    Dim ThisClass As Long
    Dim CallbackFunction As Long
    Dim pVirtualFree
    Dim i As Long
    Dim sCode As String
 
    pASMWrapper = VirtualAlloc(ByVal 0&, 104, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
    If pASMWrapper <> 0 Then
 
        ThisClass = ObjPtr(Me)
        Call CopyMemory(pVar, ByVal ThisClass, 4)
        Call CopyMemory(CallbackFunction, ByVal (pVar + 28), 4)
        pVirtualFree = GetProcAddress(GetModuleHandle("kernel32.dll"), "VirtualFree")
 
        sCode = "90FF05000000006A0054FF742418FF742418FF742418FF7424186800000000B800000000FFD0FF0D00000000A10000000085C075" & _
                "0458C21000A10000000085C0740458C2100058595858585868008000006A00680000000051B800000000FFE00000000000000000"
 
        For i = 0 To Len(sCode) - 1 Step 2
            ASM(i / 2) = CByte("&h" & Mid$(sCode, i + 1, 2))
        Next
 
        Call CopyMemory(ASM(3), pASMWrapper + 96, 4)
        Call CopyMemory(ASM(40), pASMWrapper + 96, 4)
        Call CopyMemory(ASM(58), pASMWrapper + 96, 4)
        Call CopyMemory(ASM(45), pASMWrapper + 100, 4)
        Call CopyMemory(ASM(84), pASMWrapper, 4)
        Call CopyMemory(ASM(27), ThisClass, 4)
        Call CopyMemory(ASM(32), CallbackFunction, 4)
        Call CopyMemory(ASM(90), pVirtualFree, 4)
        Call CopyMemory(ByVal pASMWrapper, ASM(0), 104)
 
    End If
 
End Sub
 
Private Sub Class_Terminate()
 
    If pASMWrapper <> 0 Then
        Call StopSubclassing
        Call CopyMemory(ByVal (pASMWrapper + 108), 1, 4)
    End If
 
End Sub

y en el formulario

Código

Option Explicit
Private WithEvents cRuedaRaton As ClsMouseWheel
 
Private Sub cRuedaRaton_MOUSEWHEEL(ByVal wParam As Long)
    If wParam > 0 Then
        MsgBox "Rueda Girada hacia Arriba"
    Else
        MsgBox "Rueda Girada hacia Abajo"
    End If
End Sub
 
Private Sub Form_Load()
    Set cRuedaRaton = New ClsMouseWheel
    cRuedaRaton.SetSubclassing Me.hwnd
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    cRuedaRaton.StopSubclassing
    Set cRuedaRaton = Nothing
End Sub

Saludos.

Option Explicit

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public 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 = -4
Private Const WM_MOUSEWHEEL As Long = &H20A

Dim hHook As Long

Public Sub StartHook(hwnd As Long)
   hHook = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub StopHook(hwnd As Long)
   SetWindowLong hwnd, GWL_WNDPROC, hHook
End Sub

Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  WindowProc = CallWindowProc(hHook, hwnd, uMsg, wParam, lParam)
  If uMsg = WM_MOUSEWHEEL Then
   If wParam > 0 Then
   Form1.Print "ARRIBA"
   Else
   Form1.Print "ABAJO"
   End If
  End If
End Function