Sign in Join
Wiki copytemporary

TCollection

Deutsch · English · Français · Polski

A TCollection is a base class for (unordered) collections of TCollectionItems.

To use a TCollection, a derived TCollectionItem has to be created

Inheritance

Simple example

pascal
unit uhair;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Dialogs;

type

  { THairItem }

  THairItem = class(TCollectionItem)
  private
    FLength: integer;
  public
    constructor Create(ACollection: TCollection); override;
  published
    property Length: integer read FLength write FLength;
  end;

  { THairList }

  THairList = class(TCollection)
  private
    function GetItems(Index: integer): THairItem;
    procedure SetItems(Index: integer; AValue: THairItem);
  public
    constructor Create;
  public
    function Add: THairItem;
    function AddEx(length: integer): THairItem;
    property Items[Index: integer]: THairItem read GetItems write SetItems; default;
  end;

var
  hairs: THairList;

implementation

{ THairItem }

constructor THairItem.Create(ACollection: TCollection);
begin
  if Assigned(ACollection) {and (ACollection is THairList)} then
    inherited Create(ACollection);
end;

{ THairList }

function THairList.GetItems(Index: integer): THairItem;
begin
  Result := THairItem(inherited Items[Index]);
end;

procedure THairList.SetItems(Index: integer; AValue: THairItem);
begin
  Items[Index].Assign(AValue);
end;

constructor THairList.Create;
begin
  inherited Create(THairItem);
end;

function THairList.Add: THairItem;
begin
  Result := inherited Add as THairItem;
end;

function THairList.AddEx(length: integer): THairItem;
begin
  Result := inherited Add as THairItem;
  Result.Length := length;
end;

Example of use:

pascal
initialization
  hairs := THairList.Create;
  hairs.AddEx(10);
  hairs.Add.Length := 100;
  hairs.Delete(0);

  ShowMessage(IntToStr(hairs.Count));

finalization
  hairs.Free;

end.

Streaming

This adds a TComponent class that can stream the list loading and saving to text files with LResources. See Streaming components.

pascal
unit uhair;

{$mode objfpc}{$H+}

interface

uses
  Classes, Graphics, SysUtils, LResources, Dialogs;

type

  { THairItem }

  THairItem = class(TCollectionItem)
  private
    FLength: integer;
    FColor: TColor;
  public
    constructor Create(ACollection: TCollection); override;
  published
    property Length: integer read FLength write FLength;
    property Color: TColor read FColor write FColor;
  end;

  { THairList }

  THairList = class(TCollection)
  private
    function GetItems(Index: integer): THairItem;
    procedure SetItems(Index: integer; AValue: THairItem);
  public
    constructor Create;
  public
    function Add: THairItem;
    function AddEx(length: integer): THairItem;
    property Items[Index: integer]: THairItem read GetItems write SetItems; default;
  end;

  { THairComponent }

  THairComponent = class(TComponent)
  private
    FHairList: THairList;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  public
    procedure SaveToFile(AFileName: string);
    procedure LoadFromFile(AFileName: string);
    procedure OnFindClass(Reader: TReader; const AClassName: string;
      var ComponentClass: TComponentClass);
  published
    property HairList: THairList read FHairList write FHairList;
  end;

var
  hairs: THairComponent;

implementation

{ THairComponent }

constructor THairComponent.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Self.SetSubComponent(True);
  // add this line if you want to put this class inside other and also be streamed
  HairList := THairList.Create;
end;

destructor THairComponent.Destroy;
begin
  HairList.Free;
  inherited Destroy;
end;

procedure THairComponent.SaveToFile(AFileName: string);
var
  AStream: TMemoryStream;
begin
  AStream := TMemoryStream.Create;
  try
    WriteComponentAsTextToStream(AStream, Self);
    AStream.SaveToFile(AFileName);
  finally
    AStream.Free;
  end;
end;

procedure THairComponent.LoadFromFile(AFileName: string);
var
  AStream: TMemoryStream;
begin
  AStream := TMemoryStream.Create;
  try
    AStream.LoadFromFile(AFileName);
    ReadComponentFromTextStream(AStream, TComponent(Self), @OnFindClass);
  finally
    AStream.Free;
  end;
end;

procedure THairComponent.OnFindClass(Reader: TReader; const AClassName: string;
  var ComponentClass: TComponentClass);
begin
  if CompareText(AClassName, 'THairComponent') = 0 then
    ComponentClass := THairComponent;
end;

{ THairItem }

constructor THairItem.Create(ACollection: TCollection);
begin
  if Assigned(ACollection) and (ACollection is THairList) then
    inherited Create(ACollection);
end;

{ THairList }

function THairList.GetItems(Index: integer): THairItem;
begin
  Result := THairItem(inherited Items[Index]);
end;

procedure THairList.SetItems(Index: integer; AValue: THairItem);
begin
  Items[Index].Assign(AValue);
end;

constructor THairList.Create;
begin
  inherited Create(THairItem);
end;

function THairList.Add: THairItem;
begin
  Result := inherited Add as THairItem;
end;

function THairList.AddEx(length: integer): THairItem;
begin
  Result := inherited Add as THairItem;
  Result.Length := length;
end;

Example of use:

pascal
initialization
  hairs := THairComponent.Create(nil);

  hairs.HairList.AddEx(10);
  hairs.HairList.AddEx(20);
  hairs.HairList.AddEx(30);
  hairs.HairList[0].Color := clRed;

  hairs.SaveToFile('test.txt');

  hairs.HairList.Delete(2);
  hairs.HairList.Delete(1);
  hairs.HairList.Delete(0);

  hairs.LoadFromFile('test.txt');

  ShowMessage(IntToStr(hairs.HairList[0].Length));

finalization
  hairs.Free;

end.

Output text file:

pascal
object THairComponent
  HairList = <  
    item
      Length = 10
      Color = clRed
    end  
    item
      Length = 20
      Color = clBlack
    end  
    item
      Length = 30
      Color = clBlack
    end>
end

Generics

This is a ready-to-use collection generic class. It implements the most elemental structure. Save time overriding the same methods each time you want to create a collection quickly. It does it for you.

pascal
unit ugenericcollection;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

type

  { TGenericCollection }

  generic TGenericCollection<T> = class(TCollection)
  private
    function GetItems(Index: integer): T;
    procedure SetItems(Index: integer; AValue: T);
  public
    constructor Create;
  public
    function Add: T;
  public
    property Items[Index: integer]: T read GetItems write SetItems; default;
  end;

implementation

{ TGenericCollection }

function TGenericCollection.GetItems(Index: integer): T;
begin
  Result := T(inherited Items[Index]);
end;

procedure TGenericCollection.SetItems(Index: integer; AValue: T);
begin
  Items[Index].Assign(AValue);
end;

constructor TGenericCollection.Create;
begin
  inherited Create(T);
end;

function TGenericCollection.Add: T;
begin
  Result := T(inherited Add);
end;

end.

Example of use:

pascal
unit usaving;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, ugenericcollection;

type

  { TBookItem }

  TBookItem = class(TCollectionItem)
  private
    FCode: string;
    FTitle: string;
  published
    property Code: string read FCode write FCode;
    property Title: string read FTitle write FTitle;
  end;

  { TPeopleItem }

  TPeopleItem = class(TCollectionItem)
  private
    FName: string;
    FChoice: string;
  published
    property Name: string read FName write FName;
    property Choice: string read FChoice write FChoice;
  end;

  { TBookCollection }

  TCustomBookCollection = specialize TGenericCollection<TBookItem>;

  TBookCollection = class(TCustomBookCollection)
  public
    function AddEx(aCode, aTitle: string): TBookItem;
  end;

  { TPeopleCollection }

  TCustomPeopleCollection = specialize TGenericCollection<TPeopleItem>;

  TPeopleCollection = class(TCustomPeopleCollection)
  public
    function AddEx(aName, aChoice: string): TPeopleItem;
  end;

implementation

{ TBookCollection }

function TBookCollection.AddEx(aCode, aTitle: string): TBookItem;
begin
  Result := inherited Add as TBookItem;
  Result.Code := aCode;
  Result.Title := aTitle;
end;

{ TPeopleCollection }

function TPeopleCollection.AddEx(aName, aChoice: string): TPeopleItem;
begin
  Result := inherited Add as TPeopleItem;
  Result.Name := aName;
  Result.Choice := aChoice;
end;

end.

See also

From the Free Pascal wiki, page "TCollection", as it stood on 2020-02-29 after a change by Trev, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's Licensing page. If you have concerns about this material, message the admin.

Revision 1, last changed by WikiArchive .

Talk about this page

Nobody has opened a bench for this page yet. Sign in to open one.