帮忙设定vb热键

简单的

先添加一个模块，把下面的代码复制到模块里
Public Const MAX_TOOLTIP As Integer = 64
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIM_Delete = &H2
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
Public Const SW_RESTORE = 9
Public Const SW_HIDE = 0
Public nfIconData As NOTIFYICONDATA
Public Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * MAX_TOOLTIP
End Type

Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal OldwndProc As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Const GWL_WNDPROC = -4
Public OldwndProc As Long

Public Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal HotKeyID As Long, ByVal fsModifiers As Long, ByVal vKey As Long) As Long
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal HotKeyID As Long) As Long

Public Const WM_HOTKEY = &H312
Public Const WM_NCDESTROY = &H82

Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4
Public Const MOD_WIN = &H8

Public Function WindowProc(ByVal hWnd As Long, ByVal WindowMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case WindowMsg
Case WM_HOTKEY
Select Case wParam
Case 1
Call Form1.ChangeCheck
End Select
End Select
WindowProc = CallWindowProc(OldwndProc, hWnd, WindowMsg, wParam, lParam)
End Function

然后再回到窗体界面，添加一个check控件，然后再把下面的代码放到窗体代码里：

Dim HotKey As Byte
Dim HotKeyEnabled(12) As Boolean
Dim Ret As Long

Private Sub Form_Load()

With nfIconData
.hWnd = Me.hWnd
.uID = Me.Icon
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon.Handle
.szTip = App.Title + "(版本 " & App.Major & "." & App.Minor & "." & App.Revision & ")" & vbNullChar
.cbSize = Len(nfIconData)
End With
Call Shell_NotifyIcon(NIM_ADD, nfIconData)
Call InitHotKey
Me.Hide

End Sub

Public Sub ChangeCheck()
If Check1.Value = 0 Then
Check1.Value = 1
Else
Check1.Value = 0
End If
End Sub

Public Sub Cleanup()
Call DeleteHotkey(1)
End Sub

Private Sub CreateHotkey(ID As Long, HK As Long, MK As Long)
Dim ReturnValue As Long
ReturnValue = RegisterHotKey(Me.hWnd, ID, MK, HK)
End Sub

Private Sub DeleteHotkey(HK As Long)
On Error Resume Next
Dim ReturnValue As Long
ReturnValue = UnregisterHotKey(Me.hWnd, HK)
End Sub

Private Sub InitHotKey()
OldwndProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf WindowProc)
Call CreateHotkey(1, 121, 0) 'F10
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call Shell_NotifyIcon(NIM_Delete, nfIconData)
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lMsg As Single
lMsg = X / Screen.TwipsPerPixelX
Select Case lMsg
Case WM_LBUTTONUP
ShowWindow Me.hWnd, SW_RESTORE
End Select
End Sub

搞定

运行后，程序直接缩到托盘内，鼠标单击，程序界面显示，任意时候按F10 都会改变check控件前面的钩钩。。

拿分闪人 哈哈

拖一个时间控件 Timer到窗体

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer '热键
Private Sub Form_Load()
Timer1.Interval = 500
Timer1.Enabled = True

End Sub

'监测按键
Private Sub Timer1_Timer()
If GetAsyncKeyState(vbKeyF10) Then

If Check1.Value = 1 Then
Check1.Value = 0
Else
Check1.Value = 1
End If
End If
End Sub

两种结合 代码如下
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer '热键
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Const NIM_ADD = &H0
Const NIM_DELETE = &H2
Const NIF_ICON = &H2
Const NIF_MESSAGE = &H1
Const NIF_TIP = &H4
Const WM_MOUSEMOVE = &H200
Const WM_LBUTTONDBLCLK = &H203
Private Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uId As Long
uFlags As Long
uCallBackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Dim tray As NOTIFYICONDATA

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim msg As Long
msg = X / 15
If msg = WM_LBUTTONDBLCLK Then
Me.Show
Shell_NotifyIcon NIM_DELETE, tray
End If
End Sub

Private Sub Form_Load()
Timer1.Interval = 500
Timer1.Enabled = True
tray.cbSize = Len(tray)
tray.uId = vbNull
tray.hWnd = Me.hWnd
tray.uFlags = NIF_TIP Or NIF_MESSAGE Or NIF_ICON
tray.uCallBackMessage = WM_MOUSEMOVE
tray.hIcon = Me.Icon
tray.szTip = "测试" & vbNullChar
Shell_NotifyIcon NIM_ADD, tray
Me.Hide

End Sub

'监测按键
Private Sub Timer1_Timer()
If GetAsyncKeyState(vbKeyF10) Then

If Check1.Value = 1 Then
Check1.Value = 0
tray.cbSize = Len(tray)
tray.uId = vbNull
tray.hWnd = Me.hWnd
tray.uFlags = NIF_TIP Or NIF_MESSAGE Or NIF_ICON
tray.uCallBackMessage = WM_MOUSEMOVE
tray.hIcon = Me.Icon
tray.szTip = "测试" & vbNullChar
Shell_NotifyIcon NIM_ADD, tray
Me.Hide
Else
Check1.Value = 1
Me.Show
End If
End If
End Sub