一个托盘图标组件

unit xsdtrayicon;

interface

uses
  sysutils, classes, windows, messages, graphics, menus, shellapi, extctrls,
  forms, registry;

const
  icon_id = 1;
  mi_iconevent = wm_user + 1;    //自定义一个消息

type
  txsdtrayicon = class(tcomponent)
  private
    fhint: string;
    fondblclick: tnotifyevent;
    ftrayicon: ticon;
    fpopmenu: tpopupmenu;
    fnotificationwnd: hwnd;
    fstartatboot: boolean;
    finterval: cardinal;
    timerhandle: longword;
    notifyicondata: tnotifyicondata;
    oldwindowproc: twndmethod;
    procedure notificationwndproc(var message: tmessage);
    procedure settrayicon(const value: ticon);
    procedure setstartatboot(const value: boolean);
    procedure registry(b: boolean);
    procedure newwindowproc(var message: tmessage);
  protected
    procedure dodblclick;
    procedure notification(acomponent: tcomponent; operation: toperation); override;
    (*
    loaded 是tcomponent 的一个虚拟方法。当所有组件被创建，并从dfm 文件读出数据
    初始化这些组件实例后，loaded 方法被自动调用。在loaded 中可以进行额外的初始化
    工作，可以对组件实例的一些成员进行改变、嫁接
    *)
    procedure loaded; override;
  public
    constructor create(aowner: tcomponent); override;
    destructor destroy; override;
    //操作托盘正常显示应用程序
    procedure restoreapp();
    procedure showtrayicon(mode: cardinal = nim_add; animated: boolean = false);
  published
    property hint: string read fhint write fhint;
    property ondodblclick: tnotifyevent read fondblclick write fondblclick;
    property popmenu: tpopupmenu read fpopmenu write fpopmenu;
    property trayicon: ticon read ftrayicon write settrayicon;
    //是否自动启动
    property startatboot: boolean read fstartatboot write setstartatboot;
    property interval: cardinal read finterval write finterval;
  end;

procedure register;

implementation

var
  fxsdtrayicon: txsdtrayicon ;
  
procedure register;
begin
  registercomponents('xsdinfo', [txsdtrayicon]);
end;

{ txsdtrayicon }

constructor txsdtrayicon.create(aowner: tcomponent);
begin
  inherited create(aowner);
  fxsdtrayicon := self;
  ftrayicon := ticon.create;
  finterval := 500;
  timerhandle := 0;
  fnotificationwnd := classes.allocatehwnd(notificationwndproc);
  if aowner is tform then
  begin
    oldwindowproc := tform(aowner).windowproc;
    tform(aowner).windowproc := newwindowproc;
  end;
end;

destructor txsdtrayicon.destroy;
begin
  showtrayicon(nim_delete); //删除托盘图标
  freeandnil(ftrayicon);
  if fnotificationwnd<>0 then
    classes.deallocatehwnd(fnotificationwnd);  //销毁窗口
  if timerhandle<>0 then
    killtimer(0, timerhandle);  //关掉定时器
  inherited destroy;
end;

procedure txsdtrayicon.dodblclick;
begin
  if assigned(ondodblclick) then ondodblclick(self);
end;

procedure txsdtrayicon.loaded;
begin
  inherited;
  if not (csdesigning in componentstate) then
  begin
    if ftrayicon.handle=0 then
      ftrayicon.assign(application.icon);
    //初始化notificationdata;
    fillchar(notifyicondata, sizeof(notifyicondata), 0);
    with notifyicondata do
    begin
      cbsize := sizeof(tnotifyicondata);
      wnd := fnotificationwnd;
      uid := icon_id;
      uflags := nif_message or nif_icon or nif_tip;
      ucallbackmessage := mi_iconevent;
      hicon := ftrayicon.handle;
      strlcopy(sztip, pchar(fhint), sizeof(sztip));
    end;
    showtrayicon();
  end;
end;

procedure txsdtrayicon.newwindowproc(var message: tmessage);
begin
  if assigned(oldwindowproc) then
    oldwindowproc(message);
  with message do
  begin
    if ((msg=wm_syscommand) and (wparam=sc_minimize)) then
      showwindow(application.handle, sw_hide);
  end;
end;

procedure txsdtrayicon.notification(acomponent: tcomponent;
  operation: toperation);
begin
  inherited notification(acomponent, operation);
  if operation=opremove then
  begin
    if acomponent=fpopmenu then fpopmenu := nil;
  end;
end;

procedure txsdtrayicon.notificationwndproc(var message: tmessage);
var
  pt: tpoint;
begin
  if message.msg=mi_iconevent then
  begin
    case message.lparam of
      wm_lbuttondblclk:
      begin
        dodblclick;
        restoreapp;
      end;
      wm_rbuttondown:
      begin
        if assigned(fpopmenu) then
        begin
          getcursorpos(pt);
          fpopmenu.popup(pt.x, pt.y);
        end;
      end;
    end;
  end else //对于其它消息 缺省处理。
    message.result := defwindowproc(fnotificationwnd, message.msg, message.wparam, message.lparam);
end;

procedure setanimatedicon(wnd: hwnd; msg, idevent: uint; dwtime: dword); stdcall;
begin
  if msg=wm_timer then
  with fxsdtrayicon.notifyicondata do
  begin
    if hicon=0 then
      hicon := fxsdtrayicon.ftrayicon.handle
    else
      hicon := 0;
    shell_notifyicon(nim_modify, @fxsdtrayicon.notifyicondata);
  end;
end;

procedure txsdtrayicon.registry(b: boolean);
var
  reg: tregistry;
  keyname: string;
begin
  reg := tregistry.create;
  keyname := extractfilename(application.exename);
  try
    reg.rootkey := hkey_local_machine;
    if reg.openkey('\software\microsoft\windows\currentversion\run', false) then
    begin
      if b then
        reg.writestring(keyname, application.exename)
      else
        reg.deletekey(keyname);
      reg.closekey;
    end;
  finally
    freeandnil(reg);
  end;
end;

procedure txsdtrayicon.restoreapp;
begin
  showtrayicon(nim_modify, false);
  showwindow(application.handle, sw_shownormal);
  showwindow(application.mainform.handle, sw_shownormal);
  setforegroundwindow(application.mainform.handle);
end;

procedure txsdtrayicon.setstartatboot(const value: boolean);
begin
  if fstartatboot<>value then
  begin
    fstartatboot := value;
    if not (csdesigning in componentstate) then
      registry(fstartatboot);
  end;
end;

procedure txsdtrayicon.settrayicon(const value: ticon);
begin
  ftrayicon := value;
end;

procedure txsdtrayicon.showtrayicon(mode: cardinal; animated: boolean);
begin
  if csdesigning in componentstate then exit;
  if mode=nim_modify then
  begin
    if animated then
    begin
      if timerhandle=0 then
        timerhandle := settimer(0, 0, finterval, @setanimatedicon);
    end else begin
      if timerhandle<>0 then
      begin
        killtimer(0, timerhandle);
        timerhandle := 0;
        notifyicondata.hicon := ftrayicon.handle;
      end;
    end;
  end;
  shell_notifyicon(mode, @notifyicondata);
end;

end.