Discussion :

[Qwazerty]

Salut tout le monde

Alors voila, je suis en train de me confectionner un composant perso, que j'intègre dans une application. Jusqu'à maintenant tout se passé pas trop mal et puis je me suis rendu compte que j'étais entrain de "spécialiser" mon composant en fonction de mes besoins rencontrés dans mon appli, hors je souhaiterais garder mon composant utilisable en dehors de cette appli, sinon aucun intérêt de faire un composant cela va de soit.

Je me suis donc dis, pas de panique , je vais tout simplement faire comme dans la VCL et implémenter une version Custom de mon compos puis dériver cette version Custom pour l'utiliser dans mon appli, belle idée... en théorie, par contre dans la pratique je me suis heurté a plusieurs mal façon de mon code, j'en ai résolue quelques unes (je pense... je ne peux plus compiler pour l'instant), mais je coince sur un problème de variable.

Je ne vais pas mettre ton mon code, ce serait long et je pense inutil, mais voila un exemple qui je l'espère vous permettra de me donner au mieux une réponse ^^, au pire de m'aiguiller vers elle :p

Donc mon composant s'organise comme ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
TCustomMonCompo //         (dérivé de TImage mais ca n'a pas d'importance je pense)
TCustomMaCollection //     (une collection qui contiendra les items)
TCustomMonItemCollection //(Les Item contenus dans la collection de mon Compos)

Dans TCustomMonCompos, je déclare une variable representant ma Collection, jusque la je pense aps avoir fait de bêtise....je suis surement prétentieux hein ^^

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private
  FCollect : TCustomMaCollection;
 
  procedure SetCollect(New : TCustomMaCollection); 
 
Published
  property Collect : TCustomMaCollection read FCollect write SetCollect;

Ensuite pour utiliser ce CustumCompos dans mon appli, je crée un dérivé de celui-ci, ainsi que des dérivé des Classe Collection et CollectionItem que je souhaite également personnaliser dans leur utilisation finale.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
TMonCompo = Class(TCustomMonCompo)
TMaCollection = Class(TCustomMaCollection)
TMaCollectionItem = Class(TCustomMaCollectionItem)

Donc dans MonCompos, FCollect ne doit plus etre de class TCustomMaCollection mais de class TMaCollection. Comment gerer cela?
Si je déclare

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

FCollect : TMaCollection;

Je vais cacher l'ancien FCollect, sans pouvoir faire d'OverRide, est ce que je dois travailler sur SetCollect et GetCollect afin d'assurer la compatibilité de mes variables entre la version CustomCompo et Compo ? Ça me parait compliqué, je pense qu'il existe un truc plus simple.

J'ai regardé dans la VCL comme dis plus haut, mais malheureusement je ne trouve pas de compos organisé comme le mien, la plupart du temps seul le composant a une version Custum, mais pas la collection et CollectionItem. Si vous en connaissez un merci de me l'indiquer afin que je regarde comment ils ont réaliser cet compatibilité.

D'avance merci
Qwaz


Ps: en faisant quelque recherche je me pose la question de savoir si le Custome est le plus adapté a mon problème car visiblement le Custome est plutot utilisé pour une question de porté de variables des class dérivées :s

[Paul TOTH]

j'ai en tête deux exemples dans la VCL : TCanvas et TStrings, il sont déclarés comme tel dans le composant alors qu'ils sont instanciés en TControlCanvas et TStringList par exemple

tu auras un problème uniquement dans le cas ou MonCompo veux utiliser une méthode de TCollection qui n'existe pas (au moins en virtual abstract) dans TCustomCollection.

je vois trois solutions au moins à ce problème :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
 
// solution 1:
begin
  TCollection(FCollection).blabla
end;
 
// solution 2
type
  TMonCompo = class(TCustomMonCompo)
    function MyCollection: TCollection;
  end;
 
function TMonCompo.MyCollection: TCollection;
begin
  Result := FCollection as TCollection;
end;
 
// solution 3
type
 TMonCompo = class(TCustomMonCompo)
 private
   FMyCollection : TCollection; 
 end.
 
begin //constrcutor
  FMyCollection := TCollection.Create;
  FCollection := FMyCollection; // celui de TCustom...
end;

[Qwazerty]

Salut
Merci pour cette réponse si rapide.
Tout d'abord au niveau des composants TControlCanvas et TStringsList, il me semble que le cas et légèrement diffèrent dans le sens ou on ne retrouve pas un variable privé identique dans la structure du TCanvas et du TControlCanvas par exemple, mais en ecrivant cela, je me rend compte qu'il est peut etre tout simplement pas normale d'avoir 2 variables du même nom entre 2 composant dérivé l'un de l'autre et qui de plus ne represente pas la même structure....
Je crois que je m'emmêle un peu les pinceaux.

Peut être qu'en voulant simplifier l'exposé de mon problème j'ai omis certain détails qui ont surement leur importances.

Dans TCustomMonCompos

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
//constructeur
begin
  Inherited create(...)
  FCollect := TCollection.create(Self);
  //puis declaration des autre variable privé
[...]
end;

Dans TMonCompos

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
//constructeur
begin
  Inherited create(...); //Je fait appelle au create de l'antécédent pour affecter mes variables, Y compris FCollect
//Donc a partir d'ici j'ai une instance Fcollect (de type TCustomMaCollection) qui existe mais pas dans MonCompo et encore moins de type TMaCollection.
//Donc par la suite je voudrais crée cette instance 
FCollect := TMaCollection.create(Self)

Mais comment lier les 2 ? Sachant que le 2eme FCollect a plus propriétés que celui héritées

Dans tous les cas, si j'utilise un transtypage TCollection, je vais perdre toutes les propriétés et function qui sorte du cadre de TCollection, ce que je veux bien sur éviter.

Merci
Qwaz

[Qwazerty]

Alors, avec l'estomac plein on réfléchi mieux ^^.
J'ai déjà modifié l'intégralité de mon code (ajout de Custom un peu partout) afin de compiler ... du coup j'ai découvert es coquilles dans mon code ^^ ca n'aura pas été inutile

ensuite je me suis inspiré du code gentiment fourni par Paul Thot, ce qui donne ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
constructor TImageEtape.Create(AOwner : TComponent);
begin
     inherited;
     FEtapes := TEtapes.Create(Self);
     TCustomImageEtape(Self).FEtapes := TCustomEtapes(FEtapes);
end;

TImageEtape étant TMonCompo
TEtapes et TCustomEtape les collections

Ca compile et mon appli remache comme avant les modifs, j'en deduit que ce doit etre bon .. je vais quand meme modifier mes dérivé de TCustomEtapes et TCustomEtape avant de crier victoire.
Je laisse donc ouvert le file le temps des essais.

encore merci pour le coup de main.
A++
Qwaz

[Paul TOTH]

alors je crois que tu fais une confusion...ou alors tu as pris la solution n°3

FCollection ne devrait être déclaré QUE dans le composant Custom, et il ne devrait instancié QUE dans le composant dérivé. En effet le composant Custom ne sait pas de quelle classe sera la collection, il ne doit donc pas l'instancier.

dans les exemples que je te donnais, FCollection: TCustomCollection est déclaré dans TCustomCompo et c'est dans TMonCompo qu'il est instancié en tant que TCollection.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
type
  TCustomCollection=class
   name : string;
 end;
 
 TCustomCompo=class
  FCollection: TCustomCollection;
 end;
 
 TCompo = class; // forward
 
 TCollection=class(TCustomCollection)
  Compo : TCompo;
 end,
 
 TCompo = class(TCustomCompo)
  constructor create;
 end;
 
constructor TCompo.Create;
begin
  FCollection := TCollection.Create;
  FCollection.name := 'toto'; // accès à FCollection comme TCustomCollection
  TCollection(FCollection).Compo := Self; // accès à une propriété de TCollection
end;

[Qwazerty]

Je me suis en effet inspiré de l'exemple 3, qui me semblait plus adapté à mon cas.

Dans le dernier exemple que tu me donnes, une chose me turlupine, si on l'instancie uniquement dans le compo dérivé, cela veut dire que le CustomCompo n'est pas fait pour être utilisé sans être dérivé auparavant.
Si c'est le cas, j'ai initialisé tout un tas de variables privates au niveau du Create du CustomCompo mais vu que dans le Create de Compo je n'appelle plus inherited, il me faut donc faire leur initialisation dans le create du Compo?

Mais alors qu'en est il de l'appelle Inherited inscrite dans le CustomCompo et qui appelle le create de l'ancêtre, qui dans mon cas dessine un Timage (CustomCompo étant dérivé de TImage)

D'où la facon de faire que j'ai utilisé, appeler inherited dans le create du Compo (ce qui provoque instanciation du FCollection dans CustomCompo) puis je crée une instance de FCollection (au niveau de Compo donc) et je lui affect l'instance précédemment créé dans CustomCompo . Mais du coup est ce bien correct comme méthode.

Merci
Qwaz

[Paul TOTH]

Je me suis en effet inspiré de l'exemple 3, qui me semblait plus adapté à mon cas.

Dans le dernier exemple que tu me donnes, une chose me turlupine, si on l'instancie uniquement dans le compo dérivé, cela veut dire que le CustomCompo n'est pas fait pour être utilisé sans être dérivé auparavant.
Si c'est le cas, j'ai initialisé tout un tas de variables privates au niveau du Create du CustomCompo mais vu que dans le Create de Compo je n'appelle plus inherited, il me faut donc faire leur initialisation dans le create du Compo?

ben non...il suffit que le constructor du Custom n'instancie par FCollection et tu peux l'appeler par héritage (inherited).

Mais alors qu'en est il de l'appelle Inherited inscrite dans le CustomCompo et qui appelle le create de l'ancêtre, qui dans mon cas dessine un Timage (CustomCompo étant dérivé de TImage)

D'où la facon de faire que j'ai utilisé, appeler inherited dans le create du Compo (ce qui provoque instanciation du FCollection dans CustomCompo) puis je crée une instance de FCollection (au niveau de Compo donc) et je lui affect l'instance précédemment créé dans CustomCompo . Mais du coup est ce bien correct comme méthode.

non ce n'est pas correct, il faut au minimum détruire le FCollection de type CustomCollection avant de le remplacer.

une autre approche serait de déclarer dans TCustomCompo une méthode virtuelle CreateCollection, par défaut elle crée un TCustomCollection et tu la surcharge dans TCompo pour créer un TCollection.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
procedure TCustomCompo.CreateCollection; // virtual
begin
  FCollection := TCustomCollection.Create;
end;
 
procedure TCompo.CreateCollection; // override
begin
  FCollection := TCollection.Create;
end;

[Qwazerty]

Oh jolie ta dernière approche me plait beaucoup et elle est semblable au CreateHandle du TControleCanvas.
Merci de ta patience, peut être a plus tard
Qwaz

[Qwazerty]

Salut
Serait il possible de m'aiguiller vers un livre traitant de la création de composant, j'ai regardé dans la section livre, j'ai vu 2 ouvrages qui évoquaient visiblement la création de composants (je suis sur Delphi 6), mais je voudrais savoir si je trouverais des explications sur l'héritage de composant créés a partir des classes Tcollection et TCollectionItem... (entre autre)

Je tourne toujours en rond avec mon problème d'héritage, j'ai du mal a poser une question structuré étant donné que je pédale un peu dans la mélasse, j'ai consulté des tutos sur la création de compo (celui d'sjrd) j'ai d'ailleurs créé mon composant en m'inspirant de ce cours, des tutos sur le polymorphisme et sur les référencements de Classe, j'ai également installé la jvcl, pour essayer de m'inspirer des codes deja créé... mais rien... j'ai refait une grosse partie de mon code plusieurs fois... sans résultat probant, d'ailleurs il ne fonctionne plus du tout ^^ (j'ai des sauvegardes ).

Tout ceci pour expliquer que je ne veux pas un livre qui va accorder 2 chapitres de 10 pages

Merci de me guider , des liens vers des tutos pouvant m'aider sont également les bienvenu.

Je profite quand même de ce post pour poser une question:
Est il plus simple d'utiliser TCollection/TColectionItem ou de partir carrément de la Classe TPersistent et de gérer sois même les relations entre la "collection" et ses Items en vu bien sur de pouvoir crée des héritage des 3 parties du composant ?

A++
Qwaz

[Qwazerty]

Salut
Alors par ce que je suis un gars têtu... j'ai réduit mon code au plus court pour exposer ma structure, j'ai essayé d'intégrer dedans les conseils qui m'ont été donnés par Paul au dessus ainsi que ce que j'ai put voir dans la vcl/Jvcl.

Mon code plante au "tout début" dans le TCustomEtape.Create, quand j'essaie de faire hériter sur le TCollectionItem.Create, j'ai beau regarder le source de TCollectionItem, je ne comprend pas pourquoi ca ne fonctionne pas.

Merci a celles et ceux qui prendront 5 minutes pour jeter un œil et un grand merci a celui ou celle qui me dira ce qui cloche

A++
Qwaz

[Edit] Correction du code le 18/09/09 à 16h02[/Edit]
[Edit] Correction du code le 18/09/09 à 19h43[/Edit]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
unit Simplification;
 
interface
 
uses Classes;
type
  TCustomImageEtape = Class;
  //TCustomEtape = class;
  //TCustomEtapes = class;
 
 
  TCustomEtapesClass = class of TCustomEtapes;
  TCustomEtapeClass = class of TCustomEtape;
/////////////////////////////////////////////////////////////////////////////////////////////
  TCustomEtape = Class(TCollectionItem)
  private
  protected
  public
    constructor Create(Collection : TCollection);Override;
  end;
/////////////////////////////////////////////////////////////////////////////////////////////
 
  TCustomEtapes = Class(TOwnedCollection)
  private
    FImageEtape             : TCustomImageEtape;
    function GetItem(Index  : integer) : TCustomEtape;
    procedure SetItem(Index : integer; Value : TCustomEtape);
  protected
    function GetOwner       : TPersistent; override;
  public
    constructor Create(ImageEtape : TCustomImageEtape);
    //destructor Destroy; override;
    function Add : TCustomEtape;
    function AddItem(ModelEtape : TCustomEtape):TCustomEtape;
    property Items[index : integer] : TCustomEtape read GetItem write SetItem; default;//
 
  end;
/////////////////////////////////////////////////////////////////////////////////////////////
 
  TCustomImageEtape = class(TImage)
  private
    FEtapes                     : TCustumEtapes;
    procedure SetItems(Value    : TCustomEtapes);
 
  protected
    function CreateEtapes       : TCustomEtapes;
    function CreateEtape        : TCustomEtape ;
 
    function GetEtapeClass      : TCustomEtapeClass; virtual;
    function GetEtapesClass     : TCustomEtapesClass; virtual;
 
    property Etapes             : TCustomEtapes read FEtapes    write SetEtapes;
  public
    constructor Create(AOwner   : TComponent); override;
 
  end;
/////////////////////////////////////////////////////////////////////////////////////////////
  TImageEtape = Class;
  TEtapes = class;
  TEtape = class;
 
  TEtapesClass = class of TEtapes;
  TEtapeClass  = class of TEtape;
 
/////////////////////////////////////////////////////////////////////////////////////////////
 
  TEtape = Class(TCustomEtape)
  private
  protected
  public
    NewProperty : String;
    procedure Assign(Source : TPersistent);Override;
  end;
/////////////////////////////////////////////////////////////////////////////////////////////
 
  TEtapes = Class(TCustomEtapes)
  private
    function  GetItem(Index : integer) : TEtape;
    procedure SetItem(Index : integer; Value : TEtape);
  protected
  public
    constructor Create(AnImageEtape : TImageEtape);
    function Add:TEtape;
    function AddEtape(ModelEtape : TEtape):TEtape;
    property Items[index : integer] : TEtape read GetItem write SetItem;
  published
  end;
/////////////////////////////////////////////////////////////////////////////////////////////
 
  TImageEtape = class(TCustomImageEtape)
  Private
    FEtapes : TEtapes;
    function GetItems : TEtapes;
    procedure SetItems(const Value : TEtapes);
  protected
    constructor Create(AOwner : TComponent); override;
    function CreateEtapes    : TEtapes;
    function CreateEtape     : TEtape ;
    function GetEtapeClass   : TCustomEtapeClass;Override;
    function GetEtapesClass  : TCustomEtapesClass;Override;
  public
    property Etapes : TEtapes read GetItems write SetItems;
  end;
end;
 
implementation
 
/////////////////////////////////////////////////////////////////////////////////////////////
///    Classe TCustomEtape      /////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
constructor TCustomEtape.Create(Collection : TCollection);
begin
     inherited Create(Collection);  //Crash ici : appel a TCollectionItem.Create
     //[...]
end;
 
 
/////////////////////////////////////////////////////////////////////////////////////////////
///    Classe TCustomEtapes     /////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
constructor TCustomEtapes.Create(ImageEtape : TCustomImageEtape);
begin
     inherited Create(ImageEtape.GetEtapeClass);
     FImageEtape := ImageEtape;
     //[...]
end;
 
function TCustomEtapes.GetItem(Index : integer) : TEtape;
begin
     result := TEtape(inherited GetItem(Index));
end;
 
procedure TCustomEtapes.SetItem(Index : integer; Value : TEtape);
begin
     inherited SetItem(Index,TCustomEtape(Value));
end;
 
function TCustomEtapes.GetOwner: TPersistent;
begin
     result := FImageEtape;
end;
 
function TCustomEtapes.Add : TCustomEtape;
begin
     result := addItem(Nil);
end;
 
 
function TCustomEtapes.AddItem(ModelEtape : TCustomEtape): TCustomEtape;
begin
     Result := FImageEtape.CreateEtape;
     if ModelEtape <> Nil then result.Assign(ModelEtape);
     FImageEtape.NewItem(Owner,Result.Index);
end;
 
/////////////////////////////////////////////////////////////////////////////////////////////
///    Classe TCustomImageEtape     /////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
constructor TCustomImageEtape.Create(AOwner : TComponent);
begin
     inherited Create(AOwner);
  //[...]
     FEtapes := CreateEtapes;
  //[...]
end;
 
function TCustomImageEtape.GetEtapeClass: TCustomEtapeClass;
begin
     result := TCustomEtape;
end;
 
function TCustomImageEtape.GetEtapesClass : TCustomEtapesClass;
begin
     result := TCustomEtapes;
end;
 
function TCustomImageEtape.CreateEtapes : TCustomEtapes;
Var LClass : TCustomEtapesClass;
begin
     LClass := GetEtapesClass;
     Result := LClass.Create(Self);        //TCustomEtapes
end;
 
function TCustomImageEtape.CreateEtape : TCustomEtape;
Var LClass : TCustomEtapeClass;
begin
  LClass := GetEtapeClass;
  Result := LClass.Create(Etapes);
end;
 
procedure TCustomImageEtape.SetItems(Value : TCustomEtapes);
begin
     FEtapes := Value; 
end;
/////////////////////////////////////////////////////////////////////////////////////////////
///    Classe TEtape      ///////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
procedure TEtape.Assign(Source : TPersistent);
begin
     inherited;
     if Source Is TEtape then
     begin
          with Source as TEtape do
          begin
               Self.NewProperty    := NewProperty;
          end;
     end;
end;
 
/////////////////////////////////////////////////////////////////////////////////////////////
///    Classe TEtapes     ///////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
constructor TEtapes.Create(AnImageEtape : TImageEtape);
begin
     inherited Create(AnImageEtape);
end;
 
 
function TEtapes.Add : TEtape;
begin
     Result := addEtape(Nil);
end;
 
function TEtapes.AddEtape(ModelEtape : TEtape): TEtape;
begin
     result := TEtape(inherited Add);
     if ModelEtape <> Nil Then result.assign(ModelEtape);
end;
 
function TEtapes.GetItem(Index : integer) : TEtape;
begin
     result := TEtape(inherited GetItem(Index));
end;
 
procedure TEtapes.SetItem(Index : integer; Value : TEtape);
begin
     inherited SetItem(Index,TCustomEtape(Value));
end;
 
/////////////////////////////////////////////////////////////////////////////////////////////
///    Classe TImageEtape     ///////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
constructor TImageEtape.Create(AOwner : TComponent);
begin
     inherited Create(AOwner);
end;
 
function TImageEtape.CreateEtapes : TEtapes;
begin
     if (FEtapes = nil) and not(CsDestroying in ComponentState) then
        FEtapes := TEtapes.Create(Self);
     result := FEtapes;
end;
 
function TImageEtape.CreateEtape : TEtape ;
begin
     result := TEtape.Create(Etapes);
end;
 
function TImageEtape.GetEtapeClass : TCustomEtapeClass;
begin
     result := TEtape;
end;
 
function TImageEtape.GetEtapesClass : TCustomEtapesClass;
begin
     result := TEtapes;
end;
 
procedure TImageEtape.SetItems(const Value : TEtapes);
begin
     inherited Etapes := Value;
end;
 
function TImageEtape.GetItems:TEtapes;
begin
     result := TEtapes(CreateEtapes);
end;
 
 
{ }
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///                 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Initialization
  RegisterClass(TImageEtape);
  RegisterClass(TEtape);
  RegisterClass(TEtapes);
 
Finalization
  UnregisterClass(TImageEtape);
  UnRegisterClass(TEtape);
  UnRegisterClass(TEtapes);
 
end.

[Qwazerty]

Re
Bon je pense m'être dépatouillé avec mon bout de code, je remet la dernière version, ca a l'aire de fonctionner comme ca, si quelqu'un est intéressé.
Ce bout de code représente la structure que "doit" (je voudrais pas être prétentieux....) prendre un composant pour que tous ses membres (Compo, Collection et Item) soient dérivables, je n'ai pas essayé de dériver qu'une partie du groupe par contre...

A++
Qwaz

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
unit Simplification;
 
interface
 
uses Classes;
type
  TCustomImageEtape = Class;
  //TCustomEtape = class;
  //TCustomEtapes = class;
 
 
  TCustomEtapesClass = class of TCustomEtapes;
  TCustomEtapeClass = class of TCustomEtape;
/////////////////////////////////////////////////////////////////////////////////////////////
  TCustomEtape = Class(TCollectionItem)
  private
  protected
  public
    constructor Create(Collection : TCollection);Override;
  end;
/////////////////////////////////////////////////////////////////////////////////////////////
 
  TCustomEtapes = Class(TOwnedCollection)
  private
    FImageEtape             : TCustomImageEtape;
    function GetItem(Index  : integer) : TCustomEtape;
    procedure SetItem(Index : integer; Value : TCustomEtape);
  protected
    function GetOwner       : TPersistent; override;
  public
    constructor Create(ImageEtape : TCustomImageEtape);
    //destructor Destroy; override;
    function Add : TCustomEtape;
    function AddItem(ModelEtape : TCustomEtape):TCustomEtape;
    property Items[index : integer] : TCustomEtape read GetItem write SetItem; default;//
 
  end;
/////////////////////////////////////////////////////////////////////////////////////////////
 
  TCustomImageEtape = class(TImage)
  private
    FEtapes                     : TCustumEtapes;
    procedure SetItems(Value    : TCustomEtapes);
 
  protected
    function CreateEtapes       : TCustomEtapes;
    function CreateEtape        : TCustomEtape ;
 
    function GetEtapeClass      : TCustomEtapeClass; virtual;
    function GetEtapesClass     : TCustomEtapesClass; virtual;
 
    property Etapes             : TCustomEtapes read FEtapes    write SetEtapes;
  public
    constructor Create(AOwner   : TComponent); override;
 
  end;
/////////////////////////////////////////////////////////////////////////////////////////////
  TImageEtape = Class;
  TEtapes = class;
  TEtape = class;
 
  TEtapesClass = class of TEtapes;
  TEtapeClass  = class of TEtape;
 
/////////////////////////////////////////////////////////////////////////////////////////////
 
  TEtape = Class(TCustomEtape)
  private
  protected
  public
    NewProperty : String;
    procedure Assign(Source : TPersistent);Override;
  end;
/////////////////////////////////////////////////////////////////////////////////////////////
 
  TEtapes = Class(TCustomEtapes)
  private
    function  GetItem(Index : integer) : TEtape;
    procedure SetItem(Index : integer; Value : TEtape);
  protected
  public
    constructor Create(AnImageEtape : TImageEtape);
    function Add:TEtape;
    function AddItem(ModelEtape : TEtape):TEtape; //correction AddEtape
    property Items[index : integer] : TEtape read GetItem write SetItem;
  published
  end;
/////////////////////////////////////////////////////////////////////////////////////////////
 
  TImageEtape = class(TCustomImageEtape)
  Private
    FEtapes : TEtapes;
    function GetItems : TEtapes;
    procedure SetItems(const Value : TEtapes);
  protected
    constructor Create(AOwner : TComponent); override;
    function CreateEtapes    : TEtapes;
    function CreateEtape     : TEtape ;
    function GetEtapeClass   : TCustomEtapeClass;Override;
    function GetEtapesClass  : TCustomEtapesClass;Override;
  public
    property Items : TEtapes read GetItems write SetItems;
  end;
end;
 
implementation
 
/////////////////////////////////////////////////////////////////////////////////////////////
///    Classe TCustomEtape      /////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
constructor TCustomEtape.Create(Collection : TCollection);
begin
     inherited Create(Collection);  //Crash ici : appel a TCollectionItem.Create
     //[...]
end;
 
 
/////////////////////////////////////////////////////////////////////////////////////////////
///    Classe TCustomEtapes     /////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
constructor TCustomEtapes.Create(ImageEtape : TCustomImageEtape);
begin
     inherited Create(ImageEtape.GetEtapeClass);
     FImageEtape := ImageEtape;
     //[...]
end;
 
function TCustomEtapes.GetItem(Index : integer) : TEtape;
begin
     result := TEtape(inherited GetItem(Index));
end;
 
procedure TCustomEtapes.SetItem(Index : integer; Value : TEtape);
begin
     inherited SetItem(Index,TCustomEtape(Value));
end;
 
function TCustomEtapes.GetOwner: TPersistent;
begin
     result := FImageEtape;
end;
 
function TCustomEtapes.Add : TCustomEtape;
begin
     result := addItem(Nil);
end;
 
 
function TCustomEtapes.AddItem(ModelEtape : TCustomEtape): TCustomEtape;
begin
     Result := FImageEtape.CreateEtape;
     if ModelEtape <> Nil then result.Assign(ModelEtape);
     FImageEtape.NewItem(Owner,Result.Index);
end;
 
/////////////////////////////////////////////////////////////////////////////////////////////
///    Classe TCustomImageEtape     /////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
constructor TCustomImageEtape.Create(AOwner : TComponent);
begin
     inherited Create(AOwner);
  //[...]
     FEtapes := CreateEtapes;
  //[...]
end;
 
function TCustomImageEtape.GetEtapeClass: TCustomEtapeClass;
begin
     result := TCustomEtape;
end;
 
function TCustomImageEtape.GetEtapesClass : TCustomEtapesClass;
begin
     result := TCustomEtapes;
end;
 
function TCustomImageEtape.CreateEtapes : TCustomEtapes;
Var LClass : TCustomEtapesClass;
begin
     LClass := GetEtapesClass;
     Result := LClass.Create(Self);        //TCustomEtapes
end;
 
function TCustomImageEtape.CreateEtape : TCustomEtape;
Var LClass : TCustomEtapeClass;
begin
  LClass := GetEtapeClass;
  Result := LClass.Create(Etapes);
end;
 
procedure TCustomImageEtape.SetItems(Value : TCustomEtapes);
begin
     FEtapes := Value; 
end;
/////////////////////////////////////////////////////////////////////////////////////////////
///    Classe TEtape      ///////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
procedure TEtape.Assign(Source : TPersistent);
begin
     inherited;
     if Source Is TEtape then
     begin
          with Source as TEtape do
          begin
               Self.NewProperty    := NewProperty;
          end;
     end;
end;
 
/////////////////////////////////////////////////////////////////////////////////////////////
///    Classe TEtapes     ///////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
constructor TEtapes.Create(AnImageEtape : TImageEtape);
begin
     inherited Create(AnImageEtape);
end;
 
 
function TEtapes.Add : TEtape;
begin
     //Result := addEtape(Nil);//erreur
     result := inherited add;  
end;
 
function TEtapes.AddItem(ModelEtape : TEtape): TEtape; //correction AddEtape
begin
     //result := TEtape(inherited Add);
     //if ModelEtape <> Nil Then result.assign(ModelEtape);//erreur
     result := TEtape(inherited AddItem(ModelEtape));
end;
 
function TEtapes.GetItem(Index : integer) : TEtape;
begin
     result := TEtape(inherited GetItem(Index));
end;
 
procedure TEtapes.SetItem(Index : integer; Value : TEtape);
begin
     inherited SetItem(Index,TCustomEtape(Value));
end;
 
/////////////////////////////////////////////////////////////////////////////////////////////
///    Classe TImageEtape     ///////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
constructor TImageEtape.Create(AOwner : TComponent);
begin
     inherited Create(AOwner);
end;
 
function TImageEtape.CreateEtapes : TEtapes;
begin
     if (FEtapes = nil) and not(CsDestroying in ComponentState) then
        FEtapes := TEtapes.Create(Self);
     result := FEtapes;
end;
 
function TImageEtape.CreateEtape : TEtape ;
begin
     result := TEtape.Create(Etapes);
end;
 
function TImageEtape.GetEtapeClass : TCustomEtapeClass;
begin
     result := TEtape;
end;
 
function TImageEtape.GetEtapesClass : TCustomEtapesClass;
begin
     result := TEtapes;
end;
 
procedure TImageEtape.SetItems(const Value : TEtapes);
begin
     inherited Etapes := Value;
end;
 
function TImageEtape.GetItems:TEtapes;
begin
     result := TEtapes(inherited Items);
end;
 
 
{ }
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///                 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Initialization
  RegisterClass(TImageEtape);
  RegisterClass(TEtape);
  RegisterClass(TEtapes);
 
Finalization
  UnregisterClass(TImageEtape);
  UnRegisterClass(TEtape);
  UnRegisterClass(TEtapes);
 
end.