我正在尝试将返回的基础对象强制转换为它的特定泛型类型.我认为下面的代码应该工作,但会产生内部编译器错误,还有另一种方法吗?
- type
- TPersistGeneric<T> = class
- private
- type
- TPointer = ^T;
- public
- class function Init : T;
- end;
- class function TPersistGeneric<T>.Init : T;
- var
- o : TXPersistent; // root class
- begin
- case PTypeInfo(TypeInfo(T))^.Kind of
- tkClass : begin
- // xpcreate returns txpersistent,a root class of T
- o := XPCreate(GetTypeName(TypeInfo(T))); // has a listed of registered classes
- result := TPointer(pointer(@o))^;
- end;
- else
- result := Default(T);
- end;
- end;
解决方法
我正在使用一个类型转换辅助类来执行类型转换,并检查这两个类是否兼容.
- class function TPersistGeneric<T>.Init: T;
- var
- o : TXPersistent; // root class
- begin
- case PTypeInfo(TypeInfo(T))^.Kind of
- tkClass : begin
- // xpcreate returns txpersistent,a root class of T
- o := XPCreate(GetTypeName(TypeInfo(T))); // has a listed of registered classes
- Result := TTypeCast.DynamicCast<TXPersistent,T>(o);
- end;
- else
- result := Default(T);
- end;
这是班级:
- type
- TTypeCast = class
- public
- // ReinterpretCast does a hard type cast
- class function ReinterpretCast<ReturnT>(const Value): ReturnT;
- // StaticCast does a hard type cast but requires an input type
- class function StaticCast<T,ReturnT>(const Value: T): ReturnT;
- // DynamicCast is like the as-operator. It checks if the object can be typecasted
- class function DynamicCast<T,ReturnT>(const Value: T): ReturnT;
- end;
- class function TTypeCast.ReinterpretCast<ReturnT>(const Value): ReturnT;
- begin
- Result := ReturnT(Value);
- end;
- class function TTypeCast.StaticCast<T,ReturnT>(const Value: T): ReturnT;
- begin
- Result := ReinterpretCast<ReturnT>(Value);
- end;
- class function TTypeCast.DynamicCast<T,ReturnT>(const Value: T): ReturnT;
- var
- TypeT,TypeReturnT: PTypeInfo;
- Obj: TObject;
- LClass: TClass;
- ClassNameReturnT,ClassNameT: string;
- FoundReturnT,FoundT: Boolean;
- begin
- TypeT := TypeInfo(T);
- TypeReturnT := TypeInfo(ReturnT);
- if (TypeT = nil) or (TypeReturnT = nil) then
- raise Exception.Create('Missing Typeinformation');
- if TypeT.Kind <> tkClass then
- raise Exception.Create('Source type is not a class');
- if TypeReturnT.Kind <> tkClass then
- raise Exception.Create('Destination type is not a class');
- Obj := TObject(Pointer(@Value)^);
- if Obj = nil then
- Result := Default(ReturnT)
- else
- begin
- ClassNameReturnT := UTF8ToString(TypeReturnT.Name);
- ClassNameT := UTF8ToString(TypeT.Name);
- LClass := Obj.ClassType;
- FoundReturnT := False;
- FoundT := False;
- while (LClass <> nil) and not (FoundT and FoundReturnT) do
- begin
- if not FoundReturnT and (LClass.ClassName = ClassNameReturnT) then
- FoundReturnT := True;
- if not FoundT and (LClass.ClassName = ClassNameT) then
- FoundT := True;
- LClass := LClass.ClassParent;
- end;
- //if LClass <> nil then << TObject doesn't work with this line
- if FoundT and FoundReturnT then
- Result := ReinterpretCast<ReturnT>(Obj)
- else
- if not FoundReturnT then
- raise Exception.CreateFmt('Cannot cast class %s to %s',[Obj.ClassName,ClassNameReturnT])
- else
- raise Exception.CreateFmt('Object (%s) is not of class %s',ClassNameT]);
- end;
- end;