How to create custom graphic hints

Problem/Question/Abstract:

How can I create my own hint windows, even with bitmaps and so on?

Answer:

You just have to add the following code to your project (it's just an example). You don't need to change something else in your project.  Maybe the code will run in earlier versions of Borland Delphi too, but didn't test it.


type
  TGraphicHintWindow = class(THintWindow)
    constructor Create(AOwner: TComponent); override;
  private
    FActivating: Boolean;
  public
    procedure ActivateHint(Rect: TRect; const AHint: string); override;
  protected
    procedure Paint; override;
  published
    property Caption;
  end;

  {...}

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

  //Here you can set custom Font properties:

  with Canvas.Font do
  begin
    Name := 'Arial';
    Style := style + [fsBold];
    Color := clBlack;
  end;
end;

procedure TGraphicHintWindow.Paint;
var
  R: TRect;
  bmp: TBitmap;
  l: TStrings;
begin
  R := ClientRect;
  Inc(R.Left, 2);
  Inc(R.Top, 2);

  {*******************************************************
   The following Code is an example how to create a custom
   Hint Object. :
   *******************************************************}

  bmp := TBitmap.create;
  bmp.LoadfromFile('D:\hint.bmp');

  with Canvas do
  begin
    Brush.style := bsSolid;
    Brush.color := clsilver;
    Pen.color := clgray;
    Rectangle(0, 0, 18, R.Bottom + 1);
    Draw(2,(R.Bottom div 2) - (bmp.height div 2), bmp);
  end;

  bmp.free;

  Color := clWhite; //Beliebige HintFarbe
  //custom Hint Color

  Canvas.Brush.style := bsClear;
  //Canvas.TextOut(20,(R.Bottom div 2)-(canvas.Textheight(caption) div 2),caption);
  Inc(R.Left, 20);
  l := TStringlist.create;
  l.SetText(PChar(Caption));
  R.top := (R.Bottom div 2) - ((canvas.Textheight(caption) * l.count) div 2);

  DrawText(Canvas.Handle, PChar(Caption), -1, R, 0);

  l.free;
  {********************************************************}
end;

procedure TGraphicHintWindow.ActivateHint(Rect: TRect; const AHint: string);
begin
  FActivating := True;
  try
    Caption := AHint;
    Inc(Rect.Bottom, 14); //Set the "Height" Property of the Hint

    Rect.Right := Rect.right + 20; //Set the "Width" Property of the Hint
    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;
    SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height,
      SWP_SHOWWINDOW or SWP_NOACTIVATE);
    Invalidate;
  finally
    FActivating := False;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  HintWindowClass := TGraphicHintWindow;
  Application.ShowHint := False;
  Application.ShowHint := True;
end;