cooltrayicon.pas

絮语2007视频聊天软件源程序.仅供参考

{*****************************************************************}
{ 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) 2001                                              }
{*****************************************************************}

unit CoolTrayIcon;

interface

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

const
  { Define user-defined message sent by the trayicon. We avoid low user-defined
    messages that are used by Windows itself (eg. WM_USER+1 = DM_SETDEFID). }
  WM_TRAYNOTIFY = WM_USER + 1024;
  // Constant used for recreating trayicon on system traybar recover
  IconID = 1;
  // Constants used for balloon hint feature
  WM_RESETTOOLTIP = WM_USER + 1025;
  NIIF_NONE    = $00000000;
  NIIF_INFO    = $00000001;
  NIIF_WARNING = $00000002;
  NIIF_ERROR   = $00000003;
  NIF_INFO     = $00000010;

var
  WM_TASKBARCREATED: Cardinal;

type
  { You can use the TNotifyIconData record structure defined in shellapi.pas.
    However, WinME, Win2000, and WinXP have expanded this structure. We define
    a similar structure, TNotifyIconDataEx. }
  TNotifyIconDataEx = record
    cbSize: DWORD;
    Wnd: HWND;
    uID: UINT;
    uFlags: UINT;
    uCallbackMessage: UINT;
    hIcon: HICON;
//    szTip: array[0..63] of AnsiChar;
    szTip: array[0..127] of AnsiChar;      // 0..63 of WideChar in stead?
    dwState: DWORD;
    dwStateMask: DWORD;
    szInfo: array[0..255] of AnsiChar;
    uTimeout: UINT; // union with uVersion: UINT;
    szInfoTitle: array[0..63] of AnsiChar;
    dwInfoFlags: DWORD;
  end;

  TBalloonHintIcon = (bitNone, bitInfo, bitWarning, bitError);
  TBalloonHintTimeOut = 10..60;   // Windows defines 10-60 secs. as min-max

  TCycleEvent = procedure(Sender: TObject; NextIndex: Integer) of object;

  TCoolTrayIcon = class(TComponent)
  private
    Fmini: Boolean;
    FEnabled: Boolean;
    FIcon: TIcon;
    FIconVisible: Boolean;
    FHint: String;
    Fmd5name: string;
    FShowHint: Boolean;
    FPopupMenu: TPopupMenu;
    FPopupMenuEx: TPopupMenu;
    FOnClick,
    FOnDblClick: TNotifyEvent;
    FOnCycle: TCycleEvent;
    FOnMouseDown,
    FOnMouseUp: TMouseEvent;
    FOnMouseMove: TMouseMoveEvent;
    FStartMinimized: Boolean;
    FMinimizeToTray: Boolean;
    FClickStart: Boolean;
    CycleTimer: TTimer;                // For icon cycling
    FIconIndex: Integer;               // Current index in imagelist
    FDesignPreview: Boolean;
    SettingPreview: Boolean;           // Internal status flag
    SettingMDIForm: Boolean;           // Internal status flag
    FIconList: TImageList;
    Ftimers:TTimer;
    FCycleIcons: Boolean;
    FCycleInterval: Cardinal;
    OldAppProc, NewAppProc: Pointer;   // Procedure variables
    OldWndProc, NewWndProc: Pointer;   // Procedure variables
    FWindowHandle: HWND;               // Window handle (not general handle)
    procedure SetDesignPreview(Value: Boolean);
    procedure SetCycleIcons(Value: Boolean);
    procedure SetCycleInterval(Value: Cardinal);
    procedure TimerCycle(Sender: TObject);
    procedure HandleIconMessage(var Msg: TMessage);
    function InitIcon: Boolean;
    procedure SetIcon(Value: TIcon);
    procedure SetIconVisible(Value: Boolean);
    procedure SetIconList(Value: TImageList);
    procedure SetIconIndex(Value: Integer);
    procedure SetHint(Value: String);
    procedure SetShowHint(Value: Boolean);
    procedure PopupAtCursor(Vleft:boolean);
    procedure leftpopup(sender:tobject);
    // Hook methods
    procedure HookApp;
    procedure UnhookApp;
    procedure HookAppProc(var Msg: TMessage);
    procedure HookForm;
    procedure UnhookForm;
    procedure HookFormProc(var Msg: TMessage);
  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 DoMinimizeToTray; dynamic;
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
  public
{$IFDEF DFS_CPPB_3_UP}
    property Handle: HWND read IconData.hWnd;
{$ELSE}
    property Handle: HWND read IconData.Wnd;
{$ENDIF}
    property WindowHandle: HWND read FWindowHandle;
    property mini:boolean read Fmini write Fmini;
    property md5name:string read Fmd5name write Fmd5name;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Refresh: Boolean;
    function ShowBalloonHint(Title: String; Text: String; IconType: TBalloonHintIcon;
      TimeoutSecs: TBalloonHintTimeOut): Boolean;
    function BitmapToIcon(const Bitmap: TBitmap; const Icon: TIcon;
      MaskColor: TColor): Boolean;
    //----- SPECIAL: methods that only apply when owner is a form -----
    procedure ShowMainForm;
    procedure HideMainForm;
    //----- END SPECIAL -----
  published
    // Properties:
    property DesignPreview: Boolean read FDesignPreview
      write SetDesignPreview default False;
    property IconList: TImageList read FIconList write SetIconList;
    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: String read FHint write SetHint;
    property ShowHint: Boolean read FShowHint write SetShowHint
      default True;
    property Icon: TIcon read FIcon write SetIcon stored True;
    property IconVisible: Boolean read FIconVisible write SetIconVisible
      default True;
    property IconIndex: Integer read FIconIndex write SetIconIndex;
    property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
    property PopupMenuEx: TPopupMenu read FPopupMenuEx write FPopupMenuEx;
    //----- SPECIAL: properties that only apply when owner is a form -----
    property StartMinimized: Boolean read FStartMinimized write FStartMinimized
      default False;         // Main form minimized on app. start-up?
    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 OnCycle: TCycleEvent read FOnCycle write FOnCycle;
  end;

procedure Register;

implementation

{------------------- TCoolTrayIcon --------------------}

constructor TCoolTrayIcon.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SettingMDIForm := True;
  FIconVisible := True;      // Visible by default
  FEnabled := True;          // Enabled by default
  FShowHint := True;         // Show hint by default
  SettingPreview := False;

  // Use the TaskbarCreated message available from Win98/IE4+
  WM_TASKBARCREATED := RegisterWindowMessage('TaskbarCreated');

  FIcon := TIcon.Create;
  IconData.cbSize := SizeOf(TNotifyIconDataEx);
  // IconData.wnd points to procedure to receive callback messages from the icon
  IconData.wnd := AllocateHWnd(HandleIconMessage);
  // Add an id for the tray icon
  IconData.uId := IconID;
  // We want icon, message handling, and tooltips by default
  IconData.uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
  // Message to send to IconData.wnd when event occurs
  IconData.uCallbackMessage := WM_TRAYNOTIFY;

  FWindowHandle := GetWindowLong(IconData.wnd, GWL_HWNDPARENT);

  CycleTimer := TTimer.Create(Self);
  CycleTimer.Enabled := False;
  CycleTimer.Interval := FCycleInterval;
  CycleTimer.OnTimer := TimerCycle;

  Ftimers    := TTimer.Create(Self);
  Ftimers.enabled:=false;
  Ftimers.interval:=GetDoubleClickTime;
  Ftimers.OnTimer:=leftpopup;

  { Assign a default icon if Icon property is empty. This will assign
    an icon to the component when it is created for the very first time.
    When the user assigns another icon it will not be overwritten next
    time the project loads. HOWEVER, if the user has decided explicitly
    to have no icon a default icon will be inserted regardless.
    I figured this was a tolerable price to pay. }
  if (csDesigning in ComponentState) then
    if FIcon.Handle = 0 then
      if LoadDefaultIcon then
        FIcon.Handle := LoadIcon(0, IDI_WINLOGO);
  { It is tempting to assign the application's icon (Application.Icon)
    as a default icon. The problem is there's no Application instance
    at design time. Or is there? Yes there is: the Delphi editor!
    Application.Icon is the icon found in delphi32.exe. How to use:
      FIcon.Assign(Application.Icon); }

  // Set hook(s)
  if not (csDesigning in ComponentState) then
  begin
    HookApp;                 // Hook into the app.'s message handling
    if Owner is TWinControl then
      HookForm;              // Hook into the main form's message handling
  end;
end;


destructor TCoolTrayIcon.Destroy;
begin
  SetIconVisible(False);     // Remove the icon from the tray
  SetDesignPreview(False);   // Remove any DesignPreview icon
  FIcon.Free;                // Free the icon
  DeallocateHWnd(IconData.Wnd);   // Free the tray window
  CycleTimer.Free;
  Ftimers.free;
  // It is important to unhook any hooked processes
  if not (csDesigning in ComponentState) then
  begin
    UnhookApp;
    if Owner is TWinControl then
      UnhookForm;
  end;
  inherited Destroy;
end;


procedure TCoolTrayIcon.Loaded;
{ This method is called when all properties of the component have been
  initialized. The method SetIconVisible must be called here, after the
  tray icon (FIcon) has loaded itself. Otherwise, the tray icon will
  be blank (no icon image). }
begin
  inherited Loaded;	     // Always call inherited Loaded first
  if Owner is TWinControl then
    if (FStartMinimized) and not (csDesigning in ComponentState) then
    begin
      Application.ShowMainForm := False;
      ShowWindow(Application.Handle, SW_HIDE);
    end;
  ModifyIcon;
  SetIconVisible(FIconVisible);
end;


function TCoolTrayIcon.LoadDefaultIcon: Boolean;
{ This method is called to determine whether to assign a default
  icon to the component. Descendant classes (like TextTrayIcon) can
  override the method to change this behavior. }
begin
  Result := True;
end;


procedure TCoolTrayIcon.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  { Check if either the imagelist or the popup menu is about
    to be deleted }
  if (AComponent = IconList) and (Operation = opRemove) then
  begin
    FIconList := nil;
    IconList := nil;
  end;
  if (AComponent = PopupMenu) and (Operation = opRemove) then
  begin
    FPopupMenu := nil;
    PopupMenu := nil;
  end;
end;


{ For MinimizeToTray to work, we need to know when the form is minimized
  (happens when either the application or the main form minimizes).
  The straight-forward way is to make TCoolTrayIcon trap the
  Application.OnMinimize event. However, if you also make use of this
  event in the application, the OnMinimize code used by TCoolTrayIcon
  is discarded.
  The solution is to hook into the app.'s message handling (via HookApp).
  You can then catch any message that goes through the app. and still
  use the OnMinimize event. }

procedure TCoolTrayIcon.HookApp;
begin
  // Hook the application
  OldAppProc := Pointer(GetWindowLong(Application.Handle, GWL_WNDPROC));
  NewAppProc := MakeObjectInstance(HookAppProc);
  SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(NewAppProc));
end;


procedure TCoolTrayIcon.UnhookApp;
begin
  if Assigned(OldAppProc) then
    SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(OldAppProc));