Update fonts recursively on a Delphi form

Question

Hello, I'm trying to iterate all the controls on a form and enable ClearType font smoothing. Something like this:

procedure TForm4.UpdateControls(AParent: TWinControl);
var
  I: Integer;
  ACtrl: TControl;
  tagLOGFONT: TLogFont;
begin
  for I := 0 to AParent.ControlCount-1 do
  begin
    ACtrl:= AParent.Controls[I];

    // if ParentFont=False, update the font here...

    if ACtrl is TWinControl then
      UpdateControls(Ctrl as TWinControl);
  end;
end;

Now, is there a easy way to check if ACtrl have a Font property so i can pass the Font.Handle to somethink like:

GetObject(ACtrl.Font.Handle, SizeOf(TLogFont), @tagLOGFONT);
tagLOGFONT.lfQuality := 5;
ACtrl.Font.Handle := CreateFontIndirect(tagLOGFONT);

Thank you in advance.

Answer 1

You use TypInfo unit, more specifically methods IsPublishedProp and GetOrdProp.

In your case, it would be something like:

if IsPublishedProp(ACtrl, 'Font') then
  ModifyFont(TFont(GetOrdProp(ACtrl, 'Font')))

A fragment from one of my libraries that should put you on the right path:

function ContainsNonemptyControl(controlParent: TWinControl;
  const requiredControlNamePrefix: string;
  const ignoreControls: string = ''): boolean;
var
  child   : TControl;
  iControl: integer;
  ignored : TStringList;
  obj     : TObject;
begin
  Result := true;
  if ignoreControls = '' then
    ignored := nil
  else begin
    ignored := TStringList.Create;
    ignored.Text := ignoreControls;
  end;
  try
    for iControl := 0 to controlParent.ControlCount-1 do begin
      child := controlParent.Controls[iControl];
      if (requiredControlNamePrefix = '') or
         SameText(requiredControlNamePrefix, Copy(child.Name, 1,
           Length(requiredControlNamePrefix))) then
      if (not assigned(ignored)) or (ignored.IndexOf(child.Name) < 0) then
      if IsPublishedProp(child, 'Text') and (GetStrProp(child, 'Text') <> '') then
        Exit
      else if IsPublishedProp(child, 'Lines') then begin
        obj := TObject(cardinal(GetOrdProp(child, 'Lines')));
        if (obj is TStrings) and (Unwrap(TStrings(obj).Text, child) <> '') then
          Exit;
      end;
    end; //for iControl
  finally FreeAndNil(ignored); end;
  Result := false;
end; { ContainsNonemptyControl }

Answer 2

There's no need to use RTTI for this. Every TControl descendant has a Font property. At TControl level its visibility is protected but you can use this workaround to access it:

type
  THackControl = class(TControl);

ModifyFont(THackControl(AParent.Controls[I]).Font);

Answer 3

One other thing worth mentioning. Every control has a ParentFont property, which - if set - allows the Form's font choice to ripple down to every control. I tend to make sure ParentFont is set true wherever possible, which also makes it easier to theme forms according to the current OS.

Anyway, surely you shouldn't need to do anything to enable ClearType smoothing? It should just happen automatically if you use a TrueType font and the user has enabled the Cleartype "effect".