unit1.pas

this sample code discripe how to use try icon in system try in delphi language

{
Article:

System Tray Delphi application - dirty and effective

. http://delphi.about.com/library/weekly/aa122501a.htm

Once you have placed a Delphi program's icon in the Tray,
it's time to show a (customized) pop up menu near the icon
and have the icon reflect the state of your application -
even animate if you want so!


.............................................
Zarko Gajic
About.com Guide to Delphi Programming
http://delphi.about.com
email: [e-mail]
free newsletter: http://delphi.about.com/library/blnewsletter.htm
forum: http://forums.about.com/ab-delphi/start/
.............................................
}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, shellapi, AppEvnts, Buttons, StdCtrls, Menus, ExtCtrls, ImgList;

const
  WM_ICONTRAY = WM_USER + 1;

type
  TMainForm = class(TForm)
    edGoDelphi: TEdit;
    SpeedButton1: TSpeedButton;
    PopupMenu1: TPopupMenu;
    ShowForm1: TMenuItem;
    HideForm1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    N2: TMenuItem;
    AnimateIcon1: TMenuItem;
    Timer1: TTimer;
    ImageList1: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure ShowForm1DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
    procedure HideForm1DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
    procedure Exit1DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
    procedure Exit1Click(Sender: TObject);
    procedure AnimateIcon1DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
    procedure ShowForm1Click(Sender: TObject);
    procedure HideForm1Click(Sender: TObject);
    procedure Exit1MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
    procedure AnimateIcon1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    TrayIconData: TNotifyIconData;
  public
    procedure TrayMessage(var Msg: TMessage); message WM_ICONTRAY;
    procedure DrawBar(ACanvas: TCanvas);
  end;


var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.DrawBar(ACanvas: TCanvas);
var
  lf : TLogFont;
  tf : TFont;
begin
  with ACanvas do begin
    Brush.Color := clGray;
    FillRect(Rect(0,0,20,92));
    Font.Name := 'Tahoma';
    Font.Size := 7;
    Font.Style := Font.Style - [fsBold];
    Font.Color := clWhite;
    tf := TFont.Create;
    try
      tf.Assign(Font);
      GetObject(tf.Handle, sizeof(lf), @lf);
      lf.lfEscapement := 900;
      lf.lfHeight := Font.Height - 2;
      tf.Handle := CreateFontIndirect(lf);
      Font.Assign(tf);
    finally
      tf.Free;
    end;
    TextOut(2, 85, 'delphi.about.com');
  end;
end;

procedure TMainForm.TrayMessage(var Msg: TMessage);
var
  p : TPoint;
begin
  case Msg.lParam of
    WM_LBUTTONDOWN:
    begin
      ShowMessage('This icon responds to RIGHT BUTTON click!');
    end;
    WM_RBUTTONDOWN:
    begin
       SetForegroundWindow(Handle);
       GetCursorPos(p);
       PopUpMenu1.Popup(p.x, p.y);
       PostMessage(Handle, WM_NULL, 0, 0);
    end;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  PopUpMenu1.OwnerDraw:=True;

  with TrayIconData do
  begin
    cbSize := SizeOf(TrayIconData);
    Wnd := Handle;
    uID := 0;
    uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
    uCallbackMessage := WM_ICONTRAY;
    hIcon := Application.Icon.Handle;
    StrPCopy(szTip, Application.Title);
  end;

  Shell_NotifyIcon(NIM_ADD, @TrayIconData);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  Shell_NotifyIcon(NIM_DELETE, @TrayIconData);
end;

procedure TMainForm.SpeedButton1Click(Sender: TObject);
begin
 ShellExecute(Handle, 'open', PChar(edGoDelphi.Text),nil,nil, SW_SHOWNORMAL);
end;

procedure TMainForm.ShowForm1DrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
begin
 if Selected then
   ACanvas.Brush.Color := clHighlight
 else
   ACanvas.Brush.Color := clMenu;

 ARect.Left := 25;
 ACanvas.FillRect(ARect);

 DrawText(ACanvas.Handle, PChar('Show Form'), -1, ARect, DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOCLIP);
end;

procedure TMainForm.HideForm1DrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
begin
 if Selected then
   ACanvas.Brush.Color := clHighlight
 else
   ACanvas.Brush.Color := clMenu;

 ARect.Left := 25;
 ACanvas.FillRect(ARect);

 DrawText(ACanvas.Handle, PChar('Hide Form'), -1, ARect, DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOCLIP);
end;

procedure TMainForm.Exit1DrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
begin
 if Selected then
   ACanvas.Brush.Color := clHighlight
 else
   ACanvas.Brush.Color := clMenu;

 ARect.Left := 25;
 ACanvas.FillRect(ARect);

 DrawText(ACanvas.Handle, PChar('Exit'), -1, ARect, DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOCLIP);

 DrawBar(ACanvas);
end;

procedure TMainForm.AnimateIcon1DrawItem(Sender: TObject;
  ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
begin
 if Selected then
   ACanvas.Brush.Color := clHighlight
 else
   ACanvas.Brush.Color := clMenu;

 ARect.Left := 25;
 ACanvas.FillRect(ARect);

 if AnimateIcon1.Checked then
  DrawText(ACanvas.Handle, PChar('DO NOT Animate Icon'), -1, ARect, DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOCLIP)
 else
  DrawText(ACanvas.Handle, PChar('Animate Icon'), -1, ARect, DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOCLIP);

end;

procedure TMainForm.Exit1Click(Sender: TObject);
begin
  Application.Terminate;
end;
procedure TMainForm.ShowForm1Click(Sender: TObject);
begin
  MainForm.Show;
end;

procedure TMainForm.HideForm1Click(Sender: TObject);
begin
  MainForm.Hide;
end;

procedure TMainForm.Exit1MeasureItem(Sender: TObject; ACanvas: TCanvas;
  var Width, Height: Integer);
begin
 Width := 120;
end;

procedure TMainForm.AnimateIcon1Click(Sender: TObject);
begin
  AnimateIcon1.Checked := NOT AnimateIcon1.Checked;

  Timer1.Enabled := AnimateIcon1.Checked;
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
{$J+}
const
  Index : Integer = 0; //typed constant - will preserve its value through OnTimer events
{$J-}
var
  Icon: TIcon;
begin
  Inc(Index);
  if Index = 2 then Index:=0;

  Icon:=TIcon.Create;
  try
    ImageList1.GetIcon(Index,Icon);
    TrayIconData.hIcon := Icon.Handle;
    Shell_NotifyIcon(NIM_Modify, @TrayIconData);
  finally
    Icon.Free;
  end;
end;

end.