Attribute VB_Name = "ModSysTray32"

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const WM_SYSCOMMAND = &H112
Public Const SC_MOVE = &HF010&
Public Const SC_RESTORE = &HF120&
Public Const SC_SIZE = &HF000&
Public Const WM_LBUTTONDBLCLICK = &H203
Public Const WM_RBUTTONUP = &H205
Public Const WM_MOUSEMOVE = &H200
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 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

Public VBGTray As NOTIFYICONDATA
Declare Function Shell_NotifyIcon Lib "shell32" Alias _
    "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

Public Sub CheckTray(frm As Form, lngMsg As Long, blnFlag As Boolean, result As Long)
On Error GoTo CheckTrayError
If Not frm.Enabled Then Exit Sub
  If blnFlag = False Then
    blnFlag = True
    Select Case lngMsg
      Case WM_LBUTTONDBLCLICK
        If frm.WindowState = vbMinimized Then
          App.TaskVisible = True
          frm.WindowState = 0
          frm.Visible = True
          AppActivate frm.Caption
         Else
          App.TaskVisible = False
          frm.WindowState = 1
          frm.Visible = False
        End If
      Case WM_RBUTTONUP
        SetForegroundWindow frm.hwnd
        'Next line is frm.popupmenu frm.<your menu name here>
        frm.PopupMenu frm.trayPopup
    End Select
    blnFlag = False
  End If
Exit Sub
CheckTrayError:
  Select Case Err
    Case Else
      Msg = Err.Description & Chr$(13)
      Msg = Msg & "Error Code " & Err & " Occured" & Chr$(13)
      Msg = Msg & "Contact program vender and report this error code."
      MsgBox Msg, vbExclamation, "Check Tray Error"
  End Select
End Sub

Sub ShowInTray(frm As Form, YesNo As Boolean)
On Error GoTo ShowInTrayError
  Select Case YesNo
    Case True
      VBGTray.cbSize = Len(VBGTray)
      VBGTray.hwnd = frm.hwnd
      VBGTray.uId = vbNull
      VBGTray.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
      VBGTray.ucallbackMessage = WM_MOUSEMOVE
      VBGTray.hIcon = frm.Icon
      VBGTray.szTip = frm.Caption & vbNullChar
      Call Shell_NotifyIcon(NIM_ADD, VBGTray)
    Case False
      VBGTray.cbSize = Len(VBGTray)
      VBGTray.hwnd = frm.hwnd
      VBGTray.uId = vbNull
      Call Shell_NotifyIcon(NIM_DELETE, VBGTray)
  End Select
Exit Sub
ShowInTrayError:
  Select Case Err
    Case Else
      Msg = Err.Description & Chr$(13)
      Msg = Msg & "Error Code " & Err & " Occured" & Chr$(13)
      Msg = Msg & "Contact program vender and report this error code."
      MsgBox Msg, vbExclamation, "Show In Tray Error"
  End Select
End Sub

Public Sub GotoTray(frm As Form)
On Error GoTo GotoTrayError
  VBGTray.cbSize = Len(VBGTray)
  VBGTray.hwnd = frm.hwnd
  VBGTray.uId = vbNull
  VBGTray.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
  VBGTray.ucallbackMessage = WM_MOUSEMOVE
  VBGTray.hIcon = frm.Icon
  VBGTray.szTip = frm.Caption & vbNullChar
  Call Shell_NotifyIcon(NIM_ADD, VBGTray)
  App.TaskVisible = False
  frm.Hide
Exit Sub
GotoTrayError:
  Select Case Err
    Case Else
      Msg = Err.Description & Chr$(13)
      Msg = Msg & "Error Code " & Err & " Occured" & Chr$(13)
      Msg = Msg & "Contact program vender and report this error code."
      MsgBox Msg, vbExclamation, "Goto Tray Error"
  End Select
End Sub