VB中定义全局热键
作者:parno 日期:2007-02-01
第一种:
比如说金山词霸用ctrl+alt+F1可实现开/关取词功能。 怎么做的呢?
bas 模块代码:
第二种:
按下某组键(HotKey)便执行某程式
在Dos的年代,我们常会以拦截中断向量的方式,做到按下某个hotkey而自动执行某个程式,在Window呢,也可以,不过它是用RegisterHotkey API来完成。
使用RegisterHotkey的概念是,它会定义一组按键的组合,当使用者不管在哪个程式之中,按下Window有注册的HotKey时,OS会传送WM_HOTKEY 的讯息给待接收该讯息的Window,而该Window收到WM_HOTKEY时,
便可知道有本身Thread所定义的HotKey被按下,於是可以从 wParam, lParam来得知是哪一组HotKey被按下。
WM_HOTKEY 叁数的定义
所以了,除了设定RegisterHotkey外,另要使用SubClassing的技巧才会得知HotKey被按下;最後,程式结束前要使用UnRegisterHotkey将HotKey的定义取消掉。
以下程式功能是:不管在哪个程式中,只要按下ALT-SHIFT-G 便执行NotePad。
'以下在.Bas
比如说金山词霸用ctrl+alt+F1可实现开/关取词功能。 怎么做的呢?
bas 模块代码:
复制内容到剪贴板 程序代码
'********************************************************
' DECLARATIONS NEEDED TO INTERCEPT WINDOW MESSAGES *
'********************************************************
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 OldwndProc As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const GWL_WNDPROC = -4
Public OldwndProc As Long
'********************************************************
' DECLARATIONS NEEDED TO Create THE HOTKEY *
'********************************************************
Public Declare Function RegisterHotKey Lib "USER32" (ByVal hWnd As Long, ByVal HotKeyID As Long, ByVal fsModifiers As Long, ByVal vKey As Long) As Long
Public Declare Function UnregisterHotKey Lib "USER32" (ByVal hWnd As Long, ByVal HotKeyID As Long) As Long
Public Const WM_HOTKEY = &H312
Public Const WM_NCDESTROY = &H82
Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4
Public Const MOD_WIN = &H8
Public HotKeyID(12) As Long
Public Function WindowProc(ByVal hWnd As Long, ByVal WindowMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'This is where all the messages for this form as directed to
'We will need to check for the WindowMessage WM_HOTKEY
'to see if a hotkey is pressed and then we need
'To check the wParam to see which HotKey (1-12) has been pressed
Select Case WindowMsg
Case WM_HOTKEY
'WM_HOTKEY
'idHotKey = (int) wParam; // identifier of hot key
'fuModifiers = (UINT) LOWORD(lParam); // key-modifier flags
'uVirtKey = (UINT) HIWORD(lParam); // virtual-key code
Select Case wParam
'This is where you put the code you want to start
'whenever someone has pressed a hotkey
Case HotKeyID(1)
MsgBox "Hotkey F1 has been pressed."
Case HotKeyID(2)
MsgBox "Hotkey F2 has been pressed."
Case HotKeyID(3)
MsgBox "Hotkey F3 has been pressed."
Case HotKeyID(4)
MsgBox "Hotkey F4 has been pressed."
Case HotKeyID(5)
MsgBox "Hotkey F5 has been pressed."
Case HotKeyID(6)
MsgBox "Hotkey F6 has been pressed."
Case HotKeyID(7)
MsgBox "Hotkey F7 has been pressed."
Case HotKeyID(8)
MsgBox "Hotkey F8 has been pressed."
Case HotKeyID(9)
MsgBox "Hotkey F9 has been pressed."
Case HotKeyID(10)
MsgBox "Hotkey F10 has been pressed."
Case HotKeyID(11)
MsgBox "Hotkey F11 has been pressed."
Case HotKeyID(12)
MsgBox "Hotkey F12 has been pressed."
End Select
End Select
'No matter what happens we *always* end with the normal
'window procedure to finish/handle the message by
'calling the CallWindowProc.
WindowProc = CallWindowProc(OldwndProc, hWnd, WindowMsg, wParam, lParam)
End Function
[h4]Form 模块代码:[h4]
'窗体上有12个checkbox控件数组,名字为chkKey.
'一个按钮cmdQUIT,
'代码:
Option Explicit
Dim HotKey As Byte
Dim HotKeyEnabled(12) As Boolean
Dim ClickedBefore As Boolean
Public Sub Cleanup()
For HotKey = 1 To 12
If HotKeyEnabled(HotKey) = True Then
Call DeleteHotkey
End If
Next HotKey
Unload Me
'Don't end with End since this will cause the program to crash
'even if you restored the SetWindowLong property to the OldwndHnd
End Sub
Public Sub CreateHotkey()
Dim ReturnValue As Long
'用户自己指定一个热键标识,一个整型数,范围:
'应用程序: 0x0000 -- 0xBFFF.
'DLL: 0xC000 -- 0xFFFF
'WM_HOTKEY 的 wPara 就是该标识的值
HotKeyID(HotKey) = HotKey
'F1 -- 112
'F2 -- 113
'......
HotKey = HotKey + 111
'Register 一个 HotKey
ReturnValue = RegisterHotKey(hWnd, HotKeyID(HotKey - 111), 0, HotKey)
'hWnd: 哪个窗体将接收 WM_HOTKEY 事件
'fsModifiers可取 :
'0, MOD_ALT, MOD_SHIFT, MOD_CONTROL, MOD_WIN
'HotKey是键码常数(注意不是ASCII码),即 vbKeyF1, vbKeyF2....
End Sub
Public Sub DeleteHotkey()
Dim ReturnValue As Long
'To disable/unload the selected hotkey (index number of the checkbox
'that was clicked on) simply unregister the HotKeyID (from the form it
'was registered to)
ReturnValue = UnregisterHotKey(hWnd, HotKeyID(HotKey))
End Sub
Private Sub chkKEY_Click(Index As Integer)
'A checkbox was clicked. We need to find out if now it is
'checked or not and act accordingly
If chkKEY(Index).Value = 1 Then 'The box that was clicked is now checked
'so enable the function key as a hotkey.
'We know that index holds the value of the function-key to enable
HotKey = Index
Call CreateHotkey 'Go to the CreateHotKey sub to actually create the hotkey
HotKeyEnabled(Index) = True
Else 'The box is now unchecked, so we need to disable this hotkey
HotKey = Index
Call DeleteHotkey
HotKeyEnabled(Index) = False
End If
If ClickedBefore = False Then
MsgBox "Now you can press F" & Index & " to see that it acts as a hotkey." & vbCrLf & _
"If you want you can select more hotkeys.", vbInformation, App.Title
ClickedBefore = True
End If
End Sub
Private Sub cmdQUIT_Click()
Call Cleanup
End Sub
Private Sub Form_Load()
'回调函数
OldwndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Private Sub Form_Terminate()
Call Cleanup
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Cleanup
End Sub
' DECLARATIONS NEEDED TO INTERCEPT WINDOW MESSAGES *
'********************************************************
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 OldwndProc As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const GWL_WNDPROC = -4
Public OldwndProc As Long
'********************************************************
' DECLARATIONS NEEDED TO Create THE HOTKEY *
'********************************************************
Public Declare Function RegisterHotKey Lib "USER32" (ByVal hWnd As Long, ByVal HotKeyID As Long, ByVal fsModifiers As Long, ByVal vKey As Long) As Long
Public Declare Function UnregisterHotKey Lib "USER32" (ByVal hWnd As Long, ByVal HotKeyID As Long) As Long
Public Const WM_HOTKEY = &H312
Public Const WM_NCDESTROY = &H82
Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4
Public Const MOD_WIN = &H8
Public HotKeyID(12) As Long
Public Function WindowProc(ByVal hWnd As Long, ByVal WindowMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'This is where all the messages for this form as directed to
'We will need to check for the WindowMessage WM_HOTKEY
'to see if a hotkey is pressed and then we need
'To check the wParam to see which HotKey (1-12) has been pressed
Select Case WindowMsg
Case WM_HOTKEY
'WM_HOTKEY
'idHotKey = (int) wParam; // identifier of hot key
'fuModifiers = (UINT) LOWORD(lParam); // key-modifier flags
'uVirtKey = (UINT) HIWORD(lParam); // virtual-key code
Select Case wParam
'This is where you put the code you want to start
'whenever someone has pressed a hotkey
Case HotKeyID(1)
MsgBox "Hotkey F1 has been pressed."
Case HotKeyID(2)
MsgBox "Hotkey F2 has been pressed."
Case HotKeyID(3)
MsgBox "Hotkey F3 has been pressed."
Case HotKeyID(4)
MsgBox "Hotkey F4 has been pressed."
Case HotKeyID(5)
MsgBox "Hotkey F5 has been pressed."
Case HotKeyID(6)
MsgBox "Hotkey F6 has been pressed."
Case HotKeyID(7)
MsgBox "Hotkey F7 has been pressed."
Case HotKeyID(8)
MsgBox "Hotkey F8 has been pressed."
Case HotKeyID(9)
MsgBox "Hotkey F9 has been pressed."
Case HotKeyID(10)
MsgBox "Hotkey F10 has been pressed."
Case HotKeyID(11)
MsgBox "Hotkey F11 has been pressed."
Case HotKeyID(12)
MsgBox "Hotkey F12 has been pressed."
End Select
End Select
'No matter what happens we *always* end with the normal
'window procedure to finish/handle the message by
'calling the CallWindowProc.
WindowProc = CallWindowProc(OldwndProc, hWnd, WindowMsg, wParam, lParam)
End Function
[h4]Form 模块代码:[h4]
'窗体上有12个checkbox控件数组,名字为chkKey.
'一个按钮cmdQUIT,
'代码:
Option Explicit
Dim HotKey As Byte
Dim HotKeyEnabled(12) As Boolean
Dim ClickedBefore As Boolean
Public Sub Cleanup()
For HotKey = 1 To 12
If HotKeyEnabled(HotKey) = True Then
Call DeleteHotkey
End If
Next HotKey
Unload Me
'Don't end with End since this will cause the program to crash
'even if you restored the SetWindowLong property to the OldwndHnd
End Sub
Public Sub CreateHotkey()
Dim ReturnValue As Long
'用户自己指定一个热键标识,一个整型数,范围:
'应用程序: 0x0000 -- 0xBFFF.
'DLL: 0xC000 -- 0xFFFF
'WM_HOTKEY 的 wPara 就是该标识的值
HotKeyID(HotKey) = HotKey
'F1 -- 112
'F2 -- 113
'......
HotKey = HotKey + 111
'Register 一个 HotKey
ReturnValue = RegisterHotKey(hWnd, HotKeyID(HotKey - 111), 0, HotKey)
'hWnd: 哪个窗体将接收 WM_HOTKEY 事件
'fsModifiers可取 :
'0, MOD_ALT, MOD_SHIFT, MOD_CONTROL, MOD_WIN
'HotKey是键码常数(注意不是ASCII码),即 vbKeyF1, vbKeyF2....
End Sub
Public Sub DeleteHotkey()
Dim ReturnValue As Long
'To disable/unload the selected hotkey (index number of the checkbox
'that was clicked on) simply unregister the HotKeyID (from the form it
'was registered to)
ReturnValue = UnregisterHotKey(hWnd, HotKeyID(HotKey))
End Sub
Private Sub chkKEY_Click(Index As Integer)
'A checkbox was clicked. We need to find out if now it is
'checked or not and act accordingly
If chkKEY(Index).Value = 1 Then 'The box that was clicked is now checked
'so enable the function key as a hotkey.
'We know that index holds the value of the function-key to enable
HotKey = Index
Call CreateHotkey 'Go to the CreateHotKey sub to actually create the hotkey
HotKeyEnabled(Index) = True
Else 'The box is now unchecked, so we need to disable this hotkey
HotKey = Index
Call DeleteHotkey
HotKeyEnabled(Index) = False
End If
If ClickedBefore = False Then
MsgBox "Now you can press F" & Index & " to see that it acts as a hotkey." & vbCrLf & _
"If you want you can select more hotkeys.", vbInformation, App.Title
ClickedBefore = True
End If
End Sub
Private Sub cmdQUIT_Click()
Call Cleanup
End Sub
Private Sub Form_Load()
'回调函数
OldwndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Private Sub Form_Terminate()
Call Cleanup
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Cleanup
End Sub
第二种:
按下某组键(HotKey)便执行某程式
在Dos的年代,我们常会以拦截中断向量的方式,做到按下某个hotkey而自动执行某个程式,在Window呢,也可以,不过它是用RegisterHotkey API来完成。
使用RegisterHotkey的概念是,它会定义一组按键的组合,当使用者不管在哪个程式之中,按下Window有注册的HotKey时,OS会传送WM_HOTKEY 的讯息给待接收该讯息的Window,而该Window收到WM_HOTKEY时,
便可知道有本身Thread所定义的HotKey被按下,於是可以从 wParam, lParam来得知是哪一组HotKey被按下。
复制内容到剪贴板 程序代码
RegisterHotKey(
ByVal hwnd As Long , //接收Hotkey的Window
ByVal idHotKey as Long, // identifier of hot key,range 0x0000 through
0xBFFF
ByVal Modifiers As Long, // 定义alt shift control等的组合
ByVal uVirtKey As Long // virtual-key code
)
ByVal hwnd As Long , //接收Hotkey的Window
ByVal idHotKey as Long, // identifier of hot key,range 0x0000 through
0xBFFF
ByVal Modifiers As Long, // 定义alt shift control等的组合
ByVal uVirtKey As Long // virtual-key code
)
WM_HOTKEY 叁数的定义
复制内容到剪贴板 程序代码
idHotKey = wParam; // identifier of hot key
Modifiers = (UINT) LOWORD(lParam); // key-modifier flags
uVirtKey = (UINT) HIWORD(lParam); // virtual-key code
Modifiers = (UINT) LOWORD(lParam); // key-modifier flags
uVirtKey = (UINT) HIWORD(lParam); // virtual-key code
所以了,除了设定RegisterHotkey外,另要使用SubClassing的技巧才会得知HotKey被按下;最後,程式结束前要使用UnRegisterHotkey将HotKey的定义取消掉。
以下程式功能是:不管在哪个程式中,只要按下ALT-SHIFT-G 便执行NotePad。
'以下在.Bas
复制内容到剪贴板 程序代码
Option Explicit
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
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
Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long
Public Const WM_HOTKEY = &H312
Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4
Public Const GWL_WNDPROC = (-4)
Public preWinProc As Long
Public Modifiers As Long, uVirtKey As Long, idHotKey As Long
Private Type taLong
ll As Long
End Type
Private Type t2Int
lWord As Integer
hword As Integer
End Type
Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_HOTKEY Then
If wParam = idHotKey Then
Dim lp As taLong, i2 As t2Int
lp.ll = lParam
LSet i2 = lp
If (i2.lWord = Modifiers) And i2.hword = uVirtKey Then
Debug.Print "HotKey Shift-Alt-G Pressed "
Shell "notepad", vbNormalFocus
End If
End If
End If
'将之送往原来的Window Procedure
wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function
'以下在 Form
Sub Form_Load()
Dim ret As Long
preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf wndproc)
idHotKey = 1 'in the range &h0000 through &hBFFF
Modifiers = MOD_ALT + MOD_SHIFT
uVirtKey = vbKeyG
ret = RegisterHotKey(Me.hwnd, idHotKey, Modifiers, uVirtKey)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim ret As Long
'取消Message的截取,而使之又只送往原来的Window Procedure
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)
Call UnregisterHotKey(Me.hwnd, uVirtKey)
End Sub
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
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
Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long
Public Const WM_HOTKEY = &H312
Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4
Public Const GWL_WNDPROC = (-4)
Public preWinProc As Long
Public Modifiers As Long, uVirtKey As Long, idHotKey As Long
Private Type taLong
ll As Long
End Type
Private Type t2Int
lWord As Integer
hword As Integer
End Type
Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_HOTKEY Then
If wParam = idHotKey Then
Dim lp As taLong, i2 As t2Int
lp.ll = lParam
LSet i2 = lp
If (i2.lWord = Modifiers) And i2.hword = uVirtKey Then
Debug.Print "HotKey Shift-Alt-G Pressed "
Shell "notepad", vbNormalFocus
End If
End If
End If
'将之送往原来的Window Procedure
wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function
'以下在 Form
Sub Form_Load()
Dim ret As Long
preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf wndproc)
idHotKey = 1 'in the range &h0000 through &hBFFF
Modifiers = MOD_ALT + MOD_SHIFT
uVirtKey = vbKeyG
ret = RegisterHotKey(Me.hwnd, idHotKey, Modifiers, uVirtKey)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim ret As Long
'取消Message的截取,而使之又只送往原来的Window Procedure
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)
Call UnregisterHotKey(Me.hwnd, uVirtKey)
End Sub
[本日志由 parno 于 2007-02-01 05:01 PM 编辑]
上一篇: ASP 脚本生成 GUID 的实现下一篇: modFormShowTop.bas 设置窗体是否为顶层显示
文章来自: メ冰枫ぱ雪
引用通告: 查看所有引用 | 我要引用此文章
Tags: VisualBasic
相关日志:
评论: 0 | 引用: 0 | 查看次数: 16366