systrayfrm.~pas

关于利用DELPHI来进行企业级方案解决的著作的附书源码

unit SysTrayFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ShellAPI, Menus;
  
const
  MyMsg = WM_USER + 1;
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure N7Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure IconTray(var Msg:TMessage); message MyMsg;
  end;

var
  Form1: TForm1;
  nid : NotifyIconData;
  iconnum: Integer;
implementation

{$R *.dfm}
{$R icon.res}

procedure TForm1.FormCreate(Sender: TObject);
begin
 nid.cbsize:=sizeof(NotifyIconData);
 nid.wnd:=handle;
 nid.uID:=0;
 nid.uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
 nid.uCallbackMessage:=MyMsg;
 nid.hIcon:=Application.Icon.Handle;
//设置鼠标经过提示
 nid.szTip:='鼠标经过提示';
//在系统托盘添加图标
 shell_NotifyIcon(NIM_ADD,@nid);
 SetWindowLong(Application.Handle,GWL_EXSTYLE,
  GetWindowLong(Application.Handle,GWL_EXSTYLE)
  or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
 ShowWindow(Application.Handle,SW_HIDE);
end;

procedure TForm1.IconTray(var Msg:TMessage);
var pt:TPoint;
begin
  inherited;
//如果点击的是鼠标右键，则弹出预先定义好的菜单
  if Msg.LParam = wm_rbuttondown then
   begin
//获得鼠标点击位置
    GetCursorPos(pt);
    SetForeGroundWindow(handle);
//在点击位置弹出
    PopupMenu1.Popup(pt.x,pt.y);
   end;
end;


procedure TForm1.Timer1Timer(Sender: TObject);
begin
 Inc(iconnum);
 case iconnum of
  1: nid.hIcon:=LoadIcon(HInstance,'play');
  2: nid.hIcon:=LoadIcon(HInstance,'stop');
  3: nid.hIcon:=LoadIcon(HInstance,'pause');
 end;
 StrPCopy(nid.szTip,'正使用图标'+IntToStr(iconnum));
 if iconnum>3 then
  iconnum:=0;
 Shell_NotifyIcon(NIM_MODIFY,@nid); 
end;

procedure TForm1.N7Click(Sender: TObject);
begin
 Application.Terminate;
end;

end.