'==================窗體代碼=================
專業(yè)從事成都做網(wǎng)站、網(wǎng)站設(shè)計(jì),高端網(wǎng)站制作設(shè)計(jì),小程序開發(fā),網(wǎng)站推廣的成都做網(wǎng)站的公司。優(yōu)秀技術(shù)團(tuán)隊(duì)竭力真誠服務(wù),采用html5+CSS3前端渲染技術(shù),成都響應(yīng)式網(wǎng)站建設(shè)公司,讓網(wǎng)站在手機(jī)、平板、PC、微信下都能呈現(xiàn)。建站過程建立專項(xiàng)小組,與您實(shí)時(shí)在線互動(dòng),隨時(shí)提供解決方案,暢聊想法和感受。
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?'窗口中按下鼠標(biāo)左鍵
'Public?Const?WM_LBUTTONUP?=?H202?'窗口中松開鼠標(biāo)左鍵
'Public?Const?WM_MOUSEMOVE?=?H200?'窗口中移動(dòng)鼠標(biāo)
'Public?Const?WM_RBUTTONDOWN?=?H204?'窗口中按下鼠標(biāo)右鍵
'Public?Const?WM_RBUTTONUP?=?H205?'窗口中松開鼠標(biāo)右鍵
Public?Const?WM_MOUSEWHEEL?=?H20A?'鼠標(biāo)滾輪
'Public?Const?WM_NCLBUTTONDOWN?=?HA1?'窗口標(biāo)題欄中按下鼠標(biāo)左鍵
'Public?Const?WM_NCLBUTTONUP?=?HA2?'窗口標(biāo)題欄中左開鼠標(biāo)左鍵
'Public?Const?WM_NCMOUSEMOVE?=?HA0??'窗口標(biāo)題欄中移動(dòng)鼠標(biāo)
'Public?Const?WM_NCRBUTTONDOWN?=?HA4?'窗口標(biāo)題欄中按下鼠標(biāo)右鍵
'Public?Const?WM_NCRBUTTONUP?=?HA5?'窗口標(biāo)題欄中松開鼠標(biāo)右鍵
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?"鼠標(biāo)移動(dòng)"
Case?WM_MOUSEWHEEL
Debug.Print?"鼠標(biāo)滾輪"
MouseHookProc?=?1
Exit?Function
End?Select
MouseHookProc?=?CallNextHookEx(hHook,?idHook,?wParam,?ByVal?lParam)
End?Function
截取鼠標(biāo)滾輪消息及窗體消息
'窗體
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
'注冊(cè)/反注冊(cè)熱鍵
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 "關(guān)閉本實(shí)例一定要按下窗體上的關(guān)閉按鈕關(guān)閉,否則會(huì)出現(xiàn)錯(cuò)誤!"
'記錄原來的 Window Procedure 的位址
preProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
'設(shè)定form的 Window Procedure 到 hProc
ret = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf hProc)
'注冊(cè)熱鍵,RegisterHotKey 的第三個(gè)參數(shù)為附加的功能鍵,不用時(shí)應(yīng)設(shè)為 0
'注冊(cè)熱鍵為 Ctrl + F
Call RegisterHotKey(Me.hWnd, HFFFFF, MOD_CONTROL, vbKeyF)
End Sub
Private Sub Form_Unload(Cancel As Integer)
'反注冊(cè)熱鍵
Call UnregisterHotKey(Me.hWnd, HFFFFF)
'取消窗體消息的截取,而使之又只送往原來的 Window Procedure
Call SetWindowLong(Me.hWnd, GWL_WNDPROC, preProc)
End Sub
'模塊
Option Explicit
'Prodeced 2007 By TZWSOHO
'下面給出一小部分窗體消息的解釋,想獲取更多內(nèi)容請(qǐng)參考微軟的 MSDN
Private Const WM_GETMINMAXINFO As Long = H24 '窗體移動(dòng)或改變大小時(shí)激發(fā)的通告,可控制窗口能改變的大小
Private Const WM_MOUSEWHEEL As Long = H20A '鼠標(biāo)滾輪滾動(dòng)通告
Private Const WM_DEVICECHANGE As Long = H219 '設(shè)備插入通告,可用于檢測(cè)當(dāng)前是否有可移動(dòng)磁盤插入
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
'轉(zhuǎn)成十六進(jìn)制后的 lParam 首兩位為對(duì)應(yīng)熱鍵的鍵代碼,
'末兩位是功能鍵的代碼:1 = Alt, 2 = Ctrl, 4 = Shift
'其余值為代碼的和,如:3 = Alt + Ctrl
Form1.Print Hex(lParam)
Form1.Print "用戶按下熱鍵!"
Case WM_MOUSEWHEEL '鼠標(biāo)滾輪滾動(dòng),方向取決于 wParam 的符號(hào)
If Sgn(wParam) = -1 Then 'wParam 的符號(hào)為負(fù),滾輪從左往右看為順時(shí)針旋轉(zhuǎn)
Form1.Print "滾輪向后滾"
ElseIf Sgn(wParam) = 1 Then 'wParam 的符號(hào)為正,滾輪從左往右看為逆時(shí)針旋轉(zhuǎn)
Form1.Print "滾輪向前滾"
End If
End Select
hProc = CallWindowProc(preProc, hWnd, msg, wParam, lParam)
End Function
Private Sub Form_Resize() '在窗口的改變大小時(shí)所觸發(fā)的事件
On Error Resume Next '有錯(cuò)誤跳到下一條繼續(xù)執(zhí)行
Form1.Height = 10185 '設(shè)定窗口高
Form1.Width = 8700 '設(shè)定窗口寬
End Sub
在combox選擇完成后的位置添加代碼,把焦點(diǎn)轉(zhuǎn)移,如移到某個(gè)控件上 ***.setfocus
很簡單,通過WindowsAPI,刪除窗體菜單項(xiàng)就行了
首先在窗體類中聲明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參數(shù)常量:
Const MF_BYPOSITION As Integer = H400
然后在窗體類中寫入過程:
Private Sub UserForm_Initialize_stopmove() '禁止窗體移動(dòng)
? 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代表菜單中從上往下數(shù)第一個(gè)菜單項(xiàng)
? End If
End Sub
Private Sub UserForm_Initialize_onmove() '恢復(fù)窗體移動(dòng)
? 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與禁止代碼中的數(shù)值同步,原因時(shí)雖然表面上刪除了菜單項(xiàng),實(shí)則為隱藏了菜單項(xiàng),各個(gè)菜單的索引值并沒有變,所以0依然代表初始菜單的第一個(gè)菜單項(xiàng),即被刪除的那個(gè)菜單項(xiàng)
? End If
End Sub
然后如果你的窗口菜單是動(dòng)態(tài)變化的,建議聲明常數(shù):
Const MF_BYPOSITION As Integer = H0
然后使用相關(guān)的Windows功能的常數(shù)進(jìn)行刪除菜單。常數(shù)需要自行查看winuser.h頭文件
如果找不到該頭文件,可以看這里:網(wǎng)頁鏈接
其余信息詳見MSDN:網(wǎng)頁鏈接
最后說一下,不建議前面網(wǎng)友說的重寫WndProc的方法,因?yàn)檫@樣攔截標(biāo)題欄點(diǎn)擊消息會(huì)導(dǎo)致窗體本身的菜單也無法顯示出來,有損窗體功能,并且像雙擊左上角圖標(biāo)關(guān)閉窗體這樣的功能也會(huì)跟著攔截消息的操作一起被吞掉。
如何禁用鼠標(biāo)滾輪?
方法一、注冊(cè)表禁用鼠標(biāo)滾輪
1、首先打開運(yùn)行對(duì)話框運(yùn)行:regedit 打開注冊(cè)表;
2、然后依次展開定位到:HKEY_CURRENT_USERControl PanelDesktop
3、然后雙擊WheelScrollLines將其值4改變就行了,0表示禁止?jié)L輪,1表示打開滾輪。然后退出注冊(cè)表即可。
方法二、設(shè)備管理器禁用鼠標(biāo)滾輪
1、鼠標(biāo)右擊“計(jì)算機(jī)”選擇管理,然后展開設(shè)備管理器;
2、在設(shè)備管理中找到并雙擊“鼠標(biāo)和其他指針設(shè)備”,然后雙擊要配置的鼠標(biāo)名稱;
3、接著在彈出來的窗口中點(diǎn)擊“高級(jí)設(shè)置”下的“鼠標(biāo)輪檢測(cè)”中,然后單擊“尋找鼠標(biāo)輪”或其他選項(xiàng)就可以了。
提示:必須以管理員或Administrators組成員的身份登錄才能完成該過程,如果選擇了“尋找鼠標(biāo)輪”而鼠標(biāo)輪不工作,就請(qǐng)單擊“假定鼠標(biāo)輪已經(jīng)存在”,然后點(diǎn)擊確定即可。