如何动态改变Windows右下角程序图标？

Question

我做了一个程序想实现跟QQ类似的动态改变右下角图标，请高手帮忙！谢谢！

Answer 1

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;

Answer 2

完整的:unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, shellapi;type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    Timer1: TTimer;
    open1: TMenuItem;
    exit1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure open1Click(Sender: TObject);
    procedure exit1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
  private
    procedure wndproc(var msg:tmessage);override;
    { Private declarations }
  public
    icondata:tnotifyicondata;
    iconcount:integer;
    { Public declarations }
  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;
      WM_LBUTTONDBLCLK:
        begin
          form1.Show;
          showwindow(application.Handle ,sw_hide);
        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;end.

Answer 3

有现成的控件
名称：trayicon
很好用的,不防试试