unit BVHint;

interface

USES Windows, Classes, Controls, Forms, Messages, Graphics;

TYPE

  TBVHint = CLASS(THintWindow)
  PRIVATE
    FRegion: THandle;
    PROCEDURE FreeCurrentRegion;
  PUBLIC
    DESTRUCTOR Destroy; OVERRIDE;
    PROCEDURE ActivateHint(Rect: TRect; CONST AHint: STRING); OVERRIDE;
    PROCEDURE Paint; OVERRIDE;
    PROCEDURE CreateParams(VAR Params: TCreateParams); OVERRIDE;
  END;

implementation

DESTRUCTOR TBVHint.Destroy;
BEGIN
  FreeCurrentRegion;
  INHERITED Destroy;
END;

PROCEDURE TBVHint.FreeCurrentRegion;
BEGIN
  IF FRegion <> 0 THEN
  BEGIN
    SetWindowRgn(Handle, 0, True);
    DeleteObject(FRegion);
    FRegion := 0;
  END;
END;

PROCEDURE TBVHint.ActivateHint(Rect: TRect; CONST AHint: STRING);
VAR Rgn1: THandle;
    M: ARRAY[0..2] OF TPoint;
BEGIN
  //Brush.Style := bsClear;
  WITH Rect DO Right := Left + Canvas.TextWidth(AHint) + 16;
  WITH Rect DO Top := Top - 10;
  BoundsRect := Rect;
  FreeCurrentRegion;
  WITH BoundsRect DO FRegion := CreateRoundRectRgn(10, 10, Width, Height, 8, 8);
  M[0] := Point(10, 0);
  M[1] := Point((Rect.Right - Rect.Left)*2 DIV 3, (Rect.Bottom - Rect.Top) DIV 2);
  M[2] := Point((Rect.Right - Rect.Left) DIV 3, (Rect.Bottom - Rect.Top) DIV 2);
  Rgn1 := CreatePolygonRgn(M, High(M) + 1, ALTERNATE);
  TRY
    CombineRgn(FRegion, FRegion, Rgn1, RGN_OR);
  FINALLY
    DeleteObject(Rgn1);
  END;
  IF FRegion <> 0 THEN SetWindowRgn(Handle, FRegion, True);
  INHERITED ActivateHint(Rect, AHint);
END;

PROCEDURE TBVHint.Paint;
VAR R1, R2: TRect;
BEGIN
  R1 := ClientRect;
  R1.Left := R1.Left + 8;
  R1.Top := R1.Top + 10;
  R2 := Rect(R1.Left + 1, R1.Top + 1, R1.Right + 1, R1.Bottom + 1);

  Canvas.Brush.Style := bsClear;

  //Canvas.Font.Color := clGray;
  //DrawText(Canvas.Handle, PChar(Caption), Length(Caption), R2,
  //  DT_NOPREFIX OR DT_WORDBREAK OR DT_CENTER OR DT_VCENTER);
  Canvas.Font.Color := clInfoText;
  DrawText(Canvas.Handle, PChar(Caption), Length(Caption), R1,
    DT_NOPREFIX OR DT_WORDBREAK OR DT_CENTER OR DT_VCENTER);
END;

PROCEDURE TBVHint.CreateParams(VAR Params: TCreateParams);
BEGIN
  INHERITED CreateParams(Params);
  Params.Style := Params.Style AND NOT WS_Border;
END;

INITIALIZATION
  Application.ShowHint := False;
  HintWindowClass := TBVHint;
  Application.ShowHint := True;

end.
