Reputation: 555
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
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