Скролинг мышкой таблицы DataGrid с ADODC в Visual Basic - VB

Формулировка задачи:

Может быть у кого-нибудь есть рабочий код модуля и код формы для скролинга мышкой таблицы DataGrid (строка соединения прописана в ADODC) для проекта, созданного под Visual Basic. Поделитесь, буду признателен.

Решение задачи: «Скролинг мышкой таблицы DataGrid с ADODC в Visual Basic»

textual
                            Листинг программы 
                        

                            Option Explicit
 
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Type MSG
    hwnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Integer, lParam As Any) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, lpClassName As Any, lpWindowName As Any) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
 
Private Const HC_ACTION = 0
Private Const WH_GETMESSAGE = 3
Private Const WM_VSCROLL = &H115
Private Const SB_LINEDOWN = 1
Private Const SB_LINEUP = 0
Private Const WM_MOUSEWHEEL = &H20A
 
Dim hHook As Long
 
' Г‚ГЄГ«ГѕГ·ГЁГІГј ГЇГ°Г®ГЄГ°ГіГІГЄГі ГЄГ®Г«ГҐГ±ГЁГЄГ®Г¬ Г¬Г»ГёГЄГЁ ГўГ® ГўГ±ГҐГµ DataGrid'Г*Гµ
Public Sub Hook()
    hHook = SetWindowsHookEx(WH_GETMESSAGE, AddressOf GetMsgProc, App.hInstance, App.ThreadID)
End Sub
' Г‚Г»ГЄГ«ГѕГ·ГЁГІГј ГЇГ°Г®ГЄГ°ГіГІГЄГі ГЄГ®Г«ГҐГ±ГЁГЄГ®Г¬ Г¬Г»ГёГЄГЁ ГўГ® ГўГ±ГҐГµ DataGrid'Г*Гµ
' Г„Г®Г«Г¦Г*Г* ГўГ»Г§Г»ГўГ*ГІГјГ±Гї Г®ГЎГїГ§Г*ГІГҐГ«ГјГ*Г®, ГҐГ±Г«ГЁ ГЎГ»Г« ГўГ»Г§Г®Гў Hook
Public Sub Unhook()
    UnhookWindowsHookEx hHook
End Sub
Private Function GetMsgProc(ByVal Code As Long, ByVal wParam As Long, lParam As MSG) As Long
    If Code = HC_ACTION And lParam.message = WM_MOUSEWHEEL Then
        Dim buf As String, l As Long, hwnd As Long, hscl As Long
        buf = Space(255)
        hwnd = WindowFromPoint(lParam.pt.X, lParam.pt.Y)
        Do
            l = GetClassName(hwnd, buf, Len(buf))
            If l Then
                If StrComp(Left$(buf, l), "DataGridWndClass", vbTextCompare) = 0 Then
                    hscl = FindWindowEx(hwnd, 0, ByVal "ScrollBar", ByVal 0&)
                    If hscl Then SendMessage hwnd, WM_VSCROLL, IIf(lParam.wParam > 0, SB_LINEUP, SB_LINEDOWN), ByVal hscl
                    Exit Do
                ElseIf StrComp(Left$(buf, l), "Edit", vbTextCompare) = 0 Then
                    hwnd = GetParent(hwnd)
                Else: Exit Do
                End If
            End If
        Loop While l > 0
    End If
    GetMsgProc = CallNextHookEx(hHook, Code, wParam, lParam)
End Function
                        