Object Pascal 从基础 class 调用或调用后代的方法

Question

我想到了这个对象：

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;

这是一个后代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;

然后我做了一个容器对象如下：

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;

用作：

TUsers = TBaseBOMList<TUser>; 

var
  Users: TUsers;

可以看出，我尝试使用后代的 clone 方法将要删除的项目的副本保存到 FDeletedItems 通用列表中，然后从 FItems 中删除，但失败了。编译器说 'no member Clone'.

如果我正在做的事情无法完成，应该如何处理？

Answer 1

根据 Dalija 的建议，我声明了 TBaseObjects<T:TBaseObject> 而不是 TBaseObjects<T:class>。

任何好奇或感兴趣的人都可以在下面找到完整的测试程序。

此外，如果有人可以使用纯多态性而不是 DelphiCoder 暗示的泛型更有效地做到这一点，我很乐意重新考虑，因为现在，如果没有泛型，我将不得不声明和定义一个 TBaseBOMList并为我想使用的每个基础对象（TUser、TRole 等）复制每个方法。

代码：

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.

Object Pascal 从基础 class 调用或调用后代的方法

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

delphi

generics

containers

freepascal

lazarus