JeffP
JeffP

Reputation: 555

Object Pascal call or invoke descendant's method from base class

I have this object in mind:

TBaseObject = class
private
  FEditState: string;
  FID: integer;
public
  constructor Create;
  ...
  procedure Clone(AObject: TObject); virtual;   //I actually want AObject to be generic
  property EditState: string read FEditState write FEditState;
  property ID: integer read FID write FID;
end;

constructor TBaseObject.Create;
begin
  FEditState := 'none';
end;

Here is one descendant class:

TUser = class(TBaseObject)
private
  FUsername: string;
public
  procedure Clone(AObject: TObject); override;
  property Username: string read FUsername write FUsername;
  ...
end;

...
procedure TUser.Clone(AObject: TObject);
begin
  self.id := aobject.id;
  ...
end;

Then I make a container object as follows:

TBaseObjects<T:class> = class
private
  FItems: TObjectList<T>;
  FDeletedItems: TObjectList<T>;
  function GetItem(Index: Integer): T;  
public 
  function Add(NewItem: T=Default(T)): T;   // adds to FItems
  function DeleteItem(AObject: T): T;       // save to FDeletedItems, delete from FItems
  property Items[Index: Integer]: T read GetItem; default;                
  ...
  
  function TBaseObjects<T>.DeleteItem(AObject: T): T;
  begin
    result := T.Create;
    result.Clone(AObject);   // ERROR: no member Clone...
    FItems.Remove(...);
  end;

Used as:

TUsers = TBaseBOMList<TUser>; 

var
  Users: TUsers;

As can be seen, I try to save a copy of the item to be deleted into FDeletedItems generic list by using the descendant's clone method, then delete from FItems, but fails. The compiler say 'no member Clone'.

If what I'm doing can't be done, how is this supposed to be handled?

Upvotes: 1

Views: 490

Answers (1)

JeffP
JeffP

Reputation: 555

As suggested by Dalija, I declared TBaseObjects<T:TBaseObject> instead of TBaseObjects<T:class>.

For anybody curious or interested, the complete test program is available below.

Also, if someone can do this more efficiently with with pure polymorpism rather than generics as implied by DelphiCoder, I'd gladly reconsider, because as it is now, wthout Generics, I would have to declare and define one TBaseBOMList and duplicate every method for every base object (TUser, TRole, etc.) I want to use.

Code:

program ProjTestGenerics;
{$mode delphi}
uses
  sysutils, TypInfo, generics.Collections;

type

  { TBaseBOM }

  TBaseBOM = class
  private
    FEditState: string;
    FID: integer;
  public
    constructor Create;
    procedure Assign(src: TBaseBOM);
  published
    property EditState: string read FEditState write FEditState;
    property ID: integer read FID write FID;
  end;

  { TBaseBOMList }

  TBaseBOMList<T:TBaseBOM> = class
  private
    FItems: TObjectList<T>;
    FDeletedItems: TObjectList<T>;
    function GetItem(Index: Integer): T;
  public
    constructor Create;
    destructor Destroy; override;
    function Add(NewItem: T=Default(T)): T;
    function Delete(Index: Integer): Boolean;
    function Find(APropertyName: string; const AValue: variant): Integer;
    property Items[Index: Integer]: T read GetItem; default;
  end;

  { TRole }

  TRole = class(TBaseBOM)
  private
    FRolename: string;
  public
    procedure Assign( AObject: TBaseBOM );
  published
    property Rolename: string read FRolename write FRolename;
  end;

  { TUser }

  TUser = class(TBaseBOM)
  private
    FUsername: string;
  public
    procedure Assign( AObject: TBaseBOM );
  published
    property Username: string read FUsername write FUsername;
  end;

  { TUserRole }

  TUserRole = class(TBaseBOM)
  private
    FRolename: string;
    FUsername: string;
  public
    procedure Assign( AObject: TBaseBOM );
  published
    property Username: string read FUsername write FUsername;
    property Rolename: string read FRolename write FRolename;
  end;

  TUsers = TBaseBOMList<TUser>;
  TRoles = TBaseBOMList<TRole>;
  TUserRoles = TBaseBOMList<TUserRole>;

function TBaseBOMList<T>.GetItem(Index: Integer): T;
begin
  result := FItems[Index];
end;

constructor TBaseBOMList<T>.Create;
begin
  inherited Create;
  FItems := TObjectList<T>.Create(true);
  FDeletedItems := TObjectList<T>.Create(true);
end;

destructor TBaseBOMList<T>.Destroy;
begin
  FDeletedItems.Free;
  FItems.Free;
  inherited Destroy;
end;

function TBaseBOMList<T>.Add(NewItem: T): T;
begin
  if NewItem = Default(T) then
    result := T.Create
  else
    result := NewItem;
  FItems.Add(result);
end;


function TBaseBOMList<T>.Delete(Index: Integer): Boolean;
var
  o: T;
begin
  o := T.Create;
  o.Assign(FItems[Index]);
  FDeletedItems.Add(o);
  FItems.Delete(Index); // error if index not valid
  result := true;
end;

function TBaseBOMList<T>.Find(APropertyName: string; const AValue: variant
  ): Integer;
var
  value : Variant;
  PropList: PPropList;
  PropCount, i: integer;
  PropExist: Boolean;
begin
  Result := -1;

  PropExist:= False;
  PropCount := GetPropList(T, PropList);
  try
    for i := 0 to PropCount-1 do
      if CompareText(PropList[i].Name, APropertyName) = 0 then
      begin
        PropExist := True;
        break;
      end;
  finally
    Freemem(PropList);
  end;

  if PropExist then
  begin
    for i := 0 to FItems.Count-1 do
    begin
      value := GetStrProp(FItems[i], APropertyName);
      if value = AValue then
      begin
        Result := i;
      end;
    end;
  end
  else
    Raise Exception.Create(Format('Property name ''%s'' not found.',[APropertyName]));
end;

procedure TUserRole.Assign(AObject: TBaseBOM);
begin
  inherited Assign(AObject);
  with TUserRole(AObject) do
  begin
    self.Rolename:= Rolename;
    self.Username:= Username;
  end;
end;

procedure TRole.Assign(AObject: TBaseBOM);
begin
  with TRole(AObject) do
    self.Rolename:= Rolename;
end;

procedure TUser.Assign(AObject: TBaseBOM);
begin
  with TUser(AObject) do
    self.Username:= Username;
end;


{ TBaseBOM }


constructor TBaseBOM.Create;
begin
  FEditState:= 'none';
end;

procedure TBaseBOM.Assign(src: TBaseBOM);
begin
  with src do
  begin
    self.ID:= src.ID;
    self.EditState:= src.EditState;
  end;
end;


var
  users: TUsers;
  roles: TRoles;
  u: TUser;
  r: TRole;
  urs: TUserRoles;
  ur: TUserRole;
  i: Integer;

begin
  roles := TRoles.Create;
  r := TRole.Create;
  r.Rolename:= 'admin';
  roles.Add(r);

  r := roles.Add;
  r.rolename := 'processor';

  users := TUsers.Create;
  u := TUser.Create;
  u.Username:= 'magic';
  users.Add(u);

  urs := TUserRoles.Create;
  ur := TUserRole.Create;
  ur.ID:= 999;
  ur.Username:= 'magic';
  ur.Rolename:= 'processor';
  urs.Add(ur);

  writeln('Find username magic');
  i := users.Find('username', 'magic');
  writeln(users[i].username);
  writeln('Find role ''processor''');
  i := roles.Find('rolename', 'processor');
  writeln(roles[i].rolename);
  writeln('Delete last found role');
  roles.Delete(i);
  writeln('Deleted roles:');
  writeln(roles.FDeletedItems[0].Rolename);
  writeln('Find rolename ''processor'' in user roles');
  i := urs.Find('rolename', 'processor');
  writeln(urs[i].Rolename, ' / ', urs[i].Username);
  writeln('Delete rolename ''processor'' in user roles');
  urs.Delete(i);
  writeln(urs.FDeletedItems[0].Rolename, ' / ', urs.FDeletedItems[0].Username);
  writeln(urs.FDeletedItems[0].ID, ' / ', urs.FDeletedItems[0].EditState);


  urs.free;
  users.free;
  roles.free;

  writeln('ok');
  readln();

end.

Upvotes: 1

Related Questions