{******************************************************************************
*              系統托盤圖標控件 - TTrayIcon                                   *
*                                                                             *
*      功能： 添加圖標到系統托盤(System Tray)，并響應相應鼠標事件             *
*      版本： V1.01                                                           *
*      作者： 顧中軍                                                          *
*      日期:  2005.3.6                                                        *
*      用法：                                                                 *
*             很簡單，試一下就知道，這里我就不多說了                          *
*      說明：                                                                 *
*          這個東東完全是照搬BCB6所帶的TrayIcon例子中的做法，換句話說，實際上 *
*      我只是將BCB6的代碼改成Delphi而已，并未作多少改進。BCB6源碼請參看其安裝 *
*      目錄下Examples\Controls\Source子目錄中的TrayIcon.cpp/TrayIcon.h 。     *
*          總的說來，這個東東要比網上流傳甚廣的TSysTray的功能要強大一些，而且 *
*      我發現它對彈出菜單的處理要更完善一些（TSysTray這個東東對彈出菜單的處理 *
*      有一些Bug）。                                                          *
*          好了，其他也沒什么多說的了，讓我們感謝一下Borland所提供的源碼吧。  *
*          祝你愉快！！！                                                     *
*                                                                             *
*      Email:     iamdream@yeah.net                                           *
******************************************************************************}

unit TrayIcon;

interface

uses
  Windows, Messages, SysUtils, Controls, Classes, Forms, ExtCtrls, Graphics,
  Menus, ShellApi;

const
  WM_SYSTEM_TRAY_NOTIFY = WM_USER + 1;

type

  TTrayIconMessage = (imClick, imDoubleClick, imMouseDown,
                      imMouseUp, imLeftClickUp, imLeftDoubleClick,
                      imRightClickUp, imRightDoubleClick, imNone);

  TTrayIcon = class(TComponent)
  private
    { Private declarations }
    FData:            TNotifyIconData;
    FIsClicked:       Boolean;
    FIcon:            TIcon;
    FIconList:        TImageList;
    FPopupMenu:       TPopupMenu;
    FTimer:           TTimer;
    FHint:            String;
    FIconIndex:       Integer;
    FVisible:         Boolean;
    FHide:            Boolean;
    FAnimate:         Boolean;
    FAppRestore:      TTrayIconMessage;
    FPopupMenuShow:   TTrayIconMessage;
    FApplicationHook: TWindowHook;

    FOnMinimize:      TNotifyEvent;
    FOnRestore:       TNotifyEvent;
    FOnMouseMove:     TMouseMoveEvent;
    FOnMouseExit:     TMouseMoveEvent;
    FOnMouseEnter:    TMouseMoveEvent;
    FOnClick:         TNotifyEvent;
    FOnDblClick:      TNotifyEvent;
    FOnMouseDown:     TMouseEvent;
    FOnMouseUp:       TMouseEvent;
    FOnAnimate:       TNotifyEvent;
    FOnCreate:        TNotifyEvent;
    FOnDestroy:       TNotifyEvent;
    FOnActivate:      TNotifyEvent;
    FOnDeactivate:    TNotifyEvent;

    procedure SetHint(Hint: String);
    procedure SetHide(Value: Boolean);
    function GetAnimateInterval: Integer;
    procedure SetAnimateInterval(Value: Integer);
    function GetAnimate: Boolean;
    procedure SetAnimate(Value: Boolean);
    procedure EndSession;
    function ShiftState: TShiftState;
    function GetHandle: HWND;

  protected
    { Protected declarations }
    procedure SetVisible(Value: Boolean); virtual;
    procedure DoMessage(var Message: TMessage); virtual;
    procedure DoClick; virtual;
    procedure DoDblClick; virtual;
    procedure DoMouseMove(Shift: TShiftState; X, Y: Integer); virtual;
    procedure DoMouseDown(Button: TMouseButton; Shift: TShiftState;
        X, Y: Integer); virtual;
    procedure DoMouseUp(Button: TMouseButton; Shift: TShiftState;
        X, Y: Integer); virtual;
    procedure DoOnAnimate(Sender: TObject); virtual;
    procedure Notification(AComponent: TComponent;
        Operation: TOperation); override;

    function ApplicationHookProc(var Message: TMessage): Boolean;

    procedure Loaded; override;
    property Data: TNotifyIconData read FData;

  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Minimize; virtual;
    procedure Restore; virtual;
    procedure Update; virtual;
    procedure ShowMenu; virtual;
    procedure SetIconIndex(Value: Integer); virtual;
    procedure SetDefaultIcon; virtual;

  published
    { Published declarations }
    property Visible: Boolean read FVisible write SetVisible default False;
    property Hint: String     read FHint    write SetHint;
    property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
    property Hide: Boolean    read FHide    write SetHide;
    property RestoreOn:   TTrayIconMessage  read FAppRestore write FAppRestore;
    property PopupMenuOn: TTrayIconMessage  read FPopupMenuShow write FPopupMenuShow;
    property Icons: TImageList  read FIconList  write FIconList;
    property IconIndex: Integer read FIconIndex write FIconIndex;
    property AnimateInterval: Integer read GetAnimateInterval write SetAnimateInterval default 1000;
    property Animate: Boolean   read GetAnimate write SetAnimate default False;
    property Handle:  HWND      read GetHandle;

    property OnMinimize:   TNotifyEvent read FOnMinimize write FOnMinimize;
    property OnRestore:    TNotifyEvent read FOnRestore  write FOnRestore;
    property OnClick:      TNotifyEvent read FOnClick    write FOnClick;
    property OnMouseEnter: TMouseMoveEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseExit:  TMouseMoveEvent read FOnMouseExit  write FOnMouseExit;
    property OnMuuseMove:  TMouseMoveEvent read FOnMouseMove  write FOnMouseMove;
    property OnMouseUp:    TMouseEvent  read FOnMouseUp  write FOnMouseUp;
    property OnMouseDown:  TMouseEvent  read FOnMouseDown write FOnMouseDown;
    property OnAnimate:    TNotifyEvent read FOnAnimate  write FOnAnimate;
    property OnCreate:     TNotifyEvent read FOnCreate   write FOnCreate;
    property OnDestroy:    TNotifyEvent read FOnDestroy  write FOnDestroy;
    property OnActivate:   TNotifyEvent read FOnActivate write FOnActivate;
    property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
     
  end;

procedure Register;

resourcestring
  sCannotCreate = 'Cannot Create System Shell Notification Icon';
  sCannotRemove = 'Cannot Remove System Shell Notification Icon';

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TTrayIcon]);
end;

constructor TTrayIcon.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FIcon  := TIcon.Create();
  FTimer := TTimer.Create(Self);

  FIconIndex      := 0;
  FIcon.Assign(Application.Icon);
  FAppRestore     := imDoubleClick;
  FOnAnimate      := DoOnAnimate;
  FPopupMenuShow  := imNone;
  FVisible        := False;
  FHide           := True;
  FTimer.Enabled  := False;
  FTimer.OnTimer  := OnAnimate;
  FTimer.Interval := 1000;

  if not (csDesigning in ComponentState) then
  begin
    FillChar(FData, SizeOf(TNotifyIconData), 0);
    with FData do
    begin
      cbSize := SizeOf(TNotifyIconData);
      Wnd    := Classes.AllocateHWnd(DoMessage);
      uID    := UINT(Self);
      hIcon  := FIcon.Handle;
      uFlags := NIF_ICON or NIF_MESSAGE;
      uCallbackMessage := WM_SYSTEM_TRAY_NOTIFY;
    end;
    FApplicationHook   := ApplicationHookProc;
    Update();
  end;
end;

destructor TTrayIcon.Destroy;
begin
  if not (csDesigning in ComponentState) then
  begin
    Shell_NotifyIcon(NIM_DELETE, @FData);
    Classes.DeallocateHWnd(FData.Wnd);
  end;

  if FIcon <> nil then
    FIcon.Free;
  if FTimer <> nil then
    FTimer.Free;

  inherited Destroy;
end;

procedure TTrayIcon.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);

  if Operation = opRemove then
  begin
    if AComponent = FIconList then
      FIconList := nil
    else if AComponent = FPopupMenu then
      FPopupMenu := nil;
  end;
end;

procedure TTrayIcon.Loaded;
begin
  inherited Loaded;

  if FIconList = nil then
  begin
    FAnimate := False;
    FIcon.Assign(Application.Icon);
  end
  else
  begin
    FTimer.Enabled := FAnimate;
    FIconList.GetIcon(FIconIndex, FIcon);
  end;

  Update();
end;

procedure TTrayIcon.SetVisible(Value: Boolean);
begin
  FVisible := Value;

  if not (csDesigning in ComponentState) then
  begin
    if FVisible then
    begin
      if not Shell_NotifyIcon(NIM_ADD, @FData) then
        raise EOutOfResources.Create(sCannotCreate);
      Hide := True;
      Application.HookMainWindow(FApplicationHook);
    end
    else
    begin
      if not Shell_NotifyIcon(NIM_DELETE, @FData) then
        raise EOutOfResources.Create(sCannotRemove);
      Hide := False;
      Application.UnhookMainWindow(FApplicationHook);
    end;
  end;
end;

procedure TTrayIcon.SetHint(Hint: String);
begin
  // The new hint must be different than the previous hint and less than
  // 64 characters to be modified. 64 is an operating system limit.
  if (FHint <> Hint) and (Length(Hint) < 64) then
  begin
    FHint := Hint;
    StrPLCopy(FData.szTip, Hint, SizeOf(FData.szTip) - 1);

    // If there is no hint then there is no tool tip.
    if Length(Hint) > 0 then
      FData.uFlags := FData.uFlags or NIF_TIP
    else
      FData.uFlags := FData.uFlags and not NIF_TIP;

    Update();
  end;
end;

procedure TTrayIcon.SetHide(Value: Boolean);
begin
  FHide := Value;
  if FVisible then
  begin
    if IsIconic(Application.Handle) then
    begin
      if Value then
        ShowWindow(Application.Handle, SW_HIDE);
    end
    else if not Value then
      ShowWindow(Application.Handle, SW_RESTORE);
  end;
end;