Module2.bas 需要修改。
错误的地方是一API函数理解错误造成的。
新的内容如下:
Option Explicit
'本函数是抄的网上的,再自己修改
Public Type POINTL
x
As Long
y
As Long
End Type
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
Declare Function SetWindowLong _
Lib "USER32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function SystemParametersInfo _
Lib "USER32" Alias "SystemParametersInfoA" _
(ByVal uAction As Long, _
ByVal uParam As Long, _
lpvParam As Any, _
ByVal fuWinIni As Long) As Long
Declare Function ScreenToClient Lib "USER32" _
(ByVal hWnd As Long, xyPoint As POINTL) 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)
lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, _
AddressOf WindowProc)
''获取"控制面板"中的滚动行数值
'Call SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, WHEEL_SCROLL_LINES, 0)
Call SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, WHEEL_SCROLL_LINES, 0)
If WHEEL_SCROLL_LINES < 3 Then WHEEL_SCROLL_LINES = 3
'防止读取失败,我测试时是读取失败
End Sub
Public Sub UnHook(ByVal hWnd As Long)
Dim lngReturnValue
As Long
lngReturnValue = SetWindowLong(hWnd, GWL_WNDPROC, lpPrevWndProc)
End Sub
'此函数自己修改了
Function WindowProc(ByVal hw As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim pt
As POINTL
Select Case uMsg
Case WM_MOUSEWHEEL
'传入的鼠标滚动消息
With Form1
If wParam = -7864320 Then
'向下滚
.wz = .wz + WHEEL_SCROLL_LINES
ElseIf wParam = 7864320 Then
'向上滚
.wz = .wz - WHEEL_SCROLL_LINES
End If
'处理完滚动消息后,就去显示
Call .显示
End With
Case Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Select
End Function
Public Function HIWORD(LongIn As Long) As Integer
HIWORD = (LongIn And &HFFFF0000) \ &H10000
End Function
Public Function LOWORD(LongIn As Long) As Integer
LOWORD = LongIn And &HFFFF&
End Function