How to efficiently let a `ParentFont = False` child control to use same font name as parent?

前端 未结 3 924
说谎
说谎 2021-01-21 12:28

Most VCL controls has Fonts and ParentFont property. It is a good practice to set ParentFont = True and the Fonts will follow it\'s paren

3条回答
  •  忘掉有多难
    2021-01-21 12:39

    One of possible ways would be to inject post-parentfont handling

    just check procedure TControl.CMParentFontChanged in VCL.Controls unit

    You should also make some uniform way of injecting font customizations to your controls. Maybe subclassing their WindowsProc or extending standard controls with interfaces like EX-controls in JediVCL

    The backbone - the proof of concept that can hardly be replicated a lot as is - maintenance problems - is below.

    unit xxx;
    interface uses yyyy;
    
    type 
     (*********** hijack start!  ****)
    
     TFontOverrideEvent = reference to procedure (const Sender: TObject; const Font: TFont);
    
     TButton = class( VCL.StdCtrls.TButton )
        protected 
           procedure ParentFontChanged(var m: TMessage); message CM_ParentFontChanged;
        public
           var FontOverrideEnabled: Boolean;
           var OnFontOverride: TFontOverrideEvent;
     end;
    
     (**** hijack end! standard form declaration below ****)
    
     TForm1 = class(TForm)
     ....
        Button1: TButton;
     ...
        procedure FormCreate(Sender: TObject);
      ...
    implementation
    
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      Button1.OnFontOverride :=
        procedure (const Sender: TObject; const LFont: TFont) begin
           with LFont do Style := [fsBold] + Style;
        end;
      Button1.FontOverrideEnabled := true;
      Button1.ParentFont := true;     
    
      PostMessage( Button1.Handle, CM_ParentFontChanged, 0, 0); 
      // trigger control to borrow font with customization
    end;
    
    ....
    
     (*** hijack implementation ***)
    
    procedure TButton.ParentFontChanged(var m: TMessage);
    var SilenceHim1: IChangeNotifier; SilenceHim2: TNotifyEvent;
    begin
      inherited; 
         // let VCL make standard font copying
         // warning! it may also make AutoSize or other automatic re-layout!
         // as we hide the fact of our font tuning from VCL - it would not 
         // have a chance to react to our customizations!
    
      if FontOverrideEnabled and Assigned( OnFontOverride ) then
      begin
        SilenceHim2 := Font.OnChange;
        SilenceHim1 := Font.FontAdapter; 
        try
          Font.OnChange := nil;
          Font.FontAdapter := nil;
          OnFontOverride( Self, Font );
        finally
          Font.OnChange := SilenceHim2;
          Font.FontAdapter := SilenceHim1;  
        end;
      end;
    end;
    

    Then try in runtime to change From1.Font and see how Button1 applies the changes to itself

提交回复
热议问题