  ////////////////////////////////////////////////////////////
 // TrayIcon.pas - Файл описания компенента TTrayIcon
// Дмитрий Демидов, С-Петербург 06.Мар.2000 г.
////////////////////////////////////////////////////////////
// Компонент TTrayIcon позволяет создать иконку в панели 
// задач, получать от неё сообщения мыши, а так же задать
// всплывающее меню.
//
// Свойства:
//       Icon    : Иконка - то самое изображение, что вы увидите
//                 в панели задач.
//       Tip     : Подпись для иконки - Текст, который появляется,
//                 когда на иконке задерживается указатель мыши.
//       Visible : Видима ли иконка. Используется для временного
//                 скрытия иконки. Внимание, если иконка не задана,
//                 то вы также ничего не увидите!
//       PopupMenu : Всплывающее меню, которое вызывается правой
//                 кнопкой мыши. (Странно, но почему-то не всегда
//                 срабатывает. Помоему что-то связано с фокусом)
// События:
//       OnMouseMove : Возникает при перемещении мыши над иконкой
//       OnMouseDown : Возникает при нажатии клавиши мыши на иконке.
//                 Передаётся информация о нажатой кнопке.
//       OnMouseUp : Возникает при отпускании клавиши мыши на иконке.
//                 Передаётся информация об отпущеной кнопке.               
//       OnDblClick : Возникает если пользователь произвёл двойной
//                 щелчёк над иконкой. Также передаётся информация о
//                 клавише.
//
// По странности, почему-то не передаются координаты мыши, но в таком 
// маленьком обёме как иконка это наверное не принципиально. Ну тут уж
// я не виноват - эту информацию не выдаёт сам Вындоуз.
////////////////////////////////////////////////////////////

unit TrayIcon;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, Menus;

const WM_TRAYNOTIFYICON	= (WM_APP+100);

type
  ETrayIconException = class( Exception );

  TTrayMouseMoveEvent = procedure of object;
  TTrayMouseEvent = procedure( Button : TMouseButton ) of object;

  TTrayIcon = class(TComponent)
  private
    FhWnd: HWND;
    FIcon: TIcon;
    FTip: TCaption;
    FVisible: Boolean;
    FPopupMenu: TPopupMenu;
    TrayIconIsCreated: Boolean;
    NotifyWindow: TWinControl;
    FOnMouseMove : TTrayMouseMoveEvent;
    FOnMouseDown: TTrayMouseEvent;
    FOnMouseUp: TTrayMouseEvent;
    FOnDblClick: TTrayMouseEvent;
    procedure SetIcon(Value : TIcon);
    procedure SetTip(Value : TCaption);
    procedure SetVisible(Value : Boolean);
    function TrayMessage(dwMessage: DWORD):Boolean;
    procedure ModifyTrayIcon;
    procedure DeleteTrayIcon;
    procedure TrayNotify(Command : Integer);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property hWnd: HWND
      read FhWnd;
  published
    property Icon: TIcon
      read FIcon
      write SetIcon;
    property Tip: TCaption
      read FTip
      write SetTip;
    property Visible: Boolean
      read FVisible
      write SetVisible;
    property PopupMenu: TPopupMenu
      read FPopupMenu
      write FPopupMenu;
    property OnMouseMove : TTrayMouseMoveEvent
      read FOnMouseMove
      write FOnMouseMove;
    property OnMouseDown : TTrayMouseEvent
      read FOnMouseDown
      write FOnMouseDown;
    property OnMouseUp : TTrayMouseEvent
      read FOnMouseUp
      write FOnMouseUp;
    property OnDblClick : TTrayMouseEvent
      read FOnDblClick
      write FOnDblClick;
  end;

procedure Register;

implementation

uses ShellApi;

type
  TTrayWinControl = class( TWinControl )
  TrayIcon : TTrayIcon;
  procedure WMTrayNotifyIcon(var Message: TWMNotifyFormat);
    message WM_TrayNotifyIcon;
  end;


  //////////////////////////////////////////////////////
 // TTrayIcon component
//////////////////////////////////////////////////////
constructor TTrayIcon.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  // Настроить поля
  NotifyWindow := TTrayWinControl.CreateParentedControl(Application.Handle);
  (NotifyWindow as TTrayWinControl).TrayIcon := Self;
  FhWnd := NotifyWindow.Handle;
  FIcon := TIcon.Create;
  FTip := '';
  FVisible := True;
  TrayIconIsCreated := False;
  FPopupMenu := nil;
  FOnMouseMove := nil;
  FOnMouseDown := nil;
  FOnMouseUp := nil;
  FOnDblClick := nil;
end;

destructor TTrayIcon.Destroy;
begin
  // Удалить иконку
  DeleteTrayIcon;
  if Assigned(FIcon) then
    FIcon.Destroy;
  NotifyWindow.Destroy;
  inherited Destroy;
end;

procedure TTrayIcon.SetIcon(Value : TIcon);
begin
  FIcon.Assign(Value);
  // Обновить TrayIconObject
  ModifyTrayIcon;
end;

procedure TTrayIcon.SetTip(Value : TCaption);
begin
  FTip := Value;
  // Обновить TrayIconObject
  ModifyTrayIcon;
end;

procedure TTrayIcon.SetVisible(Value : Boolean);
begin
  if FVisible<>Value then
  begin
    FVisible := Value;
    // Обновить TrayIconObject
    ModifyTrayIcon;
  end;
end;

function TTrayIcon.TrayMessage(dwMessage: DWORD):Boolean;
var Tnd : NOTIFYICONDATA;
begin
  // Заполнение полей структуры...
  Tnd.cbSize	     := sizeof(NOTIFYICONDATA);
  Tnd.Wnd	     := FhWnd;
  Tnd.uID	     := 0;
  Tnd.uFlags	     := NIF_MESSAGE or NIF_ICON or NIF_TIP;
  Tnd.uCallbackMessage := WM_TRAYNOTIFYICON;
  Tnd.hIcon	     := FIcon.Handle;
  StrCopy(@Tnd.szTip,PChar(Tip));
  // Собстно посылка сообщения
  TrayMessage := Shell_NotifyIcon(dwMessage, @Tnd);
end;

procedure TTrayIcon.ModifyTrayIcon;
begin
  if csDesigning in ComponentState then
    Exit;
  if FIcon.Empty or (not FVisible) then
    DeleteTrayIcon
  else
  begin
    if TrayIconIsCreated then
    begin
      if not TrayMessage(NIM_MODIFY) then
      begin
        // Ошибка модификации
        raise ETrayIconException.Create('Modify tray icon failure');
      end;
    end
    else
    begin
      if not TrayMessage(NIM_ADD) then
      begin
        // Ошибка добавления
        raise ETrayIconException.Create('Add tray icon failure');
      end
      else
        TrayIconIsCreated := True;
    end;
  end;
end;

procedure TTrayIcon.DeleteTrayIcon;
begin
  if TrayIconIsCreated and (not TrayMessage(NIM_DELETE)) then
  begin
    // Ошибка удаления
    raise ETrayIconException.Create('Delete tray icon failure');
  end
  else
    TrayIconIsCreated := False;
end;

procedure TTrayIcon.TrayNotify(Command : Integer);
begin
  case Command of
  WM_MOUSEMOVE:
      if Assigned(FOnMouseMove) then FOnMouseMove;
  WM_LBUTTONDOWN:
      if Assigned(FOnMouseDown) then FOnMouseDown(mbLeft);
  WM_LBUTTONUP:
      if Assigned(FOnMouseUp) then FOnMouseUp(mbLeft);
  WM_LBUTTONDBLCLK:
      if Assigned(FOnDblClick) then FOnDblClick(mbLeft);
  WM_RBUTTONDOWN :
    begin
      if Assigned(FOnMouseDown) then FOnMouseDown(mbRight);
      if Assigned(FPopupMenu) then
        FPopupMenu.Popup(GetSystemMetrics(SM_CXSCREEN),
                         GetSystemMetrics(SM_CYSCREEN));
    end;
  WM_RBUTTONUP:
      if Assigned(FOnMouseUp) then FOnMouseUp(mbRight);
  WM_RBUTTONDBLCLK:
      if Assigned(FOnDblClick) then FOnDblClick(mbRight);
  end; // Case
end;

  //////////////////////////////////////////////////////
 // TTrayWinControl
//////////////////////////////////////////////////////
procedure TTrayWinControl.WMTrayNotifyIcon(var Message: TWMNotifyFormat);
begin
  // Передать полученное сообщение в TrayIcon!
  TrayIcon.TrayNotify(Message.Command);
  Message.Result := 0;
end;

  //////////////////////////////////////////////////////
 // Функция регистрации компонентов
//////////////////////////////////////////////////////

procedure Register;
begin
  RegisterComponents('WinD!', [TTrayIcon]);
end;

end.
