CODEWITHSUNDEEP
delphigenerics
user2091150
user2091150

Reputation: 998

Generics and TObject based T issue

I have base class

  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;

ancestor

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

and T based manager

  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;

I want to use TWMapObject based classes as generic parameter T, for that helper function

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;

called from

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;

and manager object created as TexManager: TWMapObjectManager<TBlpTexture>. That code was working for TControl based objects like TButton etc and created exact TButton for example in prevous project

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;

With TWMapObject I see TBlpTexture as value of ct, but called only constructor of TWMapObject instead of TBlpTexture. Am I doing something wrong? Can it be fixed?

Upvotes: 2

Views: 292

Answers (1)

David Heffernan
David Heffernan

Reputation: 613441

You need a virtual constructor:

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

You'll need a meta class type:

type
  TWMapObjectClass = class of TWMapObject;

In any derived classes, override the constructor:

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

Your generic class does not need the constructor constraint (which so far as I can tell is next to useless):

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

And finally, implement CreateNewT like this:

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

And here's a complete program proving the concept:

{$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.

Upvotes: 2

Related Questions