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类型的params上使用类约束来允许编译器做一些工作（因为原始的将永远除了非类参数）然后使用TObject.InheritsFrom函数检查类型兼容性。

我也发现TryCast功能的想法非常有用（无论如何，这对我来说是一项常见的任务！）

这当然是除非我错过了在类父母中搜索匹配名称的某个地方......鉴于类型名称可能与不同范围内的非兼容类匹配，恕我直言有点危险。

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

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;

如何将对象转换为通用对象？

2 个答案: