在vb作的挂中加入热键,本文提供了一个简便的解决办法。
一、问题的提出
从 DOS 时代开始写程序的同学,对于热键的功能应该不陌生,在 DOS
时代我们往往会撰写系统常驻程序借进行热键盘的操作,随时检测用户的按键盘情况,然后根据所按的按键盘决定执行的程序。
现在到了 Windows 的时代,键盘的中断已经交由 Windows 统一管理,因此程序无法再拦载"键盘的中断",那么在 Windows
中如何实现热键盘的操作呢?
二、问题的解决
方法(1):通过 API 函数 GetAsyncKeyState(判断函数调用时指定虚拟键的状态)、和 Timer(时间控件),来实现热键的操作
例子:用热键 F2 调用 MsgBox。
Private
Declare
Function
GetAsyncKeyState Lib
"
user32
"
(ByVal vkey
As
Long ) As Integer
Private Sub Form_Load()
Timer1.Interval = 1 注释:设置检测间隔时间
End Sub
Private Sub Timer1_Timer()
If MyHotKey(vbKeyF2) Then MsgBox " 热键调用成功!! " , vbOKOnly
End Sub
Long ) As Integer
Private Sub Form_Load()
Timer1.Interval = 1 注释:设置检测间隔时间
End Sub
Private Sub Timer1_Timer()
If MyHotKey(vbKeyF2) Then MsgBox " 热键调用成功!! " , vbOKOnly
End Sub
控件来实现按键的监视,如果监视间隔时间过短,就会造成系统资源的浪费;如果间隔时间过长,按键就可能漏掉。
方法(2):通过 API 函数 RegisterHotKey(向系统注册相应的热键)、WndProc(消息处理)等等,来实现热键的操作。
例子:由于代码太多,请大家查看软件报 2000 年 第 48 期的文章<<再谈热键编程>>
小结:这种方法需要调用调用 6 个以上的 API
函数,需要定义多个常数(操作一个热键就要定义一个常数),对于一般的编程爱好者来说,过于复杂,不好掌握。
方法(3):通过调用 VC 编写的 DLL 文件。
由于 Windows 规定用以拦截全系统键盘消息的 HookProc Callback 函数必须放在 DLL 文件里面,但 VB 无法制作 DLL
文件(注:VB 可以用来制作 ActiveX DLL 文件,但 ActiveX DLL 与单纯的 DLL 不尽相同)。
我们这里调用王国荣先生用 VC 编写的 KeybHook.dll 文件(注:现在许多的有关热键操作的软件都是调用的这个 dll
文件,大家如果需要可到 。
例子:按键追踪程序(可以检测你按下的所有的键值)
Fomr1.frm 文件代码:
Option Explicit
Private Sub Form_Load() Sub Form_Load()
On Error Resume Next
注释:挂上 KeyboardHook_HookProc 函数
SetKeyboardHook Me.hWnd, WM_USER
If Err.Number <> 0 Then
MsgBox "请先将 KeybHook.dll 复制到 Windows 的所在路径!", vbCritical
End
End If
On Error GoTo 0
注释:挂上窗口程序
prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc
End Sub
Private Sub Form_Unload() Sub Form_Unload(Cancel As Integer)
注释:卸下 KeyboardHook_HookProc 函数
ReleaseKeyboardHook
注释:卸下窗口程序
SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc
End Sub
Module1.bas 文件代码:
Option Explicit
Public Const GWL_WNDPROC = ( - 4 )
Public Const WM_USER = & H400
Declare Function CallWindowProc() 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 GetWindowLong()Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal
hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong()Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal
hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function SetKeyboardHook()Function SetKeyboardHook Lib "KeybHook" (ByVal hwndPost As Long,
ByVal Msg As Long) As Long
Declare Function ReleaseKeyboardHook()Function ReleaseKeyboardHook Lib "KeybHook" () As Long
Public prevWndProc As Long
Dim IsCtrlDown As Boolean
Function WndProc()Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As
Long, ByVal lParam As Long) As Long
If Msg = WM_USER Then
Form1.List1.AddItem "wParam=" & wParam & ", lParam=" & Hex(lParam)
Form1.List1.ListIndex = Form1.List1.NewIndex
If wParam = 65 And (lParam And &H80000000) <> 0 Then MsgBox
"热键调用成功!!", vbOKOnly
注释:判断按键情况,对于你所按的按键的键值可通过本程序查看到
If wParam = 66 And (lParam And &H80000000) <> 0 And IsCtrlDown Then
MsgBox "组合热键调用成功!!", vbOKOnly, "组合键情况"
注释:判断按键情况(组合键情况)
End If
WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)
End Function
Option Explicit
Private Sub Form_Load() Sub Form_Load()
On Error Resume Next
注释:挂上 KeyboardHook_HookProc 函数
SetKeyboardHook Me.hWnd, WM_USER
If Err.Number <> 0 Then
MsgBox "请先将 KeybHook.dll 复制到 Windows 的所在路径!", vbCritical
End
End If
On Error GoTo 0
注释:挂上窗口程序
prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc
End Sub
Private Sub Form_Unload() Sub Form_Unload(Cancel As Integer)
注释:卸下 KeyboardHook_HookProc 函数
ReleaseKeyboardHook
注释:卸下窗口程序
SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc
End Sub
Module1.bas 文件代码:
Option Explicit
Public Const GWL_WNDPROC = ( - 4 )
Public Const WM_USER = & H400
Declare Function CallWindowProc() 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 GetWindowLong()Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal
hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong()Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal
hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function SetKeyboardHook()Function SetKeyboardHook Lib "KeybHook" (ByVal hwndPost As Long,
ByVal Msg As Long) As Long
Declare Function ReleaseKeyboardHook()Function ReleaseKeyboardHook Lib "KeybHook" () As Long
Public prevWndProc As Long
Dim IsCtrlDown As Boolean
Function WndProc()Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As
Long, ByVal lParam As Long) As Long
If Msg = WM_USER Then
Form1.List1.AddItem "wParam=" & wParam & ", lParam=" & Hex(lParam)
Form1.List1.ListIndex = Form1.List1.NewIndex
If wParam = 65 And (lParam And &H80000000) <> 0 Then MsgBox
"热键调用成功!!", vbOKOnly
注释:判断按键情况,对于你所按的按键的键值可通过本程序查看到
If wParam = 66 And (lParam And &H80000000) <> 0 And IsCtrlDown Then
MsgBox "组合热键调用成功!!", vbOKOnly, "组合键情况"
注释:判断按键情况(组合键情况)
End If
WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)
End Function
小结:用这种方法,就我而言感觉是最好的,可以很方便的检测按键,不需要事先用常量定义,不需要时间控件,也可方便的定义组合键。
以上程序在 VB6.0、Windows XP下调试通过。