Delphi 适当的对象创建-找到通用解决方案_Delphi_Delphi 7

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

delphi

Delphi 适当的对象创建-找到通用解决方案,delphi,delphi-7,Delphi,Delphi 7,有3个类（可能更多），它们具有相同的过程（过程填充）。它们几乎相同，只是在对象创建方面有所不同。我只想在基类中编写一个通用过程，它将永远取代这种臭名昭著的代码重复。我不是很确定，如果我能准确地表达我在做什么，但是看看下面的代码，看看 TGrandFather = class(TObject) end; TFather = class(TGrandFather) end; TSon = class(TFather) end; TGrandson.... an

有3个类（可能更多），它们具有相同的过程（过程填充）。它们几乎相同，只是在对象创建方面有所不同。我只想在基类中编写一个通用过程，它将永远取代这种臭名昭著的代码重复。我不是很确定，如果我能准确地表达我在做什么，但是看看下面的代码，看看

  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

要回答你的问题，如果你想走你要走的路线，你可以通过“类”使用元类。这段代码演示了如何实现这一点。需要清理层次结构，但您应该通过这段代码了解正在发生的事情的要点

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

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;

为了回答你的问题，如果你想走你要走的路线，你可以使用一个元类通过“class of”。这段代码演示了如何实现这一点。需要清理层次结构，但您应该通过这段代码了解正在发生的事情的要点

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

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

的实例

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;

只需使用

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.

只需使用

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.

这似乎有效：

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

//MMWIN:CLASSCOPY
单位(毫米)(复制)(缓冲);；
界面
实施
类型
TBaseSelfCreating=类（ToObject）
程序填充（金额：整数）；
程序添加（对象：TObject）；
终止
{TBaseSelfCreating}
过程TBaseSelfCreating.Add（对象：TObject）；
开始
断言（Obj是TBASESELFREATING）；
断言（Obj-Self）；
对象自由；
终止
过程TBaseSelfCreating.Populate（金额：整数）；
变量
i：整数；
开始
对于i:=1，以进行添加（Self.ClassType.Create）；
终止
终止

这似乎有效：

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

//MMWIN:CLASSCOPY
单位(毫米)(复制)(缓冲);；
界面
实施
类型
TBaseSelfCreating=类（ToObject）
程序填充（金额：整数）；
程序添加（对象：TObject）；
终止
{TBaseSelfCreating}
过程TBaseSelfCreating.Add（对象：TObject）；
开始
断言（Obj是TBASESELFREATING）；
断言（Obj-Self）；
对象自由；
终止
过程TBaseSelfCreating.Populate（金额：整数）；
变量
i：整数；
开始
对于i:=1，以进行添加（Self.ClassType.Create）；
终止
终止

如果您不想使用泛型或者您使用的是没有泛型的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;

每个子体将其类存储到类变量中。而填充将其用于创建。在泛型出现之前，我一直在使用它。
如果您不想使用泛型，或者您使用的是没有泛型的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;

每个子体将其类存储到类变量中。而填充将其用于创建。在泛型出现之前，我一直在使用它。
使用泛型containers@DavidHeffernan：我认为通用容器是从Delphi 2009引入的。不幸的是，我使用的是Delphi7，问题被标记为Delphi。你