托盘 Tray

=======================Module======================

Option Explicit

'Type NOTIFYICONDATA
' cbSize As Long 需填入NOTIFYICONDATA数据结构的长度
' HWnd As Long 设置成窗口的句柄
' Uid As Long 为图标所设置的ID值
' UFlags As Long 用来设置以下三个参数uCallbackMessage、hIcon、szTip是否有效
' UCallbackMessage As Long 消息编号
' HIcon As Long 显示在状态栏上的图标
' SzTip As String * 64 提示信息
'End Type
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const WM_MOUSEMOVE = &H200
Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIF_MESSAGE = &H1
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2

'记录 设置托盘图标的数据 的数据类型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 * 64
End Type

'TheData变量记录设置托盘图标的数据
Private TheData As NOTIFYICONDATA
Private TheForm As Form
Private TheMenu As Menu
Private OldWindowProc As Long

' 添加托盘图标
Public Sub AddToTray(frm As Form) ', mnu As Menu)
    Set TheForm = frm
    With TheData
        .Uid = 0 '忘了吗？参考一下前面内容,Uid图标的序号，做动画图标有用
        .hwnd = frm.hwnd
        .cbSize = Len(TheData)
        .HIcon = frm.Icon.Handle
        .UFlags = NIF_ICON '指明要对图标进行设置
        .UCallbackMessage = WM_LBUTTONUP  'WM_LBUTTONDBLCLK
        .UFlags = .UFlags Or NIF_MESSAGE '指明要设置图标或返回信息给主窗体，此句不能省去
        .cbSize = Len(TheData) '为什么呢？我们需要在添加图标的同时，让其返回信息
    End With '给主窗体，Or的意思是同时进行设置和返回消息

    Shell_NotifyIcon NIM_ADD, TheData '根据前面定义NIM_ADD，设置为“添加模式”
End Sub

' *********************************************
' 删除系统托盘中的图标
' *********************************************
Public Sub RemoveFromTray()
    With TheData
        .UFlags = 0
    End With
    Shell_NotifyIcon NIM_DELETE, TheData '根据前面定义NIM_DELETE，设置为“删除模式”
End Sub
'--设置图标 提示
Public Sub SetTrayTip(tip As String)
    With TheData
        .SzTip = tip & vbNullChar
        .UFlags = NIF_TIP     '指明要对浮动提示进行设置
    End With
    Shell_NotifyIcon NIM_MODIFY, TheData '根据前面定义NIM_MODIFY，设置为“修改模式”
End Sub
' --设置 图标
Public Sub SetTrayIcon(pic As Picture)
    '判断一下pic中存放的是不是图标
    If pic.Type <> vbPicTypeIcon Then Exit Sub

    '更换图标为pic中存放的图标
    With TheData
        .HIcon = pic.Handle
        .UFlags = NIF_ICON
    End With

    Shell_NotifyIcon NIM_MODIFY, TheData
End Sub

=============================窗体中应用举例==============

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lMsg As Single
    lMsg = X / Screen.TwipsPerPixelX    '--在托盘后，X传递的已经不是鼠标的坐标了，而是事件消息——微软
    Select Case lMsg
        Case WM_LBUTTONDBLCLK
            Me.Show
            Me.Move Screen.Width - Me.Width - 60, Screen.Height - Me.Height - GetTaskbarHeight
        Case WM_MOUSEMOVE
            ModTrayMenu.SetTrayTip "Backuping Outlook.." & vbCrLf & FrmMain.strStep & "CopyToTemp ... " & lblPercent.Caption
    End Select
End Sub

注意：应用中所要用到的 Menu-应是另开一个新窗体，创建一个 Menu