vb mouse wheel

http://www.xtremevbtalk.com/showthread.php?t=304609

Private Const WM_VSCROLL As Long = &H115
Private Const WM_HSCROLL As Long = &H114
Private Const WM_MOUSEWHEEL As Long = &H20A

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const SB_LINEUP As Long = 0
Private Const SB_LINEDOWN As Long = 1

Private Function NewWindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Select Case Msg
       Case Is = WM_MOUSEWHEEL
           If (wParam > 0) Then
               SendMessage Scroll.hWnd, WM_VSCROLL, SB_LINEUP, 0&
           Else
               SendMessage Scroll.hWnd, WM_VSCROLL, SB_LINEDOWN, 0&
           End If
       End Select
 
       NewWindowProc = CallWindowProc(OldWindowProc, hWnd, Msg, wParam, lParam)
End Function