{==============================================================================

  Custom GroupBox
  Copyright (C) 2000-2001 by Evgeny Kryukov
  All rights reserved

  All contents of this file and all other files included in this archive
  are Copyright (C) 2001 Evgeny Kryukov. Use and/or distribution of
  them requires acceptance of the License Agreement.

  See License.txt for licence information

===============================================================================}

unit KsHints;

{$I KsCommonVer.Inc}
{$T-,W-,X+,P+}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, KsBitmap, KsUtils, KsForms, KsEffects;

type

{ TKsCustomHint }

  TKsCustomHint = class(TComponent)
  private
    FOnShowHint: TShowHintEvent;
    FActive: Boolean;
    FDropShadow: boolean;
    FBlend: boolean;
    FShadowWidth: integer;
    FBlendValue: integer;
    FShowAnimationTime: integer;
    FShowAnimation: TKsAnimation;
    FOldShowHint: TShowHintEvent; 
    FOldHintWindowClass: THintWindowClass; 
    procedure DoShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
    procedure SetActive(const Value: Boolean);
  protected
    function GetHintBounds(Canvas: TCanvas; const AHint: string): TRect; virtual;
    procedure PaintHint(Buffer: TKsBitmap; R: TRect; const AHint: string); virtual;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Active: Boolean read FActive write SetActive;
    property Blend: boolean read FBlend write FBlend;
    property BlendValue: integer read FBlendValue write FBlendValue;
    property DropShadow: boolean read FDropShadow write FDropShadow;
    property ShadowWidth: integer read FShadowWidth write FShadowWidth;
    property ShowAnimation: TKsAnimation read FShowAnimation write FShowAnimation;
    property ShowAnimationTime: integer read FShowAnimationTime write FShowAnimationTime;
    property OnShowHint: TShowHintEvent read FOnShowHint write FOnShowHint;
  end;

implementation {===============================================================}

var
  VarHint: TKsCustomHint;
  HintFont: TFont;

procedure InitHintFont;
var
  NonClientMetrics: TNonClientMetrics;
begin
  HintFont := TFont.Create;
  NonClientMetrics.cbSize := SizeOf(NonClientMetrics);
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
    HintFont.Handle := CreateFontIndirect(NonClientMetrics.lfStatusFont);
end;


type

{ TKsHintForm }

  TKsHintForm = class(TKsCustomForm)
  private
  protected
    function GetMinTrackSize: TPoint; override;

    procedure PaintClientArea(Buffer: TKsBitmap); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{ TKsHintWindow }

  TKsHintWindow = class(THintWindow)
  private
    FActivating: Boolean;
    FHint: TKsCustomHint;
    FForm: TKsHintForm;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure ActivateHint(Rect: TRect; const AHint: string); override;
    procedure ActivateHintData(Rect: TRect; const AHint: string; AData: Pointer); override;
    function CalcHintRect(MaxWidth: Integer; const AHint: string;
      AData: Pointer): TRect; override;
    function IsHintMsg(var Msg: TMsg): Boolean; override;
    procedure ReleaseHandle;
    property BiDiMode;
    property Caption;
    property Color;
    property Canvas;
    property Font;
  end;

  TKsHintWindowClass = class of TKsHintWindow;


{ TKsHintForm =================================================================}

constructor TKsHintForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  CanMove := false;
  BorderStyle := kbsNone;

  Active := true;
end;

function TKsHintForm.GetMinTrackSize: TPoint;
begin
  Result := Point(5, 5);
end;

procedure TKsHintForm.PaintClientArea(Buffer: TKsBitmap);
var
  R: TRect;
begin
  if Owner is TKsHintWindow then
    with Owner as TKsHintWindow do
    begin
      R := Rect(0, 0, FWidth, FHeight);
      if FHint <> nil then
      begin
        Buffer.Font.Assign(HintFont);
        FHint.PaintHint(Buffer, R, Caption);
      end;
    end;
end;

{ TKsHintWindow ===============================================================}

constructor TKsHintWindow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FForm := TKsHintForm.Create(Self);
  FForm.Blend := false;
  FForm.DropShadow := true;
  FForm.ShadowWidth := 2;
  FForm.ShowAnimation := kaNone;
  FForm.ShowAnimationTime := 300;
end;

destructor TKsHintWindow.Destroy;
begin
  FForm.Free;
  inherited Destroy;
end;

procedure TKsHintWindow.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := WS_POPUP;
    WindowClass.Style := WindowClass.Style and not CS_SAVEBITS;
    if NewStyleControls then ExStyle := WS_EX_TOOLWINDOW;
    AddBiDiModeExStyle(ExStyle);
  end;
end;

procedure TKsHintWindow.Paint;
begin
end;

procedure TKsHintWindow.WMNCHitTest(var Message: TWMNCHitTest);
begin
  Message.Result := HTTRANSPARENT;
end;

function TKsHintWindow.IsHintMsg(var Msg: TMsg): Boolean;
begin
  with Msg do
    Result := ((Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST)) or
      ((Message = CM_ACTIVATE) or (Message = CM_DEACTIVATE)) or
      (Message = CM_APPKEYDOWN) or (Message = CM_APPSYSCOMMAND) or
      (Message = WM_COMMAND) or ((Message > WM_MOUSEMOVE) and
      (Message <= WM_MOUSELAST)) or (Message = WM_NCMOUSEMOVE);
end;

procedure TKsHintWindow.ReleaseHandle;
begin
  DestroyHandle;
end;

procedure TKsHintWindow.CMTextChanged(var Message: TMessage);
begin
  inherited;
  { Avoid flicker when calling ActivateHint }
  if FActivating then Exit;
  Width := Canvas.TextWidth(Caption) + 30;
  Height := Canvas.TextHeight(Caption) + 20;
end;

procedure TKsHintWindow.ActivateHint(Rect: TRect; const AHint: string);
var
  Rgn: HRgn;
begin
  FActivating := True;
  try
    Caption := AHint;
    UpdateBoundsRect(Rect);

    if Rect.Top + Height > Screen.DesktopHeight then
      Rect.Top := Screen.DesktopHeight - Height;
    if Rect.Left + Width > Screen.DesktopWidth then
      Rect.Left := Screen.DesktopWidth - Width;
    if Rect.Left < Screen.DesktopLeft then Rect.Left := Screen.DesktopLeft;
    if Rect.Bottom < Screen.DesktopTop then Rect.Bottom := Screen.DesktopTop;

    { Set KsForm Property }
    if FHint <> nil then
    begin
      FForm.Blend := FHint.Blend;
      FForm.BlendValue := FHint.BlendValue;
      FForm.DropShadow := FHint.DropShadow;
      FForm.ShadowWidth := FHint.ShadowWidth;
      FForm.ShowAnimation := FHint.ShowAnimation;
      FForm.ShowAnimationTime := FHint.ShowAnimationTime;
    end;

    { Show }
    SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height,
      SWP_NOACTIVATE);
    SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height,
      SWP_SHOWWINDOW or SWP_NOACTIVATE);
  finally
    FActivating := False;
  end;
end;

procedure TKsHintWindow.ActivateHintData(Rect: TRect; const AHint: string; AData: Pointer);
begin
  ActivateHint(Rect, AHint);
  if (AData <> nil) and (TObject(AData) is TKsCustomHint) then
    FHint := TKsCustomHint(AData)
  else
    FHint := nil;
end;

function TKsHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect;
begin
  if (FHint = nil) and (VarHint <> nil) then
    FHint := VarHint;

  if (AData <> nil) and (TObject(AData) is TKsCustomHint) then
    FHint := TKsCustomHint(AData)
  else
    FHint := nil;

  if FHint <> nil then
  begin
    Canvas.Font.Assign(HintFont);
    Result := FHint.GetHintBounds(Canvas, AHint);
  end;
end;

{ TKsCustomHint ===============================================================}

constructor TKsCustomHint.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FBlend := false;
  FBlendValue := 200;
  FDropShadow := true;
  FShadowWidth := 3;
  FShowAnimation := kaFade;
  FShowAnimationTime := 500;

  FActive := true;
  VarHint := Self;
end;

destructor TKsCustomHint.Destroy;
begin
  if Assigned(FOldShowHint) then
    Application.OnShowHint := FOldShowHint
  else
    Application.OnShowHint := nil;

  HintWindowClass := FOldHintWindowClass; 
    
  inherited Destroy;
end;

procedure TKsCustomHint.DoShowHint(var HintStr: string; var CanShow: Boolean;
  var HintInfo: THintInfo);
begin
  HintInfo.HintData := Self;
  if Assigned(FOnShowHint) then FOnShowHint(HintStr, CanShow, HintInfo);
end;

{ Abstracts }

function TKsCustomHint.GetHintBounds(Canvas: TCanvas; const AHint: string): TRect;
begin
  Result := Rect(0, 0, 1000, 1000);
  if Owner is TWinControl then
    DrawText(Canvas.Handle, PChar(AHint), -1, Result,
      (Owner as TWinControl).DrawTextBiDiModeFlags(DT_CALCRECT or DT_LEFT or DT_WORDBREAK or DT_NOPREFIX));

  Inc(Result.Right, 6);
  Inc(Result.Bottom, 6);
  if FDropShadow then
  begin
    Inc(Result.Right, FShadowWidth);
    Inc(Result.Bottom, FShadowWidth);
  end;
end;

procedure TKsCustomHint.PaintHint(Buffer: TKsBitmap; R: TRect; const AHint: string);
begin
  Buffer.FillRect(R, KColor(Application.HintColor));
  Buffer.DrawEdge(R, KColor(cl3DLight), KColor(cl3DDkShadow));


  if Owner is TWinControl then
    Buffer.DrawText(AHint, R, (Owner as TWinControl).DrawTextBiDiModeFlags(DT_CENTER or DT_SINGLELINE or DT_VCENTER));
end;

{ Properties }

procedure TKsCustomHint.SetActive(const Value: Boolean);
var
  i: Integer;
begin
  FActive := Value;
  if FActive and not (csDesigning in ComponentState) then
  begin
    FOldHintWindowClass := HintWindowClass;
    HintWindowClass := TKsHintWindow;
    with Application do
    begin
      ShowHint := false;
      FOldShowHint := OnShowHint;
      OnShowHint := DoShowHint;
      ShowHint := true;
    end;
  end;

  if FActive and (Application.MainForm <> nil) then
    with Application.MainForm do
      for i := 0 to ComponentCount-1 do
        if (Components[i] is TKsCustomHint) and (Components[i] <> Self) then
          if TKsCustomHint(Components[i]).Active then
            TKsCustomHint(Components[i]).Active := false;

  if not (csDesigning in ComponentState) and FActive then
    Application.OnShowHint := DoShowHint;
end;

initialization
  InitHintFont;
finalization
  HintFont.Free;
end.
