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
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
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
'回复人: dsclub(▁▂▃▄▅▆▇█ 騩鹬←短发男生)
Option ExplicitPrivate 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 Private Sub ProcessMessages() Dim Message As Msg 'loop until bCancel is set to True Do While Not bCancel 'wait for a message WaitMessage 'check if it's a HOTKEY-message If PeekMessage(Message, Me.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
Select Case Message.wParam Case &HBFFF& WindowState = vbMaximized Case &HC000& WindowState = vbMinimized Case &HC001& WindowState = vbNormal Case Else End Select Me.SetFocus End If 'let the operating system process other events DoEvents Loop End Sub Private Sub Form_Load() Dim ret As Long bCancel = False 'register the Ctrl-F hotkey Call RegisterHotKey(Me.hWnd, &HBFFF&, 0, vbKeyF9) 'vbMaximized Call RegisterHotKey(Me.hWnd, &HC000&, 0, vbKeyF10) 'vbMinimized Call RegisterHotKey(Me.hWnd, &HC001&, 0, vbKeyF11) 'vbNormal
'show some information Me.AutoRedraw = True Me.Print "按 F9 本窗口便被呼叫,并最大化!" & vbCrLf & "按 F10 本窗口便被呼叫,并最小化!" & vbCrLf & "按 F11 本窗口便被呼叫,并正常化!" 'show the form and Show 'process the Hotkey messages ProcessMessages End Sub Private Sub Form_Unload(Cancel As Integer) bCancel = True 'unregister hotkey Call UnregisterHotKey(Me.hWnd, &HBFFF&) End Sub ------------------------ 稍微改动一下就行了
或者使用RegisterHotKey注册热键,不过药用到回调,实现起来比较麻烦一些.
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
Option ExplicitPrivate 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
Private Sub ProcessMessages()
Dim Message As Msg
'loop until bCancel is set to True
Do While Not bCancel
'wait for a message
WaitMessage
'check if it's a HOTKEY-message
If PeekMessage(Message, Me.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
Select Case Message.wParam
Case &HBFFF&
WindowState = vbMaximized
Case &HC000&
WindowState = vbMinimized
Case &HC001&
WindowState = vbNormal
Case Else
End Select
Me.SetFocus
End If
'let the operating system process other events
DoEvents
Loop
End Sub
Private Sub Form_Load()
Dim ret As Long
bCancel = False
'register the Ctrl-F hotkey
Call RegisterHotKey(Me.hWnd, &HBFFF&, 0, vbKeyF9) 'vbMaximized
Call RegisterHotKey(Me.hWnd, &HC000&, 0, vbKeyF10) 'vbMinimized
Call RegisterHotKey(Me.hWnd, &HC001&, 0, vbKeyF11) 'vbNormal
'show some information
Me.AutoRedraw = True
Me.Print "按 F9 本窗口便被呼叫,并最大化!" & vbCrLf & "按 F10 本窗口便被呼叫,并最小化!" & vbCrLf & "按 F11 本窗口便被呼叫,并正常化!"
'show the form and
Show
'process the Hotkey messages
ProcessMessages
End Sub
Private Sub Form_Unload(Cancel As Integer)
bCancel = True
'unregister hotkey
Call UnregisterHotKey(Me.hWnd, &HBFFF&)
End Sub
------------------------
稍微改动一下就行了