Как создать приложение, которое работало бы в трее (где часы)?

Олег Кулабухов приводит следующий код:

Если вы узнали ответ на этот вопрос здесь, а не в RU.DELPHI, где он является одним из самых популярных и то же время самым надоевшим, то вы просто молодец.

На самом деле приложение не работает в трее, и даже не сворачивается туда, как думают очень многие, задающие этот вопрос. Хитрость заключается в следующем - приложение прячется из TaskBar'a, вместо этого в трей помещается созданная произвольная иконка. Усложняется все это различными разворачиваниями/сворачиваниями окна. Не более.

Нижеприведенный пример показывает структуру самой этой процедуры. Для испоьзования в повседневной работе я все-таки рекомендую написать свой компонент, либо использовать существующие, например из пакета компонентов RxLIB (rxTrayIcon)

{TrayIt.dpr}

program TrayIt;

uses
Windows,
Forms,
TrayIt1 in 'TrayIt1.pas' {Form1};

{$R *.RES}

begin
Application.Initialize;
Application.ShowMainForm := False;
Application.CreateForm(TForm1, Form1);
ShowWindow(Application.Handle, SW_HIDE);
Application.Run;
end.

{TrayIt1.pas}

unit TrayIt1;

interface

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

type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
Open1: TMenuItem;
Exit1: TMenuItem;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Open1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
procedure WndProc(var Msg : TMessage); override;
public
{ Public declarations }
IconData : TNotifyIconData;
IconCount : integer;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WndProc(var Msg : TMessage);
var
p : TPoint;
begin
case Msg.Msg of
WM_USER + 1:
case Msg.lParam of
WM_RBUTTONDOWN: begin
GetCursorPos(p);
PopupMenu1.Popup(p.x, p.y);
end
end;
end;
inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
BorderIcons := [biSystemMenu];
IconCount := 0;
IconData.cbSize := sizeof(IconData);
IconData.Wnd := Handle;
IconData.uID := 100;
IconData.uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
IconData.uCallbackMessage := WM_USER + 1;
IconData.hIcon := Application.Icon.Handle;
StrPCopy(IconData.szTip, Application.Title);
Shell_NotifyIcon(NIM_ADD, @IconData);
Timer1.Interval := 1000;
Timer1.Enabled := true;
end;

procedure TForm1.Open1Click(Sender: TObject);
begin
Form1.Show;
ShowWindow(Application.Handle, SW_HIDE);
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, @IconData);
Application.ProcessMessages;
Application.Terminate;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone;
Form1.Hide;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
case(IconCount) of
0 : IconData.hIcon := LoadIcon(0, IDI_APPLICATION);
1 : IconData.hIcon := LoadIcon(0, IDI_ASTERISK);
2 : IconData.hIcon := LoadIcon(0, IDI_EXCLAMATION);
3 : IconData.hIcon := LoadIcon(0, IDI_HAND);
4 : IconData.hIcon := LoadIcon(0, IDI_QUESTION);
5 : IconData.hIcon := Application.Icon.Handle;
end;
inc(IconCount);
if IconCount > 5 then
IconCount := 0;
Application.Title := TimeToStr(Now);
StrPCopy(IconData.szTip, Application.Title);
Shell_NotifyIcon(NIM_MODIFY, @IconData);
end;

begin
ShowWindow(Application.Handle, SW_HIDE);
end.

[001910]

Содержание раздела