unit sHintManager;

{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  sGraphUtils, sConst, sUtils, ExtCtrls, sStylePassive, IniFiles, sHtmlParse;

const
//@EXCLUDE
  DefStyle = hsEllipse;

type
  { Mouse positions relative to hint body. Can be mpLeftTop, mpLeftBottom, mpRightTop and mpRightBottom}
  TsMousePosition = (mpLeftTop, mpLeftBottom, mpRightTop, mpRightBottom);

  TsHintManager = class;

  { Component has been written for changing of standard hints outlook. For using this component just place it on Main form of your application. That all. After that you can change properties according as you want}
  TsHintManager = class(TComponent)
  private
    FsStyle : TsPassivePaintStyle;
    FBevelWidth : integer;
    FBlur: integer;
    FMarginH: integer;
    FMarginV : integer;
    FFont : TFont;
    FStyle : TsHintStyle;
    FRadius : integer;
    FExOffset : integer;
    FMaxWidth : integer;
    FPauseHide: integer;
    FHTMLMode : boolean;
    FPredefinitions: TsHintsPredefinitions;
    FHintsDesigner: integer;
    FOnShowHint: TShowHintEvent;
    procedure SetFont(const Value: TFont);
    procedure SetStyle(const Value: TsHintStyle);
    procedure SetNewStyle(hs: TsHintStyle);
    procedure SetPredefinitions(const Value: TsHintsPredefinitions);
  protected
    function DefStored: boolean;
  public
    FForm: TCustomForm;
    OldshowHintProc : pointer;
    procedure OnShowHintApp(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure Invalidate;
    procedure SetCustomDefinition;
    { The Assign method copies all properties from a Source component to method owner}
//    procedure Assign(Source, Dest: TsHintManager);
    procedure AssignTo(Dest: TPersistent); override;
    procedure PaintBG(BGBmp : TBitmap; R : TRect; ci : TCacheInfo);

    { The SaveToFile method copies all properties of the method owner to file "FileName" in section "Section"}
    procedure SaveToFile(FileName, Section : string);
    { The LoadFromFile method copies all properties from file "FileName" to method owner}
    procedure LoadFromFile(FileName, Section : string);
    procedure ShowHint(p : TPoint; Hint : string); // For future improvement
  published
    property HTMLMode : boolean read FHTMLMode write FHTMLMode default False;
    { Main property for component drawing. (Compatible with sStyle property from TsStyle pack)}
    property sStyle : TsPassivePaintStyle read FsStyle write FsStyle;
    { Set a radius of corners for some styles of hints}
    property Radius : integer read FRadius write FRadius default 20;
    { Set a width of borders for some styles of hints}
    property BevelWidth : integer read FBevelWidth write FBevelWidth default 1;
    { Set a blur for borders for some styles of hints}
    property Blur : integer read FBlur write FBlur default 1;
    { Distance from mouse position to hint body}
    property ExOffset : integer read FExOffset write FExOffset default 32;
    { Pause for hints hiding in msecs}
    property PauseHide : integer read FPauseHide write FPauseHide default 5000;
    { Horizontal margin from borders to text}
    property MarginH : integer read FMarginH write FMarginH default 15;
    { Vertical margin from borders to text}
    property MarginV : integer read FMarginV write FMarginV default 10;
    { Maximal width for hints bodyes}
    property MaxWidth : integer read FMaxWidth write FMaxWidth default 200;
    { Styles for hints (@link(TsHintStyle)). Can be hsSimply, hsExtended, hsEllipse, hsStandard and hsNone. If Style = hsNone, then hints are not shown}
    property Style: TsHintStyle read FStyle write SetStyle default DefStyle;
    { Font for text in hints}
    property Font: TFont read FFont write SetFont;

    property PreDefinitions : TsHintsPredefinitions read FPredefinitions write SetPredefinitions default shEllipse;
    property HintsDesigner : integer read FHintsDesigner write FHintsDesigner;
    property OnShowHint: TShowHintEvent read FOnShowHint write FOnShowHint;
  end;

  { Custom parent window for all sHints styles. In this window hooked WM_ERASEBKGND, WM_NCPAINT and overrided methods @Link(CalcHintRect), @Link(Paint) and @Link(ActivateHint)}
  TsCustomHintWindow = class(THintWindow)
  private
    procedure WMEraseBkGND (var Message: TWMPaint); message WM_ERASEBKGND;
    procedure WMNCPaint (var Message: TWMPaint); message WM_NCPaint;
  protected
    { @EXCLUDE}
    dx, dy : integer;
    { @EXCLUDE}
    FMousePos : TsMousePosition;
    procedure CreateParams(var Params: TCreateParams); override;
    { Function GetMousePosition returns mouse position relative to hint body}
    function GetMousePosition : TPoint; virtual; abstract;
    { Method PaintShadow paints shadow for hint body(if needed)}
    procedure PaintShadow; virtual; abstract;
    { Method GetMask returns mask bitmap for hint body}
    function GetMask : TBitmap; virtual; abstract;
    { Method GetBody returns painted body for hint}
    function GetBody : TBitmap; virtual; abstract;
    { Function MainRect calculates and returns rectangle for hint body without shadow}
    function MainRect: TRect; dynamic;
    { Correct the shadow transparency value if hint body is transparent too}
    function ShadowTransparency : integer;
  public
    { Function CalcHintRect calculates and returns rectangle for hint window on the screen}
    function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override;
    { @EXCLUDE}
//    function GetGradWidth: integer;
    { Method, that make drawing of hint}
    procedure Paint; override;
    { Method, that make background filling}
    procedure PaintBG(Bmp: TBitmap; aRect: TRect); dynamic;
    { Method, that make borders for hints}
    procedure PaintBorder(Bmp: TBitmap); dynamic;
    { Method writes text on hint body}
    procedure TextOut(Bmp: TBitmap); dynamic;
    { Overrided method for hint window activation}
    procedure ActivateHint(Rect: TRect; const AHint: string); override;
    { @EXCLUDE}
    constructor Create(AOwner:TComponent); override;
  end;

  { Hint window type for style hsSimply}
  TsSimplyHintWindow = class(TsCustomHintWindow)
  private
  protected
    procedure PaintShadow; override;
    function GetMask : TBitmap; override;
    function GetBody : TBitmap; override;
    function GetMousePosition : TPoint; override;
  public
    procedure PaintBorder(Bmp: TBitmap); override;
  end;

  { Hint window type for style hsComics}
  TsComicsHintWindow = class(TsCustomHintWindow)
  private
  protected
    function MainRect: TRect; override;
    procedure PaintShadow; override;
    function GetMask : TBitmap; override;
    function GetMousePosition : TPoint; override;
    function GetArrowPosition : TPoint;
  public
    function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override;
    function GetBody : TBitmap; override;
    procedure PaintBorder(Bmp: TBitmap); override;
  end;

  { Hint window type for style hsEllipse}
  TsEllipseHintWindow = class(TsCustomHintWindow)
  private
  protected
    function GetArrowPosition : TPoint;
    function GetBody : TBitmap; override;
    function GetMask : TBitmap; override;
    function GetMousePosition : TPoint; override;
    function MainRect: TRect; override;
    procedure PaintShadow; override;
  public
    function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override;
    procedure PaintBorder(Bmp: TBitmap); override;
  end;

  { Hint window type for style hsBalloon}
  TsBalloonHintWindow = class(TsCustomHintWindow)
  private
  protected
    procedure PaintShadow; override;
    function GetMask : TBitmap; override;
    function GetCustMask(Shadow : boolean) : TBitmap;
    function GetBody : TBitmap; override;
    function GetMousePosition : TPoint; override;
    function GetArrowPosition : TPoint;
  public
    { @EXCLUDE}
    BalloonCount : integer;
    { @EXCLUDE}
    Divid : integer;
    function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override;
    { @EXCLUDE}
    constructor Create(AOwner:TComponent); override;
    function MainRect: TRect; override;
    procedure PaintBorder(Bmp: TBitmap); override;
  end;

var
  { @EXCLUDE}
  Manager : TsHintManager;
  ActiveManagers : integer = 0;

implementation

uses sGradient, sAlphaGraph;

{ TsHintManager }

procedure TsHintManager.AssignTo(Dest: TPersistent);
begin
  TsHintManager(Dest).FBevelWidth           := BevelWidth;
  TsHintManager(Dest).FBlur                 := Blur;
  TsHintManager(Dest).FExOffset             := ExOffset;

  TsHintManager(Dest).FFont.Charset         := Font.Charset;
  TsHintManager(Dest).FFont.Color           := Font.Color;
  TsHintManager(Dest).FFont.Name            := Font.Name;
  TsHintManager(Dest).FFont.Style           := Font.Style;
  TsHintManager(Dest).FFont.Size            := Font.Size;
  TsHintManager(Dest).FFont.Style           := Font.Style;
  TsHintManager(Dest).FMarginH              := MarginH;
  TsHintManager(Dest).FMarginV              := MarginV;
  TsHintManager(Dest).FPauseHide            := FPauseHide;
  TsHintManager(Dest).FRadius               := Radius;

  TsHintManager(Dest).sStyle.Background.Gradient.Data := sStyle.Background.Gradient.Data;
  TsHintManager(Dest).sStyle.Background.Gradient.Percent := sStyle.Background.Gradient.Percent;
  TsHintManager(Dest).sStyle.Background.Image.Image.Assign(sStyle.Background.Image.Image);
  TsHintManager(Dest).sStyle.Background.Image.Percent   := sStyle.Background.Image.Percent;

  TsHintManager(Dest).sStyle.Painting.Bevel              := sStyle.Painting.Bevel;
  TsHintManager(Dest).sStyle.Painting.Color              := sStyle.Painting.Color;
  TsHintManager(Dest).sStyle.Painting.ColorBorderTop     := sStyle.Painting.ColorBorderTop;
  TsHintManager(Dest).sStyle.Painting.ColorBorderBottom  := sStyle.Painting.ColorBorderBottom;
  TsHintManager(Dest).sStyle.Painting.Transparency       := sStyle.Painting.Transparency;

  TsHintManager(Dest).sStyle.Shadow.Blur            := sStyle.Shadow.Blur;
  TsHintManager(Dest).sStyle.Shadow.Color           := sStyle.Shadow.Color;
  TsHintManager(Dest).sStyle.Shadow.Enabled         := sStyle.Shadow.Enabled;
  TsHintManager(Dest).sStyle.Shadow.Offset          := sStyle.Shadow.Offset;
  TsHintManager(Dest).sStyle.Shadow.Transparency    := sStyle.Shadow.Transparency;

  TsHintManager(Dest).Style := Style;

  TsHintManager(Dest).FPreDefinitions        := PreDefinitions;
end;

constructor TsHintManager.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
{
  if ActiveManagers > 0 then begin
    ShowWarning('Only one exemplar of TsHintManager must be used in application!');
  end;
}
  inc(ActiveManagers);
  FsStyle := TsPassivePaintStyle.Create(Self);
  FForm := GetParentForm(TControl(AOwner));
  FFont := TFont.Create;
  sStyle.COC := COC_TsHintManager;

  sStyle.GroupIndex := -101;
  sStyle.Background.ListenMSG := False;

  FRadius := 20;
  FBevelWidth :=  1;
  FBlur := 1;
  FExOffset := 32;
  FPauseHide := 5000;
  FMarginH := 15;
  FMarginV := 10;
  FMaxWidth := 200;
  FStyle := DefStyle;

  FHTMLMode := False;
  FPauseHide := 5000;
  Application.HintPause := 500;
  Application.HintShortPause := 200;

  FPreDefinitions := shEllipse;
  if csDesigning in ComponentState then begin
    SetPredefinitions(FPreDefinitions);
  end
  else Application.OnShowHint := OnShowHintApp;
end;

function TsHintManager.DefStored: boolean;
begin
  Result := FPredefinitions = shCustom;
end;

destructor TsHintManager.Destroy;
begin
  FreeAndNil(FsStyle);
  FreeAndNil(FFont);
  dec(ActiveManagers);
  inherited;
end;

procedure TsHintManager.Invalidate;
begin
  PreDefinitions := FPreDefinitions;
  if Assigned(sStyle) then begin
    SetNewStyle(Style);
  end;
end;

procedure TsHintManager.Loaded;
begin          
  inherited;
  if Assigned(sStyle) then begin
    SetNewStyle(Style);
  end;
end;

procedure TsHintManager.LoadFromFile(FileName, Section: string);
var
  IniFile : TIniFile;
begin
  if not FileExists(FileName) then Exit;
  IniFile := TIniFile.Create(FileName);

  // Background
  with sStyle do begin
    Style := aHintStyles[IniFile.ReadInteger(Section, 'HintStyle', 0)];
    Radius := IniFile.ReadInteger(Section, 'Radius', 8);
    Blur := IniFile.ReadInteger(Section, 'Blur', 0);
    BevelWidth := IniFile.ReadInteger(Section, 'BevelWidth', 1);
    MarginV := IniFile.ReadInteger(Section, 'MarginV', 8);
    MarginH := IniFile.ReadInteger(Section, 'MarginH', 8);
    MaxWidth := IniFile.ReadInteger(Section, 'MaxWidth', 200);
    ExOffset := IniFile.ReadInteger(Section, 'ExOffset', 32);


    Background.Gradient.Data   := IniFile.ReadString(Section, 'Gradient_Data', '');
    Background.Gradient.Percent   := IniFile.ReadInteger(Section, 'Gradient_Percent', integer(70));
    Background.Image.ImageName := IniFile.ReadString(Section, 'Pattern', '');
//    sGraphUtils.LoadJpegOrBmp(Background.Image, Background.ImageFileName, False);
    Background.Image.Percent   := IniFile.ReadInteger(Section, 'Image_Percent', integer(70));

    // Painting
    Painting.Color     := IniFile.ReadInteger(Section, 'Color', integer(clBtnFace));
    Painting.ColorBorderTop    := IniFile.ReadInteger(Section, 'ColorBorderTop', integer(clWhite));
    Painting.ColorBorderBottom := IniFile.ReadInteger(Section, 'ColorBorderBottom', integer(clBtnShadow));
    Painting.Bevel             := aControlBevels[IniFile.ReadInteger(Section, 'PaintBevel', 1)];
    Painting.Transparency      := IniFile.ReadInteger(Section, 'PaintingTransparency', 25);

    // Shadow
    Shadow.Color   := IniFile.ReadInteger(Section, 'ShadowColor', integer(clBlack));
    Shadow.Enabled := IniFile.ReadString(Section, 'ShadowEnabled', 'True') = 'True';
    Shadow.Offset  := IniFile.ReadInteger(Section, 'ShadowOffset', 8);
    Shadow.Blur    := IniFile.ReadInteger(Section, 'ShadowBlur', 4);
    Shadow.Transparency := IniFile.ReadInteger(Section, 'ShadowTransparency', 60);

  end;

  FreeAndNil(IniFile);
end;

procedure TsHintManager.OnShowHintApp(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
begin
  if assigned(FOnShowHint)
    then FOnShowHint(HintStr, CanShow, HintInfo)
    else inherited;
end;

procedure TsHintManager.PaintBG(BGBmp: TBitmap; R: TRect; ci: TCacheInfo);
var
  aRect, cRect: TRect;
  Bmp : TBitmap;
  TransColor : TsColor;
  iDrawed : boolean;
  procedure FillCanvas(bmp : TBitmap); begin
    BMP.Canvas.Pen.Style := psClear;
    BMP.Canvas.Brush.Style := bsSolid;
    BMP.Canvas.Brush.Color := ColorToRGB(FsStyle.Painting.Color);
    BMP.Canvas.Rectangle(aRect);
  end;
  procedure PaintAddons; begin
    iDrawed := False;
    // BGImage painting
    if (FsStyle.Background.Image.Percent > 0) and Assigned(FsStyle.Background.Image.Image)