delphi 给程序加托盘图标

一些程序运行时，会在桌面的右下角显示一个图标（任务栏的右边），这类图标称为 托盘。托盘是一个PNotifyIconDataA类型的结构，要增加托盘图标其实就是对结构PNotifyIconDataA的操作。使用控件CoolTrayIcon是个不错的选择，不过这里也给出简单实现，方便初学者学习。
这里给出实际的例子程序代码，只在form窗体上增加2个默认按钮
1、需要包含shellapi
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, shellapi, Menus;
const
WM_TaskbarIconCallBack=WM_USER+78; //托盘图标返回消息
type
TForm1 = class(TForm)
Button1: TButton;
PopupMenu1: TPopupMenu;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure TaskIcon_add(TitleName: String;ToolPopupMenu_Left,ToolPopupMenu_Right: TPopupMenu);
procedure Button2Click(Sender: TObject);
procedure nihao1Click(Sender: TObject);
procedure TrayMsg(var Msg: TMessage);message WM_TaskbarIconCallBack;
private
{ Private declarations }
PNotify : PNotifyIconDataA; //义托盘图标结构
public
{ Public declarations }
Protected
FPopupMenu_Left,FPopupMenu_Right: TPopupMenu; //义托盘图标结构
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{**********************************************
author/date:
description:给程序增加托盘
参数介绍：
TitleName：图表tip
ToolPopupMenu_Left,ToolPopupMenu_Right:点图标对应的弹出菜单
使用本函数需要包含单元
QMenus
**********************************************}
procedure TForm1.TaskIcon_add(TitleName: String;ToolPopupMenu_Left,ToolPopupMenu_Right: TPopupMenu);
begin
If Assigned(ToolPopupMenu_Left) Then
FPopupMenu_Left:=ToolPopupMenu_Left;
If Assigned(ToolPopupMenu_Right) Then
FPopupMenu_Right:=ToolPopupMenu_Right;
New(PNotify);
with PNotify^ do
begin
Wnd:=self.Handle;
uID:=0;
uFlags:=NIF_ICON+NIF_MESSAGE+NIF_TIP;//托盘的属性
hIcon:=Application.Icon.Handle; //把系统图表作为托盘
uCallbackMessage:=WM_TaskbarIconCallBack;
StrCopy(szTip, PChar(TitleName));
end;
Shell_NotifyIcon(NIM_ADD,PNotify);
end;
//增加系统图标做为托盘图标
procedure TForm1.Button1Click(Sender: TObject);
begin
TaskIcon_add('我是托盘',PopupMenu1,PopupMenu1);
end;
//释放托盘图标
procedure TForm1.Button2Click(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE,PNotify);
end;
//托盘消息相应
procedure TForm1.TrayMsg(var Msg:TMessage);
Var
APoint : TPoint;
Begin
with Msg do
begin
if (Msg = WM_TaskbarIconCallBack) then
begin
GetCursorPos(APoint);
case LParam of
WM_LBUTTONDOWN :
begin
if Assigned(FPopupMenu_Left) Then
FPopupMenu_Left.Popup(APoint.X, APoint.Y);
end;
WM_RBUTTONDOWN :
begin
if Assigned(FPopupMenu_Right) Then
FPopupMenu_Right.Popup(APoint.X, APoint.Y);
end;
end;
end
end;
End;
// if Msg.LParam = WM_LBUTTONDBLCLK then Form1.Show;

procedure TForm1.nihao1Click(Sender: TObject);
begin
showmessage('我是托盘左右键菜单');
end;
end.
如果要实现动态托盘，可以加ontimer事件处理，用函数 Shell_NotifyIcon 动态修改托盘图标
procedure TForm1.Timer1Timer(Sender: TObject);
begin
iconindex:=iconindex+1;
if iconindex=Imagelist1.Count then iconindex:=0;
Imagelist1.GetIcon(iconindex,tempicon);
PNotify.hIcon:=tempicon.Handle;
Shell_NotifyIcon(NIM_MODIFY,@PNotify);
end;