Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to use TCollection and TCollectionItem Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
30-Aug-02
Category
VCL-General
Language
Delphi 2.x
Views
71
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Tomas Rutkauskas

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:


1   unit ggImgLst;
2   
3   interface
4   
5   uses
6     Windows, Messages, SysUtils, Classes, Graphics, Controls, Dialogs,
7     ExtCtrls, Dsgnintf; {, jpeg;}
8   
9   type
10    TAboutProperty = class(TPropertyEditor)
11    private
12    protected
13    public
14      procedure Edit; override;
15      function GetAttributes: TPropertyAttributes; override;
16      function GetName: string; override;
17      function GetValue: string; override;
18    end;
19  
20    TggImageListPropertyEditor = class(TPersistent);
21  
22    TggImageListProperty = class(TClassProperty);
23  
24    TggImageSizes = (ggSmall, ggMedium, ggLarge);
25    {TggImageSize  = set of TggImageSizes;}
26  
27    TggImage = class;
28    TggImageList = class;
29  
30    TggImage = class(TCollectionItem)
31    private
32      FSize: TggImageSizes;
33      FPicture: TPicture;
34      FName: string;
35      function GetDisplayName: string; override;
36      procedure SetPicture(Value: TPicture);
37    public
38      constructor Create(Collection: TCollection); override;
39      destructor destroy; override;
40    published
41      property Size: TggImageSizes read FSize write FSize;
42      property Name: string read FName write FName;
43      property Picture: TPicture read FPicture write SetPicture;
44    end;
45  
46    TggImageClass = class of TggImage;
47  
48    TggImages = class(TCollection)
49    private
50      FggImageList: TggImageList;
51      FggImageListPropertyEditor: TggImageListPropertyEditor;
52      function GetImage(Index: Integer): TggImage;
53      procedure SetImage(Index: Integer; Value: TggImage);
54    protected
55      function GetOwner: TPersistent; override;
56    public
57      constructor create(ggImageList: TggImageList; ggImageClass: TggImageClass);
58      function Add: TggImage;
59      property ggImageList: TggImageList read FggImageList;
60      property Items[Index: Integer]: TggImage read GetImage write SetImage; default;
61    published
62    end;
63  
64    TggImageList = class(TComponent)
65    private
66      FAbout: TAboutProperty;
67      FImages: TggImages;
68      procedure WriteImages(Writer: TWriter);
69      procedure ReadImages(Reader: TReader);
70      procedure SetImages(Value: TggImages);
71    protected
72      function CreateImages: Tggimages; dynamic;
73      procedure DefineProperties(Filer: TFiler); override;
74    public
75      constructor Create(AOwner: TComponent); override;
76      function GetImageNameList: TStringList;
77      function GetPicture(PictureName: string): TPicture;
78    published
79      property About: TAboutProperty read FAbout write FAbout;
80      property Images: TggImages read FImages write SetImages;
81    end;
82  
83  procedure register;
84  
85  implementation
86  
87  uses
88    jpeg;
89  
90  {ggImage}
91  
92  constructor TggImage.Create(Collection: TCollection);
93  var
94    ggImageList: TggImageList;
95  begin
96    FPicture := TPicture.Create;
97    ggImageList := nil;
98    if assigned(Collection) and (Collection is TggImages) then
99      ggImageList := Tggimages(Collection).ggImageList;
100   if assigned(ggImageList) then
101     inherited Create(Collection);
102 end;
103 
104 destructor TggImage.Destroy;
105 begin
106   FPicture.Free;
107   inherited Destroy;
108 end;
109 
110 procedure TggImage.SetPicture(Value: TPicture);
111 begin
112   FPicture.Assign(Value);
113 end;
114 
115 function TggImage.GetDisplayName: string;
116 begin
117   Result := Name;
118   if Result = '' then
119     Result := inherited GetDisplayName;
120 end;
121 
122 {TggImages}
123 
124 function TggImages.GetImage(Index: Integer): TggImage;
125 begin
126   Result := TggImage(inherited Items[Index]);
127 end;
128 
129 procedure TggImages.SetImage(Index: Integer; Value: TggImage);
130 begin
131   Items[Index].Assign(Value);
132 end;
133 
134 constructor TggImages.Create(ggImageList: TggImageList;
135   ggImageClass: TggImageClass);
136 begin
137   inherited Create(ggImageClass);
138   FggImageList := ggImageList;
139   FggImageListPropertyEditor := TggImageListPropertyEditor.Create;
140 end;
141 
142 function TggImages.GetOwner: TPersistent;
143 begin
144   Result := FggImageList;
145 end;
146 
147 function TggImages.Add: TggImage;
148 begin
149   Result := TggImage(inherited Add);
150 end;
151 
152 {ggImageList}
153 
154 procedure TggImageList.WriteImages(Writer: TWriter);
155 begin
156   Writer.WriteCollection(Images);
157 end;
158 
159 procedure TggImageList.ReadImages(Reader: TReader);
160 begin
161   Images.Clear;
162   Reader.ReadValue;
163   Reader.ReadCollection(Images);
164 end;
165 
166 procedure TggImageList.DefineProperties(Filer: TFiler);
167 begin
168   Filer.DefineProperty('ggImages', ReadImages, WriteImages, Filer.Ancestor < > nil);
169 end;
170 
171 procedure TggImageList.SetImages(Value: TggImages);
172 begin
173   Images.Assign(Value);
174 end;
175 
176 function TggImageList.CreateImages: TggImages;
177 begin
178   Result := TggImages.Create(Self, TggImage);
179 end;
180 
181 function TggImageList.GetImageNameList: TStringList;
182 var
183   I: Integer;
184 begin
185   Result := TStringList.Create;
186   for I := 0 to Self.Images.Count - 1 do
187     Result.Add(Self.Images.Items[I].Name);
188 end;
189 
190 function TggImageList.GetPicture(PictureName: string): TPicture;
191 var
192   I: Integer;
193 begin
194   I := 0;
195   Result := nil;
196   PictureName := uppercase(Picturename);
197   while I <= Self.Images.Count - 1 do
198   begin
199     if PictureName = uppercase(Self.Images.Items[I].Name) then
200     begin
201       Result := Self.Images.Items[I].Picture;
202       I := Self.Images.Count;
203     end
204     else
205       Inc(I);
206   end;
207 end;
208 
209 constructor TggImageList.Create(AOwner: TComponent);
210 begin
211   inherited Create(AOwner);
212   FImages := CreateImages;
213 end;
214 
215 {TAboutProperty}
216 
217 procedure TAboutProperty.Edit;
218 begin
219   MessageBox(0, PChar('TggImageList component' + #13 + #13 + 'by Geurts Guido -
220     guido.geurts@advalvas.be '
221     PChar('The GuidoG utilities present...'), MB_OK);
222 end;
223 
224 function TAboutProperty.GetAttributes: TPropertyAttributes;
225 begin
226   Result := [paDialog, paReadOnly];
227 end;
228 
229 function TAboutProperty.GetName: string;
230 begin
231   Result := 'About';
232 end;
233 
234 function TAboutProperty.GetValue: string;
235 begin
236   Result := GetStrValue;
237 end;
238 
239 {Non class related procedures and functions:}
240 
241 procedure register;
242 begin
243   RegisterComponents('GuidoG', [TggImageList]);
244   RegisterPropertyEditor(TypeInfo(TggImageListPropertyEditor), TGGImages,
245     'Images', TGGImageListProperty);
246   RegisterPropertyEditor(TypeInfo(TAboutProperty), TggImageList, 'About',
247     TAboutProperty);
248 end;
249 
250 end.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC