Add Icon to Windows SysTray

'===================================================================================================
'===================================================================================================
'!! PLACE THE FOLLOWING IN A FORM:
'===================================================================================================
'===================================================================================================

'-- Create a menu with the following structure and relevant properties:
'   Caption:
'   Name: mnuFRM
'   Visible: False
'
'   (the following should be a child to mnuFRM)
'   Caption: &Restore
'   Name:	mnuFRMRestore
'
'   Caption: -
'   Name:	mnuFRMSep1
'
'   Caption: E&xit
'   Name:	mnuFRMExit

Option Explicit

Private nidSysTrayIcon		  As NOTIFYICONDATA
'

Private Sub Form_Load()
'===================================================================================================
  Call ToggleSysTray(True)
End Sub

Private Sub Form_Unload(Cancel As Integer)
'===================================================================================================
  If nidSysTrayIcon.hwnd <> 0 Then Call ToggleSysTray(False)
End Sub

Private Sub Form_Resize()
'===================================================================================================
  Call ToggleSysTray(Me.WindowState = vbMinimized)
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'===================================================================================================
  Dim lngReturn		   As Long
  Dim lngMsg			  As Long
  
  If Me.ScaleMode = vbPixels _
	  Then lngMsg = X _
		  Else lngMsg = X / Screen.TwipsPerPixelX
  
  Select Case lngMsg
	Case WM_LBUTTONDBLCLK
	  Call mnuFRMRestore_Click
	  
	Case WM_RBUTTONUP
	  lngReturn = SetForegroundWindow(Me.hwnd)
	  Me.PopupMenu Me.mnuFRM, , , , Me.mnuFRMRestore
	  
  End Select
End Sub

Private Sub mnuFRMExit_Click()
'===================================================================================================
  Unload Me
End Sub

Private Sub mnuFRMRestore_Click()
'===================================================================================================
  Me.Visible = True
End Sub

Private Sub ToggleSysTray(blnAdd As Boolean)
'===================================================================================================
  If blnAdd Then
	Me.Refresh
	
	With nidSysTrayIcon
	  .cbSize = Len(nidSysTrayIcon)
	  .hwnd = Me.hwnd
	  .uId = vbNull
	  .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
	  .uCallBackMessage = WM_MOUSEMOVE
	  .hIcon = Me.Icon
	  .szTip = App.ProductName & vbNullChar
	End With
	Shell_NotifyIcon NIM_ADD, nidSysTrayIcon
	
	Me.Hide
	Me.WindowState = vbNormal
  Else
	'-- Make sure there's an icon in the SysTray first
	If nidSysTrayIcon.hwnd <> 0 Then
	  Shell_NotifyIcon NIM_DELETE, nidSysTrayIcon
	  nidSysTrayIcon.hwnd = 0
	  
	  Me.Visible = True
	End If
  End If
End Sub


'===================================================================================================
'===================================================================================================
'!! PLACE THE FOLLOWING IN A MODULE:
'===================================================================================================
'===================================================================================================

Option Explicit

Public 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

'-- User defined type required by Shell_NotifyIcon API call
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 Const NIF_MESSAGE		As Long = &H1
Public Const NIF_ICON		   As Long = &H2
Public Const NIF_TIP			As Long = &H4

Public Const NIM_ADD			As Long = &H0
Public Const NIM_DELETE		 As Long = &H2

Public Const WM_MOUSEMOVE	   As Long = &H200
Public Const WM_LBUTTONDBLCLK   As Long = &H203
Public Const WM_RBUTTONUP	   As Long = &H205