如何设置TFontDialog示例文本及相关问题与替代方案咨询

1. 替换TFontDialog的示例文本及默认不显示的原因 #

示例文本默认不显示的原因 #

TFontDialog是对Windows原生ChooseFont对话框的封装，原生对话框的示例文本仅在检测到有效的完整字体配置时才会显示。如果只是预先设置了字号，但Font对象的Name、Style等属性没有明确赋值（或者赋值无效），对话框初始化时不会自动触发示例文本的渲染，只有当用户手动调整字体参数（如点击字号、选择字体）后，对话框才会更新示例区域。

替换示例文本的方法 #

需要通过Windows钩子拦截对话框的创建过程，找到示例文本对应的静态控件并修改内容。以下是Delphi实现代码：

unit FontDialogHook;

interface

uses
  Windows, Messages, Classes, Dialogs, Controls;

type
  TCustomFontDialog = class(TFontDialog)
  private
    FHookHandle: HHOOK;
    FSampleText: string;
    procedure SetSampleText(const Value: string);
    function DialogHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
  protected
    procedure DoShow; override;
    procedure DoClose; override;
  public
    property SampleText: string read FSampleText write SetSampleText;
  end;

implementation

{ TCustomFontDialog }

function TCustomFontDialog.DialogHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
var
  pCFS: PChooseFont;
  hSampleWnd: HWND;
begin
  Result := 0;
  if nCode = HC_ACTION then
  begin
    case wParam of
      WM_INITDIALOG:
        begin
          pCFS := PChooseFont(lParam);
          // 找到示例文本控件（原生对话框的示例控件ID通常是0x00000400，可根据系统版本调整）
          hSampleWnd := GetDlgItem(pCFS^.hwndOwner, $0400);
          if (hSampleWnd <> 0) and (FSampleText <> '') then
            SendMessage(hSampleWnd, WM_SETTEXT, 0, LPARAM(PChar(FSampleText)));
        end;
    end;
  end;
  Result := CallNextHookEx(FHookHandle, nCode, wParam, lParam);
end;

procedure TCustomFontDialog.DoShow;
begin
  inherited;
  // 设置钩子拦截对话框消息
  FHookHandle := SetWindowsHookEx(WH_CBT, @DialogHook, 0, GetCurrentThreadId);
end;

procedure TCustomFontDialog.DoClose;
begin
  if FHookHandle <> 0 then
    UnhookWindowsHookEx(FHookHandle);
  inherited;
end;

procedure TCustomFontDialog.SetSampleText(const Value: string);
begin
  FSampleText := Value;
end;

end.

使用时，创建TCustomFontDialog实例并设置SampleText属性即可替换示例文本：

var
  FontDlg: TCustomFontDialog;
begin
  FontDlg := TCustomFontDialog.Create(nil);
  try
    FontDlg.SampleText := '自定义示例文本：Hello World 测试';
    FontDlg.Font.Size := 12;
    FontDlg.Font.Name := 'Segoe UI';
    if FontDlg.Execute then
      // 应用字体设置到目标控件
  finally
    FontDlg.Free;
  end;
end;

2. 支持Segoe UI字重的自定义字体对话框方案 #

原生TFontDialog对Segoe UI的Semibold、Light等字重支持有限，因为它依赖LOGFONT结构，无法直接映射现代字体的字重属性。以下是一个轻量的自定义字体对话框实现，支持完整字重选择：

核心源码（Delphi） #

unit CustomFontForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TFontWeight = (fwThin, fwExtraLight, fwLight, fwRegular, fwMedium, fwSemibold, fwBold, fwExtraBold, fwBlack);

  TfrmCustomFontDialog = class(TForm)
    lblFont: TLabel;
    cboFontName: TComboBox;
    lblSize: TLabel;
    cboFontSize: TComboBox;
    lblWeight: TLabel;
    cboWeight: TComboBox;
    pnlSample: TPanel;
    lblSample: TLabel;
    btnOK: TButton;
    btnCancel: TButton;
    procedure FormCreate(Sender: TObject);
    procedure cboFontNameChange(Sender: TObject);
    procedure cboFontSizeChange(Sender: TObject);
    procedure cboWeightChange(Sender: TObject);
  private
    procedure UpdateSampleText;
  public
    procedure GetSelectedFont(ATargetFont: TFont);
  end;

implementation

{$R *.dfm}

{ TfrmCustomFontDialog }

procedure TfrmCustomFontDialog.FormCreate(Sender: TObject);
begin
  // 填充系统字体列表
  Screen.Fonts.Sort;
  cboFontName.Items.Assign(Screen.Fonts);
  // 填充常用字号
  cboFontSize.Items.AddStrings(['8', '9', '10', '11', '12', '14', '16', '18', '20', '24', '28', '32', '36', '48', '72']);
  // 填充字重选项
  cboWeight.Items.AddStrings(['Thin', 'ExtraLight', 'Light', 'Regular', 'Medium', 'Semibold', 'Bold', 'ExtraBold', 'Black']);

  // 初始化默认值
  cboFontName.Text := 'Segoe UI';
  cboFontSize.Text := '12';
  cboWeight.ItemIndex := Ord(fwRegular);
  UpdateSampleText;
end;

procedure TfrmCustomFontDialog.cboFontNameChange(Sender: TObject);
begin
  UpdateSampleText;
end;

procedure TfrmCustomFontDialog.cboFontSizeChange(Sender: TObject);
begin
  UpdateSampleText;
end;

procedure TfrmCustomFontDialog.cboWeightChange(Sender: TObject);
begin
  UpdateSampleText;
end;

procedure TfrmCustomFontDialog.UpdateSampleText;
var
  Weight: TFontWeight;
begin
  Weight := TFontWeight(cboWeight.ItemIndex);
  lblSample.Font.Name := cboFontName.Text;
  lblSample.Font.Size := StrToIntDef(cboFontSize.Text, 12);

  // Delphi 10.3+支持直接设置Font.Weight，精准匹配字重
  if CompilerVersion >= 32 then
  begin
    case Weight of
      fwThin: lblSample.Font.Weight := fwThin;
      fwExtraLight: lblSample.Font.Weight := fwExtraLight;
      fwLight: lblSample.Font.Weight := fwLight;
      fwRegular: lblSample.Font.Weight := fwRegular;
      fwMedium: lblSample.Font.Weight := fwMedium;
      fwSemibold: lblSample.Font.Weight := fwSemibold;
      fwBold: lblSample.Font.Weight := fwBold;
      fwExtraBold: lblSample.Font.Weight := fwExtraBold;
      fwBlack: lblSample.Font.Weight := fwBlack;
    end;
  end
  else
  begin
    // 低版本Delphi用Style模拟
    lblSample.Font.Style := IfThen(Weight >= fwSemibold, [fsBold], []);
  end;
end;

procedure TfrmCustomFontDialog.GetSelectedFont(ATargetFont: TFont);
var
  Weight: TFontWeight;
begin
  Weight := TFontWeight(cboWeight.ItemIndex);
  ATargetFont.Name := cboFontName.Text;
  ATargetFont.Size := StrToIntDef(cboFontSize.Text, 12);

  if CompilerVersion >= 32 then
    ATargetFont.Weight := TFontWeight(Weight)
  else
    ATargetFont.Style := IfThen(Weight >= fwSemibold, [fsBold], []);
end;

end.

使用方法 #

var
  FontDlg: TfrmCustomFontDialog;
  TargetFont: TFont;
begin
  TargetFont := TFont.Create;
  try
    FontDlg := TfrmCustomFontDialog.Create(nil);
    try
      if FontDlg.ShowModal = mrOK then
      begin
        FontDlg.GetSelectedFont(TargetFont);
        // 应用到目标控件，比如Label1.Font.Assign(TargetFont);
      end;
    finally
      FontDlg.Free;
    end;
  finally
    TargetFont.Free;
  end;
end;

这个自定义对话框利用Delphi高版本的Font.Weight属性，可精准识别Segoe UI的各种字重样式，避免了原生对话框的局限性。

内容的提问来源于stack exchange，提问作者kgz