如何将对象转换为泛型？

Question

我想要将返回的基础对象转换为特定的泛型类型。下面的代码应该工作我认为，但生成一个内部编译器错误，是否有另一种方法来做到这一点？

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; 

Answer 1

我正在使用一个类型转换助手类来执行类型转换，并检查这两个类是否兼容。

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', 
           [Obj.ClassName, ClassNameT]); 
    end; 
end; 

Answer 2

以上来自安德烈亚斯答案是辉煌的。这真的帮助我在Delphi中使用泛型。请原谅我Andreas，因为我想知道DynamicCast是否有点复杂。如果我错了，请纠正我，但以下内容应该更简洁，安全，快速（无字符串比较），并且仍然可以正常工作。

真的，我所做的一切就是使用DynamicCast类型参数上的类约束来允许编译器做一些工作（因为原始文件总是除非使用非类参数），然后使用TObject.InheritsFrom函数来检查类型兼容性。

我还发现一个TryCast功能非常有用的想法（这对我来说是常见的任务呢！）

这是当然的，除非我在拖网类父母匹配错了地方名称...哪些恕我直言有点危险，因为类型名称可能匹配不同范围内的不兼容类。

无论如何，这里是我的代码（适用于Delphi XE3 ... D2009兼容版本的TryCast）。

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; 
    // Attempt a dynamic cast, returning True if successful 
    class function TryCast<T, ReturnT: class>(const Value: T; out Return: ReturnT): Boolean; 
    // DynamicCast is like the as-operator. It checks if the object can be typecasted 
    class function DynamicCast<T, ReturnT: class>(const Value: T): ReturnT; 
    end; 

implementation 

uses 
    System.SysUtils; 


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.TryCast<T, ReturnT>(const Value: T; out Return: ReturnT): Boolean; 
begin 
    Result := (not Assigned(Value)) or Value.InheritsFrom(ReturnT); 
    if Result then 
    Return := ReinterpretCast<ReturnT>(Value); 
end; 

class function TTypeCast.DynamicCast<T, ReturnT>(const Value: T): ReturnT; 
begin 
    if not TryCast<T, ReturnT>(Value, Result) then 
    //Value will definately be assigned is TryCast returns false 
    raise EInvalidCast.CreateFmt('Invalid class typecast from %s(%s) to %s', 
     [T.ClassName, Value.ClassName, ReturnT.ClassName]); 
end; 

由于承诺的D2009版本（需要一些小的努力才能到达ReturnT类）。

class function TTypeCast.TryCast<T, ReturnT>(const Value: T; out Return: ReturnT): Boolean; 
var 
    LReturnTypeInfo: PTypeInfo; 
    LReturnClass: TClass; 
begin 
    Result := True; 
    if not Assigned(Value) then 
    Return := Default(ReturnT) 
    else 
    begin 
    LReturnTypeInfo := TypeInfo(ReturnT); 
    LReturnClass := GetTypeData(LReturnTypeInfo).ClassType; 
    if Value.InheritsFrom(LReturnClass) then 
     Return := ReinterpretCast<ReturnT>(Value) 
    else 
     Result := False; 
    end; 
end;