Как изменить размер шрифта Подсказка текст, связанный с ячейкой TStringGrid

Question

Я использую Lazarus v0.9.30 (32 бит компилятора). У меня есть следующий код, который я использую для отображения текста подсказки, хранящегося в объекте, связанном с объектом TColumnTitle в 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; 

У меня есть доступ к объекту HintInfo и хотите использовать его, чтобы изменить FontSize текста подсказки. Объект HintInfo предоставляет доступ к HintInfo.HintControl.Font, но с помощью этого изменяется шрифт всего текста ячейки в базовом TStringGrid. Объект HintInfo также предоставляет доступ к Hintinfo.HintWindowClass.Font, но вы не можете получить доступ к Font.Size. Есть ли способ изменить размер шрифта подсказки?

Answer 1

Там в TScreen.HintFont имущество, которое предназначено для этой цели, однако мне кажется неправильным в поглотителе. Одна вещь, которую я могу сказать в это время, не работает должным образом. А так как у вас нет доступа к экземпляру окна намеком, лучшее, что вы можете сделать, это подкласс общий класс окна намек.

В следующем примере я создал пользовательский класс окна подсказок, где вы можете указать размер шрифта, передав значение размера через 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; 

Вот скриншот, как это выглядит: