Скролинг мышкой таблицы 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д