我用 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 LongPrivate Const WM_SETHOTKEY = &H32
Private Const HOTKEYF_SHIFT = &H1
Private Const HOTKEYF_CONTROL = &H2
Private Const HOTKEYF_ALT = &H4Private 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有没有更好的方法呢?????用键盘钩子,好像可以,但我下载的键盘钩子的代码很多,担心里面可能隐含什么错误~~高手出招吧~~~~~~~~~~~

解决方案 »

  1.   

    注册热键的函数,放在模块中:
    Option ExplicitDeclare 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 LongPublic 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 LongPrivate Type taLong
        ll As Long
    End TypePrivate Type t2Int
        lWord As Integer
        hWord As Integer
    End TypePublic 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 ExplicitPrivate 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 SubPrivate 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