如何在VB中实现多个系统热键？（100分求解）

Question

很多地方都介绍了如何用VB设置系统热键。但是只能设置一个热键。
如果要设置两个或多个热键，怎么办？
如果依然使用RegisterHotKey。那么怎么解决新建立的热键和原来的热键
能被系统区分的问题，如：
当按下 CTRL+SHIFT+I 执行 sub press_i ()
当按下 CTRL+SHIFT+E 执行 sub press_e ()
请各位指点迷津。

Answer 1

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
Public Sub ProcessMessages()
    Dim Message As Msg
    Do While Not bCancel
        WaitMessage
        If PeekMessage(Message, Me.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
            Select Case Message.wParam '根据刚才注册的键来判断
                Case 11112
                    Debug.Print "按了CTRL+SHIFT+A"
                Case 11113
                    Debug.Print "按了CTRL+SHIFT+B"
                Case 11114
                    Debug.Print "按了CTRL+SHIFT+C"
            End Select
        End If
        DoEvents
    Loop
End SubPrivate Sub Form_Load()
    Dim ret As Long
    bCancel = False
    ret = RegisterHotKey(Me.hWnd, 11112, MOD_CONTROL Or MOD_SHIFT, vbKeyA) '这里注册一个11112,其它的都一样
    ret = RegisterHotKey(Me.hWnd, 11113, MOD_CONTROL Or MOD_SHIFT, vbKeyB)
    ret = RegisterHotKey(Me.hWnd, 11114, MOD_CONTROL Or MOD_SHIFT, vbKeyC)
    Show
    ProcessMessages
End Sub
Private Sub Form_Unload(Cancel As Integer)
    bCancel = True
    Call UnregisterHotKey(Me.hWnd, 11112) '卸载注册
    Call UnregisterHotKey(Me.hWnd, 11113)
    Call UnregisterHotKey(Me.hWnd, 11114)
End Sub

Answer 2

'以下在.Bas
Option Explicit'用以告訴系統當這個視窗的msg事件發生時 執行lpPrevWndFunc
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
'lpPrevWndFunc執行函數的位址
'hwnd 就是視窗的hwnd屬性
'Msg就是訊息 例如按下滑鼠右鍵 最大化....
'wParam,lParam會因Msg不同而有不同的用途'取得可用的id
Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Integer
'lpString 傳入任意字串 傳回值為可用的id'用以設定視窗的程序
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
'hwnd 就是所要設定視窗的hwnd屬性
'nIndex 是要設定的程序
'dwNewLong  所指定的程序(nIndex)所要執行的動作'用以向系統註冊熱鍵 當熱鍵按下時 系統會將WM_HOTKEY這個訊息傳過來
Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, _
ByVal id As Long, _
ByVal fsModifiers As Long, _
ByVal vk As Long) As Long
'hwnd 就是視窗的hwnd屬性
'id可以隨便填,只要不重複的話...保險起見是使用GlobalAddAtom取得未使用的id
'fsModifiers 指定按下ALT CTRL 或SHIFT鍵
Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4
'vk是按鍵的VK碼'取消熱鍵
Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As LongPublic Const GWL_WNDPROC = (-4)
Public Const WM_HOTKEY = &H312
Public AppId As Long
Public AppId1 As LongPublic PrevWndProc As LongFunction WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lResult As Long
If uMsg = WM_HOTKEY Then '當熱鍵按下時
    Form1.WindowState = 0
    Form1.Show
    If wParam = AppId1 Then '當wParam=第二組id時 是按下第二組熱鍵
        Form1.Caption = "你按Control+3"
        Shell "notepad", vbNormalFocus
    ElseIf wParam = AppId Then '當wParam=第一組id時 是按下第一組熱鍵
        Form1.Caption = "你按Control+2"
        Shell "notepad", vbNormalFocus
    End If
Else
    WndProc = CallWindowProc(PrevWndProc, hwnd, uMsg, wParam, lParam)
    '其他訊息用原來的回呼函數處理
End If
End Function
 
--------------------------------------------------------------------------------
'以下在 Form
Option Explicit
Private Sub Form_Load()
Dim lResult As Long
AppId = GlobalAddAtom("Honey") '向系統取得第一組可用id
AppId1 = GlobalAddAtom("Honey1") '向系統取得第二組可用idlResult = RegisterHotKey(Form1.hwnd, AppId, MOD_CONTROL, vbKey2)
lResult = RegisterHotKey(Form1.hwnd, AppId1, MOD_CONTROL, vbKey3)
'設定兩組熱鍵 分別是Ctrl+2和Ctrl+3
'當按下這兩組按鍵時 系統會傳WM_HOTKEY訊息
'給所熱鍵所註冊的視窗 此時是Form1PrevWndProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WndProc)
'設定新的回呼函式 以攔截訊息
'note: 傳回值PrevWndProc是原來視窗的回呼函數
'WndProc函數放在模組 因為AddressOf只能取得模組下函數的位址
End SubPrivate Sub Form_Unload(Cancel As Integer)
Dim lResult As Long
lResult = SetWindowLong(Me.hwnd, GWL_WNDPROC, PrevWndProc)
'結束時歸還原來的回呼函數 不然會當機 lResult = UnregisterHotKey(Me.hwnd, AppId)
lResult = UnregisterHotKey(Me.hwnd, AppId1)
'取消熱鍵
End Sub  

Answer 3

午夜逛街 真牛！！
收藏ing

Answer 4

推荐tztz520(午夜逛街)的方法，不推荐yifong_1981() 的方法，因为yifong_1981() 的方法修改了窗体函数(WindowProc)，这样会导致程序不稳定，尤其是调试的时候。