delphi - 基于泛型和TObject的T问题

Question

我有基础课

  TWMapObject = class (TObject)
  private
    AFname: string;
    FFileHandler: TWMapFileHandler;
    function TryOpenFileHandler(const fName: string): TWMapFileHandler;
  public
    property FileHandler: TWMapFileHandler read FFileHandler;
    constructor Create(const fName: string);
    destructor Destroy; override;
  end;

祖先

  TBlpTexture = class (TWMapObject)
  public
    width, height: integer;
    id: GLuint;
    hdr: TBLP2Header;
    constructor Create(const fname: string);
    destructor Destroy; override;
    procedure LoadBlp;
  end;

和基于T的经理

  TWMapObjectClass = class of TWMapObject;

  TWMapObjectManager<T: TWMapObject, constructor> = class
  type
    PManagerRec = ^TManagerRec;

    TManagerRec = record
      obj: T;
      ref: integer;
    end;
  private
    ht: TDictionary<string, PManagerRec>;
    function CreateNewT(const fName: string): T;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(const fName: string);
    procedure Remove(const fName: string);
    procedure Clear;
    function Get(const fName: string): T;
  end;

我想将基于 TWMapObject的类用作通用参数 T，用于该辅助函数

function TWMapObjectManager<T>.CreateNewT(const fName: string): T;
var
  obj: TWMapObject;
  ct: TWMapObjectClass;
begin
  ct := TWMapObjectClass(GetTypeData(TypeInfo(T)).ClassType);
  obj := ct.Create(fName);
  Move(obj, result, SizeOf(pointer));
end;

来自

procedure TWMapObjectManager<T>.Add(const fName: string);
var
  pr: PManagerRec;
begin
  if ht.TryGetValue(fName, pr) then
      inc(pr.ref)
  else begin
    GetMem(pr, sizeof(TManagerRec));
    pr.obj := CreateNewT(fName);
    pr.ref := 1;
    ht.Add(fName, pr);
  end
end;

和经理对象创建为 TexManager: TWMapObjectManager<TBlpTexture>。该代码适用于基于 TControl的对象，例如 TButton等，并在以前的项目中创建了精确的 TButton

class function TLuaClassTemplate<T>.CreateNewT(AOwner: TComponent): T;
var
  Ctl: TControl;
begin
  Ctl := TControlClass(GetTypeData(TypeInfo(T)).ClassType).Create(AOwner);
  Move(Ctl, result, SizeOf(pointer));
end;

使用TWMapObject时，我将 TBlpTexture视为ct的值，但仅调用 TWMapObject的构造函数，而不是 TBlpTexture。难道我做错了什么？可以解决吗？

Answer 1

您需要一个虚拟构造函数：

type
  TWMapObject = class(TObject)
  ....
    constructor Create(const fName: string); virtual;
  ....
  end;

您需要一个元类类型：

type
  TWMapObjectClass = class of TWMapObject;

在任何派生类中，重写构造函数：

type
  TBlpTexture = class(TWMapObject)
  public
  ....
    constructor Create(const fName: string); override;
  ....
  end;

您的通用类不需要 constructor约束（据我所知，它几乎是无用的）：

type
  TWMapObjectManager<T: TWMapObject> = class
  ....
  end;

最后，像这样实现 CreateNewT：

function TWMapObjectManager<T>.CreateNewT(const fName: string): T;
begin
  Result := T(TWMapObjectClass(T).Create(fName));
end;

这是一个证明概念的完整程序：

{$APPTYPE CONSOLE}

type
  TWMapObject = class
    constructor Create(const fName: string); virtual;
  end;
  TWMapObjectClass = class of TWMapObject;

  TBlpTexture = class(TWMapObject)
  public
    constructor Create(const fName: string); override;
  end;

  TWMapObjectManager<T: TWMapObject> = class
    function CreateNewT(const fName: string): T;
  end;

{ TWMapObject }

constructor TWMapObject.Create(const fName: string);
begin
  Writeln(ClassName);
end;

{ TBlpTexture }

constructor TBlpTexture.Create(const fName: string);
begin
  inherited;
  Writeln(fName);
end;

{ TWMapObjectManager<T> }

function TWMapObjectManager<T>.CreateNewT(const fName: string): T;
begin
  Result := T(TWMapObjectClass(T).Create(fName));
end;

begin
  TWMapObjectManager<TBlpTexture>.Create.CreateNewT('Foo');
  Readln;
end.