jvballoonhint.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvBalloonHint.PAS, released on 2001-02-28.

The Initial Developer of the Original Code is Remko Bonte <remkobonte att myrealbox dott com>
Portions created by Remko Bonte are Copyright (C) 2002 Remko Bonte.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
  * Only dropdown shadow for windows xp systems.
  * Only custom animation for windows xp systems, because of use of window region.
-----------------------------------------------------------------------------}
// $Id: JvBalloonHint.pas,v 1.34 2005/02/17 10:19:59 marquardt Exp $

unit JvBalloonHint;

{$I jvcl.inc}
{$I windowsonly.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, Classes, Controls, Graphics, Forms, ImgList,
  JvComponent;

const
  CJvBallonHintVisibleTimeDefault = 5000;

type
  TJvStemSize = (ssSmall, ssNormal, ssLarge);
  TJvIconKind = (ikCustom, ikNone, ikApplication, ikError, ikInformation, ikQuestion, ikWarning);
  TJvBalloonOption = (boUseDefaultHeader, boUseDefaultIcon, boUseDefaultImageIndex,
    boShowCloseBtn, boCustomAnimation, boPlaySound);
  TJvBalloonOptions = set of TJvBalloonOption;
  TJvApplicationHintOption = (ahShowHeaderInHint, ahShowIconInHint, ahPlaySound);
  TJvApplicationHintOptions = set of TJvApplicationHintOption;
  TJvBalloonPosition = (bpAuto, bpLeftDown, bpRightDown, bpLeftUp, bpRightUp);
  TJvAnimationStyle = (atNone, atSlide, atRoll, atRollHorNeg, atRollHorPos, atRollVerNeg,
    atRollVerPos, atSlideHorNeg, atSlideHorPos, atSlideVerNeg, atSlideVerPos, atCenter, atBlend);

  TJvBalloonHint = class;

  PHintData = ^THintData;
  THintData = record
    RAnchorWindow: TCustomForm;
    { Position of the top-left edge of the window balloon inside the client
      rect of the anchor window (Used to move the balloon window if the
      anchor window moves): }
    RAnchorPosition: TPoint;
    { Position of the stem point inside the client rect of the balloon window
      (Used the check on resize of the anchor window whether the stem point is
      still inside the balloon window): }
    RStemPointPosition: TPoint;
    RHeader: string;
    RHint: string;
    RIconKind: TJvIconKind;
    RImageIndex: TImageIndex;
    RVisibleTime: Integer;
    RShowCloseBtn: Boolean;
    RAnimationStyle: TJvAnimationStyle;
    RAnimationTime: Cardinal;
    { If the position of the balloon needs to be changed - for example if
      DefaultBalloonPosition = bpAuto - RSwitchHeight indicates how much we
      change the vertical position; if the balloon is an application hint,
      RSwitchHeight is the height of the cursor; if the balloon is attached to
      a control, RSwitchHeight is the height of that control }
    RSwitchHeight: Integer;
  end;

  TJvBalloonWindow = class(THintWindow)
  private
    FCurrentPosition: TJvBalloonPosition;
    FDeltaY: Integer;
    FSwitchHeight: Integer;
    FShowIcon: Boolean;
    FShowHeader: Boolean;
    FMsg: string;
    FHeader: string;
    FMessageTop: Integer;
    FTipHeight: Integer;
    FTipWidth: Integer;
    FTipDelta: Integer;
    FImageSize: TSize;
    function GetStemPointPosition: TPoint;
    function GetStemPointPositionInRect(const ARect: TRect): TPoint;
  protected
    procedure CMTextChanged(var Msg: TMessage); message CM_TEXTCHANGED;
    procedure CMShowingChanged(var Msg: TMessage); message CM_SHOWINGCHANGED;
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure CreateParams(var Params: TCreateParams); override;
    {$IFDEF COMPILER6_UP}
    procedure NCPaint(DC: HDC); override;
    {$ELSE}
    procedure WMNCPaint(var Msg: TMessage); message WM_NCPAINT;
    {$ENDIF COMPILER6_UP}
    procedure Paint; override;

    function CreateRegion: HRGN;
    procedure UpdateRegion;
    procedure CalcAutoPosition(var ARect: TRect);
    procedure CheckPosition(var ARect: TRect);

    function CalcOffset(const ARect: TRect): TPoint;
    function CalcHeaderRect(MaxWidth: Integer): TRect; virtual;
    function CalcMsgRect(MaxWidth: Integer): TRect; virtual;
    procedure Init(AData: Pointer); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    procedure ActivateHint(Rect: TRect; const AHint: string); override;
    function CalcHintRect(MaxWidth: Integer; const AHint: string;
      AData: Pointer): TRect; override;
    property StemPointPosition: TPoint read GetStemPointPosition;
  end;

  TJvBalloonWindowEx = class(TJvBalloonWindow)
  private
    FCtrl: TJvBalloonHint;
    FCloseBtnRect: TRect;
    FCloseState: Cardinal;
    FImageIndex: TImageIndex;
    FIconKind: TJvIconKind;
    FAnimationTime: Cardinal;
    FAnimationStyle: TJvAnimationStyle;
    FShowCloseBtn: Boolean;
    FIsAnchored: Boolean;
  protected
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMMouseMove(var Msg: TWMMouseMove); message WM_MOUSEMOVE;
    procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var Msg: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMActivateApp(var Msg: TWMActivateApp); message WM_ACTIVATEAPP;

    procedure Paint; override;

    { Either calls NormalizeTopMost or RestoreTopMost depending on whether the
      anchor window has focus }
    procedure EnsureTopMost;
    { Sets the balloon on top of anchor window; but below other windows }
    procedure NormalizeTopMost;
    { Sets the balloon top most }
    procedure RestoreTopMost;

    procedure InternalActivateHint(var Rect: TRect; const AHint: string);
    procedure MoveWindow(NewPos: TPoint);
    procedure ChangeCloseState(const AState: Cardinal);

    function CalcHeaderRect(MaxWidth: Integer): TRect; override;
    procedure Init(AData: Pointer); override;
  end;

  TJvBalloonHint = class(TJvComponent)
  private
    FHint: TJvBalloonWindowEx;
    FActive: Boolean;
    FOptions: TJvBalloonOptions;
    FImages: TCustomImageList;
    FDefaultHeader: string;
    FDefaultIcon: TJvIconKind;
    FDefaultImageIndex: TImageIndex;
    FData: THintData;
    FApplicationHintOptions: TJvApplicationHintOptions;
    FDefaultBalloonPosition: TJvBalloonPosition;
    FCustomAnimationTime: Cardinal;
    FCustomAnimationStyle: TJvAnimationStyle;

    FOnBalloonClick: TNotifyEvent;
    FOnClose: TNotifyEvent;
    FOnCloseBtnClick: TCloseQueryEvent;
    FOnDblClick: TNotifyEvent;
    FOnMouseDown: TMouseEvent;
    FOnMouseMove: TMouseMoveEvent;
    FOnMouseUp: TMouseEvent;

    FHandle: THandle;
    FTimerActive: Boolean;

    function GetHandle: THandle;
    function GetUseBalloonAsApplicationHint: Boolean;
    procedure SetImages(const Value: TCustomImageList);
    procedure SetOptions(const Value: TJvBalloonOptions);
    procedure SetUseBalloonAsApplicationHint(const Value: Boolean);
  protected
    function HookProc(var Msg: TMessage): Boolean;
    procedure Hook;
    procedure UnHook;

    procedure HandleMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure HandleMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure HandleMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure HandleClick(Sender: TObject);
    procedure HandleDblClick(Sender: TObject);
    function HandleCloseBtnClick: Boolean;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    procedure StartHintTimer(Value: Integer);
    procedure StopHintTimer;

    procedure InternalActivateHintPos;
    procedure InternalActivateHint(ACtrl: TControl);

    procedure WndProc(var Msg: TMessage);

    property Handle: THandle read GetHandle;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure ActivateHint(ACtrl: TControl; const AHint: string; const AHeader: string = '';
      const VisibleTime: Integer = CJvBallonHintVisibleTimeDefault); overload;
    procedure ActivateHint(ACtrl: TControl; const AHint: string; const AImageIndex: TImageIndex;
      const AHeader: string = ''; const VisibleTime: Integer = CJvBallonHintVisibleTimeDefault); overload;
    procedure ActivateHint(ACtrl: TControl; const AHint: string; const AIconKind: TJvIconKind;
      const AHeader: string = ''; const VisibleTime: Integer = CJvBallonHintVisibleTimeDefault); overload;
    procedure ActivateHintPos(AAnchorWindow: TCustomForm; AAnchorPosition: TPoint;
      const AHeader, AHint: string; const VisibleTime: Integer = CJvBallonHintVisibleTimeDefault;
      const AIconKind: TJvIconKind = ikInformation; const AImageIndex: TImageIndex = -1);
    procedure ActivateHintRect(ARect: TRect; const AHeader, AHint: string;
      const VisibleTime: Integer = CJvBallonHintVisibleTimeDefault; const AIconKind: TJvIconKind = ikInformation;
      const AImageIndex: TImageIndex = -1);
    procedure CancelHint;

    property Active: Boolean read FActive;
  published
    property CustomAnimationStyle: TJvAnimationStyle read FCustomAnimationStyle write
      FCustomAnimationStyle default atBlend;
    property CustomAnimationTime: Cardinal read FCustomAnimationTime write FCustomAnimationTime
      default 100;
    property DefaultBalloonPosition: TJvBalloonPosition read FDefaultBalloonPosition write
      FDefaultBalloonPosition default bpAuto;
    property DefaultImageIndex: TImageIndex read FDefaultImageIndex write FDefaultImageIndex
      default -1;
    property DefaultHeader: string read FDefaultHeader write FDefaultHeader;
    property DefaultIcon: TJvIconKind read FDefaultIcon write FDefaultIcon default ikInformation;
    property Images: TCustomImageList read FImages write SetImages;
    property Options: TJvBalloonOptions read FOptions write SetOptions default [boShowCloseBtn];
    property ApplicationHintOptions: TJvApplicationHintOptions read FApplicationHintOptions write
      FApplicationHintOptions default [ahShowHeaderInHint, ahShowIconInHint];
    property UseBalloonAsApplicationHint: Boolean read GetUseBalloonAsApplicationHint write
      SetUseBalloonAsApplicationHint default False;

    property OnBalloonClick: TNotifyEvent read FOnBalloonClick write FOnBalloonClick;
    property OnCloseBtnClick: TCloseQueryEvent read FOnCloseBtnClick write FOnCloseBtnClick;
    property OnClose: TNotifyEvent read FOnClose write FOnClose;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvBalloonHint.pas,v $';
    Revision: '$Revision: 1.34 $';
    Date: '$Date: 2005/02/17 10:19:59 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  SysUtils, Math,
  Registry, CommCtrl, MMSystem,
  ComCtrls, // needed for GetComCtlVersion
  JvJVCLUtils, JvThemes, JvWndProcHook, JvResources;

const
  { TJvStemSize = (ssSmall, ssNormal, ssLarge);
    ssLarge isn't used (yet)
  }
  CTipHeight: array [TJvStemSize] of Integer = (8, 16, 24);
  CTipWidth: array [TJvStemSize] of Integer = (8, 16, 24);
  CTipDelta: array [TJvStemSize] of Integer = (16, 15, 17);
  DefaultTextFlags:Longint = DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX;

type
  TGlobalCtrl = class(TComponent)
  private
    FBkColor: TColor;
    FCtrls: TList;
    FDefaultImages: TImageList;
    FNeedUpdateBkColor: Boolean;
    FOldHintWindowClass: THintWindowClass;
    FSounds: array [TJvIconKind] of string;
    FUseBalloonAsApplicationHint: Boolean;
    FDesigning: Boolean;
    function GetMainCtrl: TJvBalloonHint;
    procedure GetDefaultImages;
    procedure GetDefaultSounds;
    procedure SetBkColor(const Value: TColor);
    procedure SetUseBalloonAsApplicationHint(const Value: Boolean);
  protected
    procedure Add(ABalloonHint: TJvBalloonHint);
    procedure Remove(ABalloonHint: TJvBalloonHint);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    class function Instance: TGlobalCtrl;
    function HintImageSize: TSize; overload;
    function HintImageSize(const AIconKind: TJvIconKind;
      const AImageIndex: TImageIndex): TSize; overload;
    procedure DrawHintImage(Canvas: TCanvas; X, Y: Integer; const ABkColor: TColor); overload;
    procedure DrawHintImage(Canvas: TCanvas; X, Y: Integer; const AIconKind: TJvIconKind;
      const AImageIndex: TImageIndex; const ABkColor: TColor); overload;
    procedure PlaySound(const AIconKind: TJvIconKind);

    property BkColor: TColor read FBkColor write SetBkColor;
    property MainCtrl: TJvBalloonHint read GetMainCtrl;
    property UseBalloonAsApplicationHint: Boolean read FUseBalloonAsApplicationHint
      write SetUseBalloonAsApplicationHint;
  end;

var
  GGlobalCtrl: TGlobalCtrl = nil;
  { A TJvBalloonHint may be needed, while there isn't an instance of it around.
    For example, if the user sets HintWindowClass to TJvBalloonWindow.
  }
  GMainCtrl: TJvBalloonHint = nil;

function WorkAreaRect: TRect;
begin
  SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0);
end;

{$IFNDEF COMPILER6_UP}

const
  SPI_GETTOOLTIPANIMATION = $1016;
  {$EXTERNALSYM SPI_GETTOOLTIPANIMATION}
  SPI_GETTOOLTIPFADE = $1018;
  {$EXTERNALSYM SPI_GETTOOLTIPFADE}

type
  TAnimateWindowProc = function(hWnd: HWND; dwTime: DWORD; dwFlags: DWORD): BOOL; stdcall;

var
  AnimateWindowProc: TAnimateWindowProc = nil;

procedure InitD5Controls;
var
  UserHandle: HMODULE;
begin
  if not Assigned(AnimateWindowProc) then
  begin
    UserHandle := GetModuleHandle('USER32');
    if UserHandle <> 0 then
      @AnimateWindowProc := GetProcAddress(UserHandle, 'AnimateWindow');
  end;
end;

{$ENDIF !COMPILER6_UP}

function IsWinXP_UP: Boolean;
begin
  Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and
    ((Win32MajorVersion > 5) or
    (Win32MajorVersion = 5) and (Win32MinorVersion >= 1));
end;

{$IFDEF COMPILER6_UP}
function InternalClientToParent(AControl: TControl; const Point: TPoint;
  AParent: TWinControl): TPoint;
begin
  Result := AControl.ClientToParent(Point, AParent);
end;
{$ELSE}
function InternalClientToParent(AControl: TControl; const Point: TPoint;
  AParent: TWinControl): TPoint;
var
  LParent: TWinControl;
begin
  if AParent = nil then
    AParent := AControl.Parent;
  if AParent = nil then
    raise EInvalidOperation.CreateResFmt(@RsEParentRequired, [AControl.Name]);
  Result := Point;
  Inc(Result.X, AControl.Left);
  Inc(Result.Y, AControl.Top);
  LParent := AControl.Parent;
  while LParent <> nil do
  begin
    if LParent.Parent <> nil then
    begin
      Inc(Result.X, LParent.Left);
      Inc(Result.Y, LParent.Top);
    end;
    if LParent = AParent then
      Break
    else
      LParent := LParent.Parent;
  end;
  if LParent = nil then
    raise EInvalidOperation.CreateResFmt(@RsEParentGivenNotAParent, [AControl.Name]);
end;
{$ENDIF COMPILER6_UP}

//=== { TJvBalloonWindow } ===================================================

constructor TJvBalloonWindow.Create(AOwner: TComponent);
begin
  {$IFNDEF COMPILER6_UP}
  InitD5Controls;
  {$ENDIF !COMPILER6_UP}
  inherited Create(AOwner);
  ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks];
end;

procedure TJvBalloonWindow.ActivateHint(Rect: TRect; const AHint: string);
begin
  if HandleAllocated and IsWindowVisible(Handle) then
    ShowWindow(Handle, SW_HIDE);

  CheckPosition(Rect);

  Inc(Rect.Bottom, 4);
  UpdateBoundsRect(Rect);
  Dec(Rect.Bottom, 4);

  UpdateRegion;

  with TGlobalCtrl.Instance do
    if ahPlaySound in MainCtrl.ApplicationHintOptions then
      PlaySound(MainCtrl.DefaultIcon);
  inherited ActivateHint(Rect, AHint);
end;

procedure TJvBalloonWindow.CalcAutoPosition(var ARect: TRect);
var
  NewPosition: TJvBalloonPosition;
  ScreenRect: TRect;
  LStemPointPosition: TPoint;
begin
  { bpAuto returns the same value as bpLeftDown; bpLeftDown is choosen
    arbitrary }
  FCurrentPosition := bpLeftDown;
  ScreenRect := WorkAreaRect;

  { Note: 2*(Left + Width div 2) = 2*(Left + (Right-Left) div 2) ~=
          2*Left + (Right-Left) = Left + Right;

          Thus multiply everything with 2

         Monitor:
     |---------------|
     |       |       |
     |   1   |   2   |
     |       |       |
     |---------------|
     |       |       |
     |   3   |   4   |
     |       |       |
     |---------------|

  }
  with GetStemPointPositionInRect(ARect) do
    LStemPointPosition := Point(X * 2, Y * 2);

  if LStemPointPosition.Y < ScreenRect.Top + ScreenRect.Bottom then
  begin
    if LStemPointPosition.X < ScreenRect.Left + ScreenRect.Right then
      { 1 }
      NewPosition := bpLeftUp
    else
      { 2 }
      NewPosition := bpRightUp;
  end
  else
  begin
    if LStemPointPosition.X < ScreenRect.Left + ScreenRect.Right then
      { 3 }
      NewPosition := bpLeftDown
    else
      { 4 }
      NewPosition := bpRightDown;
  end;

  if NewPosition <> FCurrentPosition then
  begin
    { Reset the offset.. }