Shellapi 托盘程序完整版本

//托盘程序完整版本 
{
需要控件
ImageList1
PopupMenu1

其他:2个Icon图标
}
uses Shellapi; {引入Shellapi}

{在Interface的uses下面定义}
Const                 
  My_IconEvent = WM_USER + 1000;

   private
    { Private declarations }
    myIcon:TNotifyIcondata;
    NormalIcon,DisableIcon:Ticon;
     procedure IconOnClick( Var msg:TMessage);
    Message My_IconEvent;

procedure TForm1.FormCreate(Sender: TObject);
begin
  NormalIcon :=TIcon.Create; {创建NormalIcon图标}
  DisableIcon :=TIcon.Create ; {创建DisableIcon图标}
  ImageList1.GetIcon( 0,NormalIcon); {创建图标1}
  ImageList1.GetIcon( 1,DisableIcon); {创建图标2}
  myIcon.cbSize :=Sizeof(TNotifyIcondata);
  myIcon.wnd :=handle;
  myIcon.uID := 1;
  myIcon.uFlags :=nif_Message or nif_tip or nif_Icon;
  myIcon.uCallbackMessage :=My_IconEvent;
  myIcon.Sztip := '鼠标放在图标上的提示信息'; {鼠标放在图标上 的 提示信息}
  myIcon.hIcon :=NormalIcon.handle; {这具是默认图标显示}
  Shell_NotifyIcon(nim_add,@myIcon); {这具是默认图标显示}
end;

procedure TForm1.IconOnClick( Var msg:TMessage);
Var
  Mousepos:Tpoint;
begin
    Case Msg.LParam of
     wm_Lbuttonup: begin {左键单击图标显示主窗体}
                        ShowWindow(Self.Handle,SW_SHOW); {窗体的显示位置会出现一些问题}
                       end;
     wm_Rbuttonup: begin {右键单击图标显示参数菜单}
                        GetCursorpos(Mousepos);
                        PopupMenu1.Popup(Mousepos.X,Mousepos.Y);
                       end;
     end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
   if (Application.MessageBox( '确定要退出该监测系统吗？', '警示',MB_YESNO or MB_ICONINFORMATION) = IDYES) then
       begin
         Shell_NotifyIcon(nim_delete,@myIcon); {程序退出时会迅速释放图标}
         NormalIcon.Free;
         DisableIcon.Free;
         CanClose :=True;
       end
       else CanClose :=False;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
     ShowWindow(Self.Handle,SW_SHOW);
end;

procedure TForm1.N21Click(Sender: TObject);
begin
  myIcon.hIcon :=NormalIcon.handle; {DisableIcon图标显示}
  Shell_NotifyIcon(nim_modify,@myIcon);
end;

procedure TForm1.N2Click(Sender: TObject);
begin
   myIcon.hIcon :=DisableIcon.handle; {NormalIcon图标显示}
   Shell_NotifyIcon(nim_modify,@myIcon);
end;

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

通过 Wiz 发布