Systray - colocando icone ao lado relogio

{

The number of colors depend on the OS. AFAIK Win9x, ME, NT support

16 colors. XP, 2000 support 256 colors.

}

// exemplo *completo* e definitivo de systray, por Flavio Junior - testado em 06/07/01

unit Unit1;

interface

uses Forms, Menus, Classes, Messages, ShellAPI, SysUtils, Windows;

type

  TForm1 = class(TForm)

    PopupMenu1: TPopupMenu;

    mMostrar: TMenuItem;

    mFechar: TMenuItem;

    procedure FormCreate(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure mMostrarClick(Sender: TObject);

    procedure mFecharClick(Sender: TObject);

  public

    procedure IconCallBackMessage(var Msg: TMessage); message WM_USER + 100;  // quando clica no ícone

    procedure OnMinimize(var Msg: TWMSysCommand);     message WM_SYSCOMMAND;  // quando minimiza ou fecha o form

  end;

var

  Form1: TForm1;

  nid  : TNotifyIconData;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

  // Seta as informações necessárias para a variável passada como parametro

  // para o Agente Market.

  with nid do

  begin

    cbSize := SizeOf( TNotifyIconData );

    Wnd    := Self.Handle;

    uID    := 1;

    uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;

    hIcon  := Application.Icon.Handle;

    StrPCopy(szTip, 'Nome do programa ');

    uCallbackMessage := WM_USER + 100;

  end;

  Shell_NotifyIcon( NIM_ADD, @nid );

  Application.ShowMainForm := False; // esconde a form...

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  Shell_NotifyIcon( NIM_DELETE, @nid );  // remove o tray-icon

end;

procedure TForm1.IconCallBackMessage(var Msg: TMessage);

var

  Point : TPoint;

begin

  case Msg.LParam of

    WM_LBUTTONDBLCLK: begin  // duplo-click mostra form

                        Show;

                        SetForegroundWindow( Handle );

                      end;

    WM_RBUTTONUP    : begin  // botão direito = mostra menu

                        SetForegroundWindow( Handle );

                        GetCursorPos( Point );

                        PopupMenu1.Popup( Point.x, Point.y );

                        PostMessage( Handle, WM_USER, 0, 0 );

                      end;

  end;

end;

procedure TForm1.mMostrarClick(Sender: TObject);

begin

  Show;  // popup - mostrar

end;

procedure TForm1.mFecharClick(Sender: TObject);

begin

  Close; // popup - fechar

end;

// se foi "chamado" o evento minimizar OU FECHAR, da form, esconde a mesma.

procedure TForm1.OnMinimize(var Msg: TWMSysCommand);

begin

  // se quiser que o "X" feche a form tire o "SC_CLOSE"

  if (Msg.CmdType = SC_MINIMIZE) or (Msg.CmdType = SC_CLOSE) then

    Hide

  else

    inherited;

end;

end.

// ------------------------------ OBSERVAÇÕES ---------------------------------

// Se quiser mudar o icone basta usar o código:

  nid.hIcon  := Application.Icon.Handle;

  Shell_NotifyIcon( NIM_MODIFY, @nid );

// Para mudar o hint...

  StrPCopy(nid.szTip, TimeToStr(Now));

  Shell_NotifyIcon( NIM_MODIFY, @nid );

 // ----------------------------- atencao -------------------

 primeiro, quando a aplicação estiver no Tray, não existe

razão para o form estar criado....

passe todos os procedimentos que estiverem em andamento

durante o Tray para um Timer, filho de TApplication (criado

em RunTime)

Quando ele entrar no Tray, dê um free, e quando ele sair,

dê um create.... isso garantirá que o form aparecerá

por cima das outras.

no Programa principal, troque o

     CreateForm(FormX);

por

     FormX := TFormX.create(Self);

     FormX.Show

Desse modo, vc não terá um form principal no programa

e poderá criá-lo e destruí-lo sem que o programa necessariamente

pare.

(caso não saiba, cada unit é um pedaço do programa, mas

o .DPR é o programa principal.)