Difference between revisions of "TCollection"

From Lazarus wiki
m
Line 1: Line 1:
 
{{TCollection/de}}
 
{{TCollection/de}}
 +
 +
== Basic Structure ==
 +
 +
TCollection usage example.
  
 
<syntaxhighlight>
 
<syntaxhighlight>
Line 91: Line 95:
  
 
end.
 
end.
 +
</syntaxhighlight>
 +
 +
== Streaming ==
 +
 +
This adds a TComponent class that can stream the list loading and saving to text files with LResources. See [[Streaming components]].
 +
 +
<syntaxhighlight>
 +
unit uhair;
 +
 +
{$mode objfpc}{$H+}
 +
 +
interface
 +
 +
uses
 +
  Classes, SysUtils, LResources, 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;
 +
 +
  { 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);
 +
  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.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.
 +
</syntaxhighlight>
 +
 +
Output text file:
 +
 +
<syntaxhighlight>
 +
object THairComponent
 +
  HairList = < 
 +
    item
 +
      Length = 10
 +
    end 
 +
    item
 +
      Length = 20
 +
    end 
 +
    item
 +
      Length = 30
 +
    end>
 +
end
 
</syntaxhighlight>
 
</syntaxhighlight>

Revision as of 22:40, 26 March 2014

Deutsch (de) English (en) français (fr)

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, SysUtils, LResources, 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;

  { 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);
  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.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
    end  
    item
      Length = 20
    end  
    item
      Length = 30
    end>
end