在程序运行时如何改本程序的系统托盘图标

Question

小弟近日做一程序，其中一部分功能是在程序运行时改变本程序的系统托盘图标，请问各位如何实现，有源码或帮助，马上给分

Answer 1

implementationvar
  ID1:      Integer;
  ID2:      Integer;
  ICON1:    TICON;
  ICON2:    TICON;
  ICON3:    TICON;
  ICONData: TNotifyIconData;
  B_eject:  Boolean = True;{$R *.dfm}{ TForm1 }procedure Tfrm_Main.CD_Open;
begin
  MciExecute('Set cdAudio door open');
  B_eject := False;end;procedure Tfrm_Main.CD_Close;
begin
  MciExecute('Set cdAudio door closed');
  B_eject := True;end;procedure Tfrm_Main.HotKey(var Msg: TMessage);
begin
  if (Msg.LParamLo = MOD_CONTROL) and (Msg.LParamHi = 81) then
    begin
    CD_Open;
    SetIcon(1);
    end;
  if (Msg.LParamLo = MOD_CONTROL) and (Msg.LParamHi = 82) then
    begin
    CD_Close;
    SetIcon(2);
    end;end;procedure Tfrm_Main.FormCreate(Sender: TObject);
var
  Reg:     TRegistry;
  AppName: string;
  AppPath: string;
begin  AppName := ExtractFileName(Application.ExeName);
  AppPath := ExtractFilePath(Application.ExeName);  ID1 := GlobalAddAtom('HotKey');
  RegisterHotKey(Handle,ID1,MOD_CONTROL,81);
  ID2 := GlobalAddAtom('HotKey1');
  RegisterHotKey(Handle,ID2,MOD_CONTROL,82);  ICON1 := TICON.Create;
  ICON1.LoadFromFile(PChar(AppPath) + 'ICO\CD.ICO');
  ICON2 := TICON.Create;
  ICON2.LoadFromFile(PChar(AppPath) + 'ICO\CD-OPEN.ICO');
  ICON3 := TICON.Create;
  ICON3.LoadFromFile(PChar(AppPath) + 'ICO\CD-CLOSE.ICO');  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  try
  Reg.OpenKey(Key,True);
  Reg.WriteString('CDROM开关程序',Application.ExeName);
  except
  Application.Terminate;
  end;
  Reg.CloseKey;
  Reg.Free;  InstallIcon;
  Set_Hide;end;procedure Tfrm_Main.FormDestroy(Sender: TObject);
begin  ICON1.Free;
  ICON2.Free;
  ICON3.Free;  UnRegisterHotkey(Handle,ID1);
  UnRegisterHotKey(Handle,ID2);end;procedure Tfrm_Main.Set_Hide;
begin
  SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
  ShowWindow(Handle,SW_HIDE);
  //UpdateWindow(Application.Handle);
end;procedure Tfrm_Main.ICONClick(var Msg: TMessage);
var
  p: TPoint;
begin  if Msg.LParam = WM_LBUTTONDOWN then
    begin
    if B_eject then
      begin
      CD_OPEN;
      SetIcon(1);
      end else
    if not B_eject then
      begin
      CD_CLOSE;
      SetIcon(2);
      end;
    end;
  if Msg.LParam = WM_RBUTTONDOWN then
    begin
    GetCursorPos(p);
    PopupMenu1.Popup(p.X,p.Y);
    PopupMenu1.Items[0].OnClick := HitInfo;
    PopupMenu1.Items[2].OnClick := ExitClick;
    end;end;procedure Tfrm_Main.InstallIcon;
begin  ICONData.cbSize := SizeOf(ICONData);
  SetIcon(0);
  ICONData.szTip := 'CDROM开关';
  ICONData.Wnd := Handle;
  ICONData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  ICONData.uCallbackMessage := WM_USER + 1;
  Shell_NotifyIcon(NIM_ADD,@ICONData);end;procedure Tfrm_Main.SetIcon(ICON: Integer);
var
  h: hIcon;
begin  case ICON of
    0: h := ICON1.Handle;
    1: h := ICON2.Handle;
    2: h := ICON3.Handle;
  end;
  ICONData.hIcon := h;
  Shell_NotifyIcon(NIM_MODIFY,@ICONData);end;procedure Tfrm_Main.ExitClick(Sender: TObject);
begin
  Shell_NotifyIcon(NIM_DELETE,@ICONData);
  Application.Terminate;
end;procedure Tfrm_Main.HitInfo(Sender: TObject);
begin
  //MessageDlg(Info,mtInformation,[mbok],0);
  MessageBox(Handle,Info,'提示信息',MB_OK);
end;procedure Tfrm_Main.FormActivate(Sender: TObject);
begin
  Set_Hide;
end;end.

Answer 2

拉下的
unit Unit1;
interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, Menus, MMSystem, StdCtrls, ShellAPI, Registry;type
  Tfrm_Main = class(TForm)
    PopupMenu1: TPopupMenu;
    ImageList1: TImageList;
    Hit: TMenuItem;
    N2: TMenuItem;
    Exit: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure HotKey(var Msg: TMessage); message WM_HOTKEY;
    procedure ICONClick(var Msg: TMessage); message WM_USER + 1;
    procedure SetIcon(ICON: Integer);
    procedure InstallICON;
    procedure CD_Open;
    procedure CD_Close;
    procedure Set_Hide;
    procedure ExitClick(Sender: TObject);
    procedure HitInfo(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  frm_Main: Tfrm_Main;const
  Info = '************************************' + #13#10 + #13#10 +
         '      鼠标左键奇次单击 CDROM弹出' + #13#10 +
         '      鼠标左键偶次单击 CDROM关闭' + #13#10 +
         '             或是使用' + #13#10 +
         '      全局热键Ctrl+q CDROM弹出' + #13#10 +
         '      全局热键Ctrl+r CDROM关闭' + #13#10 +  #13#10 +
         '************************************' + #13#10 + #13#10 +
         '          程序设计：+ #13#10+ #13#10 +
         '    E-mail: [email protected]';  Key =  'SoftWare\Microsoft\Windows\CurrentVersion\Run';

Answer 3

procedure TForm1.TrayShow(Sender: TObject);
//当点击托盘图标时显示或隐含主窗体
begin
  PopupMenu1.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.hIcon := LoadIcon(0, IDI_WINLOGO);
  //托盘图标的提示信息
  MyTrayIcon.szTip :='定时导数据程序';
  //向托盘中添加图标
  Shell_NotifyIcon(NIM_ADD,@mytrayicon);end;procedure TForm1.WMMyTrayIconCallBack(var Msg: TMessage);
//处理点击托盘图标的事件，根据 WM_MOUSEMOVE 消息的不同情况产生不同的回应
var
  CursorPos : TPoint;
begin
  PopupMenu1.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);
                         PopupMenu1.Popup(CursorPos.x,CursorPos.y);
                       end;
   end//case
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Shell_NotifyIcon(NIM_DELETE, @MyTrayIcon);//删除托盘图标
end;procedure TForm1.FormCreate(Sender: TObject);
begin
   SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);//程序不在任务栏上显示
   TrayShow(Application.MainForm);//显示图标
   flag:=0;
end;procedure TForm1.n_MainFromDispOrHideClick(Sender: TObject);
begin
   if Application.MainForm.Visible then
  begin
     Application.MainForm.Hide;
    end
  else
  begin
    Application.MainForm.Show;
    n_MainFromDispOrHide.Caption :='隐藏主窗体';
  end;end;procedure TForm1.Timer1Timer(Sender: TObject);
var
  ic:TICON;
begin if flag=0 then flag:=1
 else flag:=0; ic:=TICON.Create;
 ImageList1.GetIcon(flag,ic);
 with MyTrayIcon do
  begin
    cbSize := SizeOf(tnotifyicondata);
    uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
    uID := 0;                    ///该是多少啊？
    Wnd := Handle;
    uCallbackMessage := WM_MYTRAYICONCALLBACK;
   // hIcon  :=Application.Icon.Handle ;]
   hicon:=ic.Handle;
   end; Shell_NotifyIcon(NIM_MODIFY,@MyTrayIcon);    ///没有任何效果！
 Application.MainForm.Hide;
 ic.Free;
end;end.

Answer 4

Timer和Shell_NotifyIcon( NIM_MODIFY, @IconData );unit TrayIcon;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus,shellapi, ImgList, ExtCtrls;type
  //----------------------------------------------------------------------
  PNotifyIconData = ^TNotifyIconDataA;
    TNotifyIconDataA = record
    cbSize : DWORD;
    Wnd : HWND;
    uID : UINT;
    uFlags : UINT;
    uCallbackMessage : UINT;
    hIcon : HICON;
    szTip : array [0..63] of AnsiChar;
  end;
  //----------------------------------------------------------------------
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    open1: TMenuItem;
    close1: TMenuItem;
    N1: TMenuItem;
    about1: TMenuItem;
    ImageList1: TImageList;
    Timer1: TTimer;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure open1Click(Sender: TObject);
    procedure close1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    //-------------------------------------------------------------
    Icons: array[0..1] of TIcon;
    IconData: TNotifyIconData;
    procedure ShowIcon;
    procedure IconOnClick(var message:TMessage); message WM_USER+1;
    Procedure WMSysCommand(Var message : TMessage) ; Message WM_SYSCOMMAND ;
    //-------------------------------------------------------------
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}procedure TForm1.IconOnClick( var message: Tmessage);
var p : TPoint;
begin
 if (message.lParam = WM_LBUTTONDOWN) then
 begin
   ShowWindow(Handle, SW_SHOW );
 end;
 
 if (message.lParam = WM_RBUTTONDOWN) then
 begin
   GetCursorPos(p);
   popupmenu1.Popup( p.x ,p.y );
 end;
end;Procedure TForm1.WMSysCommand(Var Message : TMessage) ;
begin  if (Message.WParam = SC_MINIMIZE) then
  begin
       ShowIcon;
  end
  else
     Inherited;end;procedure TForm1.ShowIcon;
begin
      IconData.cbSize := SizeOf( IconData );
      IconData.Wnd := Handle;
      IconData.uID := 1;
      IconData.uFlags := NIF_ICON
      or NIF_MESSAGE or NIF_TIP;
      IconData.uCallBackMessage := WM_USER+1;
      IconData.hIcon := Icons[0].Handle;//application.Icon.Handle;
      IconData.szTip := 'LANChat';
      Shell_NotifyIcon( NIM_ADD, @IconData );
      ShowWindow(Handle, SW_HIDE);
      hide;
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Shell_NotifyIcon( NIM_DELETE, @IconData );
end;procedure TForm1.open1Click(Sender: TObject);
begin
  Form1.Show;
end;procedure TForm1.close1Click(Sender: TObject);
begin
  Form1.close;
end;procedure TForm1.FormShow(Sender: TObject);
begin  showwindow(application.handle,sw_hide);end;procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
  for i:=0 to 1 do
  begin
    Icons[i] := TIcon.Create;
    ImageList1.GetIcon(i,Icons[i]);
  end;
  showicon;
end;procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if IconData.hIcon = Icons[0].Handle then IconData.hIcon := Icons[1].Handle
  else IconData.hIcon := Icons[0].Handle;
  Shell_NotifyIcon( NIM_MODIFY, @IconData );
end;end.

Answer 5

用rxLib的rxTrayIcon，很简单：
rxtrayicon.icons设置图标；
rxtrayicon.animated:=true;
rxtrayicon.active:=True;
rxtrayicon.interval:=50; //anim speed