VB鼠标滚轴控制滚动条

来源:互联网 发布:父母装修房子哭了知乎 编辑:程序博客网 时间:2024/04/27 01:54
添加一个窗体
在窗体上添加一个垂直滚动条
名字就默认即可
然后粘贴如下代码:

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