一个托盘图标组件

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('SoftwareMicrosoftWindowsCurrentVersionRun', 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.