模块中：  
  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   GlobalAddAtom   Lib   "kernel32"   Alias   "GlobalAddAtomA"   (ByVal   lpString   As   String)   As   Integer  
  Private   Declare   Function   GlobalDeleteAtom   Lib   "kernel32"   (ByVal   nAtom   As   Integer)   As   Integer  
  Private   Declare   Function   UnregisterHotKey   Lib   "user32"   (ByVal   hwnd   As   Long,   ByVal   id   As   Long)   As   Long  
  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  
   
  Const   GWL_WNDPROC   =   (-4)  
  Const   WM_HOTKEY   =   &H312  
   
  Public   Enum   ModKeys  
      MOD_ALT   =   &H1  
      MOD_CONTROL   =   &H2  
      MOD_SHIFT   =   &H4  
      MOD_WIN   =   &H8  
  End   Enum  
   
  Dim   iAtom   As   Integer  
  Dim   OldProc   As   Long,   hOwner   As   Long  
  Public   sDir   As   String,   sFile   As   String  
   
  Public   Function   SetHotKey(hWin   As   Long,   ModKey   As   ModKeys,   vKey   As   Long)   As   Boolean  
      If   hOwner   >   0   Then   Exit   Function  
      hOwner   =   hWin  
      iAtom   =   GlobalAddAtom("MyHotKey")  
      SetHotKey   =   RegisterHotKey(hOwner,   iAtom,   ModKey,   vKey)  
      OldProc   =   SetWindowLong(hOwner,   GWL_WNDPROC,   AddressOf   WndProc)  
  End   Function  
   
  Public   Sub   RemoveHotKey()  
      If   hOwner   =   0   Then   Exit   Sub  
      Call   UnregisterHotKey(hOwner,   iAtom)  
      Call   SetWindowLong(hOwner,   GWL_WNDPROC,   OldProc)  
  End   Sub  
   
  Public   Function   WndProc(ByVal   hwnd   As   Long,   ByVal   wMsg   As   Long,   ByVal   wParam   As   Long,   ByVal   lParam   As   Long)   As   Long  
      If   wMsg   =   WM_HOTKEY   And   wParam   =   iAtom   Then  
            按了热键后的操作  
      Else  
            WndProc   =   CallWindowProc(OldProc,   hwnd,   wMsg,   wParam,   lParam)  
      End   If  
  End   Function  
   
  窗体中：  
  Private   Sub   Form_Load()  
          SetHotKey   Me.hwnd,   MOD_CONTROL   +   MOD_SHIFT,   vbKeyJ  
  End   Sub  
   
  Private   Sub   Form_Unload(Cancel   As   Integer)  
          RemoveHotKey  
  End   Sub  
   
  以上代码可以为一个应用程序设定一个热键，那么如何为一个应用程序同时设定多个热键呢？

Dim   WithEvents   hk   As   clsRegHotKeys  
   
  Private   Sub   Form_Load()  
          Set   hk   =   New   clsRegHotKeys  
          hk.RegHotKeys   Me.hwnd,   AltKey,   vbKeyA,   "A"  
          hk.RegHotKeys   Me.hwnd,   CtrlKey,   vbKeyQ,   "Q"  
          Me.Show  
          hk.WaitMsg  
  End   Sub  
   
  Private   Sub   Form_Unload(Cancel   As   Integer)  
          hk.UnWaitMsg  
          Set   hk   =   Nothing  
  End   Sub  
   
  Private   Sub   hk_HotKeysDown(Key   As   String)  
          If   Key   =   "A"   Then  
                  MsgBox   "Alt+A"  
          ElseIf   Key   =   "Q"   Then  
                  MsgBox   "CTRL+Q"  
          End   If  
  End   Sub  
   
   
  类名   clsRegHotKeys  
   
   
  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   Type   KeyMsg  
          ID   As   Long       保存注册热键时的ID  
          Key   As   String   保存注册热键时的关键字  
  End   Type  
   
  Private   Const   PM_REMOVE   =   &H1  
  Private   Const   WM_HOTKEY   =   &H312  
   
  Private   Declare   Function   RegisterHotKey   Lib   "user32"   (ByVal   hwnd   As   Long,   ByVal   ID   As   Long,   ByVal   fsModifiers   As   Long,   ByVal   vk   As   Long)   As   Long  
  id   值范围   ：0X0000-0XBFFF  
  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  
  ************************************************************  
   
  Enum   ShiftKeys  
          AltKey   =   &H1  
          CtrlKey   =   &H2  
          ShiftKey   =   &H4  
  End   Enum  
   
  局部变量  
  Private   bCancel   As   Boolean  
  Private   clsHwnd   As   Long  
  Private   KeyGroup   As   Integer  
  Private   KeyID   As   Long  
  Private   Keys()   As   KeyMsg  
   
  声明事件  
  Public   Event   HotKeysDown(Key   As   String)  
  注册热键,可以注册多组热键  
  Sub   RegHotKeys(ByVal   hwnd   As   Long,   ByVal   ShiftKey   As   ShiftKeys,   ByVal   ComKey   As   KeyCodeConstants,   ByVal   Key   As   String)  
          On   Error   Resume   Next  
          clsHwnd   =   hwnd  
          KeyID   =   KeyID   +   1  
          KeyGroup   =   KeyGroup   +   1  
          ReDim   Preserve   Keys(KeyGroup)  
          RegisterHotKey   hwnd,   KeyID,   ShiftKey,   ComKey         注册热键  
          Keys(KeyGroup).ID   =   KeyID  
          Keys(KeyGroup).Key   =   Trim(Key)  
  End   Sub  
  取消热键注册  
  Sub   UnRegHotKeys(ByVal   Key   As   String)  
          On   Error   Resume   Next  
          If   KeyGroup   =   0   Then   Exit   Sub  
          Dim   i   As   Integer  
          For   i   =   0   To   KeyGroup  
                  If   Trim(Key)   =   Trim(Keys(i).Key)   Then  
                          UnregisterHotKey   clsHwnd,   Keys(i).ID  
                  End   If  
          Next  
  End   Sub  
   
  取消全部热键注册  
  Sub   UnRegAllHotKeys()  
          On   Error   Resume   Next  
          If   KeyGroup   =   0   Then   Exit   Sub  
          Dim   i   As   Integer  
          For   i   =   0   To   KeyGroup  
                  UnregisterHotKey   clsHwnd,   Keys(i).ID  
          Next  
  End   Sub  
   
  等候按键消息  
  Sub   WaitMsg()  
          On   Error   Resume   Next  
          bCancel   =   False  
          Dim   Message   As   Msg,   i   As   Integer  
          Do   While   Not   bCancel  
                  WaitMessage   等候按键消息  
                  判断消息  
                  If   PeekMessage(Message,   clsHwnd,   WM_HOTKEY,   WM_HOTKEY,   PM_REMOVE)   Then  
                          For   i   =   0   To   KeyGroup  
                                  If   Keys(i).ID   =   Message.wParam   Then   判断按下哪组热键  
                                          RaiseEvent   HotKeysDown(Keys(i).Key)   引发事件  
                                  End   If  
                          Next  
                  End   If  
                  DoEvents  
          Loop  
  End   Sub  
   
  取消等候消息  
  Sub   UnWaitMsg()  
          bCancel   =   True  
  End   Sub  
   
  Private   Sub   Class_Initialize()  
          KeyID   =   &H1000&   初始ID  
          KeyGroup   =   -1  
          ReDim   Keys(0)  
  End   Sub  
   
  Private   Sub   Class_Terminate()  
          On   Error   Resume   Next  
          bCancel   =   True  
          UnRegAllHotKeys  
  End   Sub  
   
 

• 软件资讯
• 技术指南
• 开发文档
• 编程技术
• 程序编程
• 数据库技术
• 服务器
• 项目开发
• 游戏编程

• 软件开发
• 服务器技术
• 行业资讯
• 程序相关
• 编程博文

• 挥泪甩卖HIS系统源代码^_^
• 空
• 我想在BCB的报表中只打印当前输入的那一张报表要怎么做啊，请大家帮帮我，谢谢啦！
• 哪位能够指教一下编写电话拨号程序
• 为何ping 的通网站名，ip地址，但是无法打开网页呢？
• 【求助】Oracle9i装了一半取消掉了，再装就装不上了
• 这个软件大概值多少钱?
• 游戏装不了....
• 如何将两表数据合并,忘各位帮忙,急....
• 求JAVA全屏显示代码
• 请问从事j2me的朋友,当时面试时公司是问你们什么样的问题?
• ListView中的PopupMenu的问题！
• XP系统USB设备问题，鼠标能用，U盘和摄象头根本就没检测到，这是怎么回事？
• 与地址栏图标相关问题!网页中加入什么代码才能使标签页显示与地址栏一样的图标?
• 编译的debug和release版有啥区别
• 禁止复止网页内容
• 函数的参数定义问题
• 大家喜欢看X片吗，
• 如何在list control中，点击某行数据时产生相应的响应？
• 200分：怎样在线程中应用Dll的接口函数呢？{急，在在线等}