适当的对象创建 - 寻找通用解决方案

Question

有 3 个 classes（可能还有更多），它们具有相同的过程（procedure Populate）。它们几乎相同，仅在对象创建方面有所不同。我只想在基础 class 中编写一个通用程序，它将永远取代这种臭名昭著的重复代码。我不太确定，如果我能准确表达我在做什么，但请查看下面的代码并查看。

  TGrandFather = class(TObject)

  end;

  TFather = class(TGrandFather)

  end;

  TSon = class(TFather)

  end;

  TGrandson.... and so on... 



  TGrandFathers = class (TList)
  public
    procedure Populate(Amount:Integer);
  end;

  TFathers = class (TGrandFathers)
  public
    procedure Populate(Amount:Integer);
  end;

  TSons = class (TFathers)
  public
    procedure Populate(Amount:Integer);
  end;

  TGrandsons.... 
...

procedure TGrandFathers.Populate(Amount:Integer);
var i:integer;
    xGrandFather:TGrandFather;
begin
   for i := 0 to Amount do
   begin
   xGrandFather:=TGrandFather.Create;
   Add(xGrandFather);
   end;
end;

procedure TFathers.Populate(Amount:Integer);
var i:integer;
    xFather:TFather;
begin
   for i := 0 to Amount do
   begin
   xFather:=TFather.Create;    //this is the point, which makes trouble
   Add(xFather);
   end;
end;

procedure TSons.Populate(Amount:Integer);
var i:integer;
    xSon:TSon;
begin
   for i := 0 to Amount do
   begin
   xSon:=TSon.Create;          //this is the point, which makes trouble
   Add(xSon);
   end;
end;

procedure Grandsons...

谢谢...

Answer 1

要回答您的问题，您可以使用元class 到 "class of"，如果您想按照自己的路线进行。此代码块演示了您将如何完成它。层次结构需要清理，但您应该了解这段代码的要点。

一个元class是一个class，它的实例是classes。这允许您构建一个更通用的框架，因为您可以使用您的元 class 来创建您需要的 classes。

type
  TGrandFather = class(TObject)

  end;

  TStrangeHeirarchyClass = class of TGrandFather;

  TFather = class(TGrandFather)

  end;

  TSon = class(TFather)

  end;

  TGrandFathers = class(TList)
  protected
    procedure PopulateInternal(aAmount:Integer; aContainedClass:
        TStrangeHeirarchyClass);
  public
    procedure Populate(Amount:Integer);
  end;

  TFathers = class (TGrandFathers)
  public
    procedure Populate(Amount:Integer);
  end;

  TSons = class (TFathers)
  public
    procedure Populate(Amount:Integer);
  end;

implementation

procedure TGrandFathers.Populate(Amount:Integer);
begin
  PopulateInternal(Amount, TGrandFather);
end;

procedure TGrandFathers.PopulateInternal(aAmount:Integer; aContainedClass:
    TStrangeHeirarchyClass);
var
  i:integer;
  xFamilyMember:TGrandFather;
begin
  for i := 0 to aAmount do
  begin
    xFamilyMember := aContainedClass.Create;
    Add(xFamilyMember);
  end;
end;

procedure TFathers.Populate(Amount:Integer);
begin
  PopulateInternal(Amount, TFather);
end;

procedure TSons.Populate(Amount:Integer);
begin
  PopulateInternal(Amount, TSon);
end;

它的工作方式是元class TStrangeHeirarchyClass，您可以像常规数据类型一样使用它，存储您想要使用的基础class .您可以将类型作为参数传递（就像我在上面的代码示例中所做的那样）或将其作为属性或这样的字段存储在 class 中：

  TGrandFathers = class(TList)
  private
    FContainedClass: TStrangeHeirarchyClass;
  public
    procedure Populate(Amount:Integer);
    property ContainedClass: TStrangeHeirarchyClass read 
        FContainedClass write FContainedClass;
  end;

设置此属性后，您就可以使用它来创建它所设置的 class 类型的实例。因此，将 ContainedClass 设置为 TFather 将导致调用 ContainedClass.Create 创建 TFather.

的实例

正如 David 在评论中指出的那样，如果您使用元 class 并覆盖默认构造函数，您将运行遇到问题。您在构造函数中的代码永远不会运行。您要么需要停止使用虚拟构造函数，要么覆盖现有的 AfterConstruction 方法，该方法是构造函数调用的虚拟方法。如果您使用 AfterConstruction:

  TGrandFathers = class(TList)
  protected
    FContainedClass: TStrangeHeirarchyClass;
  public
    procedure AfterConstruction; override;
    procedure Populate(Amount:Integer);
  end;

  TFathers = class (TGrandFathers)
  public
    procedure AfterConstruction; override;
  end;

  TSons = class (TFathers)
  public
    procedure AfterConstruction; override;
  end;

implementation

procedure TGrandFathers.AfterConstruction;
begin
  inherited;
  FContainedClass := TGrandFather;
  // Other construction code
end;

procedure TGrandFathers.Populate(aAmount:Integer);
var
  i:integer;
  xFamilyMember:TGrandFather;
begin
  for i := 0 to aAmount do
  begin
    xFamilyMember := FContainedClass.Create;
    Add(xFamilyMember);
  end;
end;

procedure TFathers.AfterConstruction;
begin
  inherited;
  FContainedClass := TFather;
  // Other construction code
end;

procedure TSons.AfterConstruction;
begin
  inherited;
  FContainedClass := TSon;
  // Other construction code
end;

虽然你的层次结构看起来很奇怪。我认为这样的事情会更合适：

type
  TRelationType = (ptSon, ptFather, ptGrandfather);

  TPerson = class;

  TRelation = class(TObject)
  strict private
    FRelationship: TRelationType;
    FRelation: TPerson;
  public
    property Relation: TPerson read FRelation write FRelation;
    property Relationship: TRelationType read FRelationship write FRelationship;
  end;

  TRelationList = class(TList)
    //...
  end;

  TPerson = class(TObject)
  strict private
    FPersonName: string;
    FRelations: TRelationList;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    property PersonName: string read FPersonName write FPersonName;
    property Relations: TRelationList read FRelations;
  end;

implementation

procedure TPerson.AfterConstruction;
begin
  inherited;
  FRelations := TRelationList.Create;
end;

procedure TPerson.BeforeDestruction;
begin
  FRelations.Free;
  inherited;
end;

Answer 2

只需使用Self.ClassType.Create:

program Project13;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  TFoo1 = class
    procedure Boo;
  end;

  TFoo2 = class(TFoo1)
  end;

{ TFoo1 }

procedure TFoo1.Boo;
var
  x: TFoo1;
begin
  x := Self.ClassType.Create as TFoo1;
  write(Cardinal(Self):16, Cardinal(x):16);
  Writeln(x.ClassName:16);
end;

begin
  try
    TFoo1.Create.Boo;
    TFoo2.Create.Boo;
    Readln;
  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
end.

Answer 3

这似乎有效：

//MMWIN:CLASSCOPY
unit _MM_Copy_Buffer_;

interface


implementation

type
  TBaseSelfCreating = class(TObject)
    procedure Populate(Amount: Integer);
    procedure Add(Obj: TObject);
  end;


{TBaseSelfCreating}

procedure TBaseSelfCreating.Add(Obj: TObject);
begin
  Assert(Obj is TBaseSelfCreating);
  Assert(Obj <> Self);
  Obj.Free;
end;

procedure TBaseSelfCreating.Populate(Amount: Integer);
var
  i: Integer;
begin
  for i := 1 to Amount do Add(Self.ClassType.Create);
end;

end.

Answer 4

如果您不想使用 Generics 或者您正在使用没有 Generics 的 Delphi 版本，那么这是一种方法。是的，我知道我可以使用前向声明来删除一个 class，但这更容易理解。

界面

type
  TBaseAncestor = class
  end;

  TBaseClass = class of TBaseAncestor;

  TGrandFathers = class (TBaseAncestor)
    FClassType : TBaseClass;
    constructor Create (AOwner : TControl); reintroduce; virtual;
    procedure Populate;
    procedure Add (X : TBaseAncestor);
  end;

  TFathers = class (TGrandFathers)
    constructor Create (AOwner : TControl); override;
  end;

实施

{ TGrandFathers }

constructor TGrandFathers.Create(AOwner: TControl);
begin
  inherited Create;
  FClassType := TGrandFathers;
end;

procedure TGrandFathers.Add (X : TBaseAncestor);
begin

end;

procedure TGrandFathers.Populate;
const
  Amount = 5;
var
  I : integer;
  x : TBaseAncestor;
begin
   for I := 0 to Amount do
   begin
     x := FClassType.Create;
     Add (x);
   end;
end;

{ TFathers }

constructor TFathers.Create(AOwner: TControl);
begin
  inherited;
  FClassType := TFathers;
end;

每个后代将其 class 存储到 class 变量 中。 Populate 将其用于创建。在 Generics 出现之前，我一直在使用它。

适当的对象创建 - 寻找通用解决方案

Appropriate object creation - finding universal solution

delphi

delphi-7