Componentes con propiedades TCollection

Buenas

Cuando diseñamos componentes y necesitamos tener una lista de algún objeto y queremos que ésta se muestre en el inspector de objetos, una buena solución es recurrir a las clases TCollection y TCollectionItem. Muchos componentes usan estas clases para mostrarnos sus propiedades, como por ejemplo el tan usado TDBGrid (su propiedad Columns es una TCollection y cada una de las columnas, TCollectionItem).

La verdad es que es sencillo de implementar. Veamos un pequeño ejemplo.

unit MyComponent;

interface

uses
  Classes;

type
  TMyCollectionItem = class(TCollectionItem)
  private
    FStringProp: string;
  protected
    function GetDisplayName: string; override;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property StringProp: string read FStringProp write FStringProp;
  end;

  TMyCollection = class(TCollection)
  private
    function GetItem(Index: Integer): TMyCollectionItem;
    procedure SetItem(Index: Integer; Value: TMyCollectionItem);
  public
    function Add: TMyCollectionItem;
    function Insert(Index: Integer): TMyCollectionItem;
    property Items[Index: Integer]: TMyCollectionItem read GetItem write SetItem;
  end;

  TMyComponent = class(TComponent)
  private
    FCollectionProp: TMyCollection;
    procedure SetCollectionProp(const Value: TMyCollection);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property CollectionProp: TMyCollection read FCollectionProp write SetCollectionProp;
  end;

procedure Register;

implementation

uses
  SysUtils;

procedure Register;
begin
  RegisterComponents('Samples', [TMyComponent]);
end;

{ TMyCollection }

function TMyCollection.Add: TMyCollectionItem;
begin
  Result := TMyCollectionItem(inherited Add);
end;

function TMyCollection.GetItem(Index: Integer): TMyCollectionItem;
begin
  Result := TMyCollectionItem(inherited GetItem(Index));
end;

function TMyCollection.Insert(Index: Integer): TMyCollectionItem;
begin
  Result := TMyCollectionItem(inherited Insert(Index));
end;

procedure TMyCollection.SetItem(Index: Integer; Value: TMyCollectionItem);
begin
  inherited SetItem(Index, Value);
end;

{ TMyCollectionItem }

procedure TMyCollectionItem.Assign(Source: TPersistent);
begin
  inherited;

  if Source is TMyCollectionItem then
    FStringProp := TMyCollectionItem(Source).FStringProp;
end;

function TMyCollectionItem.GetDisplayName: String;
begin
  Result := Format(ClassName + ' %d',[Index]);
end;

{ TMyComponent }

constructor TMyComponent.Create(AOwner: TComponent);
begin
  inherited;

  FCollectionProp := TMyCollection.Create(TMyCollectionItem);
end;

destructor TMyComponent.Destroy;
begin
  if Assigned(FCollectionProp) then FreeAndNil(FCollectionProp);

  inherited;
end;

procedure TMyComponent.SetCollectionProp(const Value: TMyCollection);
begin
  FCollectionProp.Assign(Value);
end;

end.

Con estas pocas lineas de código, conseguimos un resultado cómo el que podemos ver en la imagen de la izquierda .

Básicamente lo que hemos hecho es crear una clase que descienda de TCollectionItem a la que le hemos añadido la propiedad StringProp.

También creamos una clase que descienda de TCollection. Realmente esta clase se hace para sobreescribir algunos métodos de TCollection para que, en lugar de devolver un TCollectionItem y tengamos que hacer casteos, devuelva directamente un item de nuestra clase, es decir, un TMyCollectionItem.

Para terminar el código, creamos una última clase que será el componente propiamente dicho con la propiedad de tipo TCollection.

Hasta aquí todo normal y muy sencillo, pero… ¿qué pasa si lo que queremos es que nuestra colección «cuelgue» de otra propiedad de nuestro componente la cual deriva de TPersistent? Veamos en la imagen siguiente lo que queremos conseguir.

En este caso, lo primero que pensamos es hacer una propiedad (llamada PersistentProp) de tipo TPersistent de donde hacer «colgar» nuestra TCollection (como vemos en la imagen).

Al hacer ésto, nos encontramos con la sorpresa de que, si bien podemos ver nuestra propiedad en el inspector, no podemos acceder al editor de la colección. Esto es debido a que la colección necesita saber su owner y, la implementación del método GetOwner es muy distinta en TPersistent y TComponent (en la primera simplemente devuelve un nil, mientras que en la segunda devuelve el Owner.

Para solucionar el pequeño inconveniente, simplemente tenemos que decirle tanto a la propiedad TPersistent como a nuestra TCollection, cuál es su owner, y eso lo haremos en el constructor de la clase. Así pues, el código de nuestro componente quedará como sigue:

unit MyComponent;

interface

uses
  Classes, SysUtils;

type
  TMyCollectionItem = class(TCollectionItem)
  private
    FStringProp: String;
  protected
    function GetDisplayName: String; override;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property StringProp: String read FStringProp write FStringProp;
  end;

  TMyCollection = class(TCollection)
  private
    FOwner: TPersistent;
    function GetItem(Index: Integer): TMyCollectionItem;
    procedure SetItem(Index: Integer; Value: TMyCollectionItem);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TPersistent);
    function Add: TMyCollectionItem;
    function Insert(Index: Integer): TMyCollectionItem;
    property Items[Index: Integer]: TMyCollectionItem read GetItem write SetItem;
  end;

  TMyPersistent = class(TPersistent)
  private
    FOwner: TPersistent;
    FCollectionProp: TMyCollection;
    procedure SetCollectionProp(Value: TMyCollection);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TPersistent);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property CollectionProp: TMyCollection read FCollectionProp write SetCollectionProp;
  end;

  TMyComponent = class(TComponent)
  private
    FPersistentProp: TMyPersistent;
    procedure SetPersistentProp(Value: TMyPersistent);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property PersistentProp: TMyPersistent read FPersistentProp write SetPersistentProp;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TMyComponent]);
end;

{ TMyCollectionItem }

procedure TMyCollectionItem.Assign(Source: TPersistent);
begin
  inherited;
  if Source is TMyCollectionItem then
    FStringProp := TMyCollectionItem(Source).FStringProp;
end;

function TMyCollectionItem.GetDisplayName: String;
begin
  Result := Format(ClassName + ' %d',[Index]);
end;

{ TMyCollection }

function TMyCollection.Add: TMyCollectionItem;
begin
  Result := TMyCollectionItem(inherited Add);
end;

constructor TMyCollection.Create(AOwner: TPersistent);
begin
  inherited Create(TMyCollectionItem);
  FOwner := AOwner;
end;

function TMyCollection.GetItem(Index: Integer): TMyCollectionItem;
begin
  Result := TMyCollectionItem(inherited GetItem(Index));
end;

function TMyCollection.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

function TMyCollection.Insert(Index: Integer): TMyCollectionItem;
begin
  Result := TMyCollectionItem(inherited Insert(Index));
end;

procedure TMyCollection.SetItem(Index: Integer; Value: TMyCollectionItem);
begin
  inherited SetItem(Index, Value);
end;

{ TMyPersistent }

procedure TMyPersistent.Assign(Source: TPersistent);
begin
  inherited;
  if Source is TMyPersistent then
    CollectionProp := TMyPersistent(Source).FCollectionProp;
end;

constructor TMyPersistent.Create(AOwner: TPersistent);
begin
  inherited Create;
  FOwner := AOwner;
  FCollectionProp := TMyCollection.Create(Self);
end;

destructor TMyPersistent.Destroy;
begin
  FCollectionProp.Free;
  inherited Destroy;
end;

function TMyPersistent.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TMyPersistent.SetCollectionProp(Value: TMyCollection);
begin
  FCollectionProp.Assign(Value);
end;

{ TMyComponent }

constructor TMyComponent.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPersistentProp := TMyPersistent.Create(Self);
end;

destructor TMyComponent.Destroy;
begin
  FPersistentProp.Free;
  inherited Destroy;
end;

procedure TMyComponent.SetPersistentProp(Value: TMyPersistent);
begin
  FPersistentProp.Assign(Value);
end;

end.

Fijaros que los constructores de la propiedad TPersistent y de la TCollection ahora reciben un parámetro, el Owner. Además hemos sobreescrito el método GetOwner tanto de TMyPersistent como de TMyCollection para que devuelve el owner de la clase.

Con ésto ya tendremos funcionando nuestro componente con el comportamiento deseado.

Para mejorar o simplificar el código, existe ya una colección con owner, la TOwnedCollection, con lo que nuestra TCollection podría quedar tan simple como ésto

  TMyCollection = class(TOwnedCollection)
  private
    function GetItem(Index: Integer): TMyCollectionItem;
    procedure SetItem(Index: Integer; Value: TMyCollectionItem);
  public
    function Add: TMyCollectionItem;
    function Insert(Index: Integer): TMyCollectionItem;
    property Items[Index: Integer]: TMyCollectionItem read GetItem
      write SetItem;
  end;

Pues nada más, espero que os haya servido el ejemplo. Como siempre, podéis descargaros el ejemplo des de aquí.

Saludos.