'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
Return