13518219792
'==================窗体代码=================
专业从事成都做网站、网站设计,高端网站制作设计,小程序开发,网站推广的成都做网站的公司。优秀技术团队竭力真诚服务，采用html5+CSS3前端渲染技术，成都响应式网站建设公司，让网站在手机、平板、PC、微信下都能呈现。建站过程建立专项小组，与您实时在线互动，随时提供解决方案，畅聊想法和感受。
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseHookProc, App.hInstance, 0)
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnhookWindowsHookEx hHook
End Sub
'=============模块代码==================
Public Const WH_MOUSE = 7 '本地钩子
Public Const WH_MOUSE_LL = 14 '全局钩子
Public Const GWL_WNDPROC = (-4)
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
'Public Const WM_LBUTTONDOWN = H201 '窗口中按下鼠标左键
'Public Const WM_LBUTTONUP = H202 '窗口中松开鼠标左键
'Public Const WM_MOUSEMOVE = H200 '窗口中移动鼠标
'Public Const WM_RBUTTONDOWN = H204 '窗口中按下鼠标右键
'Public Const WM_RBUTTONUP = H205 '窗口中松开鼠标右键
Public Const WM_MOUSEWHEEL = H20A '鼠标滚轮
'Public Const WM_NCLBUTTONDOWN = HA1 '窗口标题栏中按下鼠标左键
'Public Const WM_NCLBUTTONUP = HA2 '窗口标题栏中左开鼠标左键
'Public Const WM_NCMOUSEMOVE = HA0 '窗口标题栏中移动鼠标
'Public Const WM_NCRBUTTONDOWN = HA4 '窗口标题栏中按下鼠标右键
'Public Const WM_NCRBUTTONUP = HA5 '窗口标题栏中松开鼠标右键
Public hHook As Long
Public Function MouseHookProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case wParam
' Case WM_LBUTTONDOWN, WM_NCLBUTTONDOWN
' Debug.Print "左键按下"
' Case WM_LBUTTONUP, WM_NCLBUTTONUP
' Debug.Print "左键弹起"
' Case WM_RBUTTONDOWN, WM_NCRBUTTONDOWN
' Debug.Print "右键按下"
' Case WM_RBUTTONUP, WM_NCRBUTTONUP
' Debug.Print "右键弹起"
' Case WM_MOUSEMOVE, WM_NCMOUSEMOVE
' Debug.Print "鼠标移动"
Case WM_MOUSEWHEEL
Debug.Print "鼠标滚轮"
MouseHookProc = 1
Exit Function
End Select
MouseHookProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
End Function
截取鼠标滚轮消息及窗体消息
'窗体
Option Explicit
Private Const MOD_ALT As Long = H1
Private Const MOD_CONTROL As Long = H2
Private Const MOD_SHIFT As Long = H4
Private Const GWL_WNDPROC = (-4)
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'注册/反注册热键
Private Declare Function RegisterHotKey Lib "user32.dll" (ByVal hWnd As Long, ByVal ID As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "user32.dll" (ByVal hWnd As Long, ByVal ID As Long) As Long
Private Sub Form_Load()
Dim ret As Long
Print "关闭本实例一定要按下窗体上的关闭按钮关闭，否则会出现错误！"
'记录原来的 Window Procedure 的位址
preProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
'设定form的 Window Procedure 到 hProc
ret = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf hProc)
'注册热键，RegisterHotKey 的第三个参数为附加的功能键，不用时应设为 0
'注册热键为 Ctrl + F
Call RegisterHotKey(Me.hWnd, HFFFFF, MOD_CONTROL, vbKeyF)
End Sub
Private Sub Form_Unload(Cancel As Integer)
'反注册热键
Call UnregisterHotKey(Me.hWnd, HFFFFF)
'取消窗体消息的截取，而使之又只送往原来的 Window Procedure
Call SetWindowLong(Me.hWnd, GWL_WNDPROC, preProc)
End Sub
'模块
Option Explicit
'Prodeced 2007 By TZWSOHO
'下面给出一小部分窗体消息的解释，想获取更多内容请参考微软的 MSDN
Private Const WM_GETMINMAXINFO As Long = H24 '窗体移动或改变大小时激发的通告，可控制窗口能改变的大小
Private Const WM_MOUSEWHEEL As Long = H20A '鼠标滚轮滚动通告
Private Const WM_DEVICECHANGE As Long = H219 '设备插入通告，可用于检测当前是否有可移动磁盘插入
Private Const WM_HOTKEY As Long = H312 '热键键入通告
Private Declare Function CallWindowProc Lib "user32.dll" 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 preProc As Long
Function hProc(ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case msg
Case WM_HOTKEY
'转成十六进制后的 lParam 首两位为对应热键的键代码，
'末两位是功能键的代码：1 = Alt, 2 = Ctrl, 4 = Shift
'其余值为代码的和，如：3 = Alt + Ctrl
Form1.Print Hex(lParam)
Form1.Print "用户按下热键！"
Case WM_MOUSEWHEEL '鼠标滚轮滚动，方向取决于 wParam 的符号
If Sgn(wParam) = -1 Then 'wParam 的符号为负，滚轮从左往右看为顺时针旋转
Form1.Print "滚轮向后滚"
ElseIf Sgn(wParam) = 1 Then 'wParam 的符号为正，滚轮从左往右看为逆时针旋转
Form1.Print "滚轮向前滚"
End If
End Select
hProc = CallWindowProc(preProc, hWnd, msg, wParam, lParam)
End Function
Private Sub Form_Resize() '在窗口的改变大小时所触发的事件
On Error Resume Next '有错误跳到下一条继续执行
Form1.Height = 10185 '设定窗口高
Form1.Width = 8700 '设定窗口宽
End Sub
在combox选择完成后的位置添加代码，把焦点转移，如移到某个控件上 ***.setfocus
很简单，通过WindowsAPI，删除窗体菜单项就行了
首先在窗体类中声明API：
Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As IntPtr, ByVal bRevert As Boolean) As IntPtr
Declare Function RemoveMenu Lib "user32" (ByVal lngHmenu As IntPtr, ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
其次声明API参数常量：
Const MF_BYPOSITION As Integer = H400
然后在窗体类中写入过程：
Private Sub UserForm_Initialize_stopmove() '禁止窗体移动
Dim lngHwnd As IntPtr
Dim lngHmenu As IntPtr
lngHwnd = Me.Handle
If lngHwnd 0 Then
lngHmenu = GetSystemMenu(lngHwnd, False)
RemoveMenu(lngHmenu, 0, MF_BYPOSITION) '这里的0代表菜单中从上往下数第一个菜单项
End If
End Sub
Private Sub UserForm_Initialize_onmove() '恢复窗体移动
Dim lngHwnd As IntPtr
Dim lngHmenu As IntPtr
lngHwnd = Me.Handle
If lngHwnd 0 Then
lngHmenu = GetSystemMenu(lngHwnd, True)
RemoveMenu(lngHmenu, 0, MF_BYPOSITION) '这里的0与禁止代码中的数值同步，原因时虽然表面上删除了菜单项，实则为隐藏了菜单项，各个菜单的索引值并没有变，所以0依然代表初始菜单的第一个菜单项，即被删除的那个菜单项
End If
End Sub
然后如果你的窗口菜单是动态变化的，建议声明常数：
Const MF_BYPOSITION As Integer = H0
然后使用相关的Windows功能的常数进行删除菜单。常数需要自行查看winuser.h头文件
如果找不到该头文件，可以看这里：网页链接
其余信息详见MSDN：网页链接
最后说一下，不建议前面网友说的重写WndProc的方法，因为这样拦截标题栏点击消息会导致窗体本身的菜单也无法显示出来，有损窗体功能，并且像双击左上角图标关闭窗体这样的功能也会跟着拦截消息的操作一起被吞掉。
如何禁用鼠标滚轮?
方法一、注册表禁用鼠标滚轮
1、首先打开运行对话框运行：regedit 打开注册表;
2、然后依次展开定位到：HKEY_CURRENT_USERControl PanelDesktop
3、然后双击WheelScrollLines将其值4改变就行了，0表示禁止滚轮，1表示打开滚轮。然后退出注册表即可。
方法二、设备管理器禁用鼠标滚轮
1、鼠标右击“计算机”选择管理，然后展开设备管理器;
2、在设备管理中找到并双击“鼠标和其他指针设备”，然后双击要配置的鼠标名称;
3、接着在弹出来的窗口中点击“高级设置”下的“鼠标轮检测”中，然后单击“寻找鼠标轮”或其他选项就可以了。
提示：必须以管理员或Administrators组成员的身份登录才能完成该过程，如果选择了“寻找鼠标轮”而鼠标轮不工作，就请单击“假定鼠标轮已经存在”，然后点击确定即可。
