用RegisterHotkey API来完成RegisterHotKey(ByVal hwnd As Long,ByVal idHotKey as Long,_
               ByVal Modifiers As Long, ByVal uVirtKey As Long)WM_HOTKEY 
idHotKey = wParam
Modifiers = (UINT) LOWORD(lParam)
uVirtKey = (UINT) HIWORD(lParam)以下程式功能是:不管在哪个程式中,只要按下ALT-SHIFT-G 便执行NotePad。
'以下在.BasOption 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
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 SubPrivate 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

解决方案 »

  1.   

    用 VB 实现全局热键模块
    武汉 艾军
    在软件报以前的文章中,虽然也介绍了如何用 VB 实现全局热键的方法,但是这些文章都只是针对初学者学习技巧而用,而在真正的程序编写中是不适应的,为了使我们编写的程序有继承性、维护性因此有必要制作一个实现全局热键的模块。
    请大家看看下面调用全局热键的示例:
    激活 3 个热键:(注:SetHotkey 是我自定义的函数)
    SetHotkey 1, "Ctrl,112", "Add"        按 Ctrl+F1 激活指定程序
    SetHotkey 2, 113, "Add"            按 F2 激活指定程序
    SetHotkey 3, "Ctrl+Alt,113", "Add"    按 Ctrl+Alt+F2 激活指定程序
    '注:关于激活热键后的操作,由自定义函数 SetHotkey 的 KeyId 传送的值来判断
    注销 3 个热键:
    SetHotkey 1, "", "Del"              退出程序是一定要用上的,不然会导至程序死掉
    SetHotkey 2, "", "Del"
    SetHotkey 3, "", "Del"
    请大家新建一个模块(.bas)文件,自定义 SetHotkey函数及其他,这样在以后的任何程序中只要调用此模块就可以了。
    '本模块是有关热键操作的
    Option Explicit
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private 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
    Private Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fskey_Modifiers As Long, ByVal vk As Long) As Long
    Private Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As LongConst WM_HOTKEY = &H312
    Const MOD_ALT = &H1
    Const MOD_CONTROL = &H2
    Const MOD_SHIFT = &H4
    Const GWL_WNDPROC = (-4)  '窗口函数的地址Dim key_preWinProc As Long '用来保存窗口信息
    Dim key_Modifiers As Long, key_uVirtKey As Long, key_idHotKey As Long
    Dim key_IsWinAddress  As Boolean '是否取得窗口信息的判断
    Function keyWndproc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long    If Msg = WM_HOTKEY Then
            Select Case wParam 'wParam 值就是 key_idHotKey
                Case 1 '激活 3 个热键后,3 个热键所对应的操作,大家在其他的程序中,只要修改此处就可以了
                    MsgBox "aa"
                Case 2
                    MsgBox "bb"
                Case 3
                    MsgBox "cc"
            End Select
        End If
        
        '将消息传送给指定的窗口
        keyWndproc = CallWindowProc(key_preWinProc, hwnd, Msg, wParam, lParam)
        
    End FunctionFunction SetHotkey(ByVal KeyId As Long, ByVal KeyAss0 As String, ByVal Action As String)
        Dim KeyAss1 As Long
        Dim KeyAss2 As String
        Dim i As Long
        
        i = InStr(1, KeyAss0, ",")
        If i = 0 Then
            KeyAss1 = Val(KeyAss0)
            KeyAss2 = ""
        Else
            KeyAss1 = Right(KeyAss0, Len(KeyAss0) - i)
            KeyAss2 = Left(KeyAss0, i - 1)
        End If        
        
        key_idHotKey = 0
        key_Modifiers = 0
        key_uVirtKey = 0
        
        If key_IsWinAddress = False Then  '判断是否需要取得窗口信息,如果重复取得,再最后恢复窗口时,将会造成程序死掉
            '记录原来的window程序地址
            key_preWinProc = GetWindowLong(Form1.hwnd, GWL_WNDPROC)
            '用自定义程序代替原来的window程序
            SetWindowLong Form1.hwnd, GWL_WNDPROC, AddressOf keyWndproc
        End If    key_idHotKey = KeyId
        Select Case Action
            Case "Add"
                If KeyAss2 = "Ctrl" Then key_Modifiers = MOD_CONTROL
                If KeyAss2 = "Alt" Then key_Modifiers = MOD_ALT
                If KeyAss2 = "Shift" Then key_Modifiers = MOD_SHIFT
                If KeyAss2 = "Ctrl+Alt" Then key_Modifiers = MOD_CONTROL + MOD_ALT
                If KeyAss2 = "Ctrl+Shift" Then key_Modifiers = MOD_CONTROL + MOD_SHIFT
                If KeyAss2 = "Ctrl+Alt+Shift" Then key_Modifiers = MOD_CONTROL + MOD_ALT + MOD_SHIFT
                If KeyAss2 = "Shift+Alt" Then key_Modifiers = MOD_SHIFT + MOD_ALT
                key_uVirtKey = Val(KeyAss1)
                RegisterHotKey Form1.hwnd, key_idHotKey, key_Modifiers, key_uVirtKey '向窗口注册系统热键
                key_IsWinAddress = True '不需要再取得窗口信息
                
            Case "Del"
                SetWindowLong Form1.hwnd, GWL_WNDPROC, key_preWinProc '恢复窗口信息
                UnregisterHotKey Form1.hwnd, key_uVirtKey '取消系统热键
                key_IsWinAddress = False '可以再次取得窗口信息
        End Select
    End Function该程序在 VB5.0,Win 98 下运行良好,希望这个"模块化的全局热键"对大家有帮助,希望大家在编写其他的程序代码时,尽量考虑到程序代码的后期维护性,尽量都写成模块,这样在编写其他的程序时就可以方便的调用了,大家如果对此程序还有什么问题、看法,可到 www.d1vb.com 来我们一起讨论。