'thanks to Erwin Berkouwer (erwin@null.net)

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:
'   2 June 1997
'   Erwin Berkouwer
'   erwin@null.net
'   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