InTray

Description:
This is an enhanced system tray class, similar to my clsSysTray class. Unlike that class however, this uses a class, and a standard module, to create a window to use for the callback message, instead of using a picture box. The technique this uses is slightly better than subclassing the form, but very similar to subclassing the form. One benefit of this approach is that you can look for more messages, indeed, this class watches for the "TaskbarCreated" message that IE4 and above send out when Explorer crashes and recreates itself, so the system tray icon is recreated.
 
Code:
'----------------------------------------------------------------------
'Start of Class Module: clsInTray

Option Explicit

Private m_hWndHidden As Long 'Dummy window used for call backs
Private m_nid As NOTIFYICONDATA
Private m_bVisible As Boolean 'Is the icon visible yet?
Private m_sClass As String

Public Event MouseMove()
Public Event MouseUp(Button As Integer)
Public Event MouseDown(Button As Integer)
Public Event DblClick(Button As Integer)

'The handle of the hIcon to use
Public Property Get hIcon() As Long
    
    hIcon = m_nid.hIcon
    
End Property

Public Property Let hIcon(newhIcon As Long)
    
    m_nid.hIcon = newhIcon
    
End Property

'Tool tip for the system tray icon
Public Property Get Tip() As String
    
    Tip = m_nid.szTip
    
End Property

Public Property Let Tip(szTip As String)
    
    m_nid.szTip = szTip & vbNullChar
    
End Property

'Adds the icon to the system tray.
' Set hIcon and Tip before calling this function
Public Sub AddIcon()
    
    Debug.Assert m_bVisible = False
    
    Shell_NotifyIcon NIM_ADD, m_nid
    
    m_bVisible = True
    
End Sub

'Updates the system tray icon to reflect any changes to
' hIcon or Tip
Public Sub ModifyIcon()
    
    Debug.Assert m_bVisible
    
    Shell_NotifyIcon NIM_MODIFY, m_nid
    
End Sub

'Removes the system tray icon
Public Sub RemoveIcon()
    
    Debug.Assert m_bVisible
    
    Shell_NotifyIcon NIM_DELETE, m_nid
    
    m_bVisible = False
    
End Sub

Private Sub Class_Initialize()
    
    m_sClass = "VB InTray Class"
    
    'Register a class for, and create the dummy window
    Dim wc As WNDCLASS
    wc.style = 0
    wc.lpfnwndproc = Pass(AddressOf InTrayWndProc)
    wc.hInstance = App.hInstance
    wc.lpszClassName = m_sClass
    RegisterClass wc
    m_hWndHidden = CreateWindowEx(0, m_sClass, "VB InTray Hidde" & _
                 "n Window", 0, 0, 0, 100, 100, 0, 0, 0, ByVal 0)
    
    Dim lpMe As Long
    lpMe = CreateRef(Me)
    SetWindowLong m_hWndHidden, GWL_USERDATA, lpMe
    
    'Initialize the Notify Icon Data structure
    With m_nid
        .cbSize = Len(m_nid)
        .hIcon = 0
        .hwnd = m_hWndHidden
        .szTip = "" & vbNullString
        .uCallbackMessage = WM_USER_SYSTRAY
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .uID = 0
    End With
    
End Sub

'Function should only be called from modInTray to process windows
' messages generated from the System Tray
Public Sub ProcessMessage(wParam As Long, lParam As Long)
    
    Select Case lParam
        Case WM_MOUSEMOVE
            RaiseEvent MouseMove
        Case WM_LBUTTONDOWN
            RaiseEvent MouseDown(vbLeftButton)
        Case WM_LBUTTONUP
            RaiseEvent MouseUp(vbLeftButton)
        Case WM_LBUTTONDBLCLK
            RaiseEvent DblClick(vbLeftButton)
        Case WM_RBUTTONDOWN
            RaiseEvent MouseDown(vbRightButton)
        Case WM_RBUTTONUP
            RaiseEvent MouseUp(vbRightButton)
        Case WM_RBUTTONDBLCLK
            RaiseEvent DblClick(vbRightButton)
        Case WM_MBUTTONDOWN
            RaiseEvent MouseDown(vbMiddleButton)
        Case WM_MBUTTONUP
            RaiseEvent MouseUp(vbMiddleButton)
        Case WM_MBUTTONDBLCLK
            RaiseEvent DblClick(vbMiddleButton)
    End Select
    
End Sub

Private Sub Class_Terminate()
    
    'Close the dummy window
    SendMessage m_hWndHidden, WM_CLOSE, 0, ByVal 0&
    
    'Remove the icon if it exists
    If m_bVisible Then
        RemoveIcon
    End If
    
    UnregisterClass m_sClass, App.hInstance

End Sub

'This function should only be called from modInTray when the
' TaskBar is recreated (ie, in response to TaskbarCreated)
Public Sub RecreateIcon()
    
    If m_bVisible Then
        m_bVisible = False
        AddIcon
    End If
    
End Sub

'End of Class Module: clsInTray
'----------------------------------------------------------------------


'----------------------------------------------------------------------
'Start of Module: modInTray

Option Explicit

'Windows API's
Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" _
        (Class As WNDCLASS) As Long
Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" _
        (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal _
        lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, _
        ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
        ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance _
        As Long, lpParam As Any) As Long
Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) _
        As Long
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias _
        "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As _
        NOTIFYICONDATA) As Long
Declare Function RegisterWindowMessage Lib "user32" Alias _
        "RegisterWindowMessageA" (ByVal lpString As String) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
        (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As _
        Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal _
        hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam _
        As Any) As Long
Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal _
        dest As Long, ByVal src As Long, ByVal length As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
        (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" _
        (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
        ByVal lParam As Long) As Long
Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" _
        (ByVal lpClassName As String, ByVal hInstance As Long) As Long

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

Type WNDCLASS
    style As Long
    lpfnwndproc As Long
    cbClsextra As Long
    cbWndExtra2 As Long
    hInstance As Long
    hIcon As Long
    hCursor As Long
    hbrBackground As Long
    lpszMenuName As Long
    lpszClassName As String
End Type

Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const WM_USER = &H400
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 WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MBUTTONDBLCLK = &H209
Public Const WM_USER_SYSTRAY = WM_USER + 5
Public Const WM_CLOSE = &H10
Public Const GWL_USERDATA = (-21)

'Have we initialized TaskbarRestart yet?
Private m_bMessageInited As Boolean
'Windows message sent out when the taskbar is restarted
' (ie4 and up)
Private m_uTaskbarRestart As Long

'Dummy function to allow AddressOf to assign to a variable
Public Function Pass(n As Long) As Long
    Pass = n
End Function

'Return a VB object pointed by nPointer
Public Function DeRef(nPointer As Long) As clsInTray
    CopyMemory VarPtr(DeRef), VarPtr(nPointer), 4
End Function

'Creates a pointer to a VB object
Public Function CreateRef(obj As clsInTray) As Long
    CopyMemory VarPtr(CreateRef), VarPtr(obj), 4
End Function

'Destroys a VB object created by DeRef (otherwise the VB's
'  reference count would be incorrect)
Public Sub DestroyRef(nobj As Long)
    Dim n As Long
    CopyMemory nobj, VarPtr(n), 4
End Sub

'The window procedure for the dummy windows that clsInTray creates
Public Function InTrayWndProc(ByVal hwnd As Long, ByVal uMsg As Long, _
       ByVal wParam As Long, ByVal lParam As Long) As Long
    
    Dim lpObj As Long
    Dim obj As clsInTray
    
    If Not m_bMessageInited Then
        InitMessage
    End If
    
    Select Case uMsg
        'Pass WM_USER_SYSTRAY to the clsInTray object
        Case WM_USER_SYSTRAY
            lpObj = GetWindowLong(hwnd, GWL_USERDATA)
            Set obj = DeRef(lpObj)
            obj.ProcessMessage wParam, lParam
            DestroyRef VarPtr(obj)
        'If the TaskBar restarts, let clsInTray know about it
        Case m_uTaskbarRestart
            lpObj = GetWindowLong(hwnd, GWL_USERDATA)
            Set obj = DeRef(lpObj)
            obj.RecreateIcon
            DestroyRef VarPtr(obj)
    End Select
    
    InTrayWndProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
    
End Function

'Register the windows message TaskbarCreated so we can watch for it
Private Function InitMessage()
    
    m_bMessageInited = True
    
    m_uTaskbarRestart = RegisterWindowMessage("TaskbarCreated")
    
End Function

'End of Module: modInTray
'----------------------------------------------------------------------
 
Sample Usage:
 
Option Explicit

Private WithEvents SystemTray As clsInTray

Private Sub Form_Load()
    Set SystemTray = New clsInTray
    SystemTray.hIcon = Me.Icon.Handle
    SystemTray.Tip = "My App!"
    SystemTray.AddIcon
End Sub

Private Sub Form_Resize()
    If Me.WindowState = vbMinimized Then
        Me.Visible = False
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SystemTray.RemoveIcon
    Set SystemTray = Nothing
End Sub

Private Sub SystemTray_MouseUp(Button As Integer)
    Me.WindowState = vbNormal
    Me.Visible = True
    SetForegroundWindow Me.hwnd
    MsgBox "You clicked on the system tray icon"
End Sub