unit_tray.~pas

系统托盘实现 delphi 会自动显示托盘程序

unit unit_tray;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls,shellapi;
  const
      ICON_ID=1;
      ICONEVENT=WM_USER+1;
type
  TForm1 = class(TForm)
    Button1: TButton;
    PopupMenu1: TPopupMenu;
    Resize: TMenuItem;
    Exit: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ExitClick(Sender: TObject);
    procedure ResizeClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    procedure InstallIcon;
    procedure UnInstallIcon;
    procedure IconOnclick(var message:TMessage);
    message ICONEVENT;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  IconData:TNotifyIconData;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
InstallIcon;//安装图标   
SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);//在任务栏中隐藏程序
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
UnInstallIcon;   //卸载图标
end;

  procedure   TForm1.InstallIcon;   
  begin   
      IconData.cbSize:=SizeOf(IconData);   
      IconData.Wnd:=Handle;   
      IconData.uID:=ICON_ID;   
      IconData.uFlags:=NIF_ICON   or   NIF_MESSAGE   or   NIF_TIP;   
      IconData.uCallBackMessage:=ICONEVENT;   
      IconData.hIcon:=application.Icon.Handle;//获得程序图标   
      IconData.szTip:='任务栏图标';   //图标的提示信息   
      Shell_NotifyIcon(NIM_ADD,   @IconData   );   
  end;

  procedure   TForm1.UnInstallIcon;   
  begin   
      //卸载图标   
      Shell_NotifyIcon(NIM_DELETE,   @IconData   );   
  end;   
    
      //在图标上按下鼠标   
  procedure   TForm1.IconOnclick(var   message:   TMessage);   
  var   
      p:   TPoint;   
  begin   
  case   message.LParam   of   
      WM_RBUTTONDOWN:     //点击鼠标右键时响应   
      begin   
          GetCursorPos(p);   
          //在鼠标点击处弹出快捷菜单   
          form1.PopupMenu1.Popup(p.x   ,p.y);   
      end;   
    
      WM_LBUTTONDOWN:     //点击鼠标左键时响应   
      begin   
          form1.WindowState:=wsNormal;//还原窗口大小   
          form1.Visible:=true;   
      end;   
    
  end;
  end;    

procedure TForm1.ExitClick(Sender: TObject);
begin
form1.Close;
end;

procedure TForm1.ResizeClick(Sender: TObject);
begin
      form1.WindowState:=wsNormal;     //还原窗口大小   
      form1.Visible:=true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
      form1.WindowState:=wsMinimized;   //最小化窗口
      form1.Visible:=false;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Shell_NotifyIcon(NIM_DELETE,@IconData);
end;

end.