很久没用vb了,做了个小东西,用着还挺顺手的 :)
frmmain.frm

'---------------------------------------------------------------------------------------
' Author        :阿汐
' Purpose     :vb实现老板键的简单功能
'---------------------------------------------------------------------------------------

Sub Form_Load() Sub Form_Load()
Dim ret As Long
preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf Wndproc)
idHotKey = 1
'按住ctrl+q实现切换
Modifiers = MOD_CONTROL
uVirtKey = vbKeyQ
ret = RegisterHotKey(Me.hwnd, idHotKey, Modifiers, uVirtKey)
'最小花到托盘
TrayAddIcon frmmain, App.Path & "\pbs.ico", "系统托盘"
End Sub

Sub Form_Unload() Sub Form_Unload(Cancel As Integer)
Dim ret As Long
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)
Call UnregisterHotKey(Me.hwnd, uVirtKey)
'退出时移出托盘图标
TrayRemoveIcon
End Sub

Sub Form_Resize() Sub Form_Resize()

         '窗口最小化
         If Me.WindowState = vbMinimized Then Me.Hide

End Sub

Sub Form_MouseMove() Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

         '气泡单击时的鼠标事件
         Dim Result As Long
         Dim cEvent As Single
        cEvent = X / Screen.TwipsPerPixelX

         Select Case cEvent

         Case MouseMove
                TrayBalloon frmmain, "一键隐藏程序 v0.1 By 阿汐", NIIF_INFO
         Case LeftUp

         Case LeftDown
                frmmain.WindowState = 0
                frmmain.Show
         Case LeftDbClick
                
         Case MiddleUp
            
         Case MiddleDown
                
         Case MiddleDbClick
                
         Case RightUp
                
         Case RightDown

         Case RightDbClick

         Case BalloonClick

         End Select

End Sub

Sub Label1_Click() Sub Label1_Click()

End Sub

Sub Label2_Click() Sub Label2_Click()

End Sub
 
bas_Main.bas
Option Explicit
Declare Function FindWindow Lib "user32" Alias "FindWindowA" () Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" () Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare Function RegisterHotKey Lib "user32" () Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Declare Function SetWindowPos Lib "user32" () Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" () Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetForegroundWindow Lib "user32" () Declare Function GetForegroundWindow Lib "user32" () As Long
Declare Function ShowWindow Lib "user32" () Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" () 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
Declare Sub keybd_event Lib "user32" () Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" () Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public hw1 As Long
Public CloseQuickKey As Boolean '是否可以退出
Public AutoActivate As Boolean '是否为鼠标激活
Public WindowStatus As Boolean '窗体状态(隐藏或显示)
Public Const WM_HOTKEY = &H312
Public Const WM_SYSCOMMAND = &H112
Public Const MOUSEEVENTF_ABSOLUTE = &H8000 ' absolute move
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10
Const GWL_WNDPROC = () Const GWL_WNDPROC = (-4)
HotKeys() HotKeys(100, 3) As String '热键名称和运行的程序
HotKeyValue() HotKeyValue(100, 2) As Integer '热键名所对应的值
Public Username As String * 30
Public HideOrShow As Boolean '隐藏当前窗口
Public HideWindowHnd As Long '被隐藏窗口的ID
Public ActiveHwnd As Long '活动窗口的ID
GetWindowLong Lib "user32" Alias "GetWindowLongA" () GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
UnregisterHotKey Lib "user32" () UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long
Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4

Public preWinProc As Long

Public Modifiers As Long, uVirtKey As Long, idHotKey As Long

Private Type taLong
ll As Long
End Type

Private Type t2Int
lWord As Integer
hWord As Integer
End Type


Function Wndproc() Function Wndproc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_HOTKEY Then
         If wParam = idHotKey Then
                 Dim lp As taLong, i2 As t2Int
                lp.ll = lParam
                LSet i2 = lp
                         If (i2.lWord = Modifiers) And i2.hWord = uVirtKey Then
                                 If HideWindowHnd = 0& Then
                                        HideWindowHnd = GetForegroundWindow
                                        ShowWindow HideWindowHnd, 0
                                 Else
                                        ShowWindow HideWindowHnd, 5
                                        HideWindowHnd = 0&
                                 End If
                         End If
         End If
End If
Wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function
 
bas_Tray.bas
'---------------------------------------------------------------------------------------
' Module        : modTray
' DateTime    : 12/05/2005 21:38
' Author        : Carlos Alberto S.
' Purpose     : System tray module with high resolution icon (Windows XP), balloon (with
'                             or without sound) and mouse event support for icon and balloon.
'---------------------------------------------------------------------------------------

Option Explicit

'使用高分辨率图标所用的API
Declare Function LoadImage Lib "user32" Alias "LoadImageA" () Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal dwImageType As Long, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As Long) As Long
Private Const LR_LOADFROMFILE = &H10
Private Const LR_LOADMAP3DCOLORS = &H1000
Private Const IMAGE_ICON = 1
'系统托盘
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" () Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const NIF_STATE = &H8
Private Const NIF_INFO = &H10
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIM_SETFOCUS = &H3
Private Const NIM_SETVERSION = &H4
Private Const NIM_VERSION = &H5
Private Const WM_USER As Long = &H400
Const NIN_BALLOONSHOW = () Const NIN_BALLOONSHOW = (WM_USER + 2)
Const NIN_BALLOONHIDE = () Const NIN_BALLOONHIDE = (WM_USER + 3)
Const NIN_BALLOONTIMEOUT = () Const NIN_BALLOONTIMEOUT = (WM_USER + 4)
Const NIN_BALLOONUSERCLICK = () Const NIN_BALLOONUSERCLICK = (WM_USER + 5)
Private Const NOTIFYICON_VERSION = 3
Private Const NIS_HIDDEN = &H1
Private Const NIS_SHAREDICON = &H2
Private Const WM_NOTIFY As Long = &H4E
Private Const WM_COMMAND As Long = &H111
Private Const WM_CLOSE As Long = &H10
Private Const WM_MOUSEMOVE As Long = &H200
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const WM_LBUTTONUP As Long = &H202
Private Const WM_LBUTTONDBLCLK As Long = &H203
Private Const WM_MBUTTONDOWN As Long = &H207
Private Const WM_MBUTTONUP As Long = &H208
Private Const WM_MBUTTONDBLCLK As Long = &H209
Private Const WM_RBUTTONDOWN As Long = &H204
Private Const WM_RBUTTONUP As Long = &H205
Private Const WM_RBUTTONDBLCLK As Long = &H206

Public Enum bFlag
        NIIF_NONE = &H0
        NIIF_INFO = &H1
        NIIF_WARNING = &H2
        NIIF_ERROR = &H3
        NIIF_GUID = &H5
        NIIF_ICON_MASK = &HF
        NIIF_NOSOUND = &H10 '关闭提示音标志
End Enum

Private Type NOTIFYICONDATA
        cbSize As Long
        hwnd As Long
        uID As Long
        uFlags As Long
        uCallbackMessage As Long
        hIcon As Long
        szTip As String * 128
        dwState As Long
        dwStateMask As Long
        szInfo As String * 256
        uTimeoutAndVersion As Long
        szInfoTitle As String * 64
        dwInfoFlags As Long
End Type

'鼠标事件
Public Enum TrayRetunEventEnum
        MouseMove = &H200
        LeftUp = &H202
        LeftDown = &H201
        LeftDbClick = &H203
        RightUp = &H205
        RightDown = &H204
        RightDbClick = &H206
        MiddleUp = &H208
        MiddleDown = &H207
        MiddleDbClick = &H209
        BalloonClick = (WM_USER + 5)
End Enum

Public ni As NOTIFYICONDATA
Sub TrayAddIcon() Sub TrayAddIcon(ByVal MyForm As Form, ByVal MyIcon As String, ByVal ToolTip As String, Optional ByVal bFlag As bFlag)

         With ni
                .cbSize = Len(ni)
                .hwnd = MyForm.hwnd
                .uID = vbNull
                .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
                .uCallbackMessage = WM_MOUSEMOVE
                .hIcon = LoadImage(App.hInstance, MyIcon, IMAGE_ICON, 16, 16, LR_LOADFROMFILE Or LR_LOADMAP3DCOLORS)
                .szTip = ToolTip & vbNullChar
         End With
        
         Call Shell_NotifyIcon(NIM_ADD, ni)

End Sub

Sub TrayRemoveIcon() Sub TrayRemoveIcon()

        Shell_NotifyIcon NIM_DELETE, ni
        
End Sub

Sub TrayBalloon() Sub TrayBalloon(ByVal MyForm As Form, ByVal sBaloonText As String, sBallonTitle As String, Optional ByVal bFlag As bFlag)

         With ni
                .cbSize = Len(ni)
                .hwnd = MyForm.hwnd
                .uID = vbNull
                .uFlags = NIF_INFO
                .dwInfoFlags = bFlag
                .szInfoTitle = sBallonTitle & vbNullChar
                .szInfo = sBaloonText & vbNullChar
         End With

        Shell_NotifyIcon NIM_MODIFY, ni

End Sub

Sub TrayTip() Sub TrayTip(ByVal MyForm As Form, ByVal sTipText As String)

         With ni
                .cbSize = Len(ni)
                .hwnd = MyForm.hwnd
                .uID = vbNull
                .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
                .szTip = sTipText & vbNullChar
         End With

        Shell_NotifyIcon NIM_MODIFY, ni

End Sub