-
I'm a newbie here, so I apologise if code-segments are taboo.
I have seen the various code segments in here, and in particularly the posting by Aaron relating to the System Tray.
I'm trying to convert the code into a Class so that I can have easy re-use in my projects. The tray icon is successfully added to the system tray, and can be removed by code. However, when I move my mouse over the icon in the tray it disappears - a bit like orphaned icons do when a program has terminated. I can't see anything wrong in my code, and there are no errors being returned by the API.
I have a class module called cSystemTray containing the following code:
Option Explicit
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias _
"Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private Type NOTIFYICONDATA
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 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 NIF_DOALL = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_RBUTTONDOWN = &H204
' Module-level variables
Private m_IconHandle As Long
Private m_IconToolTip As String
Private m_IconInTray As Boolean
' Put icon in System Tray
Public Sub PutInTray()
Dim Trayicon As NOTIFYICONDATA
Dim lngReturn As Long
With Trayicon
.cbSize = Len(Trayicon)
.hwnd = m_IconHandle
.uID = 1&
.uFlags = NIF_DOALL
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = m_IconHandle
.szTip = m_IconToolTip & Chr$(0)
End With
' Call the API
lngReturn = Shell_NotifyIcon(NIM_ADD, Trayicon)
' Update the status flag
m_IconInTray = True
End Sub
' Remove icon from the system tray
Public Sub RemoveFromTray()
Dim Trayicon As NOTIFYICONDATA
Dim lngReturn As Long
' Only process if the icon is in the tray
If m_IconInTray Then
With Trayicon
.cbSize = Len(Trayicon)
.hwnd = m_IconHandle
.uID = 1&
End With
' Call the API
lngReturn = Shell_NotifyIcon(NIM_DELETE, Trayicon)
End If
' Update the status flag
m_IconInTray = False
End Sub
' Allow the icon to be assigned
Public Property Let IconHandle(vNewhandle As Long)
m_IconHandle = vNewhandle
End Property
' Allow the description to be asssigned
Public Property Let IconTooltip(vNewToolTip As String)
m_IconToolTip = vNewToolTip
End Property
' Tidy up
Private Sub Class_Terminate()
' Remove any icon from the tray
RemoveFromTray
End Sub
I have a form with two command buttons and a picture box, with the following code:
Option Explicit
Private tray As cSystemTray
Private Sub Command1_Click()
Set tray = New cSystemTray
tray.IconTooltip = "Hello"
tray.IconHandle = Picture1
tray.PutInTray
End Sub
Private Sub Command2_Click()
tray.RemoveFromTray
End Sub
All help GREATLY appreciated!
-
The reason that the Icon disappears is that something is removing it.
When you move the mouse over the system tray it causes it to refresh.
Try removing the code from inside the Class Terminate Event beacause this is the event causing it to close.
Instead of the class terminate add it to a form unload or other end program event.
Class terminate is fired when you release the reference to the class rather than end the program.
Fant:cool:
-
Found it...
Many thanks for your reply.
I did a scan of the web and found an excellent example at
http://www.scottandmichelle.net/scot...mv?codenum=007
which has shown me what I was doing wrong. It was the callback routine that was throwing it all off track.
