2009-05-29 19 views
7

Dönen bir temel nesneyi, belirli bir genel türe dönüştürmeye çalışıyorum. Aşağıdaki kod bence çalışmalı ama bir iç derleyici hatası oluşturuyor, bunu yapmanın başka bir yolu var mı?Bir nesneyi bir jenere nasıl yapabilirim?

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; 

cevap

14

Ben typecast'leri yapan ve ayrıca iki sınıfın uyumlu olup olmadığını denetleyen bir typecast yardımcı sınıfı kullanıyorum. Andreas yukarıda

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

Çok kötü Ben bunu favori bir yanıt olarak işaretleyemem ... – gabr

+0

Bu daha büyük! – kabstergo

1

cevap parlak: Burada

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; 

sınıftır. Delphi'de jeneriklerin kullanılmasına gerçekten yardımcı oldu. Lütfen, lütfen DynamicCast'ın biraz karmaşık olup olmadığını merak edince Andreas'ı affedin. Lütfen yanılıyorsam beni düzeltin ama aşağıdakiler biraz daha özlü, güvenli, hızlı (dize karşılaştırması yok) ve hala işlevsel olarak olmalıdır.

Yaptığım tek şey, derleyicinin biraz iş yapmasına izin vermek için DynamicCast türü paramları üzerindeki sınıf kısıtlamasını kullanmasıdır (orijinal olarak her zaman sınıf dışı parametreler hariç) ve sonra TObject.InheritsFrom'u kullanın. tür uyumluluğunu kontrol etmek için işlev. Ben eşleşen f aile trol yerde noktası cevapsız sürece de oldukça yararlı bir TryCast fonksiyonunun fikrini buldum

(zaten benim için ortak bir görev!)

Bu elbette adlar ... bu tip isimlerin farklı kapsamlardaki uyumlu olmayan sınıflar için eşleşebileceği düşünüldüğünde IMHO biraz tehlikelidir.

Her neyse, işte kodum (Delphi XE3 ... için çalışır. D2009, TryCast'in uyumlu sürümü aşağıdaki gibidir). D2009 versiyonunu Söz verdiğimiz gibi

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; 

(ReturnT sınıfına almak için bazı küçük bir çaba gerekir).

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; 
İlgili konular