首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

注册了系统热键,用什么方法激活热键最好?(用Timer和死循环就不要了)解决方法

2012-03-16 
注册了系统热键,用什么方法激活热键最好?(用Timer和死循环就不要了)我用RegisterHotKey注册了系统热键看了

注册了系统热键,用什么方法激活热键最好?(用Timer和死循环就不要了)
我用   RegisterHotKey   注册了系统热键

看了一些代码,觉得感觉不是很好,用的是死循环来监视热键,例如

这个就是用死循环,加了个DoEvents,防止CPU100%,或者是用了Timer控件的

Private   Const   MOD_ALT   =   &H1
Private   Const   MOD_CONTROL   =   &H2
Private   Const   MOD_SHIFT   =   &H4
Private   Const   PM_REMOVE   =   &H1
Private   Const   WM_HOTKEY   =   &H312
Private   Type   POINTAPI
        x   As   Long
        y   As   Long
End   Type
Private   Type   Msg
        hWnd   As   Long
        Message   As   Long
        wParam   As   Long
        lParam   As   Long
        time   As   Long
        pt   As   POINTAPI
End   Type
Private   Declare   Function   RegisterHotKey   Lib   "user32 "   (ByVal   hWnd   As   Long,   ByVal   id   As   Long,   ByVal   fsModifiers   As   Long,   ByVal   vk   As   Long)   As   Long
Private   Declare   Function   UnregisterHotKey   Lib   "user32 "   (ByVal   hWnd   As   Long,   ByVal   id   As   Long)   As   Long
Private   Declare   Function   PeekMessage   Lib   "user32 "   Alias   "PeekMessageA "   (lpMsg   As   Msg,   ByVal   hWnd   As   Long,   ByVal   wMsgFilterMin   As   Long,   ByVal   wMsgFilterMax   As   Long,   ByVal   wRemoveMsg   As   Long)   As   Long
Private   Declare   Function   WaitMessage   Lib   "user32 "   ()   As   Long
Private   bCancel   As   Boolean
Private   Sub   ProcessMessages()
        Dim   Message   As   Msg
        'loop   until   bCancel   is   set   to   True
        Do   While   Not   bCancel
                'wait   for   a   message
                WaitMessage
                'check   if   it 's   a   HOTKEY-message
                If   PeekMessage(Message,   Me.hWnd,   WM_HOTKEY,   WM_HOTKEY,   PM_REMOVE)   Then
                        'minimize   the   form
                        WindowState   =   vbMinimized
                End   If
                'let   the   operating   system   process   other   events
                DoEvents
        Loop
End   Sub
Private   Sub   Form_Load()
        Dim   ret   As   Long
        bCancel   =   False
        'register   the   Ctrl-F   hotkey


        ret   =   RegisterHotKey(Me.hWnd,   &HBFFF&,   MOD_CONTROL,   vbKeyF)
        'show   some   information
        Me.AutoRedraw   =   True
        Me.Print   "Press   CTRL-F   to   minimize   this   form "
        'show   the   form   and
        Show
        'process   the   Hotkey   messages
        ProcessMessages
End   Sub
Private   Sub   Form_Unload(Cancel   As   Integer)
        bCancel   =   True
        'unregister   hotkey
        Call   UnregisterHotKey(Me.hWnd,   &HBFFF&)
End   Sub

'//第2个示例
'演示怎样设置一个窗口在桌面上的HotKey,这个程序将Form1的HotKey设置为
'Ctl+Alt+A.

Private   Declare   Function   SendMessage   Lib   "user32 "   Alias   "SendMessageA "   (ByVal   hwnd   As   Long,   ByVal   wMsg   As   Long,   ByVal   wParam   As   Long,   lParam   As   Any)   As   Long

Private   Const   WM_SETHOTKEY   =   &H32
Private   Const   HOTKEYF_SHIFT   =   &H1
Private   Const   HOTKEYF_CONTROL   =   &H2
Private   Const   HOTKEYF_ALT   =   &H4

Private   Sub   Form_Load()
      Dim   l   As   Long
      Dim   wHotkey   As   Long
     
      wHotkey   =   (HOTKEYF_ALT   Or   HOTKEYF_CONTROL)   *   (2   ^   8)   +   65
      l   =   SendMessage(Me.hwnd,   WM_SETHOTKEY,   wHotkey,   0)
End   Sub

有没有更好的方法呢?????

用键盘钩子,好像可以,但我下载的键盘钩子的代码很多,担心里面可能隐含什么错误~~

高手出招吧~~~~~~~~~~~

[解决办法]
注册热键的函数,放在模块中:
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
Shell "Notepad ", vbNormalFocus
End If
End If
End If
'如果不是热键信息则调用原来的程序
Wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)

End Function


使用,放在窗体中:
Option Explicit

Private Sub Form_Load()
Dim ret As Long

'记录原来的window程序地址
preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
'用自定义程序代替原来的window程序
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf Wndproc)

idHotKey = 1
Modifiers = MOD_ALT + MOD_CONTROL 'Alt+Ctrl 键
uVirtKey = vbKeyG 'G键
ret = RegisterHotKey(Me.hwnd, idHotKey, Modifiers, uVirtKey)

End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim ret As Long
'取消Message的截取,使之送往原来的windows程序
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)
Call UnregisterHotKey(Me.hwnd, uVirtKey)

End Sub

热点排行