Difference between revisions of "TCollection"
From Free Pascal wiki
Jump to navigationJump to searchm (→Streaming) |
(WIP generic class.) |
||
Line 290: | Line 290: | ||
end> | end> | ||
end | end | ||
+ | </syntaxhighlight> | ||
+ | |||
+ | == Generics == | ||
+ | |||
+ | This must be a ready-to-use collection generic class. | ||
+ | |||
+ | <syntaxhighlight> | ||
+ | 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. | ||
</syntaxhighlight> | </syntaxhighlight> | ||
[[Category:RTL]] | [[Category:RTL]] |
Revision as of 09:20, 1 April 2014
│
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
Generics
This must be a ready-to-use collection generic class.
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.