Delphi 组件:如何使用父级字体?

5

我有一个使用ParentFont的自定义组件。

在我的组件构建期间,我可以看到组件的字体最初设置为默认的MS Sans Serif

constructor TCustomWidget.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);

   ...
end;

检查显示Self.Font.Name: 'MS Sans Serif'

一段时间后,我的组件的字体被更新以反映父级的字体:

TReader.ReadComponent(nil)
   SetCompName
      TControl.SetParentComponent
         TControl.SetParent
            TWinControl.InsertControl
               AControl.Perform(CM_PARENTFONTCHANGED, 0, 0);

之后一切都很好,我的组件字体已经改为父组件的字体(例如`MS Shell Dlg 2')。

问题是我的子控件没有跟随它们的父控件(即我的组件)保持同步。

在我的组件构造函数期间,我创建了子控件:

constructor TCustomWidget.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);

   ...
   CreateComponents;
end;

procedure TCustomWidget.CreateComponents;
begin
   ...
   FpnlBottom := TPanel.Create(Self);
   FpnlBottom.Caption := '';
   FpnlBottom.Parent := Self;
   FpnlBottom.Align := alBottom;
   FpnlBottom.Height := 46;
   FpnlBottom.ParentFont := True;
   ...
end;

起初,我的 FpnlBottom 也有默认字体 MS Sans Serif
后来,当我的组件的字体被更新为其父级的字体(例如 MS Shell Dlg 2)时,子控件的字体没有被更新,仍然是 MS Sans Serif
  • 为什么我的子控件的 ParentFont 属性没有被执行?
  • 如何使我的子控件的 ParentFont 属性生效?

示例代码

花了两个小时来将其缩减为可管理、可重现的代码:
unit WinControl1;

interface

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

type
    TWidget = class(TWinControl)
    private
        FTitleLabel: Tlabel;
        FpnlBottom: TPanel;

        procedure CreateComponents;
    protected
        procedure FontChange(Sender: TObject);
    public
        constructor Create(AOwner: TComponent); override;
    published
        {Inherited from TWinControl}
        property Align;
        property Font;
        property ParentFont;
    end;

    procedure Register;

implementation

procedure Register;
begin
    RegisterComponents('Samples',[TWidget]);
end;

{ TCustomWidget }

constructor TWidget.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);

    ControlStyle := ControlStyle + [csAcceptsControls, csNoDesignVisible];

    Self.Width := 384;
    Self.Height := 240;

    Self.Font.OnChange := FontChange;

    CreateComponents;
end;

procedure TWidget.CreateComponents;
begin
    FpnlBottom := TPanel.Create(Self);
    FpnlBottom.Parent := Self;
    FpnlBottom.Align := alBottom;
    FpnlBottom.Color := clWindow;
    FpnlBottom.Caption := 'FpnlBottom';
    FpnlBottom.Height := 45;

    FTitleLabel := TLabel.Create(Self);
    FTitleLabel.Parent := FpnlBottom;
    FTitleLabel.Left := 11;
    FTitleLabel.Top := 11;
    FTitleLabel.Caption := 'Hello, world!';
    FTitleLabel.AutoSize := True;
    FTitleLabel.Font.Color := $00993300;
    FTitleLabel.Font.Size := Self.Font.Size+3;
    FTitleLabel.ParentFont := False;
end;

procedure TWidget.FontChange(Sender: TObject);
begin
    //title label is always 3 points larger than the rest of the content
    FTitleLabel.Font.Name := Self.Font.Name;
    FTitleLabel.Font.Size := Self.Font.Size+3;

    OutputDebugString(PChar('New font '+Self.Font.Name));
end;

end.

所有我的控件都使用它们父级的字体。这显然是它们应该工作的方式。为什么你的控件表现不正常呢?我不知道。也许提供一个最小化的故障复现会有所帮助。 - David Heffernan
2个回答

5
看了你的示例代码后,你完全错误地使用了FontChange事件处理程序。你根本不应该使用它。你绕过了本机TControl.FontChanged()事件处理程序,这会触发CM_FONTCHANGEDCM_PARENTFONTCHANGED通知,因此你实际上破坏了ParentFont逻辑。完全摆脱你的TWidget.FontChanged()事件处理程序。如果你需要对组件的Font属性进行反应,你需要拦截CM_FONTCHANGED消息,例如:
unit WinControl1;

interface

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

type
  TWidget = class(TWinControl)
  private
    FTitleLabel: TLabel;
    FpnlBottom: TPanel;
    procedure CreateComponents;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  public
    constructor Create(AOwner: TComponent); override;
  published
    {Inherited from TWinControl}
    property Align;
    property Font;
    property ParentFont;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples',[TWidget]);
end;

{ TCustomWidget }

constructor TWidget.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csAcceptsControls, csNoDesignVisible];
  Self.Width := 384;
  Self.Height := 240;
  CreateComponents;
end;

procedure TWidget.CreateComponents;
begin
  FpnlBottom := TPanel.Create(Self);
  FpnlBottom.Parent := Self;
  FpnlBottom.Align := alBottom;
  FpnlBottom.Color := clWindow;
  FpnlBottom.Caption := 'FpnlBottom';
  FpnlBottom.Height := 45;

  FTitleLabel := TLabel.Create(Self);
  FTitleLabel.Parent := FpnlBottom;
  FTitleLabel.Left := 11;
  FTitleLabel.Top := 11;
  FTitleLabel.Caption := 'Hello, world!';
  FTitleLabel.AutoSize := True;
  FTitleLabel.Font.Color := $00993300;
  FTitleLabel.Font.Size := Self.Font.Size+3;
  FTitleLabel.ParentFont := False;
end;

procedure TWidget.CMFontChanged(var Message: TMessage);
begin
  inherited; // let TControl and TWinControl react first
  //title label is always 3 points larger than the rest of the content
  FTitleLabel.Font.Name := Self.Font.Name;
  FTitleLabel.Font.Size := Self.Font.Size + 3;
  OutputDebugString(PChar('New font ' + Self.Font.Name));
end;

end. 

+1 在这种情况下,你甚至不需要处理CMFontChanged,因为你已经在CreateComponents中设置了所有内容。 - David Heffernan
1
需要处理 CM_FONTCHANGED,因为 Ian 的 "标题标签始终比其余内容大 3 点" 要求。如果在 TWidget 初始设置之后更改了 Font.Size,而没有处理 CM_FONTCHANGED,则 FTitleLabel.Font.Size 值将不会同步。 - Remy Lebeau
哇,我从来没有想到VCL基础设施会默默地接管OnChange事件,而不是使用内部机制。但看起来你是对的。+1并接受了。 - Ian Boyd
1
TFontTPenTBrush 等类都是独立的实用程序类。TControl 必须分配自己的内部 OnChange 事件处理程序以响应其 Font 属性的更改。您正在用自己的事件处理程序替换该内部事件处理程序。 - Remy Lebeau

4
每次更新组件的Font属性时,组件会自动向其每个子控件发送CM_PARENTFONTCHANGED消息,在此期间,每个控件都会检查其ParentFont属性是否为True。您是否已经检查过子控件的ParentFont属性是否仍然设置为True?也许在它们自己的DFM流中,子控件正在设置它们的Font属性,这将重置ParentFont为False。

而且加1,这很有用。有时追踪信息在控制层次结构中的上下流动(未记录)是困难的。 - Ian Boyd

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接