TCollection/fr

From Free Pascal wiki
Jump to navigationJump to search

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

TCollection est une classe de base pour des collections collections (non ordonnée) de TCollectionItems.

Pour utiliser une TCollection, un dérivé de TCollectionItem doit être créé.

Héritage

  • TObject - Classe de base pour toutes les autres.; IFPObserved - Interface implémentée par un objet qui peut être observé.
    • TPersistent - Classe de base pour le système de flux Base et propriétés persistantes.
      • TCollection - Classe de base pour gérer les collections d'objets nommés.

Exemple simple

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

Ceci ajoute une classe TComponent qui peut transformer en flux le chargement et le déchargement vers un fichier texte d'une liste avec LResources. Voir 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.

Fichier texte en sortie : 

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

Génériques

Ceci est une classe générique de collection prête à l'emploi. Elle implémente la plus élémentaire structure. Cela économise le temps de surcharge de la même méthode chaque fois que vous voulez créer une collection rapidement. Elle est faite pour vous. 

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.

Exemple d'emploi : 

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.

Voir aussi

Retrieved from "https://wiki.freepascal.org/index.php?title=TCollection/fr&oldid=133424"