'Icon in systemtray
'on a Module
Public Const WM_LBUTTONDBLCLICK = &H203
Public Const WM_RBUTTONUP = &H205
Public Const WM_MOUSEMOVE = &H200
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public 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
Public VBGTray as
NOTIFYICONDATA
Declare Function Shell_NotifyIcon Lib "shell32" Alias _
"Shell_NotifyIconA" (ByVal dwMessage as
Long, pnid as
NOTIFYICONDATA) as
Boolean
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd as
Long) as
Long
'on the form1
Private sub
GoSystemTray()
VBGTray.cbSize = Len(VBGTray)
VBGTray.hWnd = Me.hWnd
VBGTray.uId = vbNull
VBGTray.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
VBGTray.ucallbackMessage = WM_MOUSEMOVE
VBGTray.hIcon = Me.Icon
'tooltiptext
VBGTray.szTip = Me.Caption & vbNullChar
Call Shell_NotifyIcon(NIM_ADD, VBGTray)
App.TaskVisible = False 'remove application from taskbar
Me.Hide
End Sub
Private sub
Form_MouseMove(Button as
Integer, Shift as
Integer, X as
Single, Y as
Single)
Static lngMsg as
Long
Static blnFlag as
Boolean
Dim result as
long
lngMsg = X / Screen.TwipsPerPixelX
If blnFlag = False Then
blnFlag = True
select
case
lngMsg
'doubleclick
case
WM_LBUTTONDBLCLICK
Me.Show
'right-click
case
WM_RBUTTONUP
result = SetForegroundWindow(Me.hwnd)
Me.PopupMenu mnuSystemtray
end
Select
blnFlag = False
end
If
End Sub
Private sub
Form_QueryUnload(Cancel as
Integer, UnloadMode as
Integer)
VBGTray.cbSize = Len(VBGTray)
VBGTray.hWnd = Me.hWnd
VBGTray.uId = vbNull
Call Shell_NotifyIcon(NIM_DELETE, VBGTray)
End Sub
'make on
the form a menu called mnuSystemTray
'set visible to false
'with the neccesarry items
'at least one to exit the application!
'don't forget to put the appropiate code under the menu-item(s)
'use it as
for example
'form_load
'do something what has to be done
'goto to systemtray => Call GoSystemTray
'I have implemented it in the Online application on
'http://kather.xs4all.nl/Documents/ingelogd.zip
'thanxs to arno pijnappels
'modifications also by Rich Jones
Return