System Tray Delphi application - dirty and effective

Computing



{
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!

Download the ZIPed version.
}


MainForm.DFM

Select Form1, 
Select View As Text, 
Paste the text into Editor,
Select View As Form.




object MainForm: TMainForm
  Left = 344
  Top = 284
  Width = 292
  Height = 85
  Caption = 'MainForm'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  Icon.Data = {
    0000010001001010000000000000680500001600000028000000100000002000
    000001000800000000004001000000000000000000000001000000000000FFFF
    FF00E4E4E400989898004949490000000000FFFFFF0000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000404
    0404040404040404040404040404040404040203040404060304040404040404
    0404040402040304040404040404040404040404040304020404040404040404
    0404040403040304040404040404040404040404040404020404040404040404
    0404040304040404020404040404040404040404040202040404040404040404
    0404040403030403040404040404040404040403030000030204040404040404
    0404020300000003030404040404040404040301000001040204040404040404
    0404040100020404040404040404040404040303020403040404040404040404
    040404030404020404040404040404040404040402020404040404040404FFFF
    0000F39F0000F93F0000FC3F0000FC7F0000FC3F0000F99F0000FE7F0000FC3F
    0000F81F0000F01F0000F01F0000F03F0000F07F0000F87F0000FCFF0000}
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object SpeedButton1: TSpeedButton
    Left = 248
    Top = 16
    Width = 31
    Height = 22
    Caption = 'Go...'
    OnClick = SpeedButton1Click
  end
  object edGoDelphi: TEdit
    Left = 8
    Top = 16
    Width = 233
    Height = 21
    TabOrder = 0
    Text = 'http://delphi.about.com'
  end
  object PopupMenu1: TPopupMenu
    Left = 144
    Top = 24
    object ShowForm1: TMenuItem
      Caption = 'Show Form'
      OnClick = ShowForm1Click
      OnDrawItem = ShowForm1DrawItem
    end
    object HideForm1: TMenuItem
      Caption = 'Hide FOrm'
      OnClick = HideForm1Click
      OnDrawItem = HideForm1DrawItem
    end
    object N1: TMenuItem
      Caption = '-'
    end
    object AnimateIcon1: TMenuItem
      Caption = 'Animate Icon'
      OnClick = AnimateIcon1Click
      OnDrawItem = AnimateIcon1DrawItem
    end
    object N2: TMenuItem
      Caption = '-'
    end
    object Exit1: TMenuItem
      Caption = 'Exit'
      OnClick = Exit1Click
      OnDrawItem = Exit1DrawItem
      OnMeasureItem = Exit1MeasureItem
    end
  end
  object Timer1: TTimer
    Enabled = False
    Interval = 500
    OnTimer = Timer1Timer
    Left = 176
    Top = 24
  end
  object ImageList1: TImageList
    Left = 208
    Top = 24
    Bitmap = {
      494C010102000400040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
      0000000000003600000028000000400000001000000001001000000000000008
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000734E29250000
      0000000000002925000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000000000000000000000000000734E
      0000292500000000000000000000000000000000000000000000000000000000
      0000186310420000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      29250000734E0000000000000000000000000000000000000000000000000000
      1863186318631042000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000002925
      0000292500000000000000000000000000000000000000000000000000001863
      1863186318631863104200000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      00000000734E0000000000000000000000000000000000000000000018631863
      1863186318631863186310420000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000029250000
      000000000000734E000000000000000000000000000000000000186318631863
      1863104210421042186318631042000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      734E734E00000000000000000000000000000000000000001863186318631863
      1863000000000000104218630000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000002925
      2925000029250000000000000000000000000000000018631863186318631863
      18630000FF7F0000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000029252925
      FF7FFF7F2925734E000000000000000000000000000000001863186318631863
      104200000000207F000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000734E2925FF7F
      FF7FFF7F29252925000000000000000000000000000000000000186318630000
      0000104200000000207F00000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000000000000000000029259C73FF7F
      FF7F9C730000734E000000000000000000000000000000000000000000007B6F
      7B6F0000000000000000207F0000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000000000000000000000009C73FF7F
      734E000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000001863000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000000000000000000029252925734E
      0000292500000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000C66400000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000029250000
      0000734E00000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000000000000000000000000000734E
      734E000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000424D3E000000000000003E000000
      2800000040000000100000000100010000000000800000000000000000000000
      000000000000000000000000FFFFFF00FFFFFF7F00000000F39FFE3F00000000
      F93FFC1F00000000FC3FF80F00000000FC7FF00700000000FC3FE00300000000
      F99FC00100000000FE7F800100000000FC3F000300000000F81F800700000000
      F01FC00300000000F01FE00100000000F03FF02000000000F07FFFF000000000
      F87FFFF900000000FCFFFFFF0000000000000000000000000000000000000000
      000000000000}
  end
end

UNIT1.PAS

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.

Project1.PAS

program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {MainForm};

{$R *.res}

begin
  Application.Initialize;
  Application.ShowMainForm := False;
  Application.CreateForm(TMainForm, MainForm);
  Application.Run;
end.


{
********************************************
Zarko Gajic
About.com Guide to Delphi Programming
http://delphi.about.com
email: delphi@aboutguide.com
free newsletter: http://delphi.about.com/library/blnewsletter.htm
forum: http://forums.about.com/ab-delphi/start/
********************************************
}


Delphi