Module1.bas
资源名称:cs7_gl2.rar [点击查看]
上传用户:polywin
上传日期:2022-03-20
资源大小:3k
文件大小:4k
源码类别:
钩子与API截获
开发平台:
Visual Basic
- Attribute VB_Name = "Module1"
- Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
- 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
- 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 Const GWL_WNDPROC = -4
- Public Const SPI_GETWHEELSCROLLLINES = 104
- Public Const WM_MOUSEWHEEL = &H20A
- Public WHEEL_SCROLL_LINES As Long
- Global lpPrevWndProc As Long
- Public Sub Hook(ByVal hWnd As Long, ByVal objGrid As DataGrid)
- lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
- '获取"控制面板"中的滚动行数值
- Call SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, WHEEL_SCROLL_LINES, 0)
- '对于MSGFlexGrid,下面三行应更改
- If WHEEL_SCROLL_LINES > objGrid.VisibleRows Then
- WHEEL_SCROLL_LINES = objGrid.VisibleRows
- End If
- End Sub
- Public Sub UnHook(ByVal hWnd As Long)
- SetWindowLong hWnd, GWL_WNDPROC, lpPrevWndProc
- End Sub
- Private Function WindowProc(ByVal hw As Long, _
- ByVal uMsg As Long, _
- ByVal wParam As Long, _
- ByVal lParam As Long) As Long
- Dim wKeys As Integer
- Dim wzDelta As Integer
- Select Case uMsg
- Case WM_MOUSEWHEEL
- With Form1.grdHistory
- wKeys = LOWORD(wParam)
- wzDelta = HIWORD(wParam)
- Debug.Print wParam
- Debug.Print wKeys
- Debug.Print wzDelta
- '判断坐标是否在Form1.grdDataGrid窗口内
- If wKeys = 16 Then
- '滚动键按下,水平滚动grdDataGrid
- '对于MSGFlexGrid,水平滚动可通过其改变其leftcol现实
- If Sgn(wzDelta) = 1 Then
- .Scroll -1, 0
- Else
- .Scroll 1, 0
- End If
- Else
- '鼠标按下时垂直滚动
- '对于MSGFlexGrid,水平滚动可通过其改变其toprow现实
- If Sgn(wzDelta) = 1 Then
- .Scroll 0, 0 - WHEEL_SCROLL_LINES
- Else
- .Scroll 0, WHEEL_SCROLL_LINES
- End If
- End If
- End With
- Case Else
- WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
- End Select
- End Function
- Public Function HIWORD(LongIn As Long) As Integer
- ' 取出32位值的高16位
- HIWORD = (LongIn And &HFFFF0000) &H10000
- End Function
- Public Function LOWORD(LongIn As Long) As Integer
- ' 取出32位值的低16位
- LOWORD = LongIn And &HFFFF&
- End Function