VB实现托盘功能

参考资料

'-----------------------模块中--------------------------
'在系统托盘显示图标的模块
Option Explicit

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

Public nfIconData As NOTIFYICONDATA
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 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

 '-----------------------Form中--------------------------
Function WindowStyle()
    '以下把程序放入System Tray====================================System Tray Begin
    With nfIconData
        .hwnd = Me.hwnd
        .uID = Me.Icon
        .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
        .uCallbackMessage = WM_MOUSEMOVE
        .hIcon = Me.Icon.Handle
        '定义鼠标移动到托盘上时显示的Tip
        .szTip = "已最小化到托盘" & vbNullChar
        .cbSize = Len(nfIconData)
    End With
    
    Call Shell_NotifyIcon(NIM_ADD, nfIconData)
    '=============================================================System Tray End
    Me.Hide
End Function

Private Sub Form_Resize()
    WindowTop = Me.Top
    WindowLeft = Me.Left
    
    If Me.WindowState = 1 Then
        WindowStyle
    End If
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_LBUTTONDBLCLK '双击左键显示窗体，要改成其他的看模块里的定义
    ShowWindow Me.hwnd, SW_RESTORE
    Me.Top = WindowTop
    Me.Left = WindowLeft
    'Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
    Me.SetFocus
    Case WM_RBUTTONUP '在托盘图标上点右键显示菜单
    PopupMenu F00 '菜单名称为F00，做菜单时你可以改成别的，这里也得改成相应的
    End Select
End Sub

Private Sub F01_Click() '打开、显示，托盘右键菜单 选项之一
    ShowWindow Me.hwnd, SW_RESTORE
    Me.Top = WindowTop
    Me.Left = WindowLeft
    Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub

Private Sub F02_Click() '退出程序，托盘右键菜单 选项之一
    Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
    End
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    '退出程序时删除托盘图标
    Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub