'*********************************************************************
'*                            TrayIcon                               *
'*             Библиотека для работы с SystemTray                    *
'*-------------------------------------------------------------------*
'
'  Ивенты:
'     OnIcon ( MouseButton as integer )
'                       ; генерируется при действии над иконкой в трее.
'                       ; MouseButton соответствует - Enum TRAYICON_MOUSE_*.
'  Свойства:
'     hWnd (Long)       ; hWnd окна, к которому привязана иконка
'     Icon (Long)       ; указатель на иконку. Иконка должна быть 16 цветная.
'     ToolTipText       ; всплывающий текст
'
'  Методы:
'     Add ( )           ; добавление иконки в трей. Заранее нужно установить все свойства.
'     Modify ( )        ; изменение иконки в трее.
'     Delete ( )        ; удаление иконки из трея
'     CallEvent ( X as single, Y as single )
'                       ; вызывается из Form_MouseDown, ей передаются значения X и Y
'
'---------------------------------------------------------------------
'     Version 0.90 Beta * Copyright (с) А.Щербаков * May 17, 2000
'*********************************************************************
   Option Explicit

'декларация функций Win32API
   Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
   Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
   Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

'константы и структуры Win32API
   Private Const NIF_MESSAGE = &H1
   Private Const NIF_ICON = &H2
   Private Const NIF_TIP = &H4
   Private Const NIM_ADD = &H0
   Private Const NIM_MODIFY = &H1
   Private Const NIM_DELETE = &H2
   Private Const WM_RBUTTONDOWN = &H204
   Private Const WM_NULL = &H0
   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 NID As NOTIFYICONDATA

'---------------------------------------------------------------------

'переменные и структуры модуля
   Private m_hWnd          As Long
   Private m_Icon          As Long
   Private m_ToolTipText   As String
   Public Enum TrayIcon_Mouse
      TRAYICON_MOUSE_NONE = 0
      TRAYICON_MOUSE_LEFTDOWN = 1
      TRAYICON_MOUSE_LEFTUP = 2
      TRAYICON_MOUSE_LEFTDBLCLICK = 3
      TRAYICON_MOUSE_RIGHTDOWN = 4
      TRAYICON_MOUSE_RIGHTUP = 5
      TRAYICON_MOUSE_RIGHTDBLCLICK = 6
   End Enum

'ивенты
   Public Event OnIcon(MouseButton As Integer)
   

'---------------------------------------------------------------------
'  Свойства

'получить свойство hWnd
Public Property Get hwnd() As Long
      hwnd = m_hWnd
End Property

'присвоить свойство hWnd
Public Property Let hwnd(ByVal NewValue As Long)
      m_hWnd = NewValue
End Property


'получить свойство Icon
Public Property Get Icon() As Long
      Icon = m_Icon
End Property

'присвоить свойство Icon
Public Property Let Icon(ByVal NewValue As Long)
      m_Icon = NewValue
End Property


'получить свойство ToolTipText
Public Property Get ToolTipText() As String
      ToolTipText = m_ToolTipText
End Property

'присвоить свойство ToolTipText
Public Property Let ToolTipText(ByVal NewValue As String)
      m_ToolTipText = NewValue
End Property

'---------------------------------------------------------------------
'  Методы

'добавление иконки в Tray
Public Sub Add()
   Dim ret As Long
      
   'заполняем структуру
      NID.uID = m_hWnd
      NID.hwnd = m_hWnd
      NID.hIcon = m_Icon
      NID.szTip = Left$(m_ToolTipText, 63) & Chr$(0)
      NID.uFlags = NIF_TIP + NIF_MESSAGE + NIF_ICON
      NID.uCallbackMessage = WM_RBUTTONDOWN
      NID.cbSize = Len(NID)
    
   'вызываем функцию API
      ret = Shell_NotifyIcon(NIM_ADD, NID)
      
End Sub

'изменение иконки и ToolTip в Tray
Public Sub Modify()
   Dim ret As Long
   
   'заполняем структурку
      NID.hIcon = m_Icon
      NID.szTip = Left$(m_ToolTipText, 63) & Chr$(0)
      NID.uFlags = NIF_TIP + NIF_ICON
      NID.cbSize = Len(NID)
      
   'вызываем функцию API
      ret = Shell_NotifyIcon(NIM_MODIFY, NID)
      
End Sub

'удаление иконки из Tray
Public Sub Delete()
   Dim ret As Long
   
   'заполняем структурку
      NID.cbSize = Len(NID)
   
   'вызываем функцию API
      ret = Shell_NotifyIcon(NIM_DELETE, NID)
      
End Sub


'вызвать ивент
Public Sub CallEvent(X As Single, Y As Single)
   'проверка, было ли действие по окну или по иконке в трее
      If Y Then Exit Sub
      
   'получаем тип действия
      Dim MouseButton As Integer
      MouseButton = (X And &HFF) / Screen.TwipsPerPixelX
   
   'генерируем ивент
      RaiseEvent OnIcon(MouseButton)
      
End Sub

Private Sub Form_Load()

Set cTray = New TrayIcon
'хендл окна
      cTray.hwnd = hwnd
   'иконка, что будет отображена в трее
      cTray.Icon = frmIco.Icon

   'тултипс (всплывающая подсказка)
      cTray.ToolTipText = "Текст подсказки"
      
   'создаем иконку
      cTray.Add
Me.Visible = False

End Sub

'процедура нажатия на кнопку минимизации
Private Sub cmdMin_Click()
    Set cTray = New TrayIcon
'хендл окна
      cTray.hwnd = hwnd
   'иконка, что будет отображена в трее
      cTray.Icon = frmIco.Icon

   'тултипс (всплывающая подсказка)
      cTray.ToolTipText = "Текст подсказки"
      
   'создаем иконку
      cTray.Add
    Me.Visible = False
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

   'передаем данные в объект
      cTray.CallEvent X, Y
      
End Sub
Private Sub cTray_OnIcon(MouseButton As Integer)
   'левый двойной клик
    If MouseButton = TRAYICON_MOUSE_LEFTDBLCLICK Then
        Me.Visible = True
        Me.Hide
        Me.Show
        MouseButton = TRAYICON_MOUSE_RIGHTDOWN
    End If
End Sub