unit1.pas

delphi7编写的托盘程序标准源码

unit Unit1;

interface

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, shellapi, Menus, StdCtrls;

const
  wi_iconeven = wm_user + 1000;{定义消息常量,用来接受系统返回的消息.}
  Top_strSoftName = '托盘程序';

type
   TForm1 = class(TForm)
     PopupMenu1: TPopupMenu;{有"显示"."隐藏","关闭"三种选项}
     N1: TMenuItem;
     N2: TMenuItem;
     N3: TMenuItem;
     procedure FormCreate(Sender: TObject);
     procedure N3Click(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure N1Click(Sender: TObject);
     procedure N2Click(Sender: TObject);
     {点击托盘下图标执行的操作}
     procedure iconclick(var message : TMessage); message wi_iconeven;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
   private
     { Private declarations }
   public
     { Public declarations }
   end;

var
   Form1: TForm1;
   nodedate: Tnotifyicondata;{全局变量,整个程序基本上是围着这个变量在转}
implementation

{$R *.dfm}

{程序运行即显示托盘图标}
procedure TForm1.FormCreate(Sender: TObject);
var
  h: integer;
begin
  Application.Initialize;{程序初始化}
  h := CreateMutex(nil, true, Top_strSoftName);{防止多个实例的运行 ,建议改为重复运行时，激活已运行的实例 Adviced by lwz;}
  if h <> 0 then
  if GetLastError() <> 0 then
  begin
    Application.MessageBox('本程序不能重复运行,请退出！', Top_strSoftName, MB_ICONINFORMATION + MB_OK);
    CloseHandle(h);
    Application.Terminate;
    Exit;
  end;

  nodedate.cbSize := sizeof(tnotifyicondata);
  nodedate.Wnd := handle;
  nodedate.uID := 1;
  nodedate.uFlags := Nif_Icon or Nif_Message or Nif_Tip;
  nodedate.uCallbackMessage := wi_iconeven;
  nodedate.hIcon := application.Icon.Handle;
  nodedate.szTip := '托盘图标测试';{托盘状态下显示标题属性}
  Shell_NotifyIcon(NIM_ADD,@nodedate);
  N1.Checked := True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Shell_NotifyIcon(NIM_DELETE,@nodedate);{释放内存}
end;

{点击'显示'}
procedure TForm1.N1Click(Sender: TObject);
begin
  N1.Checked := True;
  N2.Checked := False;
  ShowWindow(Application.Handle,SW_SHOW);
  ShowWindow(form1.Handle, SW_SHOW);
end;

{"隐藏" 窗口}
procedure TForm1.N2Click(Sender: TObject);
begin
  N1.Checked := False;
  N2.Checked := True;
  ShowWindow(Application.Handle, SW_HIDE);
  ShowWindow(form1.Handle, SW_HIDE);
end;

{"关闭"}
procedure TForm1.N3Click(Sender: TObject);
begin
  Shell_NotifyIcon(NIM_DELETE,@nodedate);
  Application.Terminate;
end;

{接受消息}
procedure TForm1.iconclick(var message: TMessage);
var
  P: Tpoint;
begin
  if message.LParam = WM_RButtonUP then{按下鼠标右键:}
  begin
    SetForegroundWindow(Form1.Handle);{这句一定要加,否则弹出菜单不会自动隐藏}
    GetCursorPos(P);{获取鼠标坐标}
    PopupMenu1.Popup(P.x, P.y);{将 Popupmenu 与鼠标关联}
  end;
  if message.LParam = WM_LButtonUP then
  begin
    if Form1.Showing then
       Form1.Hide
    else if not Form1.Showing then
       Form1.Show;
   end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := False;
  N2Click(Self);  
end;

end.