程序代码

'以下代码须要两个按command,一个菜单(菜单里分别包含一个主菜单,三个子菜单,名称分别为sys\add\move\exit)
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
'------------------------------------声名API
Private nfIconData As NOTIFYICONDATA
Const MAX_TOOLTIP As Integer = 50    '提示字符串中预显示的个数
Const NIF_ICON = &H2                 '预添加的图标
Const NIF_MESSAGE = &H1              '事件消息,比如鼠标抬起或按下
Const NIF_TIP = &H4                  '预显示的文字
Const NIM_ADD = &H0                  '添加托盘图标
Const NIM_DELETE = &H2               '删除托盘图标
Const WM_MOUSEMOVE = &H200           '鼠标移动
Const WM_LBUTTONDOWN = &H201         '按下右键
Const WM_LBUTTONUP = &H202           '左键抬起
Const WM_LBUTTONDBLCLK = &H203       '左键双击
Const WM_RBUTTONDOWN = &H204         '按下右键
Const WM_RBUTTONUP = &H205           '右键抬起
Const WM_RBUTTONDBLCLK = &H206       '右键双击
Const SW_RESTORE = 9                 '状态恢复
Const SW_HIDE = 0                    '状态隐藏
'------------------------------------声名常量
Private 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
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim lMsg As Single
  lMsg = X / Screen.TwipsPerPixelX
  If lMsg = WM_LBUTTONDBLCLK Then '如果单击右键
  Me.PopupMenu sys            '菜单显示在光标处
  End If
End Sub '此事件中的代码只针对托盘上的图标
'---------------------------------------------------显示菜单
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = 2 Then   '当点击右键时(2表示右键,1表示左键)
  Me.PopupMenu sys     '菜单显示在光标处
  End If
End Sub '此事件中的代码只针对未被最小化托盘窗体
'---------------------------------------------------显示菜单
Private Sub command1_Click()
  nfIconData.hwnd = Me.hwnd
  nfIconData.uID = Me.Icon
  nfIconData.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
  nfIconData.uCallbackMessage = WM_MOUSEMOVE
  nfIconData.hIcon = Me.Icon.Handle
  nfIconData.szTip = "这就是在托盘上显示的文字！" & vbNullChar 'vbNullChar表示删除右边多于的空格
  nfIconData.cbSize = Len(nfIconData)
  
  Call Shell_NotifyIcon(NIM_ADD, nfIconData)    '添加图标到托盘
End Sub
Private Sub command2_Click()
  Call Shell_NotifyIcon(NIM_DELETE, nfIconData) '从托盘删除
End Sub
Private Sub move_Click() '从托盘删除
  Call command2_Click
End Sub
Private Sub add_Click()  '添加图标到托盘
  Call command1_Click
End Sub
Private Sub exit_Click() '退出程序
  End
End Sub
Private Sub Form_Unload(Cancel As Integer) '从托盘删除
  Call command2_Click
End Sub