Title: Cloning Component Properties
Question: Instead of writing line by line when cloning component properties, we can use this functions to do this in one line of code.
With these functions you can get/set property by using its name in a string.
For example:
Label1.Caption:= GetComponentProperty(Button1, 'Caption', AObject, false);
Answer:
uses Classes, TypInfo, Sysutils;
//To get a component property value
function GetComponentProperty(Comp: TPersistent; const CompProp: string; out AObject: TObject; const ViewByName: boolean): string;
var
C: TPersistent;
Inf: PPropInfo;
AMethod: TMethod;
Instance: TPersistent;
begin
result:='';
C:= Comp;
if C nil then
begin
Inf:= GetPropInfo(C, CompProp);
if Inf nil then
case Inf.PropType^.Kind of
tkChar,
tkWChar,
tkString,
tkLString,
tkWString : result:= GetStrProp(C, Inf);
tkInteger : result:= IntToStr(Integer(GetOrdProp(C, Inf)));
tkFloat : result:= FloatToStr(GetFloatProp(C, Inf));
tkEnumeration: result:= GetEnumName(Inf.PropType^,GetOrdProp(C, Inf));
tkClass : begin
AObject:= GetObjectProp(C, CompProp, GetClass(Inf.PropType^.Name));
end;
tkMethod : begin
if ViewByName then
begin
AMethod:= GetMethodProp(C, Inf);
Instance := AMethod.Data;
if assigned(Instance) then
result:= Instance.MethodName(AMethod.Code);
end
else
begin
AMethod:= GetMethodProp(C, Inf);
Instance := AMethod.Data;
if assigned(Instance) then
result:= format('%d.%d',[LongInt(AMethod.Code), LongInt(AMethod.Data)]);
end;
end;
end;
end;
end;
--------------------------
//To Set a component property (if it is not a object property)
procedure SetComponentProperty(Comp: TPersistent; const CompProp, PropValue: string);
var
C : TPersistent;
Inf : PPropInfo;
OrdValue: integer;
CodeAddr,
DataAddr: string;
AMethod : TMethod;
DisableMethod: TMethod;
begin
C:= Comp;
if C nil then
begin
Inf:= GetPropInfo(C.ClassInfo,CompProp);
if Inf nil then
case Inf.PropType^.Kind of
tkChar,
tkWChar,
tkInteger : SetOrdProp(C, Inf, StrToInt(PropValue));
tkLString,
tkWString : SetStrProp(C, Inf, PropValue);
tkFloat : SetFloatProp(C, Inf, StrToFloat(PropValue));
tkEnumeration: begin
OrdValue:=GetEnumValue(Inf.PropType^,PropValue);
if (OrdValue -1) then
SetOrdProp(C, Inf, OrdValue)
else
raise exception.CreateFmt('Property not found: %s',[CompProp]);
end;
tkMethod : begin
if PropValue = DisabledMethod then
SetMethodProp(C, Inf, DisableMethod)
else
if PropValue '' then
begin
CodeAddr:= Copy(PropValue, 1, Pos('.',PropValue) - 1);
DataAddr:= Copy(PropValue, Pos('.',PropValue) + 1, length(PropValue));
AMethod.Code:= Pointer(StrToInt(CodeAddr));
AMethod.Data:= Pointer(StrToInt(DataAddr));
SetMethodProp(C, CompProp, AMethod);
end;
end;
else
begin
raise exception.createfmt('Property type not allowed: %s',[Inf.PropType^.Name]);
end;
end;
end;
end;
----------------------------------------------------
//If it is a ObjectProperty
//To set
procedure SetComponentObjectProperty(Comp: TPersistent; const CompProp: string; Value: TObject);
var
Inf: PPropInfo;
begin
Inf:= GetPropInfo(Comp.ClassInfo, CompProp);
if Inf nil then
SetObjectProp(Comp, Inf, Value);
end;
//And to get
function GetComponentObjectProperty(Comp: TPersistent; const CompProp: string): TObject;
begin
result:= GetObjectProp(Comp, CompProp, GetObjectPropClass(Comp, CompProp));
end;
-------------------------------------------------------
//And now you can clone any object properties
procedure GetProperties(Comp: TPersistent; List: TStringList; TypeKinds: TTypeKinds);
var
i, Count: integer;
Size: LongInt;
PropList: PPropList;
begin
Count:=GetPropList(Comp.ClassInfo, TypeKinds, nil);
Size := Count * SizeOf(Pointer);
GetMem(PropList, Size);
GetPropList(Comp.ClassInfo, TypeKinds, PropList);
for i:= 0 to Count - 1 do
List.Add(PropList[i]^.Name);
end;
function CloneProperties(FromObject, ToObject: TPersistent): integer;
var
i: integer;
AList: TStringList;
DummyObject: TObject;
begin
AList:= TStringList.Create;
GetProperties(FromObject, AList, [tkInteger, tkChar, tkEnumeration, tkFloat,
tkString, tkSet, tkWChar, tkLString, tkWString,
tkVariant, tkArray, tkInt64, tkClass]);
for i:= 0 to AList.Count - 1 do
if GetPropertyType(FromObject, AList[i]) = tkClass then
SetComponentObjectProperty(ToObject, AList[i], GetComponentObjectProperty(FromObject, AList[i]))
else
SetComponentProperty(ToObject, AList[i], GetComponentProperty(FromObject, AList[i], DummyObject));
result:= AList.Count;
AList.free;
end;
------------------------------------------------------