System Tray Icon (code included)
##########################
CODE SNIPPETS#####
##########################
******************
Class Module (class1)
*********************
Option Explicit
Public Event TrayIconLeftCLick()
Public Event TrayIconRightCLick()
Public Event TrayIconMove()
Public Event TrayIconDoubleCLick()
Private WithEvents pct As PictureBox
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias _
"Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As _
NOTIFYICONDATA) As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) 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 'Make your own constant, e.g.:
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
Public Sub CreateIcon(Optional Tip As String = "")
Dim Tic As NOTIFYICONDATA
If pct Is Nothing Then Exit Sub
Tic.cbSize = Len(Tic)
Tic.hWnd = pct.hWnd
Tic.uID = 1&
Tic.uFlags = NIF_DOALL
Tic.uCallbackMessage = WM_MOUSEMOVE
Tic.hIcon = pct.Picture
Tic.szTip = Tip & Chr$(0)
Shell_NotifyIcon NIM_ADD, Tic
End Sub
Public Sub DeleteIcon()
Dim Tic As NOTIFYICONDATA
If pct Is Nothing Then Exit Sub
Tic.cbSize = Len(Tic)
Tic.hWnd = pct.hWnd
Tic.uID = 1&
Shell_NotifyIcon NIM_DELETE, Tic
End Sub
Public Sub ModifyIcon(Optional Tip As String = "")
Dim Tic As NOTIFYICONDATA
Tic.cbSize = Len(Tic)
Tic.hWnd = pct.hWnd
Tic.uID = 1&
Tic.uFlags = NIF_DOALL
Tic.uCallbackMessage = WM_MOUSEMOVE
Tic.hIcon = pct.Picture
Tic.szTip = Tip & Chr$(0)
Shell_NotifyIcon NIM_MODIFY, Tic
End Sub
Public Sub SetPct(nPct As PictureBox)
Set pct = nPct
End Sub
Private Sub pct_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
X = X / Screen.TwipsPerPixelX
Select Case X
Case WM_LBUTTONDOWN
'Caption = "Left Click"
RaiseEvent TrayIconLeftCLick
Case WM_RBUTTONDOWN
'Caption = "Right Click"
RaiseEvent TrayIconRightCLick
Case WM_MOUSEMOVE
'Caption = "Move"
RaiseEvent TrayIconMove
Case WM_LBUTTONDBLCLK
'Caption = "Double Click"
RaiseEvent TrayIconDoubleCLick
End Select
End Sub
*****************************************
Form1
*******************************************
Option Explicit
Private Sub Form_Load()
Dim WithEvents TI As cTrayIcon
Label1.Caption = "Current Date/Time:" & Date
Set TI = New cTrayIcon
TI.SetPct Picture1
TI.CreateIcon
TI.ModifyIcon
End Sub
Private Sub Form_Unload(Cancel As Integer)
TI.DeleteIcon
Set TI = Nothing
frmLogin.Show
Me.Hide
End Sub
Private Sub Timer1_Timer()
Label2.Caption = Time
Label2.Refresh
End Sub
**************************
##########################
Thanks in advance!

