Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Delphi Component: How to use parent font?

i have a custom component that uses the ParentFont.

During construction of my component, i can see that initially the component's font is set to the default MS Sans Serif:

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

   ...
end;

Inspecting shows Self.Font.Name: 'MS Sans Serif'

Some time later, the font of my component is updated to reflect the parent's font:

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

And after that everything is great, my component's font has been changed to the parent's font (e.g. `MS Shell Dlg 2').

The problem is that my child controls are not keeping in sync with their parent's font (i.e. my component).

During my components constructor, i create child controls:

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;

And initially my FpnlBottom has the default font also MS Sans Serif.

Later, when the font of my component has been updated to its parent's font (e.g. MS Shell Dlg 2), the child controls are not having their fonts updated, and are remaining MS Sans Serif.

  • Why are my child control's ParentFont property not being honored?
  • How do i make my child control's ParentFont property work?

Sample Code

Tool two hours to trim it down to manageable, reproducible, code:

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.
like image 492
Ian Boyd Avatar asked Feb 14 '11 20:02

Ian Boyd


1 Answers

After seeing your sample code, you are using the FontChange event handler all wrong. You should not be using it at all. You are bypassing the native TControl.FontChanged() event handler, which triggers CM_FONTCHANGED and CM_PARENTFONTCHANGED notifications, so you are actually breaking the ParentFont logic. Just get rid of your TWidget.FontChanged() event handler altogether. If you need to react to changed to your component's Font property, you need to intercept the CM_FONTCHANGED message instead, eg:

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. 
like image 117
Remy Lebeau Avatar answered Oct 07 '22 18:10

Remy Lebeau