2009-05-29 163 views
7

我想要將返回的基礎對象轉換爲特定的泛型類型。下面的代碼應該工作我認爲,但生成一個內部編譯器錯誤,是否有另一種方法來做到這一點?如何將對象轉換爲泛型?

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; 

回答

14

我正在使用一個類型轉換助手類來執行類型轉換,並檢查這兩個類是否兼容。

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

太糟糕了我不能將此標記爲最喜歡的答案... – gabr 2009-05-29 19:59:46

1

以上來自安德烈亞斯答案是輝煌的。這真的幫助我在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; 
相關問題