如何用delphi做成应用程序先qq一样在状态栏显示图标？（在线）

Question

如何用delphi做成应用程序先qq一样在状态栏显示图标？（

Answer 1

某些程序运行启动后并不出现在任务条中，而是缩小为任务条右下角的一个小图标，当鼠标移到这个小图标上时会出现一些提示信息、单击该小图标会执行一些特定的操作。便如任务条右下角的小喇叭图标，单击它会弹出一个简单的音量控制条，双击会启动另一个更大的音量控制程序。
　　在Shell32.DLL动态链接库中包括一个函数Shell_NotifyIconA()可通知Windows在任务条右下角加入一个小图标，可惜该函数的详细说明未收入Delphi的帮助文档中，下面以一个简单的实例来说明如果使用该函数。unit Unit1;interface{ 记住在uses部分中包括 ShellAPI}uses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls, Forms, Dialogs,
  ShellAPI, StdCtrls;{自定义消息，当小图标捕捉到鼠标事件时Windows向回调函数发送此消息}
const MY_MESSAGE = WM_USER + 100;type
  TForm1 = class(TForm)
  procedure FormCreate(Sender: TObject);
  procedure FormClose(Sender: TObject; var Action: TCloseAction);
  procedure FormPaint(Sender: TObject);
  private
    procedure OnIconNotify(var Message: TMessage);
      message MY_MESSAGE;
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}{当小图标捕捉到鼠标事件时进入此过程}
procedure TForm1.OnIconNotify(var Message: TMessage);
const
  Busy: Boolean = false;
begin
  if not Busy then begin    Busy := true;
    if Message.LParam=WM_LBUTTONDOWN then
      if Application.MessageBox('Are you sure',
         'Exit', MB_YESNO)=IDYES then Close;
    Busy := false;
  end;
end;{当主Form建立时通知Windows加入小图标}
procedure TForm1.FormCreate(Sender: TObject);
var
  nid: TNotifyIconData;
begin
  nid.cbSize := sizeof(nid); // nid变量的字节数
  nid.Wnd := Handle; // 主窗口句柄
  nid.uID := -1; // 内部标识，可设为任意数
  nid.hIcon := Application.Icon.Handle; // 要加入的图标句柄，可任意指定
  nid.szTip := 'This is a test application'; // 提示字符串
  nid.uCallbackMessage := MY_MESSAGE; // 回调函数消息  nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE; // 指明哪些字段有效
  if not Shell_NotifyIcon(NIM_ADD, @nid) then begin
    ShowMessage('Failed!');
    Application.Terminate;
  end;
  {将程序的窗口样式设为TOOL窗口，可避免在任务条上出现}
  SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;{程序被关闭时通知Windows去掉小图标}
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  nid: TNotifyIconData;
begin
  nid.cbSize := sizeof(nid); // nid变量的字节数
  nid.uID := -1; //内部标识，与加入小图标时的数一致
  nid.Wnd := Handle; //主窗口句柄
  Shell_NotifyIcon(NIM_DELETE, @nid); //去掉小图标end;{主窗口初始化完毕并显示时将激活Paint重画事件，此时将主窗口隐藏}
procedure TForm1.FormPaint(Sender: TObject);
begin
  Hide;
end;end.
 　　上例中将程序的图标放在任务条右下角，然后隐藏自身，当用户移动鼠标至该图标上时会看到提示字符串，如果单击该图标会出现一个对话框，选择Yes退出程序并清除小图标。

Answer 2

也给你贴个吧！pmMain中个弹出菜单，为打开窗体和退出程序功能
unit umain;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ShellApi, AppEvnts, Menus;const
  WM_NID = WM_USER + 200;type
  TfrmIcon = class(TForm)
    pmMain: TPopupMenu;
    pmOpen: TMenuItem;
    N2: TMenuItem;
    pmExit: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure pmOpenClick(Sender: TObject);
    procedure pmExitClick(Sender: TObject);
  private
    { Private declarations }
    NotifyIcon: TNotifyIconData;
    procedure IconOnClick(var Msg: TMessage); message WM_NID;
    procedure AddIcon;
    procedure DelIcon;
    procedure WMSYSCOMMAND(var Msg: TMessage); message WM_SYSCOMMAND;
    procedure OnMinimize(Sender: TObject);
  public
    { Public declarations }
  end;var
  frmIcon: TfrmIcon;implementation{$R *.dfm}procedure TfrmIcon.FormCreate(Sender: TObject);
begin
  Application.HintColor := clLime;
  self.ShowHint := true;
  self.Hint := '托盘编程窗体';
  Application.OnMinimize := OnMinimize;
end;procedure TfrmIcon.AddIcon;
begin
  with NotifyIcon do
  begin
    cbSize := SizeOf(TNotifyIconData);
    Wnd := self.Handle;
    uID := 1;     {若有多个，则以此为标志}
    uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
    uCallBackMessage := WM_NID;
    hIcon := Application.Icon.Handle;
    szTip := '我的托盘窗体';
  end;   
  ShowWindow(Application.Handle, SW_HIDE);
  Application.Minimize;
  self.Hide;
  Shell_NotifyIcon(NIM_ADD, @NotifyIcon);
end;procedure TfrmIcon.DelIcon;
begin
  ShowWindow(Application.Handle, SW_SHOW);
  Application.Restore;
  self.Show;        
  SetForegroundWindow(Self.Handle);  
  Shell_NotifyIcon(NIM_DELETE, @NotifyIcon); 
end;procedure TfrmIcon.OnMinimize(Sender: TObject);
begin
  AddIcon;
end;procedure TfrmIcon.IconOnClick(var Msg: TMessage);
var
  mp: TPoint;
begin
  if Msg.LParam = WM_LBUTTONDBLCLK then
    DelIcon
  else if Msg.LParam = WM_RBUTTONUP then
  begin
    GetCursorPos(mp);
    SetForegroundWindow(self.Handle); {解决弹出右键菜单后不操作不消失问题}
    pmMain.Popup(mp.X, mp.Y);
  end
  else
    Inherited;
end;procedure TfrmIcon.WMSYSCOMMAND(var Msg: TMessage);
begin
  if Msg.WParam = SC_MINIMIZE then
    AddIcon
  else
    Inherited;
end;procedure TfrmIcon.pmOpenClick(Sender: TObject);
begin
  DelIcon;
end;procedure TfrmIcon.pmExitClick(Sender: TObject);
begin
  Close();
end;procedure TfrmIcon.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Shell_NotifyIcon(NIM_DELETE, @NotifyIcon);
  self.Brush.Bitmap.FreeImage;
end;end.