How to use TCollection and TCollectionItem (Views: 30)
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. |