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

Узнай цену своей работы

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

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

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

textual
Листинг программы
  1. Option Explicit
  2.  
  3. Private Type POINTAPI
  4.     X As Long
  5.     Y As Long
  6. End Type
  7. Private Type MSG
  8.     hwnd As Long
  9.     message As Long
  10.     wParam As Long
  11.     lParam As Long
  12.     time As Long
  13.     pt As POINTAPI
  14. End Type
  15.  
  16. 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
  17. 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
  18. Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
  19. Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Integer, lParam As Any) As Long
  20. Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
  21. Private Declare Function WindowFromPoint Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
  22. Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, lpClassName As Any, lpWindowName As Any) As Long
  23. Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
  24.  
  25. Private Const HC_ACTION = 0
  26. Private Const WH_GETMESSAGE = 3
  27. Private Const WM_VSCROLL = &H115
  28. Private Const SB_LINEDOWN = 1
  29. Private Const SB_LINEUP = 0
  30. Private Const WM_MOUSEWHEEL = &H20A
  31.  
  32. Dim hHook As Long
  33.  
  34. ' Âêëþ÷èòü ïðîêðóòêó êîëåñèêîì ìûøêè ГўГ® ГўГ±ГҐГµ DataGrid'Г*Гµ
  35. Public Sub Hook()
  36.     hHook = SetWindowsHookEx(WH_GETMESSAGE, AddressOf GetMsgProc, App.hInstance, App.ThreadID)
  37. End Sub
  38. ' Âûêëþ÷èòü ïðîêðóòêó êîëåñèêîì ìûøêè ГўГ® ГўГ±ГҐГµ DataGrid'Г*Гµ
  39. ' ÄîëæГ*Г* âûçûâГ*ГІГјГ±Гї îáÿçГ*òåëüГ*Г®, åñëè áûë âûçîâ Hook
  40. Public Sub Unhook()
  41.     UnhookWindowsHookEx hHook
  42. End Sub
  43. Private Function GetMsgProc(ByVal Code As Long, ByVal wParam As Long, lParam As MSG) As Long
  44.     If Code = HC_ACTION And lParam.message = WM_MOUSEWHEEL Then
  45.         Dim buf As String, l As Long, hwnd As Long, hscl As Long
  46.         buf = Space(255)
  47.         hwnd = WindowFromPoint(lParam.pt.X, lParam.pt.Y)
  48.         Do
  49.             l = GetClassName(hwnd, buf, Len(buf))
  50.             If l Then
  51.                 If StrComp(Left$(buf, l), "DataGridWndClass", vbTextCompare) = 0 Then
  52.                     hscl = FindWindowEx(hwnd, 0, ByVal "ScrollBar", ByVal 0&)
  53.                     If hscl Then SendMessage hwnd, WM_VSCROLL, IIf(lParam.wParam > 0, SB_LINEUP, SB_LINEDOWN), ByVal hscl
  54.                     Exit Do
  55.                 ElseIf StrComp(Left$(buf, l), "Edit", vbTextCompare) = 0 Then
  56.                     hwnd = GetParent(hwnd)
  57.                 Else: Exit Do
  58.                 End If
  59.             End If
  60.         Loop While l > 0
  61.     End If
  62.     GetMsgProc = CallNextHookEx(hHook, Code, wParam, lParam)
  63. End Function

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

13   голосов , оценка 4.154 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы