Mouse

'Това в Формата



Private Sub Form_Load()

   VScroll1.LargeChange = 20

       Call Hook

End Sub



'-------------------------------

'Това в Модул

'-------------------------------



Public Declare Function GetWindowLong Lib "user32" Alias _

"GetWindowLongA" _

(ByVal hwnd As Long, ByVal nIndex As Long) As Long



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



Public Const WM_MOUSEWHEEL = 522

Public Const GWL_WNDPROC = (-4)

Public Const WHEEL_DELTA = 120



Global OldWndProc As Long



Public Sub Hook()



'Съобщението WM_MOUSEWHEEL се изпраща

'към контрола който е във фокус



OldWndProc = _

SetWindowLong(Form1.hwnd, GWL_WNDPROC, _

AddressOf WindowProc)



End Sub



Function WindowProc(ByVal hw As Long, _

ByVal MSG As Long, ByVal wParam As Long, _

ByVal lParam As Long) As Long



Dim ScrollValue As Long

Dim Delta As Long



If MSG = WM_MOUSEWHEEL Then



On Error Resume Next



Delta = (wParam And &HFFFF0000) \ &H10000



If Delta < 0 Then

  ScrollValue = _

  Form1.VScroll1.Value + Form1.VScroll1.LargeChange

Else

  ScrollValue = _

  Form1.VScroll1.Value - Form1.VScroll1.LargeChange

End If



If ScrollValue < Form1.VScroll1.Min Then

  ScrollValue = Form1.VScroll1.Min

End If



If ScrollValue > Form1.VScroll1.Max Then

  ScrollValue = Form1.VScroll1.Max

End If



Form1.VScroll1.Value = ScrollValue

  Form1.Caption = ScrollValue



End If



'Overflow

If Err.Number = 6 Then

  Form1.VScroll1.Value = Form1.VScroll1.Max

     Err.Clear

End If



WindowProc = _

CallWindowProc(OldWndProc, hw, MSG, wParam, lParam)



End Function