TCollection

│ Deutsch (de) │ English (en) │ français (fr) │ polski (pl) │

Basic Structure

TCollection usage example.

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;

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.

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;

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:

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