{*******************************************************************}
{                                                                   }
{       Almediadev Visual Component Library                         }
{       BusinessSkinForm                                            }
{       Version 6.15                                                }
{                                                                   }
{       Copyright (c) 2000-2008 Almediadev                          }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{       Home:  http://www.almdev.com                                }
{       Support: support@almdev.com                                 }
{                                                                   }
{*******************************************************************}

unit bsTrayIcon;

{$P+,S-,W-,R-}
{$WARNINGS OFF}
{$HINTS OFF}

interface

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

const
  WM_TRAYNOTIFY = WM_USER + 1024;
  IconID = 1;

var
  WM_TASKBARCREATED: Cardinal;

type
  TbsNotifyIconDataEx = record
    cbSize: DWORD;
    Wnd: HWND;
    uID: UINT;
    uFlags: UINT;
    uCallbackMessage: UINT;
    hIcon: HICON;
    szTip: array[0..127] of AnsiChar;
    dwState: DWORD;
    dwStateMask: DWORD;
    szInfo: array[0..255] of AnsiChar;
    uTimeout: UINT;
    szInfoTitle: array[0..63] of AnsiChar;
    dwInfoFlags: DWORD;
  end;

  TbsCycleEvent = procedure(Sender: TObject; NextIndex: Integer) of object;
  TbsBalloonHintIcon = (bsbitNone, bsbitInfo, bsbitWarning, bsbitError);

  TbsTrayIcon = class(TComponent)
  private
    FEnabled: Boolean;
    FIcon: TIcon;
    FIconVisible: Boolean;
    FHint: String;
    FShowHint: Boolean;
    FPopupMenu: TbsSkinPopupMenu;
    FPopupByLeftButton: Boolean;
    FOnBalloonHintClick,
    FOnClick,
    FOnDblClick: TNotifyEvent;
    FOnCycle: TbsCycleEvent;
    FOnMouseDown,
    FOnMouseUp: TMouseEvent;
    FOnMouseMove: TMouseMoveEvent;
    FMinimizedOnStart: Boolean;
    FMinimizeToTray: Boolean;
    FClickStart: Boolean;
    FClickReady: Boolean;
    AnimateTimer: TTimer;
    ClickTimer: TTimer;
    IsDblClick: Boolean;
    FIconIndex: Integer;
    FDesignPreview: Boolean;
    SettingPreview: Boolean;
    SettingMDIForm: Boolean;           
    FIconList: TImageList;
    FCycleIcons: Boolean;
    FAnimateTimerInterval: Cardinal;
    OldAppProc, NewAppProc: Pointer;
    OldWndProc, NewWndProc: Pointer;
    FWindowHandle: HWND;               
    procedure SetDesignPreview(Value: Boolean);
    procedure SetCycleIcons(Value: Boolean);
    procedure SetAnimateTimerInterval(Value: Cardinal);
    procedure TimerCycle(Sender: TObject);
    procedure TimerClick(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;
    // Hook methods
    procedure HookApp;
    procedure UnhookApp;
    procedure HookAppProc(var Msg: TMessage);
    procedure HookForm;
    procedure UnhookForm;
    procedure HookFormProc(var Msg: TMessage);
  protected
    IconData: TbsNotifyIconDataEx;       
    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
    property Handle: HWND read IconData.Wnd;
    property WindowHandle: HWND read FWindowHandle;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Refresh: Boolean;
    function BitmapToIcon(const Bitmap: TBitmap; const Icon: TIcon;
      MaskColor: TColor): Boolean;
    procedure ShowMainForm;
    procedure HideMainForm;
    function ShowBalloonHint(Title: String; Text: String;
                             IconType: TbsBalloonHintIcon): Boolean;
    function HideBalloonHint: Boolean;
  published
    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 AnimateTimerInterval: Cardinal read FAnimateTimerInterval
      write SetAnimateTimerInterval;
    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: TbsSkinPopupMenu read FPopupMenu write FPopupMenu;
    property PopupByLeftButton: Boolean read FPopupByLeftButton write FPopupByLeftButton
      default False;
    property MinimizedOnStart: Boolean read FMinimizedOnStart write FMinimizedOnStart
      default False;
    property MinimizeToTray: Boolean read FMinimizeToTray write FMinimizeToTray
      default False;
    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: TbsCycleEvent read FOnCycle write FOnCycle;
    property OnBalloonHintClick: TNotifyEvent read FOnBalloonHintClick write FOnBalloonHintClick;
  end;

implementation

const
  NIIF_NONE            = $00000000;
  NIIF_INFO            = $00000001;
  NIIF_WARNING         = $00000002;
  NIIF_ERROR           = $00000003;
  NIF_INFO             = $00000010;
  NIN_BALLOONUSERCLICK = WM_USER + 5;

constructor TbsTrayIcon.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SettingMDIForm := True;
  FIconVisible := True;
  FMinimizeToTray := True;
  FEnabled := True;
  FShowHint := True;         
  SettingPreview := False;
  WM_TASKBARCREATED := RegisterWindowMessage('TaskbarCreated');
  FIcon := TIcon.Create;
  IconData.cbSize := SizeOf(TbsNotifyIconDataEx);
  IconData.wnd := AllocateHWnd(HandleIconMessage);
  IconData.uId := IconID;
  IconData.uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
  IconData.uCallbackMessage := WM_TRAYNOTIFY;
  FWindowHandle := GetWindowLong(IconData.wnd, GWL_HWNDPARENT);

  AnimateTimer := TTimer.Create(Self);
  AnimateTimer.Enabled := False;
  AnimateTimer.Interval := FAnimateTimerInterval;
  AnimateTimer.OnTimer := TimerCycle;

  ClickTimer := TTimer.Create(Self);
  ClickTimer.Enabled := False;
  ClickTimer.Interval := GetDoubleClickTime;
  ClickTimer.OnTimer := TimerClick;

  if not (csDesigning in ComponentState)
  then
    begin
      if FIcon.Handle = 0
      then
        if LoadDefaultIcon
        then
          FIcon.Handle := Application.Icon.Handle;
      HookApp;
      if Owner is TWinControl then HookForm;
    end;
end;


destructor TbsTrayIcon.Destroy;
begin
  SetIconVisible(False);
  SetDesignPreview(False);
  FIcon.Free;
  DeallocateHWnd(IconData.Wnd);
  AnimateTimer.Free;
  ClickTimer.Free;
  if not (csDesigning in ComponentState)
  then
    begin
      UnhookApp;
      if Owner is TWinControl then UnhookForm;
    end;
  inherited Destroy;
end;


procedure TbsTrayIcon.Loaded;
begin
  inherited Loaded;
  if Owner is TWinControl
  then
    if (FMinimizedOnStart) and not (csDesigning in ComponentState)
    then
      begin
        FIconVisible := True;
        MinimizeToTray := True;
        Application.ShowMainForm := False;
        ShowWindow(Application.Handle, SW_HIDE);
      end;
  ModifyIcon;
  SetIconVisible(FIconVisible);
end;

function TbsTrayIcon.LoadDefaultIcon: Boolean;
begin
  Result := True;
end;

procedure TbsTrayIcon.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FIconList) and (Operation = opRemove)
  then
    begin
      FIconList := nil;
    end;
  if (AComponent = FPopupMenu) and (Operation = opRemove)
  then
    begin
      FPopupMenu := nil;
    end;
end;

procedure TbsTrayIcon.HookApp;
begin
  OldAppProc := Pointer(GetWindowLong(Application.Handle, GWL_WNDPROC));
  NewAppProc := MakeObjectInstance(HookAppProc);
  SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(NewAppProc));
end;

procedure TbsTrayIcon.UnhookApp;
begin
  if Assigned(OldAppProc)
  then
    SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(OldAppProc));
  if Assigned(NewAppProc)
  then
    FreeObjectInstance(NewAppProc);
  NewAppProc := nil;
  OldAppProc := nil;
end;

procedure TbsTrayIcon.HookAppProc(var Msg: TMessage);
begin
  case Msg.Msg of

    WM_SIZE:
      if Msg.wParam = SIZE_MINIMIZED
      then
        begin
          if FMinimizeToTray then DoMinimizeToTray;
        end;

    WM_WINDOWPOSCHANGED:
      begin
        if SettingMDIForm
        then
          if Application.MainForm <> nil
          then
            begin
              if (Application.MainForm.FormStyle = fsMDIForm) then
              if FMinimizedOnStart then
              ShowWindow(Application.Handle, SW_HIDE);
              SettingMDIForm := False;
            end;
      end;
  end;

  if (Msg.Msg = WM_TASKBARCREATED) and FIconVisible then ShowIcon;

  Msg.Result := CallWindowProc(OldAppProc, Application.Handle,
                               Msg.Msg, Msg.wParam, Msg.lParam);
end;

procedure TbsTrayIcon.HookForm;
begin
  if (Owner as TWinControl) <> nil
  then
    begin
      OldWndProc := Pointer(GetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC));
      NewWndProc := MakeObjectInstance(HookFormProc);
      SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(NewWndProc));
    end;
end;

procedure TbsTrayIcon.UnhookForm;
begin
  if ((Owner as TWinControl) <> nil) and (Assigned(OldWndProc))
  then
    SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(OldWndProc));
  if Assigned(NewWndProc)
  then
    FreeObjectInstance(NewWndProc);
  NewWndProc := nil;
  OldWndProc := nil;
end;

procedure TbsTrayIcon.HookFormProc(var Msg: TMessage);
begin
  case Msg.Msg of
    WM_SHOWWINDOW:
     begin
       if (Msg.lParam = 0) and (Msg.wParam = 1)
       then
         begin
           ShowWindow(Application.Handle, SW_RESTORE);
           SetForegroundWindow(Application.Handle);
           SetForegroundWindow((Owner as TWinControl).Handle);
         end;
     end;
    WM_ACTIVATE: begin
       if Assigned(Screen.ActiveControl)
       then
        if (Msg.WParamLo = WA_ACTIVE) or (Msg.WParamLo = WA_CLICKACTIVE)
        then
          if Assigned(Screen.ActiveControl.Parent)
          then
            begin
              if HWND(Msg.lParam) <> Screen.ActiveControl.Parent.Handle
              then SetFocus(Screen.ActiveControl.Handle);
            end
        else
          begin
            if HWND(Msg.lParam) <> Screen.ActiveControl.Handle
            then SetFocus(Screen.ActiveControl.Handle);
          end;
    end;
  end;
  Msg.Result := CallWindowProc(OldWndProc, (Owner as TWinControl).Handle,
                Msg.Msg, Msg.wParam, Msg.lParam);
end;

procedure TbsTrayIcon.HandleIconMessage(var Msg: TMessage);

  function ShiftState: TShiftState;
  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;
begin
  if Msg.Msg = WM_TRAYNOTIFY
  then