Существует свойство 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;
Вот скриншот, как это выглядит: