Visual Basic Programming Code Examples

Visual Basic > Windows and Controls Code Examples

Add an icon to the systemtray



Add an icon to the systemtray

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsSysTray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'
'clsSysTray
'
'WHO, WHAT, WHERE:
'   provided 'as is', no warranty, no guarantees
'
'TACTICS:
'   create object               Dim systray as Object
'                               set systray = New clsSysTray
'   set icon                    systray.Icon = frmMAIN.Icon
'   set tooltip text            systray.ToolTip = "My System Tray Icon !"
'   set owner control           systray.OwnerControl = frmMAIN.picAnimate
'   activate it                 systray.Add
'...
'   now, when the user clicks on the the created icon, the corresponding MOUSEMOVE event
'   of the owning control is activated. Here a sample of such code: '                    
          private Sub picAnimate_MouseMove(Button as Integer, _ '                        
      Shift as Integer, X as Single, Y as Single) '                                  
Select case Hex(X) '                                   case "1E3C"     'Right-Button-Down
'                                       MsgBox "Right-Button-Down" '                     
             case "1830"     'Right-Button-Down LARGE FONTS '                            
          MsgBox "Right-Button-Down LARGE FONTS" '                                   Case
"1E0F"     'Left-Button-Down '                                       MsgBox
"Left-Button-Down" '                                   case "1E2D"    
'Left-Button-Double-Click '                                       MsgBox
"Left-Button-Double-Click" '                                   case "1824"    
'Left-Button-Double-Click LARGE FONTS '                                       MsgBox
"Left-Button-Double-Click LARGE FONTS" '                                   case "1E5A"   
 'Right-Button-Double-Click '                                       MsgBox
"Right-Button-Double-Click" '                                   end Select '             
                 end Sub '... 'when active, you can do the following '   modify the icon
shown       systray.Icon = frmSetup.Icon '   modify the tooltip text     systray.ToolTip
= "Modified Text !" '   remove the icon             systray.Remove '       (this is not
done automatic when your program ends !) ' ' Option Explicit private Type
NOTIFYICONDATA_TYPE
    cbSize as Long
    hWnd as Long
    uID as Long
    uFlags as Long
    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_TYPE) as Long

Private mvarSysTray as NOTIFYICONDATA_TYPE
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const WM_MOUSEMOVE = &H200

Private blnIsActive as Boolean 'status flag
Private blnOwnerControlIsSet as Boolean 'status flag
Private blnIconIsSet as Boolean 'status flag
Private mvarOwnerControl as object 'local copy

Public Property Let OwnerControl(ByVal vData as Object)
    'calling program should set owning control
    If blnIsActive Then
        MsgBox "WARNING: clsSysTray cannot change owner control for an icon when active",
        vbExclamation
    Else
        set mvarOwnerControl = vData
        blnOwnerControlIsSet = True
    end If
End Property

Public Property Get OwnerControl() as Object
    'if calling program wants to know it
    set OwnerControl = mvarOwnerControl
End Property

Public Property Let ToolTip(ByVal vData as String)
    'calling program can set ToolTip (optional)
    If vData = "" Then
        mvarSysTray.szTip = vbNullChar
    Else
        mvarSysTray.szTip = " " & vData & " " & vbNullChar
    end If
    'modify shown text if active
    If blnIsActive Then Shell_NotifyIcon NIM_MODIFY, mvarSysTray
End Property

Public Property Get ToolTip() as String
Attribute ToolTip.VB_UserMemId = 0
    'if calling program wants to know it
    ToolTip = mvarSysTray.szTip
End Property

Public Property Let Icon(ByVal vData as Object)
'calling program should set icon
    mvarSysTray.hIcon = vData
    'set status
    blnIconIsSet = True
    'modify shown icon if active
    If blnIsActive Then Shell_NotifyIcon NIM_MODIFY, mvarSysTray
End Property

Public Property Get Icon() as Object
    'if calling program wants to know it
    set Icon = mvarIcon
End Property

Public Function Remove() as Boolean
    'to remove the icon from the system tray
    'NOT done automatic if your program ends !
    If blnIsActive = True Then
        Shell_NotifyIcon NIM_DELETE, mvarSysTray
        'set status
        blnIsActive = False
    end If
    Remove = True
End Function

Public Function Add() as Boolean
    'verify environment
    If blnIsActive Then MsgBox "ERROR: clsSysTray is already acive", vbExclamation
    If Not blnIconIsSet Then MsgBox "ERROR: clsSysTray cannot activate when the icon has
    not been set", vbExclamation If Not blnOwnerControlIsSet Then MsgBox "ERROR:
    clsSysTray cannot activate when the owner control has not been set", vbExclamation
    'set other variables mvarSysTray.cbSize = Len(mvarSysTray) mvarSysTray.hWnd =
    mvarOwnerControl.hWnd mvarSysTray.uID = 1& mvarSysTray.uFlags = NIF_MESSAGE Or
    NIF_ICON Or NIF_TIP mvarSysTray.uCallbackMessage = WM_MOUSEMOVE Shell_NotifyIcon
    NIM_ADD, mvarSysTray 'set status blnIsActive = True Add = True
End Function


Return