systray.pas

=== === === MiniHex 1.61 源程序说明 ============================== “$(MiniHex)Source”目录中的所有

{**********************************************************}
{                                                          }
{  TSysTray Component Version 2.6                          }
{                                                          }
{  Author: DayDream Software                               }
{  Email: [e-mail]                                   }
{  URL: http://www.soft1st.com                             }
{  Last Modified Date: 2005-03-26                          }
{                                                          }
{**********************************************************}

unit SysTray;

interface

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

const
  CM_SYSTRAY = CM_BASE + 100;
  IDI_TRAYICON = 0;
  STDefInterval = 200;
  STDefHint = 'SysTray Component';

type
  TPopupMode = set of (pmLeftClick, pmRightClick);
  TMouseButtons = set of TMouseButton;
  TAnimateMode = (amTimer, amThread);

{ classes }

  TTrayAnimateThread = class;

{ TSysTray }

  TSysTray = class(TComponent)
  private
    FIcon: TIcon;
    FCurIcon: TIcon;
    FIconData: TNotifyIconData;
    FHandle: HWnd;
    FParentWindow: HWnd;
    FActive: Boolean;
    FAnimated: Boolean;
    FAnimateMode: TAnimateMode;
    FEnabled: Boolean;
    FHint: string;
    FInterval: Word;
    FPopupMenu: TPopupMenu;
    FPopupAlign: TPopupAlignment;
    FPopupMode: TPopupMode;
    FShowDesigning: Boolean;
    FClicked: TMouseButtons;
    FImages: TCustomImageList;
    FImageChangeLink: TChangeLink;
    FImageIndex: Integer;
    FTimer: TTimer;
    FAniThread: TTrayAnimateThread;
    FIconAdded: Boolean;

    FOnIconClick: TMouseEvent;
    FOnIconDblClick: TNotifyEvent;
    FOnIconMouseMove: TMouseMoveEvent;
    FOnIconMouseDown: TMouseEvent;
    FOnIconMouseUp: TMouseEvent;

    function AddIcon: Boolean;
    function DeleteIcon: Boolean;
    function ModifyIcon: Boolean;
    procedure UpdateIcon;

    function GetAnimated: Boolean;

    procedure SetActive(Value: Boolean);
    procedure SetAnimateMode(Value: TAnimateMode);
    procedure SetAnimated(Value: Boolean);
    procedure SetInterval(Value: Word);
    procedure SetIcon(Icon: TIcon);
    procedure SetHint(const Value: string);
    procedure SetShowDesigning(Value: Boolean);
    procedure SetImages(Value: TCustomImageList);
    procedure FillDataStructure;

    procedure CheckMenuPopup(Button: TMouseButton; X, Y: Integer);
    function GetActiveIcon: TIcon;
    function GetIconFromImages(Index: Integer; Icon: TIcon): Boolean;
    procedure ImageListChange(Sender: TObject);
    procedure Timer(Sender: TObject);
    procedure IconChange(Sender: TObject);

    procedure WndProc(var Message: TMessage);

  protected
    procedure DblClick; dynamic;
    procedure Click(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); dynamic;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); dynamic;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); dynamic;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property ParentWindow: HWnd read FParentWindow write FParentWindow;

  published
    property Images: TCustomImageList read FImages write SetImages;
    property AnimateMode: TAnimateMode read FAnimateMode write SetAnimateMode default amTimer;
    property Animated: Boolean read GetAnimated write SetAnimated default False;
    property Active: Boolean read FActive write SetActive default False;
    property Enabled: Boolean read FEnabled write FEnabled default True;
    property Interval: Word read FInterval write SetInterval default STDefInterval;
    property ShowDesigning: Boolean read FShowDesigning write SetShowDesigning default False;
    property Icon: TIcon Read FIcon write SetIcon;
    property Hint: string read FHint write SetHint;
    property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
    property PopupMode: TPopupMode read FPopupMode write FPopupMode default [pmRightClick];
    property PopupAlign: TPopupAlignment read FPopupAlign write FPopupAlign default paRight;

    property OnIconClick: TMouseEvent read FOnIconClick write FOnIconClick;
    property OnIconDblClick: TNotifyEvent read FOnIconDblClick write FOnIconDblClick;
    property OnIconMouseMove: TMouseMoveEvent read FOnIconMouseMove write FOnIconMouseMove;
    property OnIconMouseDown: TMouseEvent read FOnIconMouseDown write FOnIconMouseDown;
    property OnIconMouseUp: TMouseEvent read FOnIconMouseUp write FOnIconMouseUp;
  end;

{ TTrayAnimateThread }

  TTrayAnimateThread = class(TThread)
  private
    FSysTray: TSysTray;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: Boolean; ASysTray: TSysTray);
    destructor Destroy; override;
  end;

procedure Register;

implementation

var
  WM_TASKBARCREATED: Cardinal;

{$WARN SYMBOL_DEPRECATED OFF}

procedure Register;
begin
  RegisterComponents('DayDream', [TSysTray]);
end;

{ Misc Routines }

procedure SwitchToWindow(Wnd: HWnd; Restore: Boolean);
begin
  if IsWindowEnabled(Wnd) then
  begin
    SetForegroundWindow(Wnd);
    if Restore and IsWindowVisible(Wnd) then
    begin
      if not IsZoomed(Wnd) then
        SendMessage(Wnd, WM_SYSCOMMAND, SC_RESTORE, 0);
      SetFocus(Wnd);
    end;
  end;
  Application.ProcessMessages;
end;

function GetShiftState: TShiftState;
begin
  Result := [];
  if GetKeyState(VK_SHIFT) < 0 then Include(Result, ssShift);
  if GetKeyState(VK_CONTROL) < 0 then Include(Result, ssCtrl);
  if GetKeyState(VK_MENU) < 0 then Include(Result, ssAlt);
end;

{ TSysTray }

constructor TSysTray.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIcon := TIcon.Create;
  FIcon.OnChange := IconChange;
  FCurIcon := TIcon.Create;
  FHint := STDefHint;
  FPopupMode := [pmRightClick];
  FPopupAlign := paRight;
  FActive := False;
  FAnimated := False;
  FInterval := STDefInterval;
  FEnabled := True;
  FShowDesigning := False;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
  FImageIndex := -1;

  if (AOwner <> nil) and (AOwner is TForm) then
    FParentWindow := TForm(AOwner).Handle
  else
    FParentWindow := 0;

  FHandle := AllocateHWnd(WndProc);
end;

destructor TSysTray.Destroy;
begin
  Destroying;
  SetAnimated(False);
  DeleteIcon;
  FImageChangeLink.Free;
  DeallocateHWnd(FHandle);
  FIcon.Free;
  FCurIcon.Free;

  inherited Destroy;
end;

function TSysTray.AddIcon: Boolean;
begin
  FillDataStructure;
  Result := Shell_NotifyIcon(NIM_ADD, @FIconData);
  if Result then FIconAdded := True;
end;

function TSysTray.DeleteIcon: Boolean;
begin
  Result := Shell_NotifyIcon(NIM_DELETE, @FIconData);
  if Result then FIconAdded := False;
end;

function TSysTray.ModifyIcon: Boolean;
begin
  FillDataStructure;
  Result := Shell_NotifyIcon(NIM_MODIFY, @FIconData);
end;

procedure TSysTray.UpdateIcon;
var
  Icon: TIcon;
begin
  Icon := GetActiveIcon;
  if FIconAdded then
  begin
    if (Icon <> nil) and not Icon.Empty then
      ModifyIcon
    else
      DeleteIcon;
  end else
  begin
    if (Icon <> nil) and not Icon.Empty then
    begin
      if ((csDesigning in ComponentState) and FShowDesigning) or
        (not (csDesigning in ComponentState) and (FActive)) then AddIcon;
    end;
  end;
end;

function TSysTray.GetAnimated: Boolean;
begin
  Result := FAnimated;
end;

procedure TSysTray.SetIcon(Icon: TIcon);
begin
  FIcon.Assign(Icon);
  UpdateIcon;
end;

procedure TSysTray.SetHint(const Value: string);
begin
  FHint := Value;
  if Length(FHint) >= 64 then FHint := Copy(FHint, 1, 63);
  UpdateIcon;
end;

procedure TSysTray.SetActive(Value: Boolean);
begin
  if Value <> FActive then
  begin
    FActive := Value;
    FClicked := [];
    if not (csDesigning in ComponentState) then
    begin
      case Value of
        True:    AddIcon;
        False:   DeleteIcon;
      end;
    end;
  end;
end;

procedure TSysTray.SetAnimateMode(Value: TAnimateMode);
begin
  if FAnimateMode <> Value then
  begin
    if Animated then Animated := False;
    FAnimateMode := Value;
  end;
end;

procedure TSysTray.SetAnimated(Value: Boolean);
begin
  if Value <> FAnimated then
  begin
    FAnimated := Value;
    if Value then
    begin