How To Change The Font Size Of Hint Text Associated With a TStringGrid Cell

StackOverflow https://stackoverflow.com/questions/9871252

  •  26-05-2021
  •  | 
  •  

Question

I am using Lazarus v0.9.30 (32 bit compiler). I have the following code that I use to show the hint text stored in the object associated with a TColumnTitle object in a TStringGrid.

procedure TTmMainForm.TmApplicationPropertiesShowHint
    (
    var HintStr: string; 
    var CanShow: boolean; 
    var HintInfo: THintInfo
    );
var
  aGrid        : TStringGrid;
  aColumnTitle : TTmColumnTitle;
  aRow         : integer;
  aColumn      : integer;
begin
  aRow    := 0;
  aColumn := 0;

  HintInfo.HintMaxWidth := 200;
  HintInfo.HideTimeout  := 10000;
  HintInfo.HintColor    := $00D7FBFA;

  //Get a pointer to the current grid.
  aGrid := TStringGrid(HintInfo.HintControl);

  //Find out what cell the mouse is pointing at.
  aGrid.MouseToCell(HintInfo.CursorPos.X, HintInfo.CursorPos.Y, aColumn, aRow);

  if ((aRow = 0) and (aColumn < aGrid.ColCount)) then
    begin
      //Get the object associated with the column title.
      aColumnTitle := TTmColumnTitle(aGrid.Objects[aColumn, aRow]);

      //Define where the hint window will be displayed.
      HintInfo.CursorRect := aGrid.CellRect(aColumn, aRow);

      //Display the hint.
      HintStr := Trim(aColumnTitle.stHint);
    end; {if}
end;

I have access to the HintInfo object and want to use it to change the fontsize of the hint text. The HintInfo object provides access to HintInfo.HintControl.Font but using this changes the font of all the cell text in the underlying TStringGrid. The HintInfo object also provides access to Hintinfo.HintWindowClass.Font, but you are unable to access Font.Size. Is there a way to modify the font size of the hint?

Was it helpful?

Solution

There's the TScreen.HintFont property which is intended for this purpose, however it seems to me wrong in its getter. One thing I can say at this time, it doesn't work as expected. And since you don't have an access to the hint window instance, the best what you can do is to subclass the common hint window class.

In the following example I've created the custom hint window class where you can specify the font size by passing the size value through HintInfo.HintData which was currently unused.

uses
  Windows, Types;

type
  TCustomHintWindow = class(THintWindow)
  private
    function CalcHintRect(MaxWidth: Integer; const AHint: string;
      AData: Pointer): TRect; override;
  end;

const
  HintBorderWidth = 2;

implementation

function TCustomHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string;
  AData: Pointer): TRect;
begin
  if MaxWidth <= 0 then
    MaxWidth := Screen.Width - 4 * HintBorderWidth;
  Result := Types.Rect(0, 0, MaxWidth, Screen.Height - 4 * HintBorderWidth);
  if AHint = '' then
    Exit;
  if Assigned(AData) then
    Canvas.Font.Size := Integer(AData);
  DrawText(Canvas.GetUpdatedHandle([csFontValid]), PChar(AHint), Length(AHint),
    Result, DT_CALCRECT or DT_NOPREFIX or DT_WORDBREAK);
  Inc(Result.Right, 4 * HintBorderWidth);
  Inc(Result.Bottom, 4 * HintBorderWidth);
end; 

procedure TForm1.ApplicationProperties1ShowHint(var HintStr: string;
  var CanShow: Boolean; var HintInfo: THintInfo);
begin
  HintInfo.HintColor := $0000ECFF;
  HintInfo.HintData := Pointer(12);
  HintStr := 'Hi I''m just a testing hint...';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  HintWindowClass := TCustomHintWindow;
end;

Here's a screenshot how it looks like:

enter image description here

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top