Object dynamisch in einem Array erzeufen

[David Martens]

Hast du schon mal über "Templates" nachgedacht:

Delphi-Quellcode:

////////////////////////////////////////////////////////////////////////////////
// Unit  : t_TypedObjectList                                                  //
// Quelle: www.dummzeuch.de/delphi/object_pascal_templates/deutsch.html       //
////////////////////////////////////////////////////////////////////////////////
// Erstellt von: David Martens                                                //
// Erstellt am : 10.11.2008                                                   //
// Beschreibung: Delphi-"Template" zur Erstellung typisierter Listen          //
////////////////////////////////////////////////////////////////////////////////
// Geändert von:                                                              //
// Geändert am :                                                              //
////////////////////////////////////////////////////////////////////////////////

{$IFNDEF LIST_TEMPLATE_}
unit t_TypedObjectList;

interface

{: These units must be added to the uses clause of any class built on this template }
uses
  Classes;

{: These types must be declared for each class built on this template }
type
  {: the ancestor class for the template, can be TObject or TInterfacedObject
     or anything else you like}
  _LIST_ANCESTOR_ = TObject;
  {: Container type used to actually store the items: TList or TInterfacelist }
  _LIST_CONTAINER_ = TList;
  {: The native item type of the list container (Pointer for TList, IInterface for TInterfaceList}
  _LIST_CONTAINER_ITEM_TYPE_ = pointer; 
  {: The item type to be stored in the list }
  _ITEM_TYPE_ = TObject;

{$ENDIF LIST_TEMPLATE_}

{$IFNDEF LIST_TEMPLATE_SECOND_PASS_}

type
  _LIST_TEMPLATE_ = class(_LIST_ANCESTOR_)
  private
    {: This actually stores the items }
    FItems: _LIST_CONTAINER_;
    {: Getter function for Items property }
    function _GetItems(_Idx: integer): _ITEM_TYPE_;
  protected
    {: Frees an item (does nothing here, must be overwritten }
    procedure FreeItem(_Item: _ITEM_TYPE_); virtual;
  public
    {: Creates a list for storing items }
    constructor Create;
    {: Calls FreeItem for alle items and frees the list }
    destructor Destroy; override;
    {: Returns the number of items stored in the list }
    function Count: integer;
    {: Deletes all items from the list without calling FreeItem }
    procedure DeleteAll;
    {: Exchanges the two items at index Idx1 and Idx2 }
    procedure Exchange(_Idx1, _Idx2: integer);
    {: removes the item with index Idx from the list and returns it }
    function Extract(_Idx: integer): _ITEM_TYPE_;
    {: Calls FreeItem for all items and removes them from the list }
    procedure FreeAll;
    {: inserts an item into the list and returns its index }
    procedure Insert(_Idx: integer; _Item: _ITEM_TYPE_); virtual;

    function Add(_Item: Pointer): integer;
    {: allows accessing the items in the list by index }
    property Items[_Idx: integer]: _ITEM_TYPE_ read _GetItems; default;
  end;

{$ENDIF LIST_TEMPLATE_SECOND_PASS_}

{$IFNDEF LIST_TEMPLATE_}
{$DEFINE LIST_TEMPLATE_SECOND_PASS_}
implementation
{$ENDIF LIST_TEMPLATE_}

{$IFDEF LIST_TEMPLATE_SECOND_PASS_}

{ _LIST_TEMPLATE_ }

function _LIST_TEMPLATE_.Add(_Item: Pointer): integer;
begin
  Result := FItems.Add(_LIST_CONTAINER_ITEM_TYPE_(_Item));
end;

function _LIST_TEMPLATE_.Count: integer;
begin
  Result := FItems.Count;
end;

constructor _LIST_TEMPLATE_.Create;
begin
  inherited Create;
  FItems := _LIST_CONTAINER_.Create;
end;

procedure _LIST_TEMPLATE_.DeleteAll;
begin
  FItems.Clear;
end;

destructor _LIST_TEMPLATE_.Destroy;
var
  i: integer;
  Item: _ITEM_TYPE_;
begin
  if Assigned(FItems)
  then
  begin
    for i := 0 to FItems.Count - 1
    do
    begin
      Item := _ITEM_TYPE_(FItems[i]);
      FreeItem(Item);
    end;
  end;
  FItems.Free;
  inherited;
end;

procedure _LIST_TEMPLATE_.Exchange(_Idx1, _Idx2: integer);
begin
  FItems.Exchange(_Idx1, _Idx2);
end;

function _LIST_TEMPLATE_.Extract(_Idx: integer): _ITEM_TYPE_;
begin
  Result := _ITEM_TYPE_(FItems[_Idx]);
  Fitems.Delete(_Idx);
end;

procedure _LIST_TEMPLATE_.FreeAll;
var
  i: integer;
begin
  for i := 0 to FItems.Count - 1
  do
  begin
    FreeItem(_ITEM_TYPE_(FItems[i]));
  end;
  FItems.Clear;
end;

procedure _LIST_TEMPLATE_.FreeItem(_Item: _ITEM_TYPE_);
begin
  // do nothing, override if the items must be freed
end;

function _LIST_TEMPLATE_._GetItems(_Idx: integer): _ITEM_TYPE_;
begin
  Result := _ITEM_TYPE_(FItems[_Idx]);
end;

procedure _LIST_TEMPLATE_.Insert(_Idx: integer; _Item: _ITEM_TYPE_);
begin
  FItems.Insert(_Idx, _LIST_CONTAINER_ITEM_TYPE_(_Item));
end;

{$ENDIF LIST_TEMPLATE_SECOND_PASS_}

{$DEFINE LIST_TEMPLATE_SECOND_PASS_}

{$IFNDEF LIST_TEMPLATE_}
{$WARNINGS OFF}
end.
{$ENDIF LIST_TEMPLATE_}

Und hier ist ein kleines Beispiel um die Anwendung zu demonstrieren:

Das Objekt was in der Liste gespeichert werden soll:

Delphi-Quellcode:

unit u_FilterItem;

interface

type
  TFilterItem = class
  strict private
    FHeight : integer;
    FTop : integer;

    FControl  : TControl;
    ...
  public
    constructor Create(aParent : TWinControl;
                       iName : integer;
                       Top : integer;
                       OnClick : TNotifyEvent;
                       OnChangeEvent : TNotifyEvent);

    destructor Destroy; override;

    ...

    property Height : integer read FHeight write SetHeight;
    property Top : integer read FTop write SetTop;
    ...
  end;

implementation

und er ganze Rest.......
also ein ganz normales Objekt.

Delphi-Quellcode:

////////////////////////////////////////////////////////////////////////////////
// Erstellt von: David Martens                                                //
// Erstellt am:  10.11.2008                                                   //
// Beschreibung: typisierte Listklasse unter Verwendung eines                 //
//               Delphi-"Templates"                                           //
//                                                                            //
//               In der "Listklasse" ist eine "Kontainerklasse" enthalten,    //
//               die die eigentliche Liste enthält.                           //
//                                                                            //
//               weitere Beschreibung in der Implementierung                  //
////////////////////////////////////////////////////////////////////////////////
unit u_FilterItemList;

interface

uses
  Classes,
  // Unit mit Klasse für _ITEM_TYPE_ (eine ganz normale Klasse)
  u_FilterItem;

// Kompilerdirektive für das Template
{$DEFINE LIST_TEMPLATE_}

type
  // Vorfahr der "Listklasse"
  _LIST_ANCESTOR_ = TObject;
  // Vorfahr der "Kontainerklasse", sollte ein Nachfahr von TList sein
  _LIST_CONTAINER_ = TList;
  // Typ des Items in der "Kontainerklasse" (z.B.: Pointer für TList, IInterface für TInterfaceList}
  _LIST_CONTAINER_ITEM_TYPE_ = pointer;
  // Item der typisierten Klasse, dieser Typ wird von der Klasse ausgegeben
  _ITEM_TYPE_ = TFilterItem;

// Verzeichnis: \Delphi\Komponenten\Templates nicht in Umgebungsvariablen vorhanden daher so:

// 1. Template-aufruf: erstellt den Kopf der _LIST_TEMPLATE_ Klasse anhand der oben gemachten Angaben
{$INCLUDE '..\Templates\t_TypedObjectList.pas'}

type
  // "Umbenennung" von _LIST_TEMPLATE_ und weitere spezielle Eigenschaften für die Klasse
  TFilterItemList = class(_LIST_TEMPLATE_)
  protected
    // muss implementiert werden, falls die Items freigegeben werden müssen (destructor Aufruf)
    procedure FreeItem(_Item: _ITEM_TYPE_); override;
  end;

implementation

// 2. Template-aufruf: implementiert die _LIST_TEMPLATE_ Klasse anhand der oben gemachten Angaben
{$INCLUDE '..\Templates\t_TypedObjectList.pas'}


// Implementierung der speziellen Eigenschaften der Klasse

{ TFilterItemList }

procedure TFilterItemList.FreeItem(_Item: _ITEM_TYPE_);
begin
  _Item.Free;

  inherited;
end;

end.

Zum Schluß, wie es angewendet wird:

Delphi-Quellcode:

    FFilterListe : TFilterItemList;

...

  if FFilterListe.Count > 0 then
  begin
    NewTop := FFilterListe.Items[FFilterListe.Count - 1].Top +
              FFilterListe.Items[FFilterListe.Count - 1].Height;
  end;

Kein typecating mehr