TStringGridセルに関連付けられたヒントテキストのフォントサイズを変更するには

Question

私はLazarus v0.9.30（32ビットコンパイラ）を使用しています。 TStringGridのTColumnTitleオブジェクトに関連付けられたオブジェクトに格納されているヒントテキストを表示するために使用する次のコードを用意しました。

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; 

私はHintInfoオブジェクトにアクセスでき、ヒントテキストのフォントサイズを変更するために使用します。 HintInfoオブジェクトはHintInfo.HintControl.Fontへのアクセスを提供しますが、これを使用すると、基になるTStringGridのすべてのセルテキストのフォントが変更されます。 HintInfoオブジェクトはHintinfo.HintWindowClass.Fontへのアクセスも提供しますが、Font.Sizeにアクセスすることはできません。ヒントのフォントサイズを変更する方法はありますか？

Answer 1

この目的のために作られたTScreen.HintFontのプロパティがありますが、ゲッターで間違っているようです。現時点で私が言うことの1つは、期待どおりに機能しません。 ヒントウィンドウインスタンスへのアクセス権がないため、できることはサブクラスの共通ヒントウィンドウクラスです。

次の例では、現在使用されていないHintInfo.HintDataまでのサイズ値を渡すことで、フォントサイズを指定できるカスタムヒントウィンドウクラスを作成しました。

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; 

ここでそれがどのように見えるかのスクリーンショットです：

は、