添加一个窗体
在窗体上添加一个垂直滚动条
名字就默认即可
然后粘贴如下代码:
Private Sub Form_Load()
OldProcAddr = SetWindowLong(Me.hwnd,GWL_WNDPROC,AddressOf MyWinProc)
End Sub
然后添加一个模块
粘贴如下代码:
Public Const GWL_WNDPROC = (-4)
Public Const WM_MOUSEWHEEL = &H20A
Public OldProcAddr As Long
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 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 Function MyWinProc(ByVal hwnd As Long,ByVal wp As Long,ByVal lp As Long) As Long
If msg <> WM_MOUSEWHEEL Then
MyWinProc = CallWindowProc(OldProcAddr,hwnd,msg,wp,lp)
Else
Debug.Print msg
Dim s As String
s = Hex(wp)
If Len(s) < 8 Then s = String(8 - Len(s),"0") & s
Dim zDelta As Long
zDelta = CInt("&h" & Left(s,4)) * (-1)
If Form1.VScroll1.Value + zDelta < Form1.VScroll1.Min Then
Form1.VScroll1.Value = Form1.VScroll1.Min
ElseIf Form1.VScroll1.Value + zDelta > Form1.VScroll1.Max Then
Form1.VScroll1.Value = Form1.VScroll1.Max
Form1.VScroll1.Value = Form1.VScroll1.Value + zDelta
End If
End Function