TENTA ENTENDER ESTE CÓDIGOOOO ABAIXO:
COLOCAR NUM MÓDULO de classe chamado clsTrayIcon:
Option Explicit
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
' 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
' Constants used to control the icon
Private Const NIM_ADD = &H0
'Private Const NIM_MODIFY = &H1
Private Const NIF_MESSAGE = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
' Used by Shell_NotifyIcon (TrayIcon)
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
'create variable of type NOTIFYICONDATA (TrayIcon)
Private TrayIcon As NOTIFYICONDATA
Private st_Err() As String
Private ln_ErrCount As Long
Private Sub Class_Initialize()
Erase st_Err()
ln_ErrCount = -1
End Sub
Private Function hf_StoreErr(st_Func As String, ErrorNumber As Long)
ln_ErrCount = ln_ErrCount + 1
ReDim Preserve st_Err(ln_ErrCount)
st_Err(ln_ErrCount) = st_Func & ": Error " & Error(ErrorNumber) & " - " & Err.Description
End Function
Function hf_DumpErr()
Dim ln_Index As Long
If ln_ErrCount = -1 Then Exit Function
Debug.Print ""
Debug.Print "clsTrayIcon Class Module Errors"
Debug.Print "-------------------------------"
For ln_Index = 0 To ln_ErrCount
Debug.Print st_Err(ln_Index)
Next
End Function
Function fn_ShowIcon(frm_hWnd As Long, ob_Icon As IPictureDisp, st_Tooltip As String) As Long
On Local Error Resume Next
TrayIcon.cbSize = Len(TrayIcon)
TrayIcon.hwnd = frm_hWnd
TrayIcon.uId = vbNull
TrayIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
TrayIcon.ucallbackMessage = WM_MOUSEMOVE
TrayIcon.hIcon = ob_Icon
TrayIcon.szTip = st_Tooltip & Chr$(0)
Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
If Err <> 0 Then
Call hf_StoreErr("fn_ShowIcon", Err.Number)
Err.Clear
End If
End Function
Function fn_HideIcon(frm_hWnd As Long) As Long
On Local Error Resume Next
TrayIcon.cbSize = Len(TrayIcon)
TrayIcon.hwnd = frm_hWnd
TrayIcon.uId = vbNull
Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
If Err <> 0 Then
Call hf_StoreErr("fn_HideIcon", Err.Number)
Err.Clear
End If
End Function
Function fn_MouseMove(ob_Form As Form, Button As Integer, x As Single, Y As Single, Optional int_ShowWindState As Integer = 0, Optional ob_PopupMenu As Menu = Nothing) As Long
On Local Error Resume Next
Static Message As Long
Static RR As Boolean
Message = x / Screen.TwipsPerPixelX
If RR = False Then
RR = True
Select Case Message
Case WM_LBUTTONDBLCLK
If ob_Form.WindowState = 1 Then ob_Form.WindowState = int_ShowWindState
ob_Form.Show
Case WM_RBUTTONUP
If Not ob_PopupMenu Is Nothing Then ob_Form.PopupMenu ob_PopupMenu
End Select
RR = False
End If
fn_MouseMove = Err.Number
If Err <> 0 Then
Call hf_StoreErr("fn_MouseMove", Err.Number)
Err.Clear
End If
Err.Clear
End Function
COLOCAR NUM FORM:
pode ser no form_load mesmo:
Private objTrayIcon As clsTrayIcon
'--- Cria o objeto TrayIcon ---'
Set objTrayIcon = New clsTrayIcon
objTrayIcon.fn_ShowIcon Me.hwnd, Me.Icon, "texto xxxxx"
Private Sub Form_Unload(Cancel As Integer)
'--- Destrói o objeto do TrayIcon, tirando a aplicação do SysTray ---'
objTrayIcon.fn_HideIcon Me.hwnd
objTrayIcon.hf_DumpErr
'--- Destrói o objeto de comunicação ---'
Set m_objTrayIcon = Nothing
End
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
objTrayIcon.fn_MouseMove Me, Button, x, Y, 0, mnuPopup_TrayIcon
'CRIE UM MENU CHAMADO mnuPopup_TrayIcon: POR EXEMPLO
Begin VB.Menu mnuPopup_TrayIcon
Caption = "PopupTrayIcon"
Visible = 0 'False
Begin VB.Menu mnuShowForm_TrayIcon
Caption = "Mostrar Janela Principal"
End
Begin VB.Menu mnuFechar_TrayIcon
Caption = "Fechar Aplicação"
End
Begin VB.Menu mnuLinha
Caption = "-"
End
Begin VB.Menu mnuCancelar
Caption = "Cancelar"
End
End
End Sub