遍历窗体控件,设置FontName

function HasProperty(const AObject: TObject;const APropName:String):Boolean;
 var
   PropInfo:PPropInfo;
begin
  PropInfo:=GetPropInfo(AObject.ClassInfo,APropName);
  Result:=Assigned(PropInfo);
end;

function GetObjectProperty(
     const AObject   : TObject;
     const APropName : string
     ):TObject;
 var
   PropInfo:PPropInfo;
 begin
   Result  :=  nil;
   PropInfo:=GetPropInfo(AObject.ClassInfo,APropName);
   if Assigned(PropInfo) and
       (PropInfo^.PropType^.Kind = tkClass) then
     Result  :=  GetObjectProp(AObject,PropInfo);
 end;

procedure SetFontName(Component: TComponent; FontName: string);
var
  PropInfo: PPropInfo;
  lCtl:TControl;
  lFont:TFont;
begin
  if Component = nil then exit;
  PropInfo := GetPropInfo(Component, 'FONT');
  if PropInfo = nil then exit;
  if (PropInfo.PropType^.Name <> 'TFont') then Exit;
  lCtl:=TWinControl(Component);
  lFont:=TFont(GetObjectProperty(lCtl,'FONT'));
  lFont.Name:=FontName;

end;

procedure TForm1.FormCreate(Sender: TObject);
Var
  lComponent: TComponent;
  i: Integer;
  lFontName: String;
Begin
  lFontName:='黑体';//'宋体';
  For i := 0 To Self.ComponentCount - 1 Do
  Begin
    lComponent := Self.Components[i];
    if HasProperty(lComponent, 'FONT') then
      SetFontName(lComponent,lFontName);
  End;
end;