'以下代码调试通过,但就是关闭程序时,不能正常退出程序(窗体虽然关闭,但进程依然存在)请高手帮忙!
===============================================================================================
'★添加类模块:
'新建一个类模块: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, 0, vbKeyF9, "F9"
Me.Show
hk.WaitMsg
End Sub
Private Sub hk_HotKeysDown(Key As String)
Select Case Key
Case "F9"
MsgBox "你按了F9 !"
End Select
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
'★窗体调用代码 Private WithEvents hk As clsRegHotKeys
Private Sub Form_Load()
Set hk = New clsRegHotKeys
hk.RegHotKeys Me.hwnd, 0, vbKeyF9, "F9"
Me.Show
hk.WaitMsg
End Sub
Private Sub hk_HotKeysDown(Key As String)
Select Case Key
Case "F9"
MsgBox "你按了F9 !"
End Select
End Sub
call UnRegAllHotKeys
老大们都不在???在Form_Unload 事件里执行注销热代码,我已经试过了,不行才发帖求助的。请大家帮忙调试一下。谢谢!~~~
二、计数器没有正确使用,导致热键不能及时注销。
三、在注销热键后,没有设置bCancel=True,导致循环不能结束。
hk.UnRegHotKeys "F9"
hk.UnWaitMsg
End Sub
其中hk.UnWaitMsg表示结束循环。
lz 在类的这个过程中,修改下,如下 Private Sub Class_Terminate() debug.print " hotkey class will be do something" On Error Resume Next
bCancel = True
UnRegAllHotKeys debug.print " hotkey class Terminate " End Sub
然后调试运行 》 关闭窗口 》 查看立即窗口中是否显示了debug内容
如果有,就说明,导致进程无法退出的原因不再这个hotkey上
如果没有,lz 还是再看看别的吧,你贴的代码,基本上来说问题不大如果说稍有疑问的话,试试把 while not bcancel 改成 unitl bcancel
//
上面这一句放在一个按钮事件里.然后在窗体启动后手工按一下这个按钮,启动这个循环.再退出看看.我觉得是你那个循环未退出.