VB鼠标滚轴控制滚动条
发布时间：2020-12-17 08:20:59 所属栏目：百科 来源：网络整理
导读：添加一个窗体 在窗体上添加一个垂直滚动条 名字就默认即可 然后粘贴如下代码： Private Sub Form_Load() OldProcAddr = SetWindowLong(Me.hwnd,GWL_WNDPROC,AddressOf MyWinProc) End Sub 然后添加一个模块 粘贴如下代码： Public Const GWL_WNDPROC = (-4)
|
添加一个窗体
在窗体上添加一个垂直滚动条 名字就默认即可 然后粘贴如下代码： 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 （编辑：李大同） 【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容! |