怎么让程序最小化到托盘，并不停变换图标？

Question

托盘实现，你只要在定时器中改图，就可以实现让它动了，就象qq一样。
下面是托盘技术
一、  实现步骤    
1．  创建一个应用程序，在主窗体上增加一个TpopupMenu组件。并为该弹出菜单组件增加菜单项Exit，标题为“退出”。    
2．  在Uses中添加ShellAPI，因为在系统状态栏中增加图标时需调用ShellAPI函数Shell_NotifyIconA。该函数需要2个参数，其中一个是TnotifyIconDataA结构，需在主窗体中增加TnotifyIconDataA类型全局变量ntida。    
3．  定义消息mousemsg，并编写主窗体的mousemessage消息处理函数，此函数说明在图标上用鼠标左键单击时，会打开应用程序窗口；用鼠标右键单击时，会弹出一个菜单。    
下面给出步骤2和3的实现代码：    
unit  Unit1;    
interface    
uses    
Windows,  Messages,  SysUtils,  Classes,  Graphics,  Controls,  Forms,  Dialogs,    
StdCtrls,  ExtCtrls,  Menus,  shellapi;    
   
const    
mousemsg  =  wm_user  +  1;  //自定义消息，用于处理用户在图标上点击鼠标的事件    
iid  =  100;  //用户自定义数值，在TnotifyIconDataA类型全局变量ntida中使用。    
   
type    
TForm1  =  class(TForm)    
......    
private    
//自定义消息处理函数，处理鼠标点击图标事件    
procedure  mousemessage(var  message:  tmessage);  message  mousemsg;      
public    
{  Public  declarations  }    
end;    
   
var    
Form1:  TForm1;    
ntida:  TNotifyIcondataA;  //用于增加和删除系统状态图标    
implementation    
   
{$R  *.DFM}    
   
procedure  TForm1.mousemessage(var  message:  tmessage);    
var    
mousept:  TPoint;  //鼠标点击位置    
begin    
inherited;    
if  message.LParam  =  wm_rbuttonup  then  begin  //用鼠标右键点击图标    
getcursorpos(mousept);  //获取光标位置    
popupmenu1.popup(mousept.x,  mousept.y);  //在光标位置弹出菜单    
end;    
if  message.LParam  =  wm_lbuttonup  then  begin  //用鼠标左键点击图标    
//显示应用程序窗口    
ShowWindow(Handle,  SW_SHOW);    
//在任务栏上显示应用程序窗口    
ShowWindow(Application.handle,  SW_SHOW);    
SetWindowLong(Application.Handle,  GWL_EXSTYLE,    
not  (GetWindowLong(Application.handle,  GWL_EXSTYLE)    
or  WS_EX_TOOLWINDOW  AND  NOT  WS_EX_APPWINDOW));    
end;    
message.Result  :=  0;    
end    
4．  编辑TForm1.FormCreate(Sender:  TObject)    
应用程序开始运行时，在系统状态栏上生成图标显示，代码如下：    
procedure  TForm1.FormCreate(Sender:  TObject);    
begin    
ntida.cbSize  :=  sizeof(tnotifyicondataa);  //指定ntida的长度    
ntida.Wnd  :=  handle;  //取应用程序主窗体的句柄    
ntida.uID  :=  iid;  //用户自定义的一个数值，在uCallbackMessage参数指定的消息中使用    
ntida.uFlags  :=  nif_icon  +  nif_tip  +  nif_message;//指定在该结构中uCallbackMessage、hIcon、szTip参数都有效    
ntida.uCallbackMessage  :=  mousemsg;//指定的窗口消息    
ntida.hIcon  :=  Application.Icon.handle;//指定系统状态栏显示应用程序的图标句柄    
ntida.szTip  :=  'Icon';  //当鼠标停留在系统状态栏该图标上时，出现该提示信息    
shell_notifyicona(NIM_ADD,  @ntida);  //在系统状态栏增加一个新图标    
end;    
5．  编辑Tform1.OnClose    
当用户关闭应用程序窗口时，该窗口和任务栏上相应的应用程序窗口都消失，但程序并没有退出。代码如下：    
procedure  TForm1.FormClose(Sender:  TObject;  var  Action:  TCloseAction);    
begin    
Action  :=  caNone;  //不对窗体进行任何操作    
ShowWindow(Handle,  SW_HIDE);  //隐藏主窗体    
//隐藏应用程序窗口在任务栏上的显示    
ShowWindow(Application.Handle,  SW_HIDE);    
SetWindowLong(Application.Handle,  GWL_EXSTYLE,    
GetWindowLong(Application.handle,  GWL_EXSTYLE)    
or  WS_EX_TOOLWINDOW  AND  NOT  WS_EX_APPWINDOW);    
end;    
6．  编辑弹出菜单Exit    
当用户点击该菜单时完全退出应用程序。代码如下：    
procedure  TForm1.ExitClick(Sender:  TObject);    
begin    
//为ntida赋值，指定各项参数    
ntida.cbSize  :=  sizeof(tnotifyicondataa);    
ntida.wnd  :=  handle;    
ntida.uID  :=  iid;    
ntida.uFlags  :=  nif_icon  +  nif_tip  +  nif_message;    
ntida.uCallbackMessage  :=  mousemsg;    
ntida.hIcon  :=  Application.Icon.handle;    
ntida.szTip  :=  'Icon';    
shell_notifyicona(NIM_DELETE,  @ntida);  //删除已有的应用程序图标    
Application.Terminate;  //中断应用程序运行，退出应用程序    
end;    
 
---------------------------------------------------------------  
 
const  WM_MYTRAYICONCALLBACK  =  WM_USER  +  1000;  
 
type  
   TForm1  =  class(TForm)  
       ...  
       n_MainFromDispOrHide:  TMenuItem;  
   private  
       {  Private  declarations  }  
       MyTrayIcon  :  TNotifyIconData;      //定义一个托盘图标的类  
       procedure  TrayShow(Sender:  TObject);  
       procedure  WMMyTrayIconCallBack(var  Msg  :  TMessage);  //处理点击托盘图标的事件  
           message  WM_MYTRAYICONCALLBACK;  
       procedure  n_MainFromDispOrHideClick(Sender:  TObject);  
       procedure  FormCreate(Sender:  TObject);  
       procedure  FormClose(Sender:  TObject;  var  Action:  TCloseAction);  
   ...  
end;  
 
procedure  TForm1.TrayShow(Sender:  TObject);  
//当点击托盘图标时显示或隐含主窗体  
begin  
   TrayBarPopMenu.AutoPopup:=False;  
   //设定  TNotifyIconData  的记录长度  
   MyTrayIcon.cbSize  :=SizeOf(tnotifyicondata);  
   //确定调用程序的窗体句柄  
   MyTrayIcon.Wnd  :=Handle;  
   //确定图标的  uID  
   MyTrayIcon.uID  :=1;  
   //设定显示标记  
   MyTrayIcon.uFlags  :=NIF_ICON  or  NIF_TIP  or  NIF_MESSAGE;  
   //用户自定义消息  
   MyTrayIcon.uCallbackMessage  :=  WM_MYTRAYICONCALLBACK;  
   //托盘图标的句柄  
   MyTrayIcon.hIcon  :=  Application.Icon.Handle;  
   //托盘图标的提示信息  
   MyTrayIcon.szTip  :='定时导数据程序';  
   //向托盘中添加图标  
   Shell_NotifyIcon(NIM_ADD,@mytrayicon);  
end;  
 
procedure  TForm1.WMMyTrayIconCallBack(var  Msg:  TMessage);  
//处理点击托盘图标的事件，根据  WM_MOUSEMOVE  消息的不同情况产生不同的回应  
var  
   CursorPos  :  TPoint;  
begin  
   TrayBarPopMenu.AutoPopup:=False;  
   case  Msg.lParam  of  
       //左键按下  
       WM_LBUTTONDOWN  :  begin  
                                             application.MainForm.BringToFront;      //窗体置前  
                                         end;  
       //左键双击  
       WM_LBUTTONDBLCLK  :  begin                                                                //窗体隐含或显示  
                                                 Application.MainForm.Visible  :=  not  Application.MainForm.Visible;  
                                                 SetForegroundWindow(Application.Handle);  
                                             end;  
       //右键按下  
       WM_RBUTTONDOWN  :      begin                                                                //显示弹出菜单  
                                                 GetCursorPos(CursorPos);  
                                                 TrayBarPopMenu.Popup(CursorPos.x,CursorPos.y);  
                                             end;  
     end//case  
end;  
 
procedure  TForm1.n_MainFromDispOrHideClick(Sender:  TObject);  
begin  
   if  Application.MainForm.Visible  then  
   begin  
       if  FormStep1.Showing  Then  FormStep1.Hide;  
       if  FormStep2.Showing  Then  FormStep2.Hide;  
       Application.MainForm.Hide;  
       n_MainFromDispOrHide.Caption  :='显示主窗体';  
   end  
   else  
   begin  
       Application.MainForm.Show;  
       n_MainFromDispOrHide.Caption  :='隐藏主窗体';  
   end;  
end;  
 
procedure  TForm1.FormCreate(Sender:  TObject);  
begin  
   SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);//程序不在任务栏上显示  
   TrayShow(Application.MainForm);//显示图标  
end;  
 
procedure  TForm1.FormClose(Sender:  TObject;  var  Action:  TCloseAction);  
begin  
   Shell_NotifyIcon(NIM_DELETE,  @MyTrayIcon);//删除托盘图标  
end;    
 
---------------------------------------------------------------  
 
就是托盘技术，这种答案太多了，搜索一下可以找到非常多啊。

Answer 1

用rx的vcl吧，做的很经典
只是rx没有出delphi6版本的。
不过，我把这个控件单独提出来了，可在delphi6下用，要不要

Answer 2

我还将它改造的可以显示Balloon Tooltips，只要调用ShowBalloonTips方法就可以。要的话留下email.

Answer 3

你最好找一个有原码的控件，比如RX LIB里就有，这个控件很容易找到

Answer 4

有一个cooltrayicon的托盘控件
实现这个很简单

Answer 5

trayicon控件可以实现一切你想要的。

Answer 6

to  netlib(河外孤星):
用你的方法点右键弹出菜单后,鼠标再点击空白地方菜单不会消失,一定要点了菜单才行.
让图标不停变动,这一句怎么改? ntida.hIcon:=Application.Icon.handle;  to happyjoe(尘土飞扬):
发一个吧,
[email protected]

Answer 7

netlib(河外孤星) (  ) 信誉：105
写的很好！！！！！

Answer 8

netlib(河外孤星) (  ) 信誉：105
写的很好！！！！！

Answer 9

给你一个纯C的框架
#include <windows.h>
#include <stdio.h>
#include <shellapi.h>
#include <memory.h>
#include <io.h>
#include <fcntl.h>
#include <dir.h>
#include <shellapi.h>#define WIDTH  280
#define HEIGHT 28char *app_name="receiver";
HICON myicon;
#define iconmessage     (WM_USER+0x10001)long PASCAL WndProc(HWND hwnd, UINT msg, WPARAM wParam, LONG lParam );int WINAPI WinMain(HINSTANCE inst, HINSTANCE prev_inst, LPSTR cmd_line, int cmd_show )
{  HWND      hwnd;
   MSG       msg;
   WNDCLASS  wnd_class;
   // Register the Window Class and Procedure   myicon=(HICON)LoadImage(NULL,"receiver.ico",IMAGE_ICON,LR_DEFAULTSIZE,LR_DEFAULTSIZE,LR_LOADFROMFILE);
   icon2=(HICON)LoadImage(NULL,"xxxx.ico",IMAGE_ICON,LR_DEFAULTSIZE,LR_DEFAULTSIZE,LR_LOADFROMFILE);
   if ( ! prev_inst )
   {   wnd_class.style           = CS_HREDRAW | CS_VREDRAW;
       wnd_class.lpfnWndProc     = WndProc;
       wnd_class.cbClsExtra      = 0;
       wnd_class.cbWndExtra      = 0;
       wnd_class.hInstance       = inst;
       wnd_class.hIcon           = myicon;
       wnd_class.hCursor         = LoadCursor ( NULL,IDC_ARROW);
       wnd_class.hbrBackground   = CreateSolidBrush(RGB(214,211,206));
       wnd_class.lpszMenuName    = app_name;
       wnd_class.lpszClassName   = app_name;
       RegisterClass ( &wnd_class );
   }
   // Create the Main Window
   hwnd = CreateWindow ( app_name, app_name,
                         WS_OVERLAPPED|WS_CAPTION|WS_SYSMENU|WS_THICKFRAME|WS_MINIMIZEBOX,
                         10,//(GetSystemMetrics(SM_CXSCREEN)-WIDTH),
                         10,//GetSystemMetrics(SM_CYSCREEN)-HEIGHT*2,
                         WIDTH,HEIGHT,
                         NULL,NULL, inst, NULL);
   if (hwnd==NULL) return 0;
   // Display the window
   ShowWindow(hwnd,SW_HIDE);
   UpdateWindow(hwnd);   while (GetMessage(&msg,NULL,0,0))
   {   TranslateMessage(&msg );
       DispatchMessage(&msg );
   }
   return  msg.wParam;
}void AddTrayIcon(HWND hwnd,char *msg)
{  NOTIFYICONDATA icondata;
   memset(&icondata,0,sizeof(icondata));
   icondata.cbSize=sizeof(icondata);
   icondata.hWnd=hwnd;
   strncpy(icondata.szTip,msg,sizeof(icondata.szTip));
   icondata.hIcon=myicon;
   icondata.uCallbackMessage=iconmessage;
   icondata.uFlags=NIF_MESSAGE|NIF_ICON|NIF_TIP;
   Shell_NotifyIcon(NIM_ADD,&icondata);
}void RemoveTrayIcon(HWND hwnd)
{  NOTIFYICONDATA icondata;
   memset(&icondata,0,sizeof(icondata));
   icondata.cbSize=sizeof(icondata);
   icondata.hWnd=hwnd;
   Shell_NotifyIcon(NIM_DELETE,&icondata);
}void ModifyTrayMsg(HWND hwnd,char *msg)
{  NOTIFYICONDATA icondata;
   memset(&icondata,0,sizeof(icondata));
   icondata.cbSize=sizeof(icondata);
   icondata.hWnd=hwnd;
   strncpy(icondata.szTip,msg,sizeof(icondata.szTip));
   icondata.uFlags=NIF_TIP;
   Shell_NotifyIcon(NIM_MODIFY,&icondata);
}void ModifyTrayIcon(HWND hwnd,HICON icon)
{  NOTIFYICONDATA icondata;
   memset(&icondata,0,sizeof(icondata));
   icondata.cbSize=sizeof(icondata);
   icondata.hWnd=hwnd;
   icondata.hIcon=icon;
   icondata.uFlags=NIF_ICON;
   Shell_NotifyIcon(NIM_MODIFY,&icondata);
}case WM_CREATE:
       AddTrayIcon(hwnd,"receiver");case WM_TIMER :
       ModifyTrayMsg(hwnd,"test");
       if (xxx)   ModifyTrayIcon(hwnd,icon2);
       else ModifyTrayIcon(hwnd,myicon);

Answer 10

unit SysTray;interfaceuses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls, Forms, Dialogs,
  ShellApi, ExtCtrls, Menus, StdCtrls;const
  WM_SYSTRAY = WM_USER + 1;
  IDI_TRAYICON = 0;type
  TPopupMode = set of(pmLeftClick, pmRightClick, pmLeftDblClick, pmRightDblClick);
  TMouseEvent= procedure(Sender: TObject;
                         Button: TMouseButton;
                         X, Y: Integer) of object;  TSysTray = class(TComponent)
  private
    { Private declarations }
    FIcon: TIcon;
    FIconData: TNotifyIconData;
    FParentWindow: HWnd;
    FWindowHandle: HWnd;
    FHint: string;
    FPopupMenu: TPopupMenu;
    FPopupAlign: TPopupAlignment;
    FPopupMode: TPopupMode;
    FActive: boolean;
    FShowDesigning: boolean;    FOnIconMouseDown: TMouseEvent;
    FOnIconDoubleClick: TMouseEvent;    function AddIcon: boolean;
    function DeleteIcon: boolean;
    function ModifyIcon: boolean;    procedure SetIcon(Icon: TIcon);
    procedure SetHint(Hint: string);
    procedure SetActive(Value: boolean);
    procedure SetShowDesigning(Value: boolean);
    procedure FillDataStructure;    procedure WndProc(var Msg: TMessage); message WM_SYSTRAY;  protected
    { Protected declarations }  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;  published
    { Published declarations }
    property Active: boolean read FActive write SetActive;
    property ShowDesigning: boolean read FShowDesigning write SetShowDesigning;
    property Icon: TIcon Read FIcon write SetIcon;
    property Hint: string read FHint write SetHint;
    property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
    property PopupMode: TPopupMode read FPopupMode write FPopupMode;
    property PopupAlign: TPopupAlignment read FPopupAlign write FPopupAlign;    property OnIconDoubleClick:TMouseEvent
             read FOnIconDoubleClick write FOnIconDoubleClick;
    property OnIconMouseDown:TMouseEvent
             read FOnIconMouseDown write FOnIconMouseDown ;
  end;procedure Register;implementationconstructor TSysTray.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIcon := TIcon.Create;
  FHint := 'SysTray Component.';
  FPopupMode := [pmRightClick];
  FPopupAlign := paRight;
  FActive := false;
  FShowDesigning := false;  if (AOwner <> nil) and (AOwner is TForm) then
    FParentWindow := TForm(AOwner).Handle
  else
    FParentWindow := 0;  FWindowHandle := AllocateHWnd(WndProc);  FillDataStructure;
end;destructor TSysTray.Destroy;
begin
  try
    if (not (csDesigning in ComponentState) and FActive)
       or ((csDesigning in ComponentState) and FShowDesigning) then
          DeleteIcon;
  finally
    FIcon.Free;
    DeallocateHWnd(FWindowHandle);
  end;
  inherited Destroy;
end;function TSysTray.AddIcon: boolean;
begin
  FillDataStructure;
  Result := Shell_NotifyIcon(NIM_ADD, @FIconData);
end;function TSysTray.DeleteIcon: boolean;
begin
  Result := Shell_NotifyIcon(NIM_DELETE, @FIconData);
end;function TSysTray.ModifyIcon: boolean;
begin
  FillDataStructure;
  if FActive then
    Result := Shell_NotifyIcon(NIM_MODIFY, @FIconData)
  else
    Result := true;
end;procedure TSysTray.SetIcon(Icon: TIcon);
begin
  FIcon.Assign(Icon);
  ModifyIcon;
end;procedure TSysTray.SetHint(Hint: string);
begin
  if Length(Hint) >= 64 then Hint := Copy(Hint, 1, 63);
  FHint := Hint;
  ModifyIcon;
end;procedure TSysTray.SetActive(Value: boolean);
begin
  if Value <> FActive then
  begin
    FActive := Value;
    if not (csDesigning in ComponentState) then
    begin
      case Value of
        true:    AddIcon;
        false:   DeleteIcon;
      end;
    end;
  end;
end;procedure TSysTray.SetShowDesigning(Value: boolean);
begin
  if (csDesigning in ComponentState) then
  begin
    if Value <> FShowDesigning then
    begin
      FShowDesigning := Value;
      case Value of
        true:    AddIcon;
        false:   DeleteIcon;
      end;
    end;
  end;
end;procedure TSysTray.FillDataStructure;
begin
  With FIconData do
  begin
    uCallbackMessage:=WM_SYSTRAY;
    cbSize := SizeOf(FIconData);
    uID := IDI_TRAYICON;
    wnd := FWindowHandle;
    hIcon := FIcon.Handle;
    StrCopy(FIconData.szTip, PChar(FHint));
    uFlags := NIF_ICON + NIF_TIP + NIF_MESSAGE;
  end;
end;procedure TSysTray.WndProc(var Msg: TMessage);
var
  P: TPoint;
begin
  if (Msg.WParam <> IDI_TRAYICON) then exit;
  if Assigned(FPopupMenu) then
    FPopupMenu.Alignment := FPopupAlign;  GetCursorPos(p);
  case Msg.LParam of
    WM_LBUTTONDOWN:
      begin
        if (pmLeftClick in FPopupMode) and Assigned(FPopupMenu) then
        begin
          SetForegroundWindow(FParentWindow);
          FPopupMenu.Popup(p.x,p.y);
        end;
        if Assigned(FOnIconMouseDown) then
        begin
          SetForegroundWindow(FParentWindow);
          FOnIconMouseDown(Self, mbLeft, p.x, p.y);
        end;
      end;    WM_RBUTTONDOWN:
      begin
        if (pmRightClick in FPopupMode) and Assigned(FPopupMenu) then
        begin
          SetForegroundWindow(FParentWindow);
          FPopupMenu.Popup(p.x,p.y);
        end;
        if Assigned(FOnIconMouseDown) then
        begin
          SetForegroundWindow(FParentWindow);
          FOnIconMouseDown(Self, mbRight, p.x, p.y);
        end;
      end;    WM_LBUTTONDBLCLK:
      begin
        if (pmLeftDblClick in FPopupMode) and Assigned(FPopupMenu) then
        begin
          SetForegroundWindow(FParentWindow);
          FPopupMenu.Popup(p.x,p.y);
        end;
        if Assigned(FOnIconDoubleClick) then
        begin
          SetForegroundWindow(FParentWindow);
          FOnIconDoubleClick(Self, mbLeft, p.x, p.y);
        end;
      end;    WM_RBUTTONDBLCLk:
      begin
        if (pmRightDblClick in FPopupMode) and Assigned(FPopupMenu) then
        begin
          SetForegroundWindow(FParentWindow);
          FPopupMenu.Popup(p.x,p.y);
        end;
        if Assigned(FOnIconDoubleClick) then
        begin
          SetForegroundWindow(FParentWindow);
          FOnIconDoubleClick(Self, mbRight, p.x, p.y);
        end;
      end;    else
      Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
  end;
end;end.

Answer 11

unit SysTray;interfaceuses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls, Forms, Dialogs,
  ShellApi, ExtCtrls, Menus, StdCtrls;const
  WM_SYSTRAY = WM_USER + 1;
  IDI_TRAYICON = 0;type
  TPopupMode = set of(pmLeftClick, pmRightClick, pmLeftDblClick, pmRightDblClick);
  TMouseEvent= procedure(Sender: TObject;
                         Button: TMouseButton;
                         X, Y: Integer) of object;  TSysTray = class(TComponent)
  private
    { Private declarations }
    FIcon: TIcon;
    FIconData: TNotifyIconData;
    FParentWindow: HWnd;
    FWindowHandle: HWnd;
    FHint: string;
    FPopupMenu: TPopupMenu;
    FPopupAlign: TPopupAlignment;
    FPopupMode: TPopupMode;
    FActive: boolean;
    FShowDesigning: boolean;    FOnIconMouseDown: TMouseEvent;
    FOnIconDoubleClick: TMouseEvent;    function AddIcon: boolean;
    function DeleteIcon: boolean;
    function ModifyIcon: boolean;    procedure SetIcon(Icon: TIcon);
    procedure SetHint(Hint: string);
    procedure SetActive(Value: boolean);
    procedure SetShowDesigning(Value: boolean);
    procedure FillDataStructure;    procedure WndProc(var Msg: TMessage); message WM_SYSTRAY;  protected
    { Protected declarations }  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;  published
    { Published declarations }
    property Active: boolean read FActive write SetActive;
    property ShowDesigning: boolean read FShowDesigning write SetShowDesigning;
    property Icon: TIcon Read FIcon write SetIcon;
    property Hint: string read FHint write SetHint;
    property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
    property PopupMode: TPopupMode read FPopupMode write FPopupMode;
    property PopupAlign: TPopupAlignment read FPopupAlign write FPopupAlign;    property OnIconDoubleClick:TMouseEvent
             read FOnIconDoubleClick write FOnIconDoubleClick;
    property OnIconMouseDown:TMouseEvent
             read FOnIconMouseDown write FOnIconMouseDown ;
  end;procedure Register;implementationconstructor TSysTray.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIcon := TIcon.Create;
  FHint := 'SysTray Component.';
  FPopupMode := [pmRightClick];
  FPopupAlign := paRight;
  FActive := false;
  FShowDesigning := false;  if (AOwner <> nil) and (AOwner is TForm) then
    FParentWindow := TForm(AOwner).Handle
  else
    FParentWindow := 0;  FWindowHandle := AllocateHWnd(WndProc);  FillDataStructure;
end;destructor TSysTray.Destroy;
begin
  try
    if (not (csDesigning in ComponentState) and FActive)
       or ((csDesigning in ComponentState) and FShowDesigning) then
          DeleteIcon;
  finally
    FIcon.Free;
    DeallocateHWnd(FWindowHandle);
  end;
  inherited Destroy;
end;function TSysTray.AddIcon: boolean;
begin
  FillDataStructure;
  Result := Shell_NotifyIcon(NIM_ADD, @FIconData);
end;function TSysTray.DeleteIcon: boolean;
begin
  Result := Shell_NotifyIcon(NIM_DELETE, @FIconData);
end;function TSysTray.ModifyIcon: boolean;
begin
  FillDataStructure;
  if FActive then
    Result := Shell_NotifyIcon(NIM_MODIFY, @FIconData)
  else
    Result := true;
end;procedure TSysTray.SetIcon(Icon: TIcon);
begin
  FIcon.Assign(Icon);
  ModifyIcon;
end;procedure TSysTray.SetHint(Hint: string);
begin
  if Length(Hint) >= 64 then Hint := Copy(Hint, 1, 63);
  FHint := Hint;
  ModifyIcon;
end;procedure TSysTray.SetActive(Value: boolean);
begin
  if Value <> FActive then
  begin
    FActive := Value;
    if not (csDesigning in ComponentState) then
    begin
      case Value of
        true:    AddIcon;
        false:   DeleteIcon;
      end;
    end;
  end;
end;procedure TSysTray.SetShowDesigning(Value: boolean);
begin
  if (csDesigning in ComponentState) then
  begin
    if Value <> FShowDesigning then
    begin
      FShowDesigning := Value;
      case Value of
        true:    AddIcon;
        false:   DeleteIcon;
      end;
    end;
  end;
end;procedure TSysTray.FillDataStructure;
begin
  With FIconData do
  begin
    uCallbackMessage:=WM_SYSTRAY;
    cbSize := SizeOf(FIconData);
    uID := IDI_TRAYICON;
    wnd := FWindowHandle;
    hIcon := FIcon.Handle;
    StrCopy(FIconData.szTip, PChar(FHint));
    uFlags := NIF_ICON + NIF_TIP + NIF_MESSAGE;
  end;
end;procedure TSysTray.WndProc(var Msg: TMessage);
var
  P: TPoint;
begin
  if (Msg.WParam <> IDI_TRAYICON) then exit;
  if Assigned(FPopupMenu) then
    FPopupMenu.Alignment := FPopupAlign;  GetCursorPos(p);
  case Msg.LParam of
    WM_LBUTTONDOWN:
      begin
        if (pmLeftClick in FPopupMode) and Assigned(FPopupMenu) then
        begin
          SetForegroundWindow(FParentWindow);
          FPopupMenu.Popup(p.x,p.y);
        end;
        if Assigned(FOnIconMouseDown) then
        begin
          SetForegroundWindow(FParentWindow);
          FOnIconMouseDown(Self, mbLeft, p.x, p.y);
        end;
      end;    WM_RBUTTONDOWN:
      begin
        if (pmRightClick in FPopupMode) and Assigned(FPopupMenu) then
        begin
          SetForegroundWindow(FParentWindow);
          FPopupMenu.Popup(p.x,p.y);
        end;
        if Assigned(FOnIconMouseDown) then
        begin
          SetForegroundWindow(FParentWindow);
          FOnIconMouseDown(Self, mbRight, p.x, p.y);
        end;
      end;    WM_LBUTTONDBLCLK:
      begin
        if (pmLeftDblClick in FPopupMode) and Assigned(FPopupMenu) then
        begin
          SetForegroundWindow(FParentWindow);
          FPopupMenu.Popup(p.x,p.y);
        end;
        if Assigned(FOnIconDoubleClick) then
        begin
          SetForegroundWindow(FParentWindow);
          FOnIconDoubleClick(Self, mbLeft, p.x, p.y);
        end;
      end;    WM_RBUTTONDBLCLk:
      begin
        if (pmRightDblClick in FPopupMode) and Assigned(FPopupMenu) then
        begin
          SetForegroundWindow(FParentWindow);
          FPopupMenu.Popup(p.x,p.y);
        end;
        if Assigned(FOnIconDoubleClick) then
        begin
          SetForegroundWindow(FParentWindow);
          FOnIconDoubleClick(Self, mbRight, p.x, p.y);
        end;
      end;    else
      Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
  end;
end;end.

Answer 12

要变换图标可以改变以上控件的TSysTray.Icon!实际上就是调用了API:Shell_NotifyIcon(NIM_MODIFY, @FIconData)进行重载!

Answer 13

在Delphi中用好图标资源
邓家宏  
图标是组成应用程序的重要资源，我们的设计目标是让程序标题栏上的图标交替显示，形成动画效果。方法一：调用图标文件
1.首先在窗体中添加一变量，控制图标交替显示，语句如下：varForm1: TForm1;ico:integer;//添加这一句双击窗体为其OnCreat事件添加代码，如下：ico:=12.在窗体中添加一时钟控件，设置其Interal属性为100(即两个图标交替出现的时间间隔)，为OnTimer事件添加代码，如下：if ico=1 thenbeginform1.icon.LoadFromFile('d:\amydocu\ico1.ico')//显示图标1ico:=2endelsebeginform1.icon.LoadFromFile('d:\amydocu\ico2.ico') //显示图标2ico:=1;end;3.运行窗体，即可得到动画图标。方法二：利用程序中的图标资源
方法一设计出的程序在发布时，必须带上图标文件，否则无法运行。为了克服这一缺点，我们可以将图标文件做成资源文件，将其包含在执行文件中，使程序更专业化，他人想轻易改变图标也较困难。1.首先建立资源文件demo.rc，它是一个文本文件，包含如下内容：ico1 icon D:\amydocu\ico1.icoico2 icon D:\amydocu\ico2.ico2.在DOS提示符下利用Delphi提供的资源编译器brcc32.exe将其编译成demo.res，命令如下：brcc32 demo.rc3.将生成的demo.res加入程序中，可以在窗体中加入如下代码：implementation{$R *.DFM}{$R d:\amydocu\resource.res}4.使用图标资源，将方法一中时钟控件的OnTimer事件改为如下代码：if ico=1 thenbeginform1.Icon.Handle:=Loadicon(hinstance,'ico1');ico:=2;endelsebeginform1.Icon.Handle:=Loadicon(hinstance.'ico2');ico:=1;end;