TCollection
From Free Pascal wiki
Jump to navigationJump to search
│
Deutsch (de) │
English (en) │
français (fr) │
polski (pl) │
A TCollection is a base class for (unordered) collections of TCollectionItems.
To use a TCollection, a derived TCollectionItem has to be created
Inheritance
- TObject - Base class of all classes.; IFPObserved - Interface implemented by an object that can be observed.
- TPersistent - Base class for streaming system and persistent properties.
- TCollection - Base class to manage collections of named objects.
- TPersistent - Base class for streaming system and persistent properties.
Simple 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;
Example of use:
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;
Example of use:
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
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.
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:
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.