亲爱的Alex,我和你遇到了同样的问题。经过一番思考,我写了下面的代码来解决我的问题。希望这段代码也能解决你或其他人的问题。
function TModel.Clone(pObj:TObject): TObject;
procedure WriteInField(pField:TRttiField; result, source:Pointer);
var
Field:TRttiField;
Val:TValue;
Len: NativeInt;
I :Integer;
tp:TRttiType;
ctx:TRttiContext;
begin
if not pField.GetValue(source).IsEmpty then
case pField.FieldType.TypeKind of
TTypeKind.tkRecord:
begin
for Field in pField.FieldType.GetFields do
WriteInField(Field, PByte(result)+pField.Offset, pField.GetValue(source).GetReferenceToRawData);
end;
TTypeKind.tkClass:
begin
Val:=Self.Clone(pField.GetValue(source).AsObject);
if Assigned(TObject(pField.GetValue(result).AsObject)) then
pField.GetValue(result).AsObject.Free;
pField.SetValue(result,Val);
end;
TTypeKind.tkDynArray:
begin
Len := pField.GetValue(source).GetArrayLength;
for I := 0 to Len -1 do
case pField.GetValue(source).GetArrayElement(I).Kind of
TTypeKind.tkRecord:
begin
tp:=ctx.GetType(pField.GetValue(source).GetArrayElement(I).TypeInfo);
for Field in tp.GetFields do
WriteInField(Field,PByte(result)+Field.Offset, pField.GetValue(source).GetReferenceToRawData);
end;
TTypeKind.tkClass:
begin
Val:=Self.Clone(pField.GetValue(source).GetArrayElement(I).AsObject);
DynArraySetLength(PPointer(PByte(result)+pField.Offset)^,pField.GetValue(source).TypeInfo,1,@Len);
pField.GetValue(result).SetArrayElement(I,Val);
end;
else
DynArraySetLength(PPointer(PByte(result)+pField.Offset)^,pField.GetValue(source).TypeInfo,1,@Len);
pField.GetValue(result).SetArrayElement(I, pField.GetValue(source).GetArrayElement(I));
end;
end;
else
pField.SetValue(result,pField.GetValue(source));
end;
end;
var
Context: TRttiContext;
IsComponent, LookOutForNameProp: Boolean;
RttiType: TRttiType;
Method: TRttiMethod;
MinVisibility: TMemberVisibility;
Params: TArray<TRttiParameter>;
PropFild: TRttiField;
Fild: TRttiField;
SourceAsPointer, ResultAsPointer: Pointer;
ObjWithData:TObject;
Value:TValue;
begin
try
if Assigned(pObj) then
ObjWithData := pObj
else
ObjWithData := Self;
RttiType := Context.GetType(ObjWithData.ClassType);
IsComponent := (ObjWithData is TComponent);
for Method in RttiType.GetMethods do
if Method.IsConstructor then
begin
Params := Method.GetParameters;
if Params = nil then Break;
if (Length(Params) = 1) and IsComponent and
(Params[0].ParamType is TRttiInstanceType) and
SameText(Method.Name, 'Create') then Break;
end;
if Params = nil then
Result := Method.Invoke(ObjWithData.ClassType, []).AsObject
else
Raise Exception.CreateFmt('Object Invalid to clone : ''%s''', [ObjWithData.ClassName]);
try
Move(ObjWithData, SourceAsPointer, SizeOf(Pointer));
Move(Result, ResultAsPointer, SizeOf(Pointer));
for PropFild in RttiType.GetFields do
WriteInField(PropFild,ResultAsPointer,SourceAsPointer);
except
Result.Free;
raise;
end;
finally
ObjWithData := nil;
end;
end;
Assign
不是这样工作的。你应该重写AssignTo
,提供复制的手段。 - OnTheFly