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;
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;