VERSION 1.0 CLASS BEGIN MultiUse = -1 'True Persistable = 0 'NotPersistable DataBindingBehavior = 0 'vbNone DataSourceBehavior = 0 'vbNone MTSTransactionMode = 0 'NotAnMTSObject END Attribute VB_Name = "cSysTray" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit '============================================================================================================= ' ' cSysTray Class Module ' --------------------- ' ' Created By : Kevin Wilson ' http://www.TheVBZone.com ( The VB Zone ) ' http://www.TheVBZone.net ( The VB Zone .net ) ' ' Last Update : October 31, 2001 ' ' VB Versions : 5.0 / 6.0 ' ' Requires : modSysTray.bas (System tray icon support module - by Kevin Wilson) ' ' Description : This class module was written to give you COMPLETE functionality when it comes to placing ' icons in the system tray (next to the clock in the lower right corner of your screen). ' Using this module, you can add one or many icon(s) with just one instance of this class ' module, track user interaction with the various system tray icons you've added to the ' taskbar, modify the icon or the ToolTipText associated with those icons dynamically at run- ' time, and remove the icons when needed. ' A neat feature of this class module is that you don't have to clean up any icons that are ' placed! All you do is add them. When you destroy the variable that represents this class ' module by setting it equal to NOTHING, this class module automatically locates any icons ' that have not been deleted and deletes them for you, thus avoiding stranded icons in the ' system tray, and memory leaks due to memory objects being left to hang. ' ' Example Use : ' '------------------------------------------------------------------------------------------------------------- ' SIMPLE USAGE (SINGLE ICON) '------------------------------------------------------------------------------------------------------------- ' ' Option Explicit ' Private TestIcon As StdPicture ' Private WithEvents SysTray As cSysTray ' Private Sub Form_Load() ' Set TestIcon = LoadPicture("C:\TEST.ICO") ' If Not TestIcon Is Nothing Then ' Set SysTray = New cSysTray ' Set SysTray.ST_OwnerForm = Me ' SysTray.ST_CreateIcon 1, TestIcon.Handle, "Test System Tray Icon" ' End If ' End Sub ' Private Sub Form_Terminate() ' SysTray.ST_DeleteIcon 1 ' Set SysTray = Nothing ' Set TestIcon = Nothing ' End Sub ' Private Sub SysTray_RightClick(ByVal IconID As Long) ' PopupMenu mnuFile ' End Sub ' '------------------------------------------------------------------------------------------------------------- ' ADVANCED USAGE (MULTIPLE ICONS WITH ID TRACKING) '------------------------------------------------------------------------------------------------------------- ' ' Option Explicit ' Private WithEvents SysTray As cSysTray ' Private TestIcon1 As StdPicture ' Private TestIcon2 As StdPicture ' Private Sub Form_Click() ' Static Toggle As Boolean ' Toggle = Not Toggle ' If Toggle = True Then ' SysTray.ST_ModifyIcon 2, TestIcon2.Handle, "Icon2" ' Else ' SysTray.ST_ModifyIcon 2, TestIcon1.Handle, "Icon1" ' End If ' End Sub ' Private Sub Form_DblClick() ' SysTray.ST_DeleteIcon 1 ' End Sub ' Private Sub Form_Load() ' Set TestIcon1 = LoadPicture("C:\TEST1.ICO") ' Set TestIcon2 = LoadPicture("C:\TEST2.ICO") ' If Not TestIcon1 Is Nothing Then ' Set SysTray = New cSysTray ' Set SysTray.ST_OwnerForm = Me ' SysTray.ST_AdvancedProcessing = True ' SysTray.ST_CreateIcon 1, TestIcon1.Handle, "Test System Tray Icon 1" ' SysTray.ST_CreateIcon 2, TestIcon1.Handle, "Test System Tray Icon 2" ' SysTray.ST_CreateIcon 3, TestIcon1.Handle, "Test System Tray Icon 3" ' End If ' End Sub ' Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) ' ' Destroy the objects used to free up the memory they are retaining ' Set TestIcon1 = Nothing ' Set TestIcon2 = Nothing ' Set SysTray = Nothing ' End Sub ' Private Sub SysTray_DblClick(ByVal IconID As Long) ' MsgBox "Double Click - " & CStr(IconID) ' End Sub ' '============================================================================================================= ' ' LEGAL: ' ' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit ' given where credit is due. Also, it is not required, but it would be appreciated if you would mention ' somewhere in your compiled program that that your program makes use of code written and distributed by ' Kevin Wilson (www.TheVBZone.com). Feel free to link to this code via your web site or articles. ' ' You may NOT take this code and pass it off as your own. You may NOT distribute this code on your own server ' or web site. You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products, ' utilities, or applications that directly compete with products, utilities, and applications created by Kevin ' Wilson, TheVBZone.com, or Wilson Media. You may NOT take this code and sell it for profit without first ' obtaining the written consent of the author Kevin Wilson. ' ' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without ' warning or notice. Copyright© by Kevin Wilson. All rights reserved. ' '============================================================================================================= ' Type - Shell_NotifyIcon.pnid Private Type NOTIFYICONDATA cbSize As Long 'DWORD // Size of this structure, in bytes. hWnd As Long 'HWND // Handle to the window that will receive notification messages associated with an icon in the taskbar status area. The shell uses hWnd and uID to identify which icon on which to operate when Shell_NotifyIcon is invoked. uID As Long 'UINT // Application-defined identifier of the taskbar icon. The shell uses hWnd and uID to identify which icon on which to operate when Shell_NotifyIcon is invoked. You can have multiple icons associated with a single hWnd by assigning each a diffent uID. uFlags As Long 'UINT // Array of flags that indicate which of the other members contain valid data. This member can be a combination of the following: NIF_ICON, NIF_MESSAGE, NIF_TIP, NIF_STATE, NIF_INFO uCallbackMessage As Long 'UINT // Application-defined message identifier. The system uses this identifier to send notifications to the window identified in hWnd. These notifications are sent when a mouse event occurs in the bounding rectangle of the icon, or when the icon is selected or activated with the keyboard. The wParam parameter of the message contains the identifier of the taskbar icon in which the event occurred. The lParam parameter holds the mouse or keyboard message associated with the event. For example, when the mouse cursor moves over a taskbar icon, lParam is set to WM_MOUSEMOVE. hIcon As Long 'HICON // Handle to the icon to be added, modified, or deleted. szTip As String * 64 'TCHAR[64] // Pointer to a NULL-terminated string with the text for a standard tooltip. It can have a maximum of 64 characters including the terminating NULL. For Version 5.0 and later, szTip can have a maximum of 128 characters, including the terminating NULL. ' dwState As Long 'DWORD // IE 5.x - State of the icon. There are two flags that can be set independently: NIS_HIDDEN, NIS_SHAREDICON ' dwStateMask As Long 'DWORD // IE 5.x - A value that specifies which bits of the state member will be retrieved or modified. For example, setting this member to NIS_HIDDEN will cause only the item's hidden state to be retrieved. ' szInfo As String * 256 'TCHAR[256] // IE 5.x - Pointer to a NULL-terminated string with the text for a balloon-style tooltip. It can have a maximum of 255 characters. To remove the tooltip, set the NIF_INFO flag in uFlags and set szInfo to an empty string. ' uTimeout As Long 'UINT // IE 5.x - The timeout value, in milliseconds, for a balloon-style tooltip. The system enforces minimum and maximum timeout values. uTimeout values that are too large are set to the maximum value and values that are too small default to the minimum value. The system minimum and maximum timeout values are currently set at 10 seconds and 30 seconds, respectively. These values may change in future versions of Windows. See the remarks for further discussion of uTimeout. Union with uVersion. ' uVersion As Long 'UINT // IE 5.x - Specifies whether the shell notify icon interface should use Windows 95 or Windows 2000 behavior. This member is only employed when using Shell_NotifyIcon to send an NIM_VERSION message. 0 = Use the Windows 95 behavior, NOTIFYICON_VERSION = Use the Windows 2000 behavior. ' szInfoTitle As String * 64 'TCHAR[64] // IE 5.x - Pointer to a NULL-terminated string containing a title for a balloon tooltip. This title will be in boldface, and placed above the text. It can have a maximum of 63 characters. ' dwInfoFlags As Long 'DWORD // IE 5.x - Version 5.0. Flags that can be set to add an icon to a balloon tooltip. It will be placed to the left of the title. If the szTitleInfo member is zero-length, the icon will not be shown. NIIF_WARNING, NIIF_ERROR, NIIF_INFO End Type ' Constants - NOTIFYICONDATA.uFlags Private Const NIF_MESSAGE = &H1 ' The uCallbackMessage member is valid. Private Const NIF_ICON = &H2 ' The hIcon member is valid. Private Const NIF_TIP = &H4 ' The szTip member is valid. 'Private Const NIF_STATE = &H8 ' IE 5.x - The dwState and dwStateMask members are valid. 'Private Const NIF_INFO = &H10 ' IE 5.x - Use a balloon-style tooltip instead of a standard tooltip. The szInfo, uTimeout, szInfoTitle, and dwInfoFlags members are valid. ' Constants - NOTIFYICONDATA.dwState Private Const NIS_HIDDEN = &H1 ' The icon is hidden. Private Const NIS_SHAREDICON = &H2 ' The icon is shared. ' Constants - NOTIFYICONDATA.dwInfoFlags Private Const NIIF_NONE = &H0 Private Const NIIF_INFO = &H1 ' An information icon. Private Const NIIF_WARNING = &H2 ' A warning icon. Private Const NIIF_ERROR = &H3 ' An error icon. ' Constants - NOTIFYICONDATA.uVersion 'Private Const NOTIFYICON_VERSION = 3 ' IE 5.x ' Constants - Shell_NotifyIcon.dwMessage Private Const NIM_ADD = &H0 ' Adds an icon to the status area. The hWnd and uID members of the NOTIFYICONDATA structure pointed to by pnid will be used to identify the icon in future calls to Shell_NotifyIcon. Private Const NIM_MODIFY = &H1 ' Modifies an icon in the status area. Use the hWnd and uID members of the NOTIFYICONDATA structure pointed to by pnid to identify the icon to be modified. Private Const NIM_DELETE = &H2 ' Deletes an icon from the status area. Use the hWnd and uID members of the NOTIFYICONDATA structure pointed to by pnid to identify the icon to be deleted. 'Private Const NIM_SETFOCUS = &H3 ' IE 5.x - Returns focus to the taskbar notification area. Taskbar icons should use this message when they have completed their user interface operation. For example, if the taskbar icon displays a context menu, but the user presses ESCAPE to cancel it, use NIM_SETFOCUS to return focus to the taskbar notification area. 'Private Const NIM_SETVERSION = &H4 ' IE 5.x - Instructs the taskbar to behave according to the version number specified in the uVersion member of the structure pointed to by pnid. This message allows you to specify whether you want the version 5.0 behavior found on Microsoft® Windows® 2000 systems, or that found with earlier shell versions. The default value for uVersion is zero, indicating that the original Windows 95 notify icon behavior should be used. For details, see the Remarks section. ' Property Variables Private IconIDs() As Long Private IconIDsActive() As Boolean Private IconIDsCount As Integer Private BypassCheck As Boolean Private AdvancedMsgProc As Boolean Private WithEvents FormReference As Form Attribute FormReference.VB_VarHelpID = -1 ' Win32 API Declarations Private Declare Function Shell_NotifyIcon Lib "SHELL32.DLL" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, ByRef pNID As NOTIFYICONDATA) As Long 'BOOL 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' CLASS EVENT DECLARATIONS 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX Public Event LeftClick(ByVal IconID As Long) Public Event MiddleClick(ByVal IconID As Long) Public Event RightClick(ByVal IconID As Long) Public Event DblClick(ByVal IconID As Long) Public Event MouseMove(ByVal IconID As Long) 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' CLASS EVENTS 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX Private Sub Class_Terminate() On Error Resume Next Dim MyCounter As Integer ' If the user specified to use subclassing, make sure to unsubclass the form before terminating If AdvancedMsgProc = True Then SubClass_CleanUp FormReference.hWnd ' Remove any icons that are currently in the system tray. ' This takes the burden of deleting the icons in the system tray off the programmer's hands by automating it. If IconIDsCount > 0 Then For MyCounter = 1 To IconIDsCount IconRemove , MyCounter DoEvents Next End If End Sub 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' CLASS PROPERTIES 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' Specifies which form the system tray icons are to be owned by Public Property Get ST_OwnerForm() As Form Set ST_OwnerForm = FormReference End Property Public Property Set ST_OwnerForm(ByVal NewValue As Form) Set FormReference = NewValue End Property ' Indicates that subclassing should be used to retrieve the system tray icon's ID so that ' an application can have multiple system tray icons that do different things when the user ' clicks/double-clicks on them. ' ' WARNING : Whenever you use subclassing, you run the risk of making your Visual Basic ' development environment unstable, but this is required to properly process user interaction ' with multiple system tray icons. If you only have 1 system tray icon, DO NOT USE THIS FEATURE. ' ' NOTE : You must set this to TRUE before calling the "ST_CreateIcon" method or the default ' non-subclassing method will be used to track user interaction with the system tray icons. Public Property Get ST_AdvancedProcessing() As Boolean ST_AdvancedProcessing = AdvancedMsgProc End Property Public Property Let ST_AdvancedProcessing(ByVal NewValue As Boolean) AdvancedMsgProc = NewValue End Property 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' CLASS METHOD 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' Creates an icon in the system tray Public Function ST_CreateIcon(ByVal IconID As Long, _ ByVal hIcon As Long, _ Optional ByVal ToolTipText As String) As Boolean On Error Resume Next Dim NID As NOTIFYICONDATA Dim lngMessage As Long ' Make sure there's an owner form If FormReference Is Nothing Then Exit Function ' Make sure the specified icon ID hasn't been used before If IconExists(IconID) = True Then Exit Function ' If the user has chosen to use advanced processing, subclass the form, ' register a custom message to use for communication, and set the message ' for the system tray icon. If AdvancedMsgProc = False Then lngMessage = WM_MOUSEMOVE Else If SubClass_Exists(FormReference.hWnd) = False Then If SubClass_Add(FormReference.hWnd, Me) = True Then lngMessage = SubClass_GetCustMsg If lngMessage = 0 Then lngMessage = WM_MOUSEMOVE SubClass_Remove FormReference.hWnd AdvancedMsgProc = False End If Else lngMessage = WM_MOUSEMOVE SubClass_Remove FormReference.hWnd AdvancedMsgProc = False End If Else lngMessage = SubClass_GetCustMsg If lngMessage = 0 Then lngMessage = WM_MOUSEMOVE SubClass_Remove FormReference.hWnd AdvancedMsgProc = False End If End If End If ' Setup the information With NID .cbSize = Len(NID) .hWnd = FormReference.hWnd .uID = IconID .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE .hIcon = hIcon .szTip = Left(Trim(ToolTipText), 63) & Chr(0) .uCallbackMessage = lngMessage End With ' Pass the information to the API If Shell_NotifyIcon(NIM_ADD, NID) <> 0 Then IconAdd IconID ST_CreateIcon = True End If End Function ' Modifies the specified existing icon in the system tray Public Function ST_ModifyIcon(ByVal IconID As Long, _ ByVal hIcon As Long, _ Optional ByVal ToolTipText As String) As Boolean On Error Resume Next Dim NID As NOTIFYICONDATA Dim lngMessage As Long ' Make sure there's an owner form If FormReference Is Nothing Then Exit Function ' Make sure the specified icon ID has already been created - you can't modify something that doesn't exist If IconExists(IconID) = False Then Exit Function ' If the user has chosen to use advanced processing, subclass the form, ' register a custom message to use for communication, and set the message ' for the system tray icon. If AdvancedMsgProc = False Then lngMessage = WM_MOUSEMOVE Else If SubClass_Exists(FormReference.hWnd) = False Then If SubClass_Add(FormReference.hWnd, Me) = True Then lngMessage = SubClass_GetCustMsg If lngMessage = 0 Then lngMessage = WM_MOUSEMOVE SubClass_Remove FormReference.hWnd AdvancedMsgProc = False End If Else lngMessage = WM_MOUSEMOVE SubClass_Remove FormReference.hWnd AdvancedMsgProc = False End If Else lngMessage = SubClass_GetCustMsg If lngMessage = 0 Then lngMessage = WM_MOUSEMOVE SubClass_Remove FormReference.hWnd AdvancedMsgProc = False End If End If End If ' Setup the information With NID .cbSize = Len(NID) .hWnd = FormReference.hWnd .uID = IconID .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE .hIcon = hIcon .szTip = Left(Trim(ToolTipText), 63) & Chr(0) .uCallbackMessage = lngMessage End With ' Pass the information to the API If Shell_NotifyIcon(NIM_MODIFY, NID) <> 0 Then ST_ModifyIcon = True End Function ' Removes the specified icon in the system tray Public Function ST_DeleteIcon(ByVal IconID As Long) As Boolean On Error Resume Next Dim NID As NOTIFYICONDATA ' Make sure there's an owner form If FormReference Is Nothing Then Exit Function ' Make sure the specified icon exists - you can't delete something that doesn't exist If BypassCheck = False Then If IconExists(IconID) = False Then Exit Function End If End If ' Setup the information With NID .cbSize = Len(NID) .hWnd = FormReference.hWnd .uID = IconID .uFlags = 0 End With ' Pass the information to the API If Shell_NotifyIcon(NIM_DELETE, NID) <> 0 Then If BypassCheck = False Then IconRemove IconID ST_DeleteIcon = True End If End Function 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' This function is used internally to this class module only, and should not be called by the programmer or user Friend Sub SysTrayEvent(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) ' NOTE : This function should only be called by the "SubClass_Proc" function within the ' modSysTray.bas standard module when the user interacts with an icon created by this class module. ' The "uMsg" will always be the same, the "wParam" will return the ID assigned to the system ' tray icon by the programmer using this class module, and the "lParam" will return the ' Windows message that corisponds with the user's interaction with the system tray icon ' (i.e. - MouseMove, Click, DblClick, etc.) ' Get which message was passed Select Case lParam Case WM_LBUTTONUP RaiseEvent LeftClick(wParam) Case WM_MBUTTONUP RaiseEvent MiddleClick(wParam) Case WM_RBUTTONUP RaiseEvent RightClick(wParam) Case WM_LBUTTONDBLCLK RaiseEvent DblClick(wParam) Case WM_MOUSEMOVE RaiseEvent MouseMove(wParam) End Select End Sub ' This function used only internally to this class module to keep track of icon IDs and enable cleanup Private Function IconAdd(ByVal IconID As Long) As Boolean On Error Resume Next Dim MyCounter As Integer ' Validate passed parameter(s) If IconID <= 0 Then Exit Function ' If there are no icons, add it and exit If IconIDsCount = 0 Then IconIDsCount = 1 ReDim IconIDs(1 To 1) As Long ReDim IconIDsActive(1 To 1) As Boolean IconIDs(1) = IconID IconIDsActive(1) = True ' There are icons already created Else ' If icons exist, go through them and check to see if the icon already exists... if so, exit For MyCounter = 1 To IconIDsCount If IconIDsActive(MyCounter) = True Then If IconIDs(MyCounter) = IconID Then Exit Function End If End If Next ' The icon ID doesn't exist, look for an open index For MyCounter = 1 To IconIDsCount If IconIDsActive(MyCounter) = False Then IconIDsActive(MyCounter) = True IconIDs(MyCounter) = IconID IconAdd = True Exit Function End If Next ' There were no open indexes, so create one IconIDsCount = IconIDsCount + 1 ReDim Preserve IconIDs(1 To IconIDsCount) As Long ReDim Preserve IconIDsActive(1 To IconIDsCount) As Boolean ' Set the newly created icon index to the specified one IconIDs(IconIDsCount) = IconID IconIDsActive(IconIDsCount) = True IconAdd = True End If End Function ' This function used only internally to this class module to keep track of icon IDs and enable cleanup Private Function IconExists(ByVal IconID As Long) As Boolean Dim MyCounter As Integer ' Validate passed parameter(s) If IconID <= 0 Then Exit Function ' If there are no icons added yet, it doesn't exist If IconIDsCount <= 0 Then Exit Function ' Loop through all the existing For MyCounter = 1 To IconIDsCount If IconIDsActive(MyCounter) = True And IconIDs(MyCounter) = IconID Then IconExists = True Exit Function End If Next End Function ' This function used only internally to this class module to keep track of icon IDs and enable cleanup Private Function IconRemove(Optional ByVal IconID As Long, Optional ByVal IconIndex As Long) As Boolean On Error Resume Next Dim MyCounter As Integer ' Validate passed parameter(s) If IconIDsCount <= 0 Then Exit Function If (IconID <= 0) And (IconIndex <= 0) Then Exit Function If (IconID <= 0) And (IconIndex > 0) And (IconIndex > IconIDsCount) Then Exit Function ' If the icon's ID is specified, loop through all the current icons If IconID > 0 Then For MyCounter = 1 To IconIDsCount If IconIDs(MyCounter) = IconID And IconIDsActive(MyCounter) = True Then IconRemove = ST_DeleteIcon(IconID) IconIDs(MyCounter) = 0 IconIDsActive(MyCounter) = False End If Next ' If the index of the icon's ID is specified, pull the ID directly using that Else If IconIDs(IconIndex) <= 0 Or IconIDsActive(IconIndex) = False Then Exit Function Else BypassCheck = True IconRemove = ST_DeleteIcon(IconIDs(IconIndex)) BypassCheck = False IconIDs(IconIndex) = 0 IconIDsActive(IconIndex) = False End If End If End Function Private Sub FormReference_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) On Error Resume Next Dim uMsg As Long ' If the mouse move event is being fired from the SysTray icon, Y will always be ZERO If Y <> 0 Then Exit Sub ' Get the correct message based on the scale mode (must be translated to PIXELS to work) If FormReference.ScaleMode = vbTwips Then uMsg = X / Screen.TwipsPerPixelX Else uMsg = X End If ' Get which message was passed Select Case uMsg Case WM_LBUTTONUP RaiseEvent LeftClick(1) Case WM_MBUTTONUP RaiseEvent MiddleClick(1) Case WM_RBUTTONUP RaiseEvent RightClick(1) Case WM_LBUTTONDBLCLK RaiseEvent DblClick(1) Case WM_MOUSEMOVE RaiseEvent MouseMove(1) End Select End Sub