在Delphi窗体上递归更新字体

Question

我正在尝试迭代表单上的所有控件，并启用ClearType字体平滑。类似这样的东西：

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;

现在，有没有一种简单的方法可以检查ACtrl是否具有Font属性，这样我就可以将Font.Handle传递给之类的东西

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

提前谢谢。

Answer 1

您使用TypInfo单元，更具体地说是方法IsPublishedProp和GetOrdProp。

在您的情况下，它将类似于：

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

我的一个库中的一个片段应该会让你走上正确的道路：

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

没有必要为此使用RTTI。每个TControl子代都有一个Font属性。在TControl级别，它的可见性受到保护，但您可以使用以下变通方法访问它：

type
  THackControl = class(TControl);
ModifyFont(THackControl(AParent.Controls[I]).Font);

Answer 3

还有一件事值得一提。每个控件都有一个ParentFont属性，如果设置了该属性，则允许Form的字体选择向下扩展到每个控件。我倾向于尽可能确保ParentFont设置为true，这也使根据当前操作系统对表单进行主题设置变得更容易。

无论如何，你肯定不需要做任何事情来启用ClearType平滑吗？如果您使用TrueType字体，并且用户已启用Cleartype"效果"，则应该自动发生这种情况。

Answer 4

以下是TOndrej答案的C++Builder示例：

struct THackControl : TControl
{
    __fastcall virtual THackControl(Classes::TComponent* AOwner);
    TFont* Font() { return TControl::Font; };
};
for(int ControlIdx = 0; ControlIdx < ControlCount; ++ControlIdx)
{
    ((THackControl*)Controls[ControlIdx])->Font()->Color = clRed;
}