unit1.pas

一个简单的托盘程序

unit Unit1;

interface

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

const
  ICON_ID=1;
  //ICON的ID标志
  MI_ICONEVENT=WM_USER+1;
  //自定义ICON事件消息
type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    open1: TMenuItem;
    enable1: TMenuItem;
    close1: TMenuItem;
    Timer1: TTimer;
    Label1: TLabel;
    Image1: TImage;
    Label2: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure open1Click(Sender: TObject);
    procedure enable1Click(Sender: TObject);
    procedure close1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
  private
    { Private declarations }
      { Private declarations } 
    NormalIcon,DisabledIcon:TIcon;
    //正常和失效两种情况下的图标 
    Status:Boolean; 
    //标志"允许使用"还是"禁止使用" 
    procedure InstallIcon;
    procedure ChangeIcon(s:Boolean); 
    procedure UnInstallIcon; 
    procedure IconOnClick(var message:TMessage); message MI_ICONEVENT;
    //捕捉自定义消息MI_ICONEVENT的过程IconOnClick的声明

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  start:boolean;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.ChangeIcon(s:Boolean); 
//自定义过程ChangeIcon，改变本程序在指示状态栏的图标 
var 
  IconData:TNotifyIconData; 
begin 
  IconData.cbSize:=SizeOf(IconData); 
  IconData.Wnd:=Handle; 
  IconData.uID:=ICON_ID; 
  if s=False then //禁止使用 
  begin 
    IconData.hIcon:=DisabledIcon.Handle;
    Status:=False;
    open1.Enabled:=false;
    enable1.Caption:='允许使用';
    if form2.Showing then form2.close;
  end
  else //允许使用
  begin
    IconData.hIcon:=Normalicon.Handle;
    Status:=True;
    open1.Enabled:=true;
    enable1.Caption:='暂停使用';
    if not form2.Showing then form2.Show;
  end;
  IconData.uFlags:=NIF_ICON;
  Shell_NotifyIcon(NIM_MODIFY,@IconData);
end;

procedure TForm1.IconOnClick(var message:TMessage);
//处理鼠标在指示状态栏对应的图标上的单击事件
var 
  p:TPoint;
begin 
  //如果按下的是鼠标左键，并且允许显示，则显示Form2 
  if((message.lParam=WM_LBUTTONDOWN) and (Status=True)) then
  if open1.Enabled then
  if not form2.Showing then
    form2.Show
  else
    form2.Close;
  //如果按下的是鼠标右键，则显示弹出菜单
  if (message.lParam=WM_RBUTTONDOWN)then
  begin
    GetCursorPos(p);
    PopupMenu1.Popup(p.x,p.y);
  end;
end;

procedure TForm1.InstallIcon; 
//安装图标 
var 
  IconData:TNotifyIconData; 
begin 
  NormalIcon:=TIcon.Create; 
  DisabledIcon:=TIcon.Create; 
  NormalIcon.LoadFromFile('normal.ico'); 
//允许使用状态下的图标 
  DisabledIcon.LoadFromFile('disable.ico');
//禁止使用状态下的图标
  IconData.cbSize:=SizeOf(IconData);
  IconData.Wnd:=Handle;
  IconData.uID:=ICON_ID;
  IconData.uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
  IconData.uCallBackMessage:=MI_ICONEVENT;
  IconData.hIcon:=NormalIcon.Handle;
  IconData.szTip:='由托盘控制的程序';
  //鼠标悬在状态指示栏对应的图标上时的提示信息
  Shell_NotifyIcon(NIM_ADD,@IconData);
end;

procedure TForm1.UnInstallIcon; 
//卸载图标 
var 
  IconData:TNotifyIconData; 
begin 
  IconData.cbSize:=SizeOf(IconData); 
  IconData.Wnd:=Handle; 
  IconData.uID:=ICON_ID; 
  Shell_NotifyIcon(NIM_DELETE,@IconData);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin 
  UnInstallIcon;
  //卸载图标
  NormalIcon.Free; 
  DisabledIcon.Free; 
  //释放两个图标资源
end; 

procedure TForm1.FormCreate(Sender: TObject);
begin
  Status:=True;
  start:=true;
  InstallIcon;
  //安装图标
  //SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
end;

procedure TForm1.open1Click(Sender: TObject);
begin
  form2.Show;
end;

procedure TForm1.enable1Click(Sender: TObject);
begin
  if (Status=True) then
  //根据状态更改菜单项标题
  begin
    ChangeIcon(False);
  end
  else
  begin
    ChangeIcon(True);
  end;
end;


procedure TForm1.close1Click(Sender: TObject);
begin
  FORM2.Close;
  form1.close;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if start then
  if Form1.AlphaBlendValue<245 then
     Form1.AlphaBlendValue:=Form1.AlphaBlendValue+20
  else
    begin
      Timer1.Interval:=1000;
      start:=false;
      label2.Visible:=true;
  end
  else
  begin
    Timer1.Enabled:=false;
    form1.Hide;
  end;
end;

procedure TForm1.Image1Click(Sender: TObject);
begin
   form1.Hide;
   Timer1.Enabled:=false;
end;

procedure TForm1.PopupMenu1Popup(Sender: TObject);
begin
  open1.Enabled:=Status and (not form2.Showing);
end;

end.