How to use TCollection and TCollectionItem

Problem/Question/Abstract:

Has anyone out there attempted to use TCollection and TCollectionItem? What I am trying to do is mimic what the Columns Editor does in the TDBGrid for the TStringGrid component. This is the first time that I have made a component that needs properties and sub-properties. I am not sure how to go about this.

Answer:

This one worked for me:


unit ggImgLst;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Dialogs,
  ExtCtrls, Dsgnintf; {, jpeg;}

type
  TAboutProperty = class(TPropertyEditor)
  private
  protected
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetName: string; override;
    function GetValue: string; override;
  end;

  TggImageListPropertyEditor = class(TPersistent);

  TggImageListProperty = class(TClassProperty);

  TggImageSizes = (ggSmall, ggMedium, ggLarge);
  {TggImageSize  = set of TggImageSizes;}

  TggImage = class;
  TggImageList = class;

  TggImage = class(TCollectionItem)
  private
    FSize: TggImageSizes;
    FPicture: TPicture;
    FName: string;
    function GetDisplayName: string; override;
    procedure SetPicture(Value: TPicture);
  public
    constructor Create(Collection: TCollection); override;
    destructor destroy; override;
  published
    property Size: TggImageSizes read FSize write FSize;
    property Name: string read FName write FName;
    property Picture: TPicture read FPicture write SetPicture;
  end;

  TggImageClass = class of TggImage;

  TggImages = class(TCollection)
  private
    FggImageList: TggImageList;
    FggImageListPropertyEditor: TggImageListPropertyEditor;
    function GetImage(Index: Integer): TggImage;
    procedure SetImage(Index: Integer; Value: TggImage);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor create(ggImageList: TggImageList; ggImageClass: TggImageClass);
    function Add: TggImage;
    property ggImageList: TggImageList read FggImageList;
    property Items[Index: Integer]: TggImage read GetImage write SetImage; default;
  published
  end;

  TggImageList = class(TComponent)
  private
    FAbout: TAboutProperty;
    FImages: TggImages;
    procedure WriteImages(Writer: TWriter);
    procedure ReadImages(Reader: TReader);
    procedure SetImages(Value: TggImages);
  protected
    function CreateImages: Tggimages; dynamic;
    procedure DefineProperties(Filer: TFiler); override;
  public
    constructor Create(AOwner: TComponent); override;
    function GetImageNameList: TStringList;
    function GetPicture(PictureName: string): TPicture;
  published
    property About: TAboutProperty read FAbout write FAbout;
    property Images: TggImages read FImages write SetImages;
  end;

procedure Register;

implementation

uses
  jpeg;

{ggImage}

constructor TggImage.Create(Collection: TCollection);
var
  ggImageList: TggImageList;
begin
  FPicture := TPicture.Create;
  ggImageList := nil;
  if assigned(Collection) and (Collection is TggImages) then
    ggImageList := Tggimages(Collection).ggImageList;
  if assigned(ggImageList) then
    inherited Create(Collection);
end;

destructor TggImage.Destroy;
begin
  FPicture.Free;
  inherited Destroy;
end;

procedure TggImage.SetPicture(Value: TPicture);
begin
  FPicture.Assign(Value);
end;

function TggImage.GetDisplayName: string;
begin
  Result := Name;
  if Result = '' then
    Result := inherited GetDisplayName;
end;

{TggImages}

function TggImages.GetImage(Index: Integer): TggImage;
begin
  Result := TggImage(inherited Items[Index]);
end;

procedure TggImages.SetImage(Index: Integer; Value: TggImage);
begin
  Items[Index].Assign(Value);
end;

constructor TggImages.Create(ggImageList: TggImageList;
  ggImageClass: TggImageClass);
begin
  inherited Create(ggImageClass);
  FggImageList := ggImageList;
  FggImageListPropertyEditor := TggImageListPropertyEditor.Create;
end;

function TggImages.GetOwner: TPersistent;
begin
  Result := FggImageList;
end;

function TggImages.Add: TggImage;
begin
  Result := TggImage(inherited Add);
end;

{ggImageList}

procedure TggImageList.WriteImages(Writer: TWriter);
begin
  Writer.WriteCollection(Images);
end;

procedure TggImageList.ReadImages(Reader: TReader);
begin
  Images.Clear;
  Reader.ReadValue;
  Reader.ReadCollection(Images);
end;

procedure TggImageList.DefineProperties(Filer: TFiler);
begin
  Filer.DefineProperty('ggImages', ReadImages, WriteImages, Filer.Ancestor < > nil);
end;

procedure TggImageList.SetImages(Value: TggImages);
begin
  Images.Assign(Value);
end;

function TggImageList.CreateImages: TggImages;
begin
  Result := TggImages.Create(Self, TggImage);
end;

function TggImageList.GetImageNameList: TStringList;
var
  I: Integer;
begin
  Result := TStringList.Create;
  for I := 0 to Self.Images.Count - 1 do
    Result.Add(Self.Images.Items[I].Name);
end;

function TggImageList.GetPicture(PictureName: string): TPicture;
var
  I: Integer;
begin
  I := 0;
  Result := nil;
  PictureName := uppercase(Picturename);
  while I <= Self.Images.Count - 1 do
  begin
    if PictureName = uppercase(Self.Images.Items[I].Name) then
    begin
      Result := Self.Images.Items[I].Picture;
      I := Self.Images.Count;
    end
    else
      Inc(I);
  end;
end;

constructor TggImageList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FImages := CreateImages;
end;

{TAboutProperty}

procedure TAboutProperty.Edit;
begin
  MessageBox(0, PChar('TggImageList component' + #13 + #13 + 'by Geurts Guido -
    guido.geurts@advalvas.be ' + #13 + ' 10 / 03 / 1999'),
    PChar('The GuidoG utilities present...'), MB_OK);
end;

function TAboutProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paReadOnly];
end;

function TAboutProperty.GetName: string;
begin
  Result := 'About';
end;

function TAboutProperty.GetValue: string;
begin
  Result := GetStrValue;
end;

{Non class related procedures and functions:}

procedure register;
begin
  RegisterComponents('GuidoG', [TggImageList]);
  RegisterPropertyEditor(TypeInfo(TggImageListPropertyEditor), TGGImages,
    'Images', TGGImageListProperty);
  RegisterPropertyEditor(TypeInfo(TAboutProperty), TggImageList, 'About',
    TAboutProperty);
end;

end.