Tray Icon

This code allow the application to be put in the system tray during run time.

Tray Icon Module

The following snippet must be put in a module (for example: mTrayIcon.bas).

Attribute VB_Name = "Module1"
Option Explicit

'Type passed to Shell_NotifyIcon
Private Type NotifyIconData
  Size As Long
  Handle As Long
  ID As Long
  Flags As Long
  CallBackMessage As Long
  Icon As Long
  Tip As String * 64
End Type

' Constants for managing System Tray tasks, found in shellapi.h
Private Const AddIcon = &H0
Private Const ModifyIcon = &H1
Private Const DeleteIcon = &H2

Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202

Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205

Private Const MessageFlag = &H1
Private Const IconFlag = &H2
Private Const TipFlag = &H4

Private Declare Function Shell_NotifyIcon Lib "shell32" _
    Alias "Shell_NotifyIconA" (ByVal Message As Long, _
    Data As NotifyIconData) As Boolean

Private Data As NotifyIconData

Public Sub AddIconToTray(frm As Form)
    Data.Size = Len(Data)
    Data.Handle = frm.hWnd
    Data.ID = vbNull
    Data.Flags = IconFlag Or TipFlag Or MessageFlag
    Data.CallBackMessage = WM_MOUSEMOVE
    Data.Icon = frm.Icon
    Data.Tip = "Time Counter" & vbNullChar
    Call Shell_NotifyIcon(AddIcon, Data)
End Sub

Public Sub UpdateTrayTip(msg As String)
    Data.Tip = Trim(msg) & vbNullChar
    Call Shell_NotifyIcon(ModifyIcon, Data)
End Sub

Public Sub DeleteIconFromTray()
   Call Shell_NotifyIcon(DeleteIcon, Data)
End Sub

Main Application

Make sure the following constants are declared in
your main program.

Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONUP = &H205

Detecting Mouse Move Event

Private Sub Form_MouseMove(Button As Integer, _
   Shift As Integer, x As Single, y As Single)

    Dim Result As Long
    Dim Message As Long

    If Me.ScaleMode = vbPixels Then
    'If Picture1.ScaleMode = vbPixels Then
        Message = x
    Else
        Message = x / Screen.TwipsPerPixelX
    End If

    Select Case Message
        Case WM_LBUTTONDBLCLK
            'Remove icon
            DeleteIconFromTray
            WindowState = 0
            frmMain.Show
        Case WM_RBUTTONUP
            'Me.PopupMenu mnPopUp
            'Add a menu to your application and call it here
    End Select

End Sub

Detecting Minimize

Private Sub Form_Resize()

    If WindowState = 1 Then
        AddIconToTray frmMain
        frmMain.Hide
    End If

End Sub

Ending the application

Don't forget to remove the icon when you exit your application

Private Sub Form_Unload(Cancel As Integer)
    'Remove icon
    DeleteIconFromTray
End Sub

See also

Unless otherwise stated, the content of this page is licensed under Creative Commons Attribution-ShareAlike 3.0 License