Solved

VB6 Systray icon remains after closing my app

Posted on 2007-03-28
28
682 Views
Last Modified: 2008-01-09
Hi fellow programmers!

I have a few functions in place to send my app to the systray and make use of display balloons.
My problem (if you can call it that) is that when I close the app THE ICON REMAINS IN THE SYSTRAY. When I move my mouse over the icon it disappears. This behaviour doesn't exist on any other app in the systray, so I wanted to know how I automatically remove this icon.

I have added a call to the 'DeleteIconFromTray' function on every event related to closing the main from. I'll post my current code in the next comment.

Note - in this particular app I always have an icon in the tray as I have the property 'ShowInTaskbar' = False and there it no title bar or border on the forms used.
0
Comment
Question by:Ryan_R
  • 16
  • 6
  • 3
  • +2
28 Comments
 
LVL 15

Author Comment

by:Ryan_R
ID: 18814038
The following was taken from a text file from my personal code library - I may have changed a few things after copying it to my project:

Declares:
----------------------------------------------------------------------------------------
'SysTray Icon
Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(7) As Byte
End Type

' 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 * 128
  dwState As Long
  dwStateMask As Long
  szInfo As String * 256
  uTimeoutAndVersion As Long
  szInfoTitle As String * 64
  dwInfoFlags As Long
  guidItem As GUID
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 Const APP_SYSTRAY_ID = 999 'unique identifier
Private Const NOTIFYICON_VERSION = &H3
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const NIF_STATE = &H8
Private Const NIF_INFO = &H10
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIM_SETFOCUS = &H3
Private Const NIM_SETVERSION = &H4
Private Const NIM_VERSION = &H5
Private Const NIS_HIDDEN = &H1
Private Const NIS_SHAREDICON = &H2

'shell version / NOTIFIYICONDATA struct size constants
Private Const NOTIFYICONDATA_V1_SIZE As Long = 88  'pre-5.0 structure size
Private Const NOTIFYICONDATA_V2_SIZE As Long = 488 'pre-6.0 structure size
Private Const NOTIFYICONDATA_V3_SIZE As Long = 504 '6.0+ structure size
Private NOTIFYICONDATA_SIZE As Long

'icon flags
Private Const NIIF_NONE = &H0
Private Const NIIF_INFO = &H1
Private Const NIIF_WARNING = &H2
Private Const NIIF_ERROR = &H3
Private Const NIIF_GUID = &H5
Private Const NIIF_ICON_MASK = &HF
Private Const NIIF_NOSOUND = &H10
   
Private Const WM_USER = &H400
Private Const NIN_BALLOONSHOW = (WM_USER + 2)
Private Const NIN_BALLOONHIDE = (WM_USER + 3)
Private Const NIN_BALLOONTIMEOUT = (WM_USER + 4)
Private Const NIN_BALLOONUSERCLICK = (WM_USER + 5)

Private Data As NOTIFYICONDATA
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Boolean
Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lpBuffer As Any, nVerSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
----------------------------------------------------------------------------------------


User Code:
----------------------------------------------------------------------------------------
AddIconToTray(sIconToolTip As String)
DisplayBallon(nIconIndex As Long, sTitle As String, sText As String) 'nIconIndex: 0=nothing, 1=info, 2=exclam, 3=critical
DeleteIconFromTray
----------------------------------------------------------------------------------------


User Functions:
----------------------------------------------------------------------------------------
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

  Dim message As Long
  message = X / Screen.TwipsPerPixelX

  Select Case message
    Case WM_LBUTTONDBLCLK
                ' "Left Button Double Click!"
                Me.Show
                DeleteIconFromTray
    Case WM_MOUSEMOVE
                ' "MouseMove!"
    Case WM_LBUTTONDOWN
                ' "Left MouseDown"
    Case WM_LBUTTONUP
                ' "Left MouseUp"
    Case WM_RBUTTONDOWN
                ' "Right MouseDown"
    Case WM_RBUTTONUP
                ' "Right MouseUp"
                PopupMenu mnuPopup
    Case WM_RBUTTONDBLCLK
                ' "Right Button Double Click!"
    End Select
End Sub
----------------------------------------------------------------------------------------


Functions:
----------------------------------------------------------------------------------------
Private Sub AddIconToTray(sIconToolTip As String)
  If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
  Data.Size = NOTIFYICONDATA_SIZE 'Len(Data)
  Data.Handle = hwnd
  Data.ID = APP_SYSTRAY_ID 'vbNull
  Data.Flags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP 'IconFlag Or TipFlag Or MessageFlag
  Data.CallBackMessage = WM_MOUSEMOVE
  Data.Icon = Icon
  Data.Tip = sIconToolTip & vbNullChar
  Data.dwState = NIS_SHAREDICON
  Data.uTimeoutAndVersion = NOTIFYICON_VERSION
 
  Call Shell_NotifyIcon(AddIcon, Data)
  Call Shell_NotifyIcon(NIM_SETVERSION, Data)
'''
   
  'add the icon ...
   'Call Shell_NotifyIcon(NIM_ADD, nid)
   
  '... and inform the system of the
  'NOTIFYICON version in use
   'Call Shell_NotifyIcon(NIM_SETVERSION, nid)
End Sub
'---------------------------------------------------------------------------------------
Private Sub DisplayBallon(nIconIndex As Long, sTitle As String, sText As String)
   'Dim nid As NOTIFYICONDATA use data
   If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
   With Data
      .Size = NOTIFYICONDATA_SIZE
      .Handle = hwnd
      .ID = APP_SYSTRAY_ID
      .Flags = NIF_INFO
      .dwInfoFlags = nIconIndex
      'InfoTitle is the balloon tip title,
      'and szInfo is the message displayed.
      'Terminate both with vbNullChar
      .szInfoTitle = sTitle & vbNullChar
      .szInfo = sText & vbNullChar
   End With

   Call Shell_NotifyIcon(NIM_MODIFY, Data)
End Sub
'---------------------------------------------------------------------------------------
Private Sub DeleteIconFromTray()
  Call Shell_NotifyIcon(DeleteIcon, Data)
  '''
 
   If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
     
   With Data
      .Size = NOTIFYICONDATA_SIZE
      .Handle = hwnd
      .ID = APP_SYSTRAY_ID
   End With
   
   'Call Shell_NotifyIcon(NIM_DELETE, nid)
End Sub
'---------------------------------------------------------------------------------------
Private Sub SetShellVersion()
   Select Case True
      Case IsShellVersion(6)
         NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V3_SIZE '6.0+ structure size
      Case IsShellVersion(5)
         NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V2_SIZE 'pre-6.0 structure size
      Case Else
         NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V1_SIZE 'pre-5.0 structure size
   End Select
End Sub
'---------------------------------------------------------------------------------------
Private Function IsShellVersion(ByVal version As Long) As Boolean
  'returns True if the Shell version
  '(shell32.dll) is equal or later than
  'the value passed as 'version'
   Dim nBufferSize As Long
   Dim nUnused As Long
   Dim lpBuffer As Long
   Dim nVerMajor As Integer
   Dim bBuffer() As Byte
   Const sDLLFile As String = "shell32.dll"
   nBufferSize = GetFileVersionInfoSize(sDLLFile, nUnused)
   If nBufferSize > 0 Then
      ReDim bBuffer(nBufferSize - 1) As Byte
      Call GetFileVersionInfo(sDLLFile, 0&, nBufferSize, bBuffer(0))
      If VerQueryValue(bBuffer(0), "\", lpBuffer, nUnused) = 1 Then
         CopyMemory nVerMajor, ByVal lpBuffer + 10, 2
         IsShellVersion = nVerMajor >= version
      End If  'VerQueryValue
   End If  'nBufferSize
End Function
'---------------------------------------------------------------------------------------
Public Function AppHolok(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim CWP As CWPSTRUCT
    CopyMemory CWP, ByVal lParam, Len(CWP)
    Select Case CWP.message
        Case WM_CREATE
            SetForegroundWindow CWP.hwnd
            AppHook = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
            UnhookWindowsHookEx hHook
            hHook = 0
            Exit Function
    End Select
    AppHook = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
End Function
----------------------------------------------------------------------------------------
0
 
LVL 12

Expert Comment

by:jkaios
ID: 18814283
In you DeleteIconFromTray sub-routine, try call the Shell_NotifyIcon at the BOTTOM of the procedure

'---------------------------------------------------------------------------------------
Private Sub DeleteIconFromTray()
 
   If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
     
   With Data
      .Size = NOTIFYICONDATA_SIZE
      .Handle = hwnd
      .ID = APP_SYSTRAY_ID
   End With
   
   Call Shell_NotifyIcon(DeleteIcon, Data)   '<== PUT IT HERE ==>

End Sub
'---------------------------------------------------------------------------------------
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 18814339
sorry - that didn't work
0
 
LVL 11

Expert Comment

by:TreyH
ID: 18815627
Could the .size be wrong ?

Private Sub DeleteIconFromTray()
 
   If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
     
   With Data
      '.Size = NOTIFYICONDATA_SIZE
      .Size = Len(Data)                 <========= Try this ?
      .Handle = hwnd
      .ID = APP_SYSTRAY_ID
   End With
   
   Call Shell_NotifyIcon(NIM_DELETE, Data)

End Sub
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 18815751
again - no success
the icon remains in the systray until i move my mouse over it

i have a incling that it might be due to Public Function AppHolok(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

when i copied the code over from an older project (that doesn't have this prob) i got some errors from that function - and since then I have deleted the whole function from my new project

does this help?
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 18815755
loggin off for tonight - will check back here tomorrow
0
 
LVL 12

Expert Comment

by:jkaios
ID: 18820497
Three questions:

1. Why do you have to call DeleteIconFromTray immediately after calling AddIconToTray?
2. Why do you have to call DeleteIconFromTray in your Form_MouseMove event?
3. Shouldn't you have to use App.ThreadID instead of the fixed APP_SYSTRAY_ID?

The right way to do it is to add the icon to the tray (AddIconToTray) when the form loads.
Now, when the form unloads that's when you call the DeleteIconFromTray function.

DO NOT TRY TO REMOVE THE ICON FROM THE TRAY WHILE THE APP IS RUNNING
WHICH IS WHAT YOU'RE DOING IN THE "MouseMove" EVENT.

'---------------------------------------------------------------------------------------
Private Sub Form_Load()
   '// add the icon to the system tray area
   Call AddIconToTray("My Tool Tip")
End Sub
'---------------------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
   '// remove the icon from the system tray
   DeleteIconFromTray
End Sub
'---------------------------------------------------------------------------------------
Private Sub DeleteIconFromTray()
 
   If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
     
   With Data
      .Size = NOTIFYICONDATA_SIZE
      .Handle = hwnd
      '*** .ID = APP_SYSTRAY_ID
      .ID = App.ThreadID                '<<=== TRY THIS INSTEAD
   End With
   
   Call Shell_NotifyIcon(DeleteIcon, Data)   '<== PUT IT HERE ==>

End Sub
'---------------------------------------------------------------------------------------
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 18821219
1. - I don't. Please note this code wasn't copied out of my project but rather from a text file in my 'Code Library' folder. Therefore all functions that I have to call were in the section User Code.

2. Good point. In my old app I had the icon removed when the form was visible. I obviously haven't removed that line out of the text file.

3. I dunno. I just copied all the code from a website - I'm not sure what half of it does - haven't really worried about it.

I replaced DeleteIconFromTray with your code but still no success.
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 18821251
ProjectA is my old app that doesn't have this problem:

It has this code (currently):
----------------------------------------
Private Sub DeleteIconFromTray()
  Call Shell_NotifyIcon(DeleteIcon, Data)
  '''
    If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
     
   With Data
      .Size = NOTIFYICONDATA_SIZE
      .Handle = hwnd
      .ID = APP_SYSTRAY_ID
   End With
   
   'Call Shell_NotifyIcon(NIM_DELETE, nid)
End Sub
------------------------------------------------

ProjectB (this one):
------------------------------------------------
Private Sub DeleteIconFromTray()
    If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
    With Data
      .Size = NOTIFYICONDATA_SIZE
      .Handle = hwnd
      '*** .ID = APP_SYSTRAY_ID
      .ID = App.ThreadID                '<<=== TRY THIS INSTEAD
   End With
   'Call Shell_NotifyIcon(DeleteIcon, Data)   '<== PUT IT HERE ==>
   Call Shell_NotifyIcon(NIM_DELETE, nid)
End Sub
----------------------------------------

This suggests to me the the problem lies elsewhere
0
 
LVL 26

Expert Comment

by:EDDYKT
ID: 18822418
don't sure where do you get this from

Private Type NOTIFYICONDATA
  Size As Long
  Handle As Long
  ID As Long
  Flags As Long
  CallBackMessage As Long
  Icon As Long
  Tip As String * 128
  dwState As Long
  dwStateMask As Long
  szInfo As String * 256
  uTimeoutAndVersion As Long
  szInfoTitle As String * 64
  dwInfoFlags As Long
  guidItem As GUID
End Type


should it be only

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
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 18822758
Replacing that gives errors on the follwoing lines of code:

Private Sub AddIconToTray(sIconToolTip As String)
'''''code
Data.dwState = NIS_SHAREDICON
Data.uTimeoutAndVersion = NOTIFYICON_VERSION
''''code
End Sub

Problem still exists
0
 
LVL 26

Expert Comment

by:EDDYKT
ID: 18823212
Does your program crash when it exists?
If it is, then there is no way to remove icon (as far as i know).
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 18827422
See - that's the weird thing. I have the same code in another project and the icon does disappear whenever I close the app. I'll look for any discrepencies later today, otherwise I'll just google for some different sys tray code and try that.
0
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
ID: 18830893


did you use the End command while unloading your program?


NEVER use it, because it equals ending your process in the task list
and that way your app can't fire form_unload and so



and for EDDYKT,

the first one is valid too,
added in a newer version of the structure
see this for more info: http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/structures/notifyicondata.asp
0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 
LVL 15

Author Comment

by:Ryan_R
ID: 18830958
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
DeleteIconFromTray
End Sub

Private Sub mnpExit_Click() 'tray popup menu
DeleteIconFromTray
End
End Sub

Private Sub mnuExit_Click() 'menu on frmMain
DeleteIconFromTray
End
End Sub

that's the code currently being used
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 18830962
i've found on projects that have more than one form don't actually end as a process shown in tasklist unless i use the End command.
0
 
LVL 12

Expert Comment

by:jkaios
ID: 18834236
>> 've found on projects that have more than one form don't actually end as a process shown in tasklist unless i use the End command. <<

This is probably the problem why your icon does not disappear immediately after you exit you app.
If this is the case, then use the following code in the Unload event of the main form to make sure all
loaded forms are, in fact, destroyed when your app exits.

'===============================================================================
Private Sub Form_Unload(Cancel As Integer)

   '// make sure all forms are unloaded
   
   Dim ldForm As Form
   
   For Each ldForm In Forms
      Unload ldForm
      Set ldForm = Nothing
   Next

End Sub
'===============================================================================
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 18834272
apart from adding that code - should i do anything else?
0
 
LVL 26

Expert Comment

by:EDDYKT
ID: 18835217
should change this to

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
DeleteIconFromTray
End Sub

Private Sub mnpExit_Click() 'tray popup menu
DeleteIconFromTray
End
End Sub

Private Sub mnuExit_Click() 'menu on frmMain
DeleteIconFromTray
End
End Sub



to



Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
DeleteIconFromTray
End Sub

Private Sub mnpExit_Click() 'tray popup menu
unload me
End Sub

Private Sub mnuExit_Click() 'menu on frmMain
unload me
End Sub

Private Sub Form_Unload(Cancel As Integer)

   '// make sure all forms are unloaded
   
   Dim ldForm As Form
   
   For Each ldForm In Forms
      Unload ldForm
      Set ldForm = Nothing
   Next

End Sub
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 18835622
made all those changes - still no joy  :(
0
 
LVL 12

Accepted Solution

by:
jkaios earned 125 total points
ID: 18839775
If all the above don't seem to work then try the following code.  Create new Class Module, name it "clsTrayIcon" then copy the paste the code into it:

With the example below, all you have to do is call these two methods at the Form_Load event:

   1. Call oTray.AttachForm(Me)
   2. Call oTray.AddIconToTray(Me.Icon, App.Title)

The MouseMove event will be automatically taken care of once the "AttachForm" method has been
called, which pass the form object to the class so that the class can use its "hwnd" property thru-out
the program execution.

'==============================[ CLASS MODULE ]==================================
Option Explicit

Private Declare Function Shell_NotifyIcon Lib "shell32.dll" _
   Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Private Declare Function GetFileVersionInfoSize Lib "version.dll" _
   Alias "GetFileVersionInfoSizeA" _
  (ByVal lptstrFilename As String, _
   lpdwHandle As Long) As Long

Private Declare Function GetFileVersionInfo Lib "version.dll" _
   Alias "GetFileVersionInfoA" _
  (ByVal lptstrFilename As String, _
   ByVal dwHandle As Long, _
   ByVal dwLen As Long, _
   lpData As Any) As Long
   
Private Declare Function VerQueryValue Lib "version.dll" _
   Alias "VerQueryValueA" _
  (pBlock As Any, _
   ByVal lpSubBlock As String, _
   lpBuffer As Any, _
   nVerSize As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (Destination As Any, _
   Source As Any, _
   ByVal Length As Long)

Private Const NOTIFYICON_VERSION = &H3

' Constants for the "uFlags" member of the NOTIFYICONDATA structure
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const NIF_STATE = &H8
Private Const NIF_INFO = &H10

' Constants used to control the icon
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIM_SETFOCUS = &H3
Private Const NIM_SETVERSION = &H4
Private Const NIM_VERSION = &H5

Private Const NIS_HIDDEN = &H1
Private Const NIS_SHAREDICON = &H2

' Ballloon icon flags
Private Const NIIF_NONE = &H0
Private Const NIIF_INFO = &H1
Private Const NIIF_WARNING = &H2
Private Const NIIF_ERROR = &H3
Private Const NIIF_GUID = &H5
Private Const NIIF_ICON_MASK = &HF
Private Const NIIF_NOSOUND = &H10

' Balloon icon type enum for the ShowBalloon function
Public Enum tiBalloonIconEnum
   BalloonIconNone = NIIF_NONE
   BalloonIconInfo = NIIF_INFO
   BalloonIconWarn = NIIF_WARNING
   BalloonIconError = NIIF_ERROR
End Enum

' Constants used to detect clicking on the icon
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONUP = &H205
Private Const WM_LBUTTONUP = &H202
Private Const WM_MOUSEMOVE = &H200
Private Const WM_USER = &H400

' Constants used to detect clicking on the balloon
Private Const NIN_BALLOONSHOW = (WM_USER + 2)
Private Const NIN_BALLOONHIDE = (WM_USER + 3)
Private Const NIN_BALLOONTIMEOUT = (WM_USER + 4)
Private Const NIN_BALLOONUSERCLICK = (WM_USER + 5)

' shell version / NOTIFIYICONDATA struct size constants
Private Const NOTIFYICONDATA_V1_SIZE As Long = 88  'pre-5.0 structure size
Private Const NOTIFYICONDATA_V2_SIZE As Long = 488 'pre-6.0 structure size
Private Const NOTIFYICONDATA_V3_SIZE As Long = 504 '6.0+ structure size

Private Type GUID
   Data1    As Long
   Data2    As Integer
   Data3    As Integer
   Data4(7) As Byte
End Type

Private Type NOTIFYICONDATA
   cbSize            As Long
   hWnd              As Long
   uID               As Long
   uFlags            As Long
   uCallbackMessage  As Long
   hIcon             As Long
   szTip             As String * 128
   dwState           As Long
   dwStateMask       As Long
   szInfo            As String * 256
   uTimeoutAndVersion As Long
   szInfoTitle       As String * 64
   dwInfoFlags       As Long
   guidItem          As GUID
End Type

' Variable representing the tray icon structure
Private TrayIcon As NOTIFYICONDATA
Private NOTIFYICONDATA_SIZE As Long

' Event for displaying any error
Public Event OnError(ByVal sErrorMsg As String, ByVal sProcedure As String)

' Event that fires when the user clicks on a popup balloon tip
Public Event OnBalloonClick(ByVal sBalloonTitle As String, ByVal sBalloonMessage As String)

' Variables representing the main application form
Dim WithEvents m_oForm  As Form
Dim m_bIsAttached       As Boolean
Dim m_oPopupMenu        As Menu
Dim m_oPopupMenuDefault As Menu

Private Sub Class_Initialize()
   m_bIsAttached = False
End Sub

Private Sub Class_Terminate()
   Set m_oForm = Nothing
   Set m_oPopupMenu = Nothing
   Set m_oPopupMenuDefault = Nothing
End Sub

Public Property Let PopupMenu(newValue As Menu)
   Set m_oPopupMenu = newValue
End Property

Public Property Get PopupMenu() As Menu
   Set PopupMenu = m_oPopupMenu
End Property

Public Property Let PopupDefaultMenuItem(newValue As Menu)
   Set m_oPopupMenuDefault = newValue
End Property

Public Property Get PopupDefaultMenuItem() As Menu
   Set PopupDefaultMenuItem = m_oPopupMenuDefault
End Property

Public Function AttachForm(oForm As Form, _
                           Optional mnuMainPopupMenu As Menu, _
                           Optional mnuDefaultPopupMenuItem As Menu) As Boolean
   On Error Resume Next
   
   Set m_oForm = oForm
   
   If Err.Number = 0 Then
      m_bIsAttached = True
   Else
      RaiseEvent OnError(Err.Description, "clsTrayIcon.AttachForm()")
      Err.Clear
   End If
   
   AttachForm = m_bIsAttached
   
   If Not mnuMainPopupMenu Is Nothing Then
      PopupMenu = mnuMainPopupMenu
   End If
   
   If Not mnuDefaultPopupMenuItem Is Nothing Then
      PopupDefaultMenuItem = mnuDefaultPopupMenuItem
   End If
   
   If Err Then
      RaiseEvent OnError(Err.Description, "clsTrayIcon.AttachForm()")
   End If
   
End Function

Public Function AddIconToTray(oIcon As IPictureDisp, sTooltip As String, _
                              Optional ByVal lFormHandle As Long) As Boolean

   On Local Error Resume Next
   
   If m_bIsAttached Then
      lFormHandle = m_oForm.hWnd
   End If
   
   If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
   
   TrayIcon.cbSize = NOTIFYICONDATA_SIZE 'Len(TrayIcon)
   TrayIcon.hWnd = lFormHandle
   TrayIcon.uID = App.ThreadID 'vbNull
   TrayIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
   TrayIcon.uCallbackMessage = WM_MOUSEMOVE
   TrayIcon.hIcon = oIcon
   TrayIcon.szTip = sTooltip & vbNullChar
   TrayIcon.uTimeoutAndVersion = NOTIFYICON_VERSION
   
   ' Add the icon to the system tray
   Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
   
   ' Inform the system of the NOTIFYICON version is use
   Call Shell_NotifyIcon(NIM_SETVERSION, TrayIcon)
   
   If Err Then
      RaiseEvent OnError(Err.Description, "clsTrayIcon.AddIconToTray()")
      Err.Clear
   Else
      AddIconToTray = True
   End If
   
End Function

Public Function ChangeIcon(oIcon As IPictureDisp, sTooltip As String) As Boolean

   On Local Error Resume Next
   
   If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
   
   TrayIcon.cbSize = NOTIFYICONDATA_SIZE 'Len(TrayIcon)
   TrayIcon.uID = App.ThreadID 'vbNull
   TrayIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
   TrayIcon.hIcon = oIcon
   TrayIcon.szTip = sTooltip & vbNullChar
   
   Call Shell_NotifyIcon(NIM_MODIFY, TrayIcon)
   
   If Err Then
      RaiseEvent OnError(Err.Description, "clsTrayIcon.ChangeIcon()")
      Err.Clear
   Else
      ChangeIcon = True
   End If
   
End Function

Public Function RemoveIcon(Optional ByVal lFormHandle As Long) As Boolean

   On Local Error Resume Next
   
   If m_bIsAttached Then
      lFormHandle = m_oForm.hWnd
   End If
   
   If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
   
   TrayIcon.cbSize = NOTIFYICONDATA_SIZE 'Len(TrayIcon)
   TrayIcon.hWnd = lFormHandle
   TrayIcon.uID = App.ThreadID 'vbNull
   
   Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
   
   If Err Then
      RaiseEvent OnError(Err.Description, "clsTrayIcon.RemoveIcon()")
      Err.Clear
   Else
      RemoveIcon = True
   End If
   
End Function

Public Function ShowBalloon(sTitle As String, sTooltip As String, _
                            Optional lIconType As tiBalloonIconEnum = BalloonIconInfo, _
                            Optional lTimeoutSeconds As Long = 10, _
                            Optional ByVal lFormHandle As Long) As Boolean

   On Local Error Resume Next
   
   If m_bIsAttached Then
      lFormHandle = m_oForm.hWnd
   End If
   
   If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
   
   TrayIcon.cbSize = NOTIFYICONDATA_SIZE 'Len(TrayIcon)
   TrayIcon.hWnd = lFormHandle
   TrayIcon.uID = App.ThreadID 'vbNull
   TrayIcon.uFlags = NIF_INFO  '<- show a balloon tip instead of the regular popup tooltip
   TrayIcon.dwInfoFlags = lIconType
   TrayIcon.uTimeoutAndVersion = lTimeoutSeconds And NOTIFYICON_VERSION
   TrayIcon.szInfo = sTooltip & vbNullChar
   TrayIcon.szInfoTitle = sTitle & vbNullChar
   
   Call Shell_NotifyIcon(NIM_MODIFY, TrayIcon)
   
   If Err Then
      RaiseEvent OnError(Err.Description, "clsTrayIcon.ShowBalloon()")
      Err.Clear
   Else
      ShowBalloon = True
   End If
   
End Function

Public Function ShowPopupMenu(oForm As Form, _
                              mnuMainPopupMenu As Menu, _
                              x As Single, _
                              y As Single, _
                              Optional mnuDefaultPopupMenuItem As Menu = Nothing) As Long

 '***********************************************************
 ' This method should be called from the client form's      *
 ' MouseMove event if we don't use the AttachForm method.   *
 '***********************************************************

   On Local Error Resume Next
   Dim lMessage As Long
   
   lMessage = x / Screen.TwipsPerPixelX
   
   Select Case lMessage
      Case WM_LBUTTONDBLCLK
         oForm.WindowState = vbNormal
         oForm.Show
      Case WM_RBUTTONUP
         If Not mnuMainPopupMenu Is Nothing Then
            If mnuDefaultPopupMenuItem Is Nothing Then
               oForm.PopupMenu mnuMainPopupMenu, , x, y
            Else
               oForm.PopupMenu mnuMainPopupMenu, , x, y, mnuDefaultPopupMenuItem
            End If
         End If
   End Select
   
   ShowPopupMenu = Err.Number
   
   If Err Then
      RaiseEvent OnError(Err.Description, "clsTrayIcon.ShowPopupMenu()")
      Err.Clear
   End If
   
End Function

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

 '*****************************************************************
 ' This event receives the callbacks from the System Tray icon.   *
 ' This should automatically take care of the mouse event on the  *
 ' client form if we use the AttachForm method.                   *
 '*****************************************************************
   On Error Resume Next
   
   Dim lMsg As Long
   
   ' The value of X will vary depending
   ' upon the scalemode setting.
   
   If m_oForm.ScaleMode = vbPixels Then
     lMsg = x
   Else
     lMsg = x / Screen.TwipsPerPixelX
   End If
   
   Select Case lMsg
     'Case WM_LBUTTONUP        '514 restore form window
     '   m_oForm.WindowState = vbNormal
     '   m_oForm.Show
       
     Case WM_LBUTTONDBLCLK    '515 restore form window
        m_oForm.WindowState = vbNormal
        m_oForm.Show
       
     Case WM_RBUTTONUP        '517 display popup menu
        If Not m_oPopupMenu Is Nothing Then
           If Not m_oPopupMenuDefault Is Nothing Then
              m_oForm.PopupMenu m_oPopupMenu, , , , m_oPopupMenuDefault
           End If
        End If
       
     Case NIN_BALLOONSHOW
        ' Sent when the balloon is shown (balloons are queued)
        Debug.Print "NIN_BALLOONSHOW"
       
     Case NIN_BALLOONHIDE
        ' Sent when the balloon disappears—for example, when the icon is deleted.
        ' This message is not sent if the balloon is dismissed because of a timeout or a mouse click.
        Debug.Print "NIN_BALLOONHIDE"
       
     Case NIN_BALLOONTIMEOUT
        ' Sent when the balloon is dismissed because of a timeout
        Debug.Print "NIN_BALLOONTIMEOUT"
       
     Case NIN_BALLOONUSERCLICK
        ' Sent when the balloon is dismissed because of a mouse click
        RaiseEvent OnBalloonClick(Trim(TrayIcon.szInfoTitle), Trim(TrayIcon.szInfo))
       
   End Select
   
   If Err Then
      RaiseEvent OnError(Err.Description, "clsTrayIcon.m_oForm_MouseMove")
   End If

End Sub

Private Sub SetShellVersion()

   Select Case True
      Case IsShellVersion(6)
         NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V3_SIZE '6.0+ structure size
      Case IsShellVersion(5)
         NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V2_SIZE 'pre-6.0 structure size
      Case Else
         NOTIFYICONDATA_SIZE = NOTIFYICONDATA_V1_SIZE 'pre-5.0 structure size
   End Select

End Sub

Private Function IsShellVersion(ByVal lVersion As Long) As Boolean

   ' Returns True if the Shell version(shell32.dll) is equal
   ' or later than the specified version.
   
   Dim nBufferSize As Long
   Dim nUnused As Long
   Dim lpBuffer As Long
   Dim nVerMajor As Integer
   Dim bBuffer() As Byte
   
   Const sDLLFile As String = "shell32.dll"
   
   nBufferSize = GetFileVersionInfoSize(sDLLFile, nUnused)
   
   If nBufferSize > 0 Then
      ReDim bBuffer(nBufferSize - 1) As Byte
      Call GetFileVersionInfo(sDLLFile, 0&, nBufferSize, bBuffer(0))
      If VerQueryValue(bBuffer(0), "\", lpBuffer, nUnused) = 1 Then
         CopyMemory nVerMajor, ByVal lpBuffer + 10, 2
         IsShellVersion = nVerMajor >= lVersion
      End If
   End If
 
End Function
'==============================[ CLASS MODULE ]==================================


'================================[ FORM CODE ]===================================
Option Explicit

Dim WithEvents oTray As clsTrayIcon

Private Sub Form_Load()
   
   ' Initialize all object variables first
   Set oTray = New clsTrayIcon
   
   ' Hide this program from appearing on
   ' the Applications tab of the Task Manager
   App.TaskVisible = False
   
   ' Put the program in the system tray
   Call oTray.AttachForm(Me)
   Call oTray.AddIconToTray(Me.Icon, App.Title)
   
End Sub

Private Sub Form_Resize()
   
   If Me.WindowState = vbMinimized Then
      Me.Hide
      oTray.ChangeIcon Me.Icon, App.Title & " - MINIMIZE MODE"
   Else
      oTray.ChangeIcon Me.Icon, App.Title & " - NORMAL MODE"
   End If
   
End Sub

Private Sub Form_Unload(Cancel As Integer)
   
   oTray.RemoveIcon
   Set oTray = Nothing
   
End Sub

Private Sub oTray_OnBalloonClick(ByVal sBalloonTitle As String, ByVal sBalloonMessage As String)
   ' Display the main window when the user clicks
   ' on a popup balloon from the system tray.
   Me.WindowState = vbNormal
   Me.Show
End Sub
'================================[ FORM CODE ]===================================
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 18840324
Great job jkaios - I've got a soltuion going now.
Out of the code I posted in the first comment - how much can I delete?

I made this change:
If UCase(Command) = "/HIDE" Then App.TaskVisible = False 'for Windows Startup

also another tip (although not used in this case):
instead of                Dim WithEvents oTray As clsTrayIcon
and then                 Set oTray = New clsTrayIcon
you can just use      Dim oTray As New clsTrayIcon   (btw I called it clsSysTray)

I working through a few other probs that I'll post here later if I don't solve them (in regards to your code)
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 18841377
OK - I've worked through a lot of your code understanding how it works so that I can customize stuff for my needs - there's at least one thing that I need a bit of help with regarding the AttachForm function.

Using this function and deleteing my old code meant that mnuPopup wouldn't appear when r/clicking my tray icon. I found out that i could change it and add the arguments:
Call oTray.AttachForm(Me, mnuPopup, mnpTray)
however this makes "Restore From Tray" appear in bold (since it's default) - and I DON"T want this. So I removed the last argument but now I don't get the popup menu at all.  Can I just use   oTray.AttachForm(Me, mnuPopup)   on its own somehow?
0
 
LVL 12

Expert Comment

by:jkaios
ID: 18841432
No problem, in the "m_oForm_MouseMove()" event in the Class module add an "Else" under

 Case WM_RBUTTONUP


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

     Case WM_RBUTTONUP        '517 display popup menu
        If Not m_oPopupMenu Is Nothing Then
           If Not m_oPopupMenuDefault Is Nothing Then
              m_oForm.PopupMenu m_oPopupMenu, , , , m_oPopupMenuDefault
           Else                                                             '<<== ADD THIS LINE ==>>
              m_oForm.PopupMenu m_oPopupMenu    '<<== ADD THIS LINE ==>>
           End If
        End If

End Sub
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 18841532
thanks heaps for that - as soon as I finish this second version of my app I'll be sure to send you a copy for your own personal use

Ryan
0
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
ID: 18844350

hey Ryan_R,

you wrote this:
>>also another tip (although not used in this case):
>>instead of                Dim WithEvents oTray As clsTrayIcon
>>and then                 Set oTray = New clsTrayIcon
>>you can just use      Dim oTray As New clsTrayIcon   (btw I called it clsSysTray)


but that is not entirely true

if you dim an object as New, vb will (internally) EVERY time you access an property or method, check if the object exists.

this adds a slight overhead, and an unnecessarily one!



mark
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 18846771
thanks mark - i suppose at the time the only overhead i was worried about was how much code i have to type    :)
0
 
LVL 12

Expert Comment

by:jkaios
ID: 18848091
The only reason to use "WithEvents" statement in the declaration section is to take advantage of the events "exposed" by the class - the OnBalloonClick and OnError events.

And because the "WithEvents" statement does not work the the "New" declaration command, it is then important to later "instantiate" the object using the "Set" command in the Load event of the form.
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

This article is meant to give a basic understanding of how to use R Sweave as a way to merge LaTeX and R code seamlessly into one presentable document.
This is an explanation of a simple data model to help parse a JSON feed
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Viewers will learn how to properly install Eclipse with the necessary JDK, and will take a look at an introductory Java program. Download Eclipse installation zip file: Extract files from zip file: Download and install JDK 8: Open Eclipse and …

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now