Как добавить иконку в System Tray

[Ducis]

Об этом, по-моему, не писал только ленивый
Полная объява:

Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Long
'для dwMessage
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2

Public Type NOTIFYICONDATA
cbSize As Long 'Размер структуры в байтах
hWnd As Long 'Дескриптор окна,к которому относится значок в systray
uID As Long 'Идентификатор, который уникально идентифицирует значок. Это значение позволяет окну иметь множественные значки в systray, позволяя окно сообщать различия между ними.
uFlags As Long 'Комбинация следующих флажков, определяющих, которые из последующих членов структуры содержат полезные данные. Любые компоненты данных, не идентифицированные флажком будут игнорироваться.
uCallbackMessage As Long 'Определенный приложением идентификатор сообщения. Это сообщение посылается окну всякий раз, когда происходит событие,связанное со значком в systray. Прежде всего-это, когда мышь перемещается или происходитщелчок поверх значка или когда окно получает ввод с клавиатуры. Параметр wParam будет определен идентификатором значка, который генерирует сообщение. Параметр lParam "реальный" идентификатор сообщения Windows .
hIcon As Long 'Дескриптор значка
szTip As String * 64 ' Windows 2000: возможно String * 128
'Строка с нулевым символом в конце. Этот текст появляется, когда курсор мыши находится над значком.
End Type
'для uFlags
Public Const NIF_ICON = &H2 'Компонент данных hIcon.
Public Const NIF_MESSAGE = &H1 'Компонент данных uCallbackMessage.
Public Const NIF_TIP = &H4 'Компонент данных szTip .
'для uCallbackMessage
'Public Const WM_MOUSEMOVE = &H200
'Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
'Public Const WM_LBUTTONDBLCLK = &H203
'Public Const WM_RBUTTONDOWN = &H204
'Public Const WM_RBUTTONUP = &H205
'Public Const WM_RBUTTONDBLCLK = &H206
'Public Const WM_MBUTTONDOWN = &H207
'Public Const WM_MBUTTONUP = &H208
'Public Const WM_MBUTTONDBLCLK = &H209
'Public Const WM_SETFOCUS = &H7
'Public Const WM_KEYDOWN = &H100
'Public Const WM_KEYFIRST = &H100
'Public Const WM_KEYLAST = &H108
'Public Const WM_KEYUP = &H101
'===================================================
Как видно из заремапиных констант - перехватывать события с иконкой будем в WM_LBUTTONUP

Далее пишем:

Public Function SetTrayIcon(Mode As Long, hWnd As Long, Icon As Long, Optional strToolTipText As String = "")
'для помещения иконки в трей и генерации события WM_LBUTTONUP
On Error Resume Next
Dim NID As NOTIFYICONDATA
With NID
.cbSize = Len(NID)
.hWnd = hWnd
.uID = &H0
.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
.uCallbackMessage = WM_LBUTTONUP
.hIcon = Icon
.szTip = Left(strToolTipText, 63) & Chr(0)
SetTrayIcon = Shell_NotifyIcon(Mode, NID)
End With
End Function

Public Sub DelIcon(frForm As Form)
'удаляет иконку из трея
On Error Resume Next
With frForm
SetTrayIcon NIM_DELETE, .hWnd, 0, ""
End With
End Sub

Public Sub ModIcon(frForm As Form, Optional strToolTipText As String = "")
'заменяет иконку или всплывающую подсказку на новую
On Error Resume Next
With frForm
SetTrayIcon NIM_MODIFY, .hWnd, .Icon, strToolTipText
End With
End Sub

А события с иконкой перехватываем так (событие MouseUp задали константой WM_LBUTTONUP, можно задать другое):
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'здесь будет работа с иконкой в трее
If Y = 0 Then 'при работе с иконкой у=0
Select Case X '/ Screen.TwipsPerPixelX
Case 512 'MouseMove
Case 513 'LeftButtonDown
Case 514 'LeftButtonUp
Case 515 'LeftButtonDblClick
Case 516 'RightButtonDown
Case 517 'RightButtonUp
Case 518 'RightButtonDblClick
End Select
End If
End Sub

[A.A.Z.]

Меню в Трее

Код: Выделить всё

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
Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow 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 Sub Add(hWnd As Long, Icon As Long, Tip As String)
    Dim ret As Long
     
    NID.uID = hWnd
    NID.hWnd = hWnd
    NID.hIcon = Icon
    NID.szTip = Left(Tip, 63) & Chr(0)
    NID.uFlags = NIF_TIP + NIF_MESSAGE + NIF_ICON
    NID.uCallbackMessage = WM_RBUTTONDOWN
    NID.cbSize = Len(NID)

    ret = Shell_NotifyIcon(NIM_ADD, NID)
End Sub

Public Sub Delete(hWnd As Long)
    Dim ret As Long
     
    NID.uID = hWnd
    NID.hWnd = hWnd
    NID.cbSize = Len(NID)

    ret = Shell_NotifyIcon(NIM_DELETE, NID)
End Sub


[Ducis]

Меню в Трее

Только про само меню в трее не дописал
По всей видимости, предполагалось использовать ф-ции ShowWindow, PostMessage.
Но можно проще:
сделать меню стандартными средствами, а потом так:
Select Case X '/ Screen.TwipsPerPixelX
Case 512 'MouseMove
Case 513 'LeftButtonDown
Case 514 'LeftButtonUp
Case 515 'LeftButtonDblClick
Case 516 'RightButtonDown
PopupMenu menu_name
Case 517 'RightButtonUp
Case 518 'RightButtonDblClick
End Select

[Fedorfx]

Можно еще проще.
Поищи контрол в архиве. Там 1 функция Add и все.

[Fedorfx]

В том же контроле и меню есть.
Поищи не пожалеешь.

[Ducis]

не пойму как делать Меню в Трее
остальное понял

Речь идет о всплывающем меню? Типа клацаем мышкой по иконке и вылезает меню?
Создаешь меню в форме с помощью Menu Editor. Пусть меню верхнего уровня будет mnuMain (его можно скрыть), пусть у него подменю Caption="Open" , сепаратор Caption="-", подменю Caption="Close".

Пусть меню появляется при правом клике на иконке.
Вот и делай:
Select Case X '/ Screen.TwipsPerPixelX
Case 516 'RightButtonDown
PopupMenu mnuMain
End Select
Только это надо помещать в соотв. обработчик событий формы. См. выше.

[goro]

http://vbaccelerator.com - Там точно есть контрол для работы с треем и меню в нем.

[Drag]

Сори за археологию, просто не хотелось создавать еще одну тему... Можно ли в трэй засунуть анимированную иконку(.ani, .gif)?

[GSerg]

Не приходила мысль менять её по таймеру, мой юный археолог?

[Drag]

Приходила... но посчитал, что регулярная подгрузка 42 иконок немного скажется на быстродействии. Ладно, буду по таймеру...
И по ходу еще вопрос - можно ли вызвать ToolTip этой иконки без наведения на нее курсора?

[Lumen]

Посмотри архив из аттача:
Там есть то что тебе нужно...