如何将对象强制转换为泛型?

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

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;

上面安德烈亚斯的回答很精彩。这真的有助于我在德尔福使用仿制药。请原谅我,安德烈亚斯,因为我想知道,活力是不是有点复杂。如果我错了,请纠正我,但是下面的内容应该更简洁、安全、快速(没有字符串比较),并且仍然是功能性的。

实际上,我所做的就是在dynamiccast类型参数上使用class约束来允许编译器做一些工作(与原始的一样,除了使用非类参数),然后使用tobject.inheritsfrom函数来检查类型兼容性。

我还发现Trycast函数的概念非常有用(不管怎样,这对我来说是一项常见的任务!)

当然,除非我在搜寻班级家长的名字时漏掉了重点…其中imho有点危险,因为类型名可能与不同范围中不兼容的类匹配。

总之,这是我的代码(适用于DelphiXE3…之后是与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版本(需要一些小努力才能到达返回类)。

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;