Скролл по DBGrid'у с помощью колесика мышки

Private Sub Form_Load()
  
pObj = ObjPtr(DBGrid1)
    lpPrevWndProc = SetWindowLong(DBGrid1.hWnd, [OFF]вот на следующее [/OFF]GWL_WNDPROC, AddressOf WindowProc)

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'
Public pObj As Long
'
Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim X As Integer
Dim dlist As Object
    On Error Resume Next
    If uMsg = 522 Then
        CopyMemory dlist, pObj, Len(pObj)
        If wParam > 0 Then
            dlist.Scroll 0, -1
        Else
            dlist.Scroll 0, 1
        End If
        Set dlist = Nothing
    End If
    WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Function
 
 
Private Sub Form_Load()
    pObj = ObjPtr(dgList)
    lpPrevWndProc = SetWindowLong(dgList.hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

'в модуле:
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 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
 
Public Const GWL_WNDPROC = -4
Const WM_MOUSEWHEEL = &H20A
 
Public OldProc As Long
Public Function ScrollDBGrid(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_MOUSEWHEEL Then
    If wParam < 0 Then
        Form1.DBGrid1.Scroll 0, 1
    ElseIf wParam > 0 Then
        Form1.DBGrid1.Scroll 0, -1
    End If
End If
ScrollDBGrid = CallWindowProc(OldProc, hwnd, Msg, wParam, lParam)
End Function
 
 
' в форме:
Private Sub Form_Load()
OldProc = SetWindowLong(DBGrid1.hwnd, GWL_WNDPROC, AddressOf ScrollDBGrid)
End Sub
 
Private Sub Form_Terminate()
Call SetWindowLong(DBGrid1.hwnd, GWL_WNDPROC, OldProc)
End Sub

Private Sub Command1_Click()
DBGrid1.Scroll 0, -1
End Sub
 
Private Sub Command2_Click()
DBGrid1.Scroll 0, 1
End Sub

' в модуле:
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 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
 
Public Const GWL_WNDPROC = -4
Const WM_MOUSEWHEEL = &H20A
 
Public FlGrOldProc As Long
 
Public Function ScrollFlGrid(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_MOUSEWHEEL Then
    If wParam < 0 Then
        If Form1.MSFlexGrid1.Rows > Form1.MSFlexGrid1.TopRow + 1 Then _
        Form1.MSFlexGrid1.TopRow = Form1.MSFlexGrid1.TopRow + 1
    ElseIf wParam > 0 Then
        If Form1.MSFlexGrid1.TopRow > 1 Then _
        Form1.MSFlexGrid1.TopRow = Form1.MSFlexGrid1.TopRow - 1
    End If
End If
ScrollFlGrid = CallWindowProc(FlGrOldProc, hwnd, Msg, wParam, lParam)
End Function
 
' в форме:
Private Sub Form_Load()
FlGrOldProc = SetWindowLong(MSFlexGrid1.hwnd, GWL_WNDPROC, AddressOf ScrollFlGrid)
End Sub
 
Private Sub Form_Terminate()
Call SetWindowLong(MSFlexGrid1.hwnd, GWL_WNDPROC, FlGrOldProc)
End Sub