How to adjust hint properties of a control at runtime?

Question

I have this code with which I can set the font size of the control hint, but I want to be able somehow to adjust it later at runtime. How can I do that ?

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TMyHintWindow = class(THintWindow)
    constructor Create(AOwner: TComponent); override;
  end;

  TMyButton = class(TButton)
  protected
    procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    MyButton: TMyButton;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 MyButton:=TMyButton.Create(Form1);
 MyButton.Parent:=Form1;
 MyButton.Caption:='Test';
 MyButton.Left:=100;
 MyButton.Top:=100;
 MyButton.ShowHint:=true;
end;

procedure TMyButton.CMHintShow(var Message: TCMHintShow);
begin
 inherited;
 Message.HintInfo.HintWindowClass:=TMyHintWindow;
 Message.HintInfo.HintStr:='My custom hint';
end;

constructor TMyHintWindow.Create(AOwner: TComponent);
begin
 inherited;
 Canvas.Font.Size:=25;
end;

end.

Answer 1

Since there is only one hint window instance at the time, and that instance will be created after call to CMHintShow, you can use class variables to do additional hint customization. Class variable is class member that is shared among all instances of the class and can be accessed directly through class type or class instance.

type
  TMyHintWindow = class(THintWindow)
  protected
    class constructor ClassCreate;
  public
    class var FontSize: integer;
    constructor Create(AOwner: TComponent); override;
  end;

class constructor TMyHintWindow.ClassCreate;
begin
  FontSize := 25;
end;

constructor TMyHintWindow.Create(AOwner: TComponent);
begin
  inherited;
  Canvas.Font.Size := FontSize;
end;

and then you can change FontSize in CMHintShow method

procedure TMyButton.CMHintShow(var Message: TCMHintShow);
begin
  inherited;
  TMyHintWindow.FontSize := 12;
  Message.HintInfo.HintWindowClass := TMyHintWindow;
  Message.HintInfo.HintStr := 'My custom hint';
end;

Answer 2

Starting from indications given by TLama I finally solved this problem. The key was to set Canvas.Font.Size in TMyHintWindow.CalcHintRect.

Here is the code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TMyHintData = record
    FontSize: Integer;
  end;

  TMyHintWindow = class(THintWindow)
  public
    function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: TCustomData): TRect; override;
  end;

  TMyButton = class(TButton)
  private
    procedure CMHintShow(var AMessage: TCMHintShow); message CM_HINTSHOW;
  public
    FMyHintData: TMyHintData;
    constructor Create(AOwner: TComponent); override;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    MyButton: TMyButton;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
 TMyButton(Sender).FMyHintData.FontSize:=44;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 MyButton:=TMyButton.Create(Form1);
 MyButton.Parent:=Form1;
 MyButton.Caption:='Test';
 MyButton.Left:=100;
 MyButton.Top:=100;
 MyButton.ShowHint:=true;
 MyButton.OnClick:=Button1Click;
end;

function TMyHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: TCustomData): TRect;
begin
 Canvas.Font.Size:=TMyHintData(AData^).FontSize;
 Result:=inherited;
end;

constructor TMyButton.Create(AOwner: TComponent);
begin
 inherited;
 FMyHintData.FontSize:=25;
end;

procedure TMyButton.CMHintShow(var AMessage: TCMHintShow);
begin
 inherited;
 AMessage.HintInfo.HintData:=@FMyHintData;
 AMessage.HintInfo.HintWindowClass:=TMyHintWindow;
 AMessage.HintInfo.HintStr:='My custom hint';
end;

end.

Answer 3

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnShowHint:=AppOnShowHint;
end;

procedure TForm1.AppOnShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
begin
  {Use HintInfo (type:THintInfo) to specify some property of hint-window}
  {For example: set hint-window width to the width of longest word in the hint-text}
  HintInfo.HintMaxWidth:=1;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  {Set HintFont at runtime}
  Screen.HintFont.Size:=strtoint(Edit1.Text);
  {It's necessary to recreate the Application.FHintWindow private variable, so:}
  Application.ShowHint:=False;
  Application.ShowHint:=True;
end;