cooltrayicon.pas

delphi换肤控件2.0破解版,虽然版本不高但相当好用的。

{*****************************************************************}
{ This is a component for placing icons in the notification area  }
{ of the Windows taskbar (aka. the traybar).                      }
{                                                                 }
{ The component is freeware. Feel free to use and improve it.     }
{ I would be pleased to hear what you think.                      }
{                                                                 }
{ Troels Jakobsen - [e-mail]                     }
{ Copyright (c) 2006                                              }
{                                                                 }
{ Portions by Jouni Airaksinen - [e-mail]             }
{*****************************************************************}

unit CoolTrayIcon;

{$T-}  // Use untyped pointers as we override TNotifyIconData with TNotifyIconDataEx

{$IFDEF VER80}  {$DEFINE DELPHI_1} {$ENDIF}
{$IFDEF VER90}  {$DEFINE DELPHI_2} {$ENDIF}
{$IFDEF VER100} {$DEFINE DELPHI_3} {$ENDIF}
{$IFDEF VER120} {$DEFINE DELPHI_4} {$ENDIF}
{$IFDEF VER130} {$DEFINE DELPHI_5} {$ENDIF}
{$IFDEF VER93}  {$DEFINE BCB_1}    {$ENDIF}
{$IFDEF VER110} {$DEFINE BCB_3}    {$ENDIF}
{$IFDEF VER125} {$DEFINE BCB_4}    {$ENDIF}
{$IFDEF VER135} {$DEFINE BCB_5}    {$ENDIF}

{ Some methods have moved to the Classes unit in D6 and are thus deprecated.
  Using the following compiler directives we handle that situation. }
{$DEFINE DELPHI_6_UP}
{$IFDEF DELPHI_1} {$UNDEF DELPHI_6_UP} {$ENDIF}
{$IFDEF DELPHI_2} {$UNDEF DELPHI_6_UP} {$ENDIF}
{$IFDEF DELPHI_3} {$UNDEF DELPHI_6_UP} {$ENDIF}
{$IFDEF DELPHI_4} {$UNDEF DELPHI_6_UP} {$ENDIF}
{$IFDEF DELPHI_5} {$UNDEF DELPHI_6_UP} {$ENDIF}
{$IFDEF BCB_1}    {$UNDEF DELPHI_6_UP} {$ENDIF}
{$IFDEF BCB_3}    {$UNDEF DELPHI_6_UP} {$ENDIF}
{$IFDEF BCB_4}    {$UNDEF DELPHI_6_UP} {$ENDIF}
{$IFDEF BCB_5}    {$UNDEF DELPHI_6_UP} {$ENDIF}

{ The TCustomImageList class only exists from D4, so we need special handling
  for D2 and D3. We define another compiler directive for this. }
{$DEFINE DELPHI_4_UP}
{$IFDEF DELPHI_1} {$UNDEF DELPHI_4_UP} {$ENDIF}
{$IFDEF DELPHI_2} {$UNDEF DELPHI_4_UP} {$ENDIF}
{$IFDEF DELPHI_3} {$UNDEF DELPHI_4_UP} {$ENDIF}
{$IFDEF BCB_1}    {$UNDEF DELPHI_4_UP} {$ENDIF}
{$IFDEF BCB_3}    {$UNDEF DELPHI_4_UP} {$ENDIF}

{ I tried to hack around the problem that in some versions of NT4 the tray icon
  will not display properly upon logging off, then logging on. It appears to be
  a VCL problem. The solution is probably to substitute Delphi's AllocateHWnd
  method, but I haven't gotten around to experimenting with that.
  For now, leave WINNT_SERVICE_HACK undefined (no special NT handling). }
{$UNDEF WINNT_SERVICE_HACK}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Menus, ShellApi, ExtCtrls, SimpleTimer {$IFDEF DELPHI_4_UP}, ImgList{$ENDIF};

const
  // User-defined message sent by the trayicon
  WM_TRAYNOTIFY = WM_USER + 1024;

type
  TTimeoutOrVersion = record
    case Integer of          // 0: Before Win2000; 1: Win2000 and up
      0: (uTimeout: UINT);
      1: (uVersion: UINT);   // Only used when sending a NIM_SETVERSION message
  end;

  { You can use the TNotifyIconData record structure defined in shellapi.pas.
    However, WinME, Win2000, and WinXP have expanded this structure, so in
    order to implement their new features we define a similar structure,
    TNotifyIconDataEx. }
  { The old TNotifyIconData record contains a field called Wnd in Delphi
    and hWnd in C++ Builder. The compiler directive DFS_CPPB_3_UP was used
    to distinguish between the two situations, but is no longer necessary
    when we define our own record, TNotifyIconDataEx. }
  TNotifyIconDataEx = record
    cbSize: DWORD;
    hWnd: HWND;
    uID: UINT;
    uFlags: UINT;
    uCallbackMessage: UINT;
    hIcon: HICON;
    szTip: array[0..127] of AnsiChar;  // Previously 64 chars, now 128
    dwState: DWORD;
    dwStateMask: DWORD;
    szInfo: array[0..255] of AnsiChar;
    TimeoutOrVersion: TTimeoutOrVersion;
    szInfoTitle: array[0..63] of AnsiChar;
    dwInfoFlags: DWORD;
{$IFDEF _WIN32_IE_600}
    guidItem: TGUID;  // Reserved for WinXP; define _WIN32_IE_600 if needed
{$ENDIF}
  end;

  TBalloonHintIcon = (bitNone, bitInfo, bitWarning, bitError, bitCustom);
  TBalloonHintTimeOut = 10..60;   // Windows defines 10-60 secs. as min-max
  TBehavior = (bhWin95, bhWin2000);
  THintString = AnsiString;       // 128 bytes, last char should be #0

  TCycleEvent = procedure(Sender: TObject; NextIndex: Integer) of object;
  TStartupEvent = procedure(Sender: TObject; var ShowMainForm: Boolean) of object;

  TCoolTrayIcon = class(TComponent)
  private
    FEnabled: Boolean;
    FIcon: TIcon;
    FIconID: Cardinal;
    FIconVisible: Boolean;
    FHint: THintString;
    FShowHint: Boolean;
    FPopupMenu: TPopupMenu;
    FLeftPopup: Boolean;
    FOnClick,
    FOnDblClick: TNotifyEvent;
    FOnCycle: TCycleEvent;
    FOnStartup: TStartupEvent;
    FOnMouseDown,
    FOnMouseUp: TMouseEvent;
    FOnMouseMove: TMouseMoveEvent;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseExit: TNotifyEvent;
    FOnMinimizeToTray: TNotifyEvent;
    FOnBalloonHintShow,
    FOnBalloonHintHide,
    FOnBalloonHintTimeout,
    FOnBalloonHintClick: TNotifyEvent;
    FMinimizeToTray: Boolean;
    FClickStart: Boolean;
    FClickReady: Boolean;
    CycleTimer: TSimpleTimer;          // For icon cycling
    ClickTimer: TSimpleTimer;          // For distinguishing click and dbl.click
    ExitTimer: TSimpleTimer;           // For OnMouseExit event
    LastMoveX, LastMoveY: Integer;
    FDidExit: Boolean;
    FWantEnterExitEvents: Boolean;
    FBehavior: TBehavior;
    IsDblClick: Boolean;
    FIconIndex: Integer;               // Current index in imagelist
    FDesignPreview: Boolean;
    SettingPreview: Boolean;           // Internal status flag
    SettingMDIForm: Boolean;           // Internal status flag
{$IFDEF DELPHI_4_UP}
    FIconList: TCustomImageList;
{$ELSE}
    FIconList: TImageList;
{$ENDIF}
    FCycleIcons: Boolean;
    FCycleInterval: Cardinal;
//    OldAppProc, NewAppProc: Pointer;   // Procedure variables
    OldWndProc, NewWndProc: Pointer;   // Procedure variables
//    HasCheckedShowMainFormOnStartup, ShowMainFormOnStartup: Boolean;
    procedure SetDesignPreview(Value: Boolean);
    procedure SetCycleIcons(Value: Boolean);
    procedure SetCycleInterval(Value: Cardinal);
    function InitIcon: Boolean;
    procedure SetIcon(Value: TIcon);
    procedure SetIconVisible(Value: Boolean);
{$IFDEF DELPHI_4_UP}
    procedure SetIconList(Value: TCustomImageList);
{$ELSE}
    procedure SetIconList(Value: TImageList);
{$ENDIF}
    procedure SetIconIndex(Value: Integer);
    procedure SetHint(Value: THintString);
    procedure SetShowHint(Value: Boolean);
    procedure SetWantEnterExitEvents(Value: Boolean);
    procedure SetBehavior(Value: TBehavior);
    procedure IconChanged(Sender: TObject);
{$IFDEF WINNT_SERVICE_HACK}
    function IsWinNT: Boolean;
{$ENDIF}
    // Hook methods
    function HookAppProc(var Msg: TMessage): Boolean;
    procedure HookForm;
    procedure UnhookForm;
    procedure HookFormProc(var Msg: TMessage);
    // SimpleTimer event methods
    procedure ClickTimerProc(Sender: TObject);
    procedure CycleTimerProc(Sender: TObject);
    procedure MouseExitTimerProc(Sender: TObject);
  protected
    IconData: TNotifyIconDataEx;       // Data of the tray icon wnd.
    procedure Loaded; override;
    function LoadDefaultIcon: Boolean; virtual;
    function ShowIcon: Boolean; virtual;
    function HideIcon: Boolean; virtual;
    function ModifyIcon: Boolean; virtual;
    procedure Click; dynamic;
    procedure DblClick; dynamic;
    procedure CycleIcon; 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 MouseEnter; dynamic;
    procedure MouseExit; dynamic;
    procedure DoMinimizeToTray; dynamic;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    property Handle: HWND read IconData.hWnd;
    property Behavior: TBehavior read FBehavior write SetBehavior default bhWin95;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Refresh: Boolean;
    function ShowBalloonHint(Title, Text: String; IconType: TBalloonHintIcon;
      TimeoutSecs: TBalloonHintTimeOut): Boolean;
    function ShowBalloonHintUnicode(Title, Text: WideString; IconType: TBalloonHintIcon;
      TimeoutSecs: TBalloonHintTimeOut): Boolean;
    function HideBalloonHint: Boolean;
    procedure Popup(X, Y: Integer);
    procedure PopupAtCursor;
    function BitmapToIcon(const Bitmap: TBitmap; const Icon: TIcon;
      MaskColor: TColor): Boolean;
    function GetClientIconPos(X, Y: Integer): TPoint;
    function GetTooltipHandle: HWND;
    function GetBalloonHintHandle: HWND;
    function SetFocus: Boolean;
    //----- SPECIAL: methods that only apply when owner is a form -----
    procedure HideTaskbarIcon;
    procedure ShowTaskbarIcon;
    procedure ShowMainForm;
    procedure HideMainForm;
    //----- END SPECIAL -----
  published
    // Properties:
    property DesignPreview: Boolean read FDesignPreview write SetDesignPreview
      default False;
{$IFDEF DELPHI_4_UP}
    property IconList: TCustomImageList read FIconList write SetIconList;
{$ELSE}
    property IconList: TImageList read FIconList write SetIconList;
{$ENDIF}
    property CycleIcons: Boolean read FCycleIcons write SetCycleIcons
      default False;
    property CycleInterval: Cardinal read FCycleInterval write SetCycleInterval;
    property Enabled: Boolean read FEnabled write FEnabled default True;
    property Hint: THintString read FHint write SetHint;
    property ShowHint: Boolean read FShowHint write SetShowHint default True;
    property Icon: TIcon read FIcon write SetIcon;
    property IconVisible: Boolean read FIconVisible write SetIconVisible
      default False;
    property IconIndex: Integer read FIconIndex write SetIconIndex;
    property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
    property LeftPopup: Boolean read FLeftPopup write FLeftPopup default False;
    property WantEnterExitEvents: Boolean read FWantEnterExitEvents
      write SetWantEnterExitEvents default False;
    //----- SPECIAL: properties that only apply when owner is a form -----
    property MinimizeToTray: Boolean read FMinimizeToTray write FMinimizeToTray
      default False;             // Minimize main form to tray when minimizing?
    //----- END SPECIAL -----
    // Events:
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
    property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseExit: TNotifyEvent read FOnMouseExit write FOnMouseExit;
    property OnCycle: TCycleEvent read FOnCycle write FOnCycle;
    property OnBalloonHintShow: TNotifyEvent read FOnBalloonHintShow
      write FOnBalloonHintShow;
    property OnBalloonHintHide: TNotifyEvent read FOnBalloonHintHide
      write FOnBalloonHintHide;
    property OnBalloonHintTimeout: TNotifyEvent read FOnBalloonHintTimeout
      write FOnBalloonHintTimeout;
    property OnBalloonHintClick: TNotifyEvent read FOnBalloonHintClick
      write FOnBalloonHintClick;
    //----- SPECIAL: events that only apply when owner is a form -----
    property OnMinimizeToTray: TNotifyEvent read FOnMinimizeToTray
      write FOnMinimizeToTray;
    property OnStartup: TStartupEvent read FOnStartup write FOnStartup;
    //----- END SPECIAL -----
  end;


implementation

{$IFDEF DELPHI_4_UP}
uses
  ComCtrls;
{$ENDIF}

const
  // Key select events (Space and Enter)
  NIN_SELECT           = WM_USER + 0;
  NINF_KEY             = 1;
  NIN_KEYSELECT        = NINF_KEY or NIN_SELECT;
  // Events returned by balloon hint
  NIN_BALLOONSHOW      = WM_USER + 2;
  NIN_BALLOONHIDE      = WM_USER + 3;
  NIN_BALLOONTIMEOUT   = WM_USER + 4;
  NIN_BALLOONUSERCLICK = WM_USER + 5;
  // Constants used for balloon hint feature
  NIIF_NONE            = $00000000;
  NIIF_INFO            = $00000001;
  NIIF_WARNING         = $00000002;
  NIIF_ERROR           = $00000003;
  NIIF_USER            = $00000004;
  NIIF_ICON_MASK       = $0000000F;    // Reserved for WinXP
  NIIF_NOSOUND         = $00000010;    // Reserved for WinXP
  // uFlags constants for TNotifyIconDataEx
  NIF_STATE            = $00000008;
  NIF_INFO             = $00000010;
  NIF_GUID             = $00000020;
  // dwMessage constants for Shell_NotifyIcon
  NIM_SETFOCUS         = $00000003;
  NIM_SETVERSION       = $00000004;
  NOTIFYICON_VERSION   = 3;            // Used with the NIM_SETVERSION message
  // Tooltip constants
  TOOLTIPS_CLASS       = 'tooltips_class32';
  TTS_NOPREFIX         = 2;

type
  TTrayIconHandler = class(TObject)
  private
    RefCount: Cardinal;
    FHandle: HWND;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add;
    procedure Remove;
    procedure HandleIconMessage(var Msg: TMessage);
  end;

var
  TrayIconHandler: TTrayIconHandler = nil;
{$IFDEF WINNT_SERVICE_HACK}
  WinNT: Boolean = False;              // For Win NT
  HComCtl32: Cardinal = $7FFFFFFF;     // For Win NT
{$ENDIF}
  WM_TASKBARCREATED: Cardinal;
{$IFDEF DELPHI_4_UP}
  SHELL_VERSION: Integer;
{$ENDIF}

{------------------ TTrayIconHandler ------------------}

constructor TTrayIconHandler.Create;
begin
  inherited Create;
  RefCount := 0;
{$IFDEF DELPHI_6_UP}
  FHandle := Classes.AllocateHWnd(HandleIconMessage);
{$ELSE}
  FHandle := AllocateHWnd(HandleIconMessage);
{$ENDIF}
end;


destructor TTrayIconHandler.Destroy;
begin
{$IFDEF DELPHI_6_UP}
  Classes.DeallocateHWnd(FHandle);     // Free the tray window
{$ELSE}
  DeallocateHWnd(FHandle);             // Free the tray window
{$ENDIF}
  inherited Destroy;
end;


procedure TTrayIconHandler.Add;
begin
  Inc(RefCount);
end;


procedure TTrayIconHandler.Remove;
begin
  if RefCount > 0 then
    Dec(RefCount);
end;


{ HandleIconMessage handles messages that go to the shell notification
  window (tray icon) itself. Most messages are passed through WM_TRAYNOTIFY.
  In these cases we use lParam to get the actual message, eg. WM_MOUSEMOVE.
  The method fires the appropriate event methods like OnClick and OnMouseMove. }

{ The message always goes through the container, TrayIconHandler.
  Msg.wParam contains the ID of the TCoolTrayIcon instance, which we stored
  as the object pointer Self in the TCoolTrayIcon constructor. We therefore
  cast wParam to a TCoolTrayIcon instance. }

procedure TTrayIconHandler.HandleIconMessage(var Msg: TMessage);

  function ShiftState: TShiftState;
  // Return the state of the shift, ctrl, and alt keys
  begin
    Result := [];
    if GetAsyncKeyState(VK_SHIFT) < 0 then
      Include(Result, ssShift);
    if GetAsyncKeyState(VK_CONTROL) < 0 then
      Include(Result, ssCtrl);
    if GetAsyncKeyState(VK_MENU) < 0 then
      Include(Result, ssAlt);
  end;

var
  Pt: TPoint;
  Shift: TShiftState;
  I: Integer;
  M: TMenuItem;
{$IFDEF WINNT_SERVICE_HACK}
  InitComCtl32: procedure;
{$ENDIF}
begin
  if Msg.Msg = WM_TRAYNOTIFY then
  // Take action if a message from the tray icon comes through
  begin