jfzlnyf的电子文摘http://blog.yesky.com/Blog/jfzlnyf/复制地址
控制面板
日历
<2008年10月>
SuMoTuWeThFrSa
2829301234
567891011
12131415161718
19202122232425
2627282930311
2345678
留言簿(2)
文章档案


我在网上找的例子都是注册一个热键
我试着改了一下,可都没有成功
怎么向系统注册多个热键?就是软件在后台运行也能检测到热键的
比如注册Ctrl+D Ctrl+G这两个?


类模块
类名: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
窗体
Private WithEvents hk As clsRegHotKeys

Private Sub Form_Load()
    Set hk = New clsRegHotKeys
    hk.RegHotKeys Me.hwnd, CtrlKey, vbKeyC, "C"
    hk.RegHotKeys Me.hwnd, CtrlKey, vbKeyD, "D"
    Me.Show '这个不能省略,否则窗体无法显示出来!
   
    hk.WaitMsg

End Sub

Private Sub hk_HotKeysDown(Key As String)
    Select Case Key
        Case "C"
            MsgBox "你按了Ctrl+C !"
        Case "D"
            MsgBox "你按了Ctrl+D !"
    End Select
End Sub


作者:jfzlnyf 阅读() 评论()  编辑 发表于:2005-03-13 11:06
相关内容
文章评论

暂无人对此文章发表评论!

发表评论
标题 *  
姓名 *  
内容 *  
   验证码: *       
       
版权声明:天极是本Blog托管服务提供商。如本文牵涉版权问题,天极不承担相关责任,请版权拥有者直接与文章作者联系解决。
Powered by:

Copyright © jfzlnyf