急啊！！最小化到托盘的问题！！

Question

使用ImageList存储动画序列图片，用时钟控制转换。

Answer 1

这个问题我答过很多遍了，真的不想答了。但还是给一下源码吧。
unit fshbx;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, shellapi,
  Menus, ExtCtrls;const WM_NOTIFYICON = WM_USER + 1;
type
  Tserverfrom = class(TForm)
    PopupMenu1: TPopupMenu;
    about1: TMenuItem;
    exit1: TMenuItem;
    Timer1: TTimer;
    procedure exit1Click(Sender: TObject);
    procedure about1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
  private
    check: string;
    Notifydata: Tnotifyicondata;
    procedure addicon;
    procedure removeicon;
    { Private declarations }
  protected
    procedure onnotifyicon(var message: TMessage); message WM_NOTIFYICON;
  public
    { Public declarations }
  end;
var
  serverfrom: Tserverfrom;implementation{$R *.DFM}procedure Tserverfrom.addicon;
begin
  notifydata.cbSize := sizeof(notifydata);
  with notifydata do
  begin
    wnd := handle;
    uid := 1;
    uflags := NIF_TIP or NIF_ICON or NIF_MESSAGE;
    hicon := application.Icon.Handle;
    sztip := '应用服务器';
    ucallbackmessage := WM_NOTIFYICON;
  end;
  shell_notifyicon(NIM_ADD, @notifydata);
end;procedure Tserverfrom.removeicon;
begin
  notifydata.uID := 1;
  shell_notifyicon(NIM_DELETE, @notifydata);
end;procedure Tserverfrom.onnotifyicon(var message: Tmessage);
var
  mousepos: Tpoint;
begin
  if message.lparam = WM_LBUTTONDBLCLK then
    showmessage('不要乱动!');
  if (message.lparam = WM_RBUTTONDBLCLK) then
  begin
    getcursorpos(mousepos);
    setforegroundwindow(application.handle);
    application.ProcessMessages;
    popupmenu1.Popup(mousepos.x, mousepos.y);
  end;
end;procedure Tserverfrom.exit1Click(Sender: TObject);
begin
  removeicon;
  close;
end;procedure Tserverfrom.about1Click(Sender: TObject);
begin
  showmessage('应用服务器');
end;procedure Tserverfrom.FormCreate(Sender: TObject);
begin
  addicon;
  showwindow(application.handle, SW_HIDE);
  Application.ShowMainForm := False;
  check :='-255';
end;procedure Tserverfrom.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  removeicon;
end;procedure Tserverfrom.Timer1Timer(Sender: TObject);
begin
  removeicon;
  if check = '-255' then
  begin
    Application.Icon.LoadFromFile('D:\delphivcl\ico\ico\Funny\grrr!.ico');
    check :='0';
  end
  else
  begin
    Application.Icon.LoadFromFile('D:\delphivcl\ico\ico\Funny\mr remote.ico');
    check :='-255';
  end;
  addicon;
end;end.

Answer 2

最简单的是用一下cooltray控件，很单间设置几个属性就可以！

Answer 3

楼上兄弟，发到[email protected]谢谢！

Answer 4

发一个给我好吗？我给你高分
[email protected]

Answer 5

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,shellapi, Menus, ImgList, XPMenu, ExtCtrls;const
  WM_BARICON=WM_USER+200;
type
  TForm1 = class(TForm)
    XPMenu1: TXPMenu;
    ImageList1: TImageList;
    PopupMenu1: TPopupMenu;
    a1: TMenuItem;
    b1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    procedure N5Click(Sender: TObject);
    procedure a1Click(Sender: TObject);
  private
    { Private declarations }  procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND;
  procedure WMBarIcon(var Message:TMessage);message WM_BARICON; public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}
procedure TForm1.WMSysCommand(var Message:TMessage);
var
  lpData:PNotifyIconData;
begin
if Message.WParam = SC_ICON then
  begin
  //如果用户最小化窗口则将窗口 隐藏并在任务栏上添加图标
  lpData := new(PNotifyIconDataA);
  lpData.cbSize := 88;
  //SizeOf(PNotifyIconDataA);
  lpData.Wnd := Form1.Handle;
  lpData.hIcon := Form1.Icon.Handle;
  lpData.uCallbackMessage := WM_BARICON;
  lpData.uID :=0;
  lpData.szTip := 'Samples';
  lpData.uFlags := NIF_ICON  or NIF_MESSAGE or NIF_TIP;
  Shell_NotifyIcon(NIM_ADD,lpData);
  dispose(lpData);
  Form1.Visible := False;
  end
else
  begin
  //如果是其它的SystemCommand消息则调用系统缺省处理函数处理之。
  DefWindowProc(Form1.Handle,Message.Msg,Message.WParam,Message.LParam);
  end;
//
end;
procedure Tform1.WMBarIcon(var Message:TMessage);
var
  lpData:PNotifyIconData;
begin
if (Message.LParam = WM_LBUTTONDOWN) then
    begin
    //如果用户点击任务栏图标则将图标删除并回复窗口。
    lpData := new(PNotifyIconDataA);
    lpData.cbSize := 88; //SizeOf(PNotifyIconDataA);
    lpData.Wnd := Form1.Handle;
    lpData.hIcon := Form1.Icon.Handle;
    lpData.uCallbackMessage := WM_BARICON;
    lpData.uID :=0;
    lpData.szTip := 'Samples';
    lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
    Shell_NotifyIcon(NIM_DELETE,lpData);
    dispose(lpData);
    Form1.Visible := True;
    end
else
if (Message.LParam = WM_rBUTTONDOWN) then
    begin
      popupmenu1.Popup(mouse.CursorPos.X ,mouse.CursorPos.Y);
    end;end;
procedure TForm1.N5Click(Sender: TObject);
begin
  close;
  
end;procedure TForm1.a1Click(Sender: TObject);
begin
  form1.Show ;
  
end;end.
end.