trayicon.pas

一些小文档,不是很有用.但也还可以

unit TrayIcon;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ImgList,
  ShellApi;

type
  TTrayIcon = class(TComponent)
  private
    FImages: TCustomImageList;
    FActive: Boolean;
    FImageIndex: Integer;
    FImageLink: TChangeLink;
    FIcon: TIcon;
    FHint: string;
    FHandle: HWND;

    FOnMouseDown: TMouseEvent;
    FOnMouseUp: TMouseEvent;
//    FOnClick: TNotifyEvent;
    FOnDblClick: TNotifyEvent;

    function GetActive: Boolean;
    procedure SetHint(const Value: string);
    procedure SetActive(Value: Boolean);
    procedure SetImages(Value: TCustomImageList);
    procedure SetImageIndex(Value: Integer);
    procedure ImageChanged(Sender: TObject);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Loaded; override;
    procedure WindowProc(var message: TMessage);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function Handle: HWND;
    procedure Update;
  published
    property Active: Boolean read GetActive write SetActive;
    property Hint: string read FHint write SetHint;
    property Images: TCustomImageList read FImages write SetImages;
    property ImageIndex: Integer read FImageIndex write SetImageIndex;
    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
  end;

procedure Register;

implementation

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

constructor TTrayIcon.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIcon := TIcon.Create;
  FImageLink := TChangeLink.Create;
  FImageLink.OnChange := ImageChanged;
end;

destructor TTrayIcon.Destroy;
begin
  Active := False;
  Images := nil;
  FImageLink.Free;
  FIcon.Free;
  inherited Destroy;
end;

function TTrayIcon.GetActive: Boolean;
begin
  Result := FHandle <> 0;
end;

procedure TTrayIcon.SetActive(Value: Boolean);
var
  Data: TNotifyIconData;
begin
  if FActive = Value then Exit;
  FActive := Value;
  Data.cbSize := SizeOf(Data);
  Data.uID := 0;
  Data.uCallbackMessage := WM_User;
  if Length(FHint) > 0 then
    StrLCopy(Data.szTip, @FHint[1], 64)
  else
    Data.szTip[0] := #0;
  if FActive then
  begin
    FHandle := AllocateHWnd(WindowProc);
    Data.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
    if Assigned(FImages) then FImages.GetIcon(ImageIndex, FIcon);
    Data.Wnd := FHandle;
    Data.hIcon := FIcon.Handle;
    Shell_NotifyIcon(NIM_Add, @Data);
  end
  else
  begin
    Data.hIcon := 0;
    Data.uFlags := 0;
    Data.Wnd := FHandle;
    Shell_NotifyIcon(NIM_Delete, @Data);
    DeallocateHWnd(FHandle);
    FHandle := 0;
  end;
end;

procedure TTrayIcon.SetHint(const Value: string);
begin
  FHint := Value;
  Update;
end;

procedure TTrayIcon.SetImages(Value: TCustomImageList);
begin
  if Assigned(FImages) then
    FImages.UnRegisterChanges(FImageLink);
  FImages := Value;
  if Assigned(FImages) then
  begin
    FImages.RegisterChanges(FImageLink);
    FImages.FreeNotification(Self);
  end;
end;

procedure TTrayIcon.SetImageIndex(Value: Integer);
begin
  FImageIndex := Value;
  Update;
end;

procedure TTrayIcon.ImageChanged(Sender: TObject);
begin
  Update;
end;

procedure TTrayIcon.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FImages) and (Operation = opRemove) then SetImages(nil);
end;

procedure TTrayIcon.Loaded;
begin
  inherited;
  Update;
end;

procedure TTrayIcon.WindowProc(var message: TMessage);
begin
  case message.LParam of
    WM_LBUTTONDBLCLK: if Assigned(OnDblClick) then OnDblClick(Self);
    WM_LButtonDown: if Assigned(OnMouseDown) then OnMouseDown(Self, mbLeft, [], 0, 0);
    WM_RButtonDown: if Assigned(OnMouseUp) then OnMouseUp(Self, mbRight, [], 0, 0);
  end;
end;

function TTrayIcon.Handle: HWND;
begin
  Result := FHandle;
end;

procedure TTrayIcon.Update;
var
  Data: TNotifyIconData;
begin
  if Active then
  begin
    if Assigned(Images) then Images.GetIcon(ImageIndex, FIcon);
    Data.cbSize := SizeOf(Data);
    Data.Wnd := Handle;
    Data.uID := 0;
    Data.uFlags := NIF_ICON or NIF_TIP;
    Data.uCallbackMessage := WM_User;
    Data.hIcon := FIcon.Handle;
    StrLCopy(Data.szTip, @FHint[1], 64);
    Shell_NotifyIcon(NIM_MODIFY, @Data);
  end;
end;

end.