sethotkey.bas

热键音量

Attribute VB_Name = "Module1"
'请大家新建一个模块（.bas）文件，自定义 SetHotkey函数及其他，
'这样在以后的任何程序中只要调用此模块就可以了。


'示例:
'激活 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"


'键盘按键常量值说明（使用时用Windows计算器转换为10进制）

'vbKeyLButton 0x1 鼠标左键
'vbKeyRButton 0x2 鼠标右键
'vbKeyCancel 0x3 CANCEL键
'vbKeyMButton 0x4 鼠标中键
'vbKeyBack 0x8 退格键
'vbKeyTab 0x9 TAB 键
'vbKeyClear 0xC CLEAR健
'vbKeyReturn 0xD 回车键
'vbKeyShift 0x10 SHIFT 键
'vbKeyControl 0x11 CTRL 键
'vbKeyMenu 0x12 MENU 键
'vbKeyPause 0x13 PAUSE 键
'vbKeyCapital 0x14 CAPS LOCK 键
'vbKeyEscape 0x1B ESC 键
'vbKeySpace 0x20 空格键
'vbKeyPageUp 0x21 Page Up 键
'vbKeyPageDown 0x22 Page Down 键
'vbKeyEnd 0x23 END 键
'vbKeyHome 0x24 HOME 键
'vbKeyLeft 0x25 光标左键
'vbKeyUp 0x26 光标上键
'vbKeyRight 0x27 光标右键
'vbKeyDown 0x28 光标下键
'vbKeySelect 0x29 SELECT 键
'vbKeyPrint 0x2A Print Screen 键
'vbKeyExecute 0x2B EXECUTE 键
'vbKeySnapshot 0x2C SnapShot 键
'vbKeyInsert 0x2D INSERT 键
'vbKeyDelete 0x2E DELETE 键
'vbKeyHelp 0x2F HELP 键
'vbKeyNumlock 0x90 NUM LOCK 键
'vbKeyA 65 字母 A 键
'vbKeyB 66 字母 B 键
'vbKeyC 67 字母 C 键
'vbKeyD 68 字母 D 键
'vbKeyE 69 字母 E 键
'vbKeyF 70 字母 F 键
'vbKeyG 71 字母 G 键
'vbKeyH 72 字母 H 键
'vbKeyI 73 字母 I 键
'vbKeyJ 74 字母 J 键
'vbKeyK 75 字母 K 键
'vbKeyL 76 字母 L 键
'vbKeyM 77 字母 M 键
'vbKeyN 78 字母 N 键
'vbKeyO 79 字母 O 键
'vbKeyP 80 字母 P 键
'vbKeyQ 81 字母 Q 键
'vbKeyR 82 字母 R 键
'vbKeyS 83 字母 S 键
'vbKeyT 84 字母 T 键
'vbKeyU 85 字母 U 键
'vbKeyV 86 字母 V 键
'vbKeyW 87 字母 W 键
'vbKeyX 88 字母 X 键
'vbKeyY 89 字母 Y 键
'vbKeyZ 90 字母 Z 键
'vbKey0 48 数字 0 键
'vbKey1 49 数字 1 键
'vbKey2 50 数字 2 键
''vbKey3 51 数字 3 键
'vbKey4 52 数字 4 键
'vbKey5 53 数字 5 键
'vbKey6 54 数字 6 键
'vbKey7 55 数字 7 键
'vbKey8 56 数字 8 键
'vbKey9 57 数字 9 键
'vbKeyF1 0x70 F1 功能键
'vbKeyF2 0x71 F2 功能键
'vbKeyF3 0x72 F3 功能键
'vbKeyF4 0x73 F4 功能键
'vbKeyF5 0x74 F5 功能键
'vbKeyF6 0x75 F6 功能键
'vbKeyF7 0x76 F7 功能键
'vbKeyF8 0x77 F8 功能键
'vbKeyF9 0x78 F9 功能键
'vbKeyF10 0x79 F10 功能键
'vbKeyF11 0x7A F11 功能键
'vbKeyF12 0x7B F12 功能键
'vbKeyF13 0x7C F13 功能键
'vbKeyF14 0x7D F14 功能键
'vbKeyF15 0x7E F15 功能键
'vbKeyF16 0x7F F16 功能键
'vbKeyNumpad0 0x60 小键盘 0 键
'vbKeyNumpad1 0x61 小键盘 1 键
'vbKeyNumpad2 0x62 小键盘 2 键
'vbKeyNumpad3 0x63 小键盘 3 键
'vbKeyNumpad4 0x64 小键盘 4 键
'vbKeyNumpad5 0x65 小键盘 5 键
'vbKeyNumpad6 0x66 小键盘 6 键
'vbKeyNumpad7 0x67 小键盘 7 键
'vbKeyNumpad8 0x68 小键盘 8 键
'vbKeyNumpad9 0x69 小键盘 9 键
'vbKeyMultiply 0x6A 小键盘 * 键
'vbKeyAdd 0x6B 小键盘 + 键
'vbKeySeparator 0x6C 小键盘回车键
'vbKeySubtract 0x6D 小键盘 - 键
'vbKeyDecimal 0x6E 小键盘 . 键
'vbKeyDivide 0x6F 小键盘 / 键






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 Long

Const 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 '注释：是否取得窗口信息的判断
Public HotKeyNumber As Integer '用户所按下的热键序号
Public hui As Single


Function keyWndproc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim HEE As Integer
If msg = WM_HOTKEY Then
HEE = wParam
MSGM HEE
End If
'注释: 将消息传送给指定的窗口
keyWndproc = CallWindowProc(key_preWinProc, hwnd, msg, wParam, lParam)
End Function

Function 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

Public Function CH(KP As Integer) As String
Select Case KP
Case vbKeyRButton
CH = "鼠标左键"
Case vbKeyRButton
CH = "鼠标右键"
Case vbKeyCancel
CH = "CANCEL键"
Case vbKeyMButton
CH = "鼠标中键"
Case vbKeyBack
CH = ""
Case vbKeyTab
CH = "TAB键"
Case vbKeyClear
CH = "CLEAR健"
Case vbKeyReturn
CH = "回车键"
Case vbKeyShift
CH = "Shift+"
Case vbKeyControl
CH = "Ctrl+"
Case vbKeyMenu
CH = "Alt+"
Case vbKeyPause
CH = "PAUSE"
Case vbKeyCapital
CH = "CAPS LOCK"
Case vbKeyEscape
CH = "ESC"
Case vbKeySpace
CH = "空格键"
Case vbKeyPageUp
CH = "Page Up"
Case vbKeyPageDown
CH = "Page Down"
Case vbKeyEnd
CH = "END"
Case vbKeyHome
CH = "HOME"
Case vbKeyLeft
CH = "光标左键"
Case vbKeyUp
CH = "光标上键"
Case vbKeyRight
CH = "光标右键"
Case vbKeyDown
CH = "光标下键"
Case vbKeySelect
CH = "SELECT"
Case vbKeyPrint
CH = "Print Screen"
Case vbKeyExecute
CH = "EXECUTE"
Case vbKeySnapshot
CH = "napShot"
Case vbKeyInsert
CH = "INSERT"
Case vbKeyDelete
CH = "DELETE"
Case vbKeyHelp
CH = "HELP"
Case vbKeyNumlock
CH = "NUM LOCK"
Case vbKeyA
CH = "A"
Case vbKeyB
CH = "B"
Case vbKeyC
CH = "C"
Case vbKeyD
CH = "D"
Case vbKeyE
CH = "E"
Case vbKeyF
CH = "F"
Case vbKeyG
CH = "G"
Case vbKeyH
CH = "H"
Case vbKeyI
CH = "I"
Case vbKeyJ
CH = "J"
Case vbKeyK
CH = "K"
Case vbKeyL
CH = "L"
Case vbKeyM
CH = "M"
Case vbKeyN
CH = "n"
Case vbKeyO
CH = "O"
Case vbKeyP
CH = "P"
Case vbKeyQ
CH = "Q"
Case vbKeyR
CH = "R"
Case vbKeyS
CH = "S"
Case vbKeyT
CH = "T"
Case vbKeyU
CH = "U"
Case vbKeyV
CH = "V"
Case vbKeyW
CH = "W"
Case vbKeyX
CH = "X"
Case vbKeyY
CH = "Y"
Case vbKeyZ
CH = "Z"
Case vbKey0
CH = "0"
Case vbKey1
CH = "1"
Case vbKey2
CH = "2"
Case vbKey3
CH = "3"
Case vbKey4
CH = "4"
Case vbKey5
CH = "5"
Case vbKey6
CH = "6"
Case vbKey7
CH = "7"
Case vbKey8
CH = "8"
Case vbKey9
CH = "9"
Case vbKeyF1
CH = "F1"
Case vbKeyF2
CH = "F2"
Case vbKeyF3
CH = "F3"
Case vbKeyF4
CH = "F4"
Case vbKeyF5
CH = "F5"
Case vbKeyF6
CH = "F6"
Case vbKeyF7
CH = "F7"
Case vbKeyF8
CH = "F8"
Case vbKeyF9
CH = "F9"
Case vbKeyF10
CH = "F10"
Case vbKeyF11
CH = "F11"
Case vbKeyF12
CH = "F12"
Case vbKeyF13
CH = "F13"
Case vbKeyF14
CH = "F14"
Case vbKeyF15
CH = "F15"
Case vbKeyF16
CH = "F16"
Case vbKeyNumpad0
CH = "小键盘 0 键"
Case vbKeyNumpad1
CH = "小键盘 1 键"
Case vbKeyNumpad2
CH = "小键盘 2 键"
Case vbKeyNumpad3
CH = "小键盘 3 键"
Case vbKeyNumpad4
CH = "小键盘 4 键"
Case vbKeyNumpad5
CH = "小键盘 5 键"
Case vbKeyNumpad6
CH = "小键盘 6 键"
Case vbKeyNumpad7
CH = "小键盘 7 键"
Case vbKeyNumpad8
CH = "小键盘 8 键"
Case vbKeyNumpad9
CH = "小键盘 9 键"
Case vbKeyMultiply
CH = "小键盘 * 键"
Case vbKeyAdd
CH = "小键盘 + 键"
Case vbKeySeparator
CH = "小键盘回车键"
Case vbKeySubtract
CH = "小键盘 - 键"
Case vbKeyDecimal
CH = "小键盘 . 键"
Case vbKeyDivide
CH = "小键盘 / 键"
End Select
End Function
Public Function HC(PK As String) As Integer
Select Case PK
Case "鼠标左键"
HC = vbKeyRButton
Case "鼠标右键"
HC = vbKeyRButton
Case "CANCEL键"
HC = vbKeyCancel
Case "鼠标中键"
HC = vbKeyMButton
Case ""
HC = vbKeyBack
Case "TAB键"
HC = vbKeyTab
Case "CLEAR健"
HC = vbKeyClear
Case "回车键"
HC = vbKeyReturn
Case "Shift+"
HC = vbKeyShift
Case "Ctrl+"
HC = vbKeyControl
Case "Alt+"
HC = vbKeyMenu
Case "PAUSE"
HC = vbKeyPause
Case "CAPS LOCK"
HC = vbKeyCapital
Case "ESC"
HC = vbKeyEscape
Case "空格键"
HC = vbKeySpace
Case "Page Up"
HC = vbKeyPageUp
Case "Page Down"
HC = vbKeyPageDown
Case "END"
HC = vbKeyEnd
Case "HOME"
HC = vbKeyHome
Case "光标左键"
HC = vbKeyLeft
Case "光标上键"
HC = vbKeyUp
Case "光标右键"
HC = vbKeyRight
Case "光标下键"
HC = vbKeyDown
Case "SELECT"
HC = vbKeySelect
Case "Print Screen"
HC = vbKeyPrint
Case "EXECUTE"
HC = vbKeyExecute
Case "napShot"
HC = vbKeySnapshot
Case "INSERT"
HC = vbKeyInsert
Case "DELETE"
HC = vbKeyDelete
Case "HELP"
HC = vbKeyHelp
Case "NUM LOCK"
HC = vbKeyNumlock
Case "A"
HC = vbKeyA
Case "B"
HC = vbKeyB
Case "C"
HC = vbKeyC
Case "D"
HC = vbKeyD
Case "E"
HC = vbKeyE
Case "F"
HC = vbKeyF
Case "G"
HC = vbKeyG
Case "H"
HC = vbKeyH
Case "I"
HC = vbKeyI
Case "J"
HC = vbKeyJ
Case "K"
HC = vbKeyK
Case "L"
HC = vbKeyL
Case "M"
HC = vbKeyM
Case "n"
HC = vbKeyN
Case "O"
HC = vbKeyO
Case "P"
HC = vbKeyP
Case "Q"
HC = vbKeyQ
Case "R"
HC = vbKeyR
Case "S"
HC = vbKeyS
Case "T"
HC = vbKeyT
Case "U"
HC = vbKeyU
Case "V"
HC = vbKeyV
Case "W"
HC = vbKeyW
Case "X"
HC = vbKeyX
Case "Y"
HC = vbKeyY
Case "Z"
HC = vbKeyZ
Case "0"
HC = vbKey0
Case "1"
HC = vbKey1
Case "2"
HC = vbKey2
Case "3"
HC = vbKey3
Case "4"
HC = vbKey4
Case "5"
HC = vbKey5
Case "6"
HC = vbKey6
Case "7"
HC = vbKey7
Case "8"
HC = vbKey8
Case "9"
HC = vbKey9
Case "F1"
HC = vbKeyF1
Case "F2"
HC = vbKeyF2
Case "F3"
HC = vbKeyF3
Case "F4"
HC = vbKeyF4
Case "F5"
HC = vbKeyF5
Case "F6"
HC = vbKeyF6
Case "F7"
HC = vbKeyF7
Case "F8"
HC = vbKeyF8
Case "F9"
HC = vbKeyF9
Case "F10"
HC = vbKeyF10
Case "F11"
HC = vbKeyF11
Case "F12"
HC = vbKeyF12
Case "F13"
HC = vbKeyF13
Case "F14"
HC = vbKeyF14
Case "F15"
HC = vbKeyF15
Case "F16"
HC = vbKeyF16
Case "小键盘 0 键"
HC = vbKeyNumpad0
Case "小键盘 1 键"
HC = vbKeyNumpad1
Case "小键盘 2 键"
HC = vbKeyNumpad2
Case "小键盘 3 键"
HC = vbKeyNumpad3
Case "小键盘 4 键"
HC = vbKeyNumpad4
Case "小键盘 5 键"
HC = vbKeyNumpad5
Case "小键盘 6 键"
HC = vbKeyNumpad6
Case "小键盘 7 键"
HC = vbKeyNumpad7
Case "小键盘 8 键"
HC = vbKeyNumpad8
Case "小键盘 9 键"
HC = vbKeyNumpad9
Case "小键盘 * 键"
HC = vbKeyMultiply
Case "小键盘加号"
HC = vbKeyAdd
Case "小键盘回车键"
HC = vbKeySeparator
Case "小键盘 - 键"
HC = vbKeySubtract
Case "小键盘 . 键"
HC = vbKeyDecimal
Case "小键盘 / 键"
HC = vbKeyDivide
End Select
End Function

Public Function ChC(C As String) As String
Dim WS As Integer
Dim Z As String
Dim cle As String
Dim cri As String
If InStr(C, "+") <> 0 Then
WS = Len(C)
While Mid(C, WS, 1) <> "+"
WS = WS - 1
Wend
cle = Left(C, WS - 1)
cri = HC(Right(C, Len(C) - WS))
ChC = cle + "," + cri
Else
ChC = Str(HC(C))
End If
End Function
Public Sub MSGM(wp As Integer)
Select Case wp
Case 1
Form1.Command1_Click
HotKeyNumber = 1
Case 2
Form1.Command2_Click
HotKeyNumber = 2
Case 3
Form1.Command3_Click
HotKeyNumber = 3
End Select
End Sub