How to change the font size of the tooltip text associated with a TStringGrid cell
I am using Lazarus v0.9.30 (32 bit compiler). I have the following code that I am using to display the tooltip text stored in an 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 would like to use it to change the font of the tooltip text. The HintInfo object exposes HintInfo.HintControl.Font, but it changes the font of all cell text in the underlying TStringGrid. The HintInfo object also provides access to Hintinfo.HintWindowClass.Font, but you cannot access Font.Size. Is there a way to change the font size of the tooltip?
source to share
Here's a TScreen.HintFont
property designed for this purpose, however it seems to be wrong in its getter. One thing I can say at this time is not working properly. And since you don't have access to an instance of the tooltip box, the best you can do is to subclass the general class of the tooltip box.
In the following example, I created a custom tooltip window class where you can specify the font size by passing in a size value through HintInfo.HintData
which is currently not in use.
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 of how it looks:
source to share