Module1.bas
上传用户:polywin
上传日期:2022-03-20
资源大小:3k
文件大小:4k
源码类别:

钩子与API截获

开发平台:

Visual Basic

  1. Attribute VB_Name = "Module1"
  2. Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  3. Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
  4. 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
  5.       
  6.   Public Const GWL_WNDPROC = -4
  7.   Public Const SPI_GETWHEELSCROLLLINES = 104
  8.   Public Const WM_MOUSEWHEEL = &H20A
  9.   Public WHEEL_SCROLL_LINES         As Long
  10.       
  11.   Global lpPrevWndProc         As Long
  12.       
  13.   Public Sub Hook(ByVal hWnd As Long, ByVal objGrid As DataGrid)
  14.         lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
  15.             
  16.         '获取"控制面板"中的滚动行数值
  17.         Call SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, WHEEL_SCROLL_LINES, 0)
  18.           
  19.         '对于MSGFlexGrid,下面三行应更改
  20.   If WHEEL_SCROLL_LINES > objGrid.VisibleRows Then
  21.               WHEEL_SCROLL_LINES = objGrid.VisibleRows
  22.         End If
  23.   End Sub
  24.       
  25.   Public Sub UnHook(ByVal hWnd As Long)
  26.           SetWindowLong hWnd, GWL_WNDPROC, lpPrevWndProc
  27.   End Sub
  28.       
  29.   Private Function WindowProc(ByVal hw As Long, _
  30.   ByVal uMsg As Long, _
  31.   ByVal wParam As Long, _
  32.   ByVal lParam As Long) As Long
  33.     
  34.         Dim wKeys     As Integer
  35.         Dim wzDelta     As Integer
  36.           
  37.         Select Case uMsg
  38.                 Case WM_MOUSEWHEEL
  39.                         With Form1.grdHistory
  40.                               
  41.                                 wKeys = LOWORD(wParam)
  42.                                 wzDelta = HIWORD(wParam)
  43.                                 Debug.Print wParam
  44.                                 Debug.Print wKeys
  45.                                 Debug.Print wzDelta
  46.                               '判断坐标是否在Form1.grdDataGrid窗口内
  47.                                 If wKeys = 16 Then
  48.                                       '滚动键按下,水平滚动grdDataGrid
  49.         '对于MSGFlexGrid,水平滚动可通过其改变其leftcol现实
  50.     
  51.                                           If Sgn(wzDelta) = 1 Then
  52.                                                           .Scroll -1, 0
  53.                                           Else
  54.                                                           .Scroll 1, 0
  55.                                           End If
  56.                                   Else
  57.                                       '鼠标按下时垂直滚动
  58.   '对于MSGFlexGrid,水平滚动可通过其改变其toprow现实
  59.                                       If Sgn(wzDelta) = 1 Then
  60.                                               .Scroll 0, 0 - WHEEL_SCROLL_LINES
  61.                                                   Else
  62.                                               .Scroll 0, WHEEL_SCROLL_LINES
  63.                                       End If
  64.                                 End If
  65.                   End With
  66.             
  67.         Case Else
  68.               WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
  69.             
  70.         End Select
  71.       
  72.   End Function
  73.         
  74.   Public Function HIWORD(LongIn As Long) As Integer
  75.   '     取出32位值的高16位
  76.         HIWORD = (LongIn And &HFFFF0000)  &H10000
  77.   End Function
  78.       
  79.   Public Function LOWORD(LongIn As Long) As Integer
  80.         '     取出32位值的低16位
  81.         LOWORD = LongIn And &HFFFF&
  82.   End Function