Question

There are 3 classes (there may be much more), which have the same procedure (procedure Populate). They are nearly identical and differs only by object creation. All I want is to write a universal procedure in the base class, which will replace this notorious repeating of code forever. I am not really sure, if I can express exactly what I am up to, but look at the code below and see. 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... Thanx...

Answer 1

要回答您的问题，您可以使用＆＃34;类＃34;如果你想去你要去的路线。这段代码演示了如何实现这一目标。需要清理层次结构，但是您应该了解通过此代码进行的操作。

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

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;

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

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

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

正如David在评论中指出的那样，如果使用元类并覆盖默认构造函数，则会遇到问题。您的构造函数中的代码永远不会运行。您可能需要使用虚拟构造函数或覆盖现有的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

这似乎有效：

//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 3

只需使用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 4

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

接口

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;

每个后代将其类存储到类变量中。并且填充将此用于创建。在Generics出现之前我一直在使用它。

Appropriate object creation - finding universal solution

4 个答案: