VB鼠标滚轴控制滚动条

添加一个窗体
在窗体上添加一个垂直滚动条
名字就默认即可
然后粘贴如下代码:

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 msg 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
        Else
            Form1.VScroll1.Value = Form1.VScroll1.Value + zDelta
        End If
    End If
End Function

你可能感兴趣的:(VB鼠标滚轴控制滚动条)