[DXE] TCollection imbriqué : erreur lors de la suppression

**Rayek** · 29/04/2011, 14h14

Bonjour,

Toujours dans le développement d'un composant, j'ai besoin d'avoir une collection de collection.
Pour ce faire j'avais fait simplement une première collection puis une seconde qui appelait l'autre mais j'ai vite remarqué que la 2em collection n'avait pas accès à l'éditeur de propriété en mode conception.

Alors j'ai regardé comme était fait le TCategoriesButtons (Present depuis D2005) pour voir comment ils ont fait.

J'ai donc réussi à faire apparaitre l'éditeur en mode conception, à créer/Modifier les Item mais lors de la suppression (Via l'éditeur) j'ai un soucis de pointeur.
Les composants sont détruits (donc passe bien par la case Destroy de l'item) mais la liste dans l'éditeur ne bouge pas et c'est à ce moment que j'ai le message d'erreur de pointeur(les données sont toujours présentes dans le dfm).

Classes principale pour les collections et collections items
(Si on ne passe pas par ses classes l'éditeur n'apparait pas pour la 2em

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
 
Type
  TCollectionItemBase = class(TCollectionItem)
  private
    FBaseCaption : TCaption;
    procedure Set_BaseCaption(const Value: TCaption); virtual;
  published
    property Caption : TCaption read FBaseCaption write Set_BaseCaption;
  end;
 
  TCollectionBase = class(TCollection)
  private
    FParent : TComponent;
  strict protected
    procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override;
  public
    constructor Create(AOwner : TComponent; CollectionItem : TCollectionItemClass);overload;virtual;
  end;

Puis les classes dérivant des classes de bases.

TPanelCollection => Génère des panels dans un TRzGridPanel

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
 
  TPanelCollection = Class(TCollectionBase)
  private
//    FParent : TComponent;
    function GetItem(Index: Integer): TPanelCollectionItem;
    procedure SetItem(Index: Integer; const Value: TPanelCollectionItem);
  protected
    function GetOwner : TPersistent;override;
  public
    ParentGridPanel : TRzGridPanel;
    constructor Create(AOwner : TComponent);overload;
    function Add : TPanelCollectionItem;
    property Items[Index : Integer] : TPanelCollectionItem read GetItem write SetItem;default;
  published
  End;

TPanelCollectionItem => Paramétrage des panels + Création de boutton pour les panels

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
 
   TPanelCollectionItem = class(TCollectionItemBase)
  private
    FBtnCollection : TBtnCollection;
    FParentCollection : TCollection;
    FGinPanel : TGinPanel;
    FPanCenter : TRzPanel;
    FImageIndex: TImageIndex;
    FLineColor: TColor;
    FVisible: Boolean;
    FImageList : TImageList;
    procedure Set_BaseCaption(const Value: TCaption); override;
    procedure Set_LineColor(const Value: TColor);
    procedure Set_ImageIndex(const Value: TImageIndex);
    procedure Set_ImageList(const Value: TimageList);
    procedure Set_BtnCollection(const Value: TBtnCollection);
  protected
    function GetDisplayName : String; override;
  public
    ParentGridPanel : TRzGridPanel;
    constructor Create(Collection: TCollection); override;
    destructor Destroy;override;
  published
      property BtnCollection : TBtnCollection read FBtnCollection write Set_BtnCollection;
      property ImageIndex : TImageIndex read FImageIndex write Set_ImageIndex Default -1;
      property ImageList : TimageList read FImageList write Set_ImageList;
      property LineColor  : TColor read FLineColor write Set_LineColor;
      property Visible    : Boolean read FVisible write FVisible Default True;
  end;

TBtnCollection => Collection des boutons qui seront dans les panels

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
  TBtnCollection = class(TCollectionBase)
  private
//    FParent : TPersistent;
    function GetItem(Index: Integer): TBtnCollectionItem;
    procedure SetItem(Index: Integer; const Value: TBtnCollectionItem);
  protected
    function GetOwner : TPersistent;override;
  public
    constructor Create(AOwner : TComponent);overload;
    function Add : TBtnCollectionItem;
    property Items[Index : Integer] : TBtnCollectionItem read GetItem write SetItem;default;
  end;

TBtnCollectionItem => Configuration des boutons

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
 
  TBtnCollectionItem = class(TCollectionItemBase)
  private
    FParentCollection : TCollection;
    FRzPanelCtner : TRzPanel;
    FAdvGlowBtn   : TAdvGlowButton;
    FVisible : Boolean;
    FImageList: TImageList;
    FImageIndex: TImageIndex;
    FOnClick : TNotifyEvent;
    procedure Set_ImageIndex(const Value: TImageIndex);
    procedure Set_ImageList(const Value: TImageList);
    procedure Set_OnClick(const Value: TNotifyEvent);
  protected
    function GetDisplayName : String; override;
  public
    constructor Create(Collection : TCollection);override;
    destructor Destroy; override;
  published
    property Visible : Boolean read FVisible write FVisible;
    property ImageIndex : TImageIndex read FImageIndex write Set_ImageIndex;
    property ImageList : TImageList read FImageList write Set_ImageList;
    property OnClick : TNotifyEvent read FOnclick write Set_OnClick;
  end;

Si vous voyez d'où vient le soucis ou si vous avez une autre solution pour faire apparaitre l'éditeur pour la 2em collection sans à faire ce traffic, je suis prenneur

Merci

**ShaiLeTroll** · 02/05/2011, 11h37

Lors du Destroy du CollectionItem tu dois avoir un appel au Collection.Notify, tu dois pouvoir agir à ce niveau

**Rayek** · 02/05/2011, 14h33

Envoyé par ShaiLeTroll

Lors du Destroy du CollectionItem tu dois avoir un appel au Collection.Notify, tu dois pouvoir agir à ce niveau

Par rapport à cela le notify ?

Code :

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

1
2
3
4
5
6
7
8
9
 
  TCollectionBase = class(TCollection)
  private
    FParent : TComponent;
  strict protected
    procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override;
  public
    constructor Create(AOwner : TComponent; CollectionItem : TCollectionItemClass);overload;virtual;
  end;

Si oui, lors du "delete" de l'item il ne passe pas dedans.

**Rayek** · 03/05/2011, 12h36

Bon après de multiple essai sur un projet vierge j'ai enfin reussi à avoir une collection de collection et que l'éditeur de collection fonctionne pour les deux.

Mon problème de pointeur venait du fait que la deuxieme collection n'avait pas de parent correcte.

Unité : MonTest.pas

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
 
unit MonTest;
 
interface
 
uses Classes, Controls, Dialogs, ExtCtrls;
 
type
  TMonTest    = Class;
  TCollectionBaseItem = Class;
  TPanelCollection = Class;
  TPanelCollectionClass = Class of TPanelCollection;
  TPanelCollectionItem = Class;
  TPanelCollectionItemClass = Class of TPanelCollectionItem;
  TBtnCollection = class;
  TBtnCollectionClass = Class of TBtnCollection;
  TBtnCollectionItem = Class;
  TBtnCollectionItemClass = Class of TBtnCollectionItem;
 
  TMonTest = Class(TPanel)
  Private
    FPanelCollection : TPanelCollection;
    procedure Set_PanelCollection(const Value: TPanelCollection);
  public
    function GetCollectionClassFirst : TPanelCollectionClass;
    function GetCollectionClassFirstItem : TPanelCollectionItemClass;
    function GetCollectionClassSecondItem : TBtnCollectionItemClass;
    constructor Create(AOwner : TComponent);override;
  published
    property Panels : TPanelCollection read FPanelCollection write Set_PanelCollection;
  End;
 
  TCollectionBaseItem = Class(TCollectionItem)
  strict private
    FCaption: string;
    FInterfaceData: IInterface;
  private
    function IsCaptionStored: Boolean;
  protected
    procedure SetCaption(const Value: string);
  published
  public
    property InterfaceData: IInterface read FInterfaceData write FInterfaceData;
    property Caption: string read FCaption write SetCaption stored IsCaptionStored;
  End;
 
  TBtnBase = Class(TCollectionBaseItem)
  private
    FOnclick : TNotifyEvent;
  public
    procedure Assign(Source : TPersistent);override;
  published
    property Caption;
    property Onclick : TNotifyEvent read FOnclick write FOnClick;
  End;
 
  TBtnCollectionItem = Class(TBtnBase)
  private
    function GetPanelCollection: TPanelCollection;
    function GetMonTest: TMonTest;
  public
    procedure Assign(Source : TPersistent);override;
    property Panels : TPanelCollection read GetPanelCollection;
  published
    property MonTest : TMonTest read GetMonTest;
  End;
 
  TBtnCollection = class(TCollection)
  private
    FPanelCollectionItem : TPanelCollectionItem;
    function GetItem(Index: Integer): TBtnCollectionItem;
    procedure SetItem(Index: Integer; const Value: TBtnCollectionItem);
  protected
    function GetOwner : TPersistent;override;
  public
    constructor Create(AFCollection : TPanelCollectionItem);
    function Add : TBtnCollectionItem;
 
    property Items[Index : Integer] : TBtnCollectionItem read GetItem write SetItem;default;
    property PanelCollectionItem : TPanelCollectionItem read FPanelCollectionItem;
  end;
 
  TPanelCollectionItem = Class(TCollectionBaseItem)
  private
    FBtnCollection : TBtnCollection;
    procedure Set_BtnCollection(const Value: TBtnCollection);
    function GetPanelCollection: TPanelCollection;
    function GetMonTest: TMonTest;
  public
    constructor Create(Collection : TCollection);override;
    procedure Assign(Source : TPersistent);override;
    property Panels : TPanelCollection read GetPanelCollection;
  published
    property Caption;
    property MonTest : TMonTest read GetMonTest;
    property Buttons : TBtnCollection read FBtnCollection write Set_BtnCollection;
  End;
 
  TPanelCollection = Class(TCollection)
  private
    FMonTest : TMonTest;
    function GetItem(Index: Integer): TPanelCollectionItem;
    procedure SetItem(Index: Integer; const Value: TPanelCollectionItem);
  protected
    function GetOwner : TPersistent;override;
  published
  public
    constructor Create(AMonTest : TMonTest);
    function Add : TPanelCollectionItem;
    property Items[Index : Integer] : TPanelCollectionItem read GetItem write SetItem;default;
    property MonTest : TMonTest read FMonTest;
  End;
 
implementation
 
{ TCollectionBaseItem }
 
function TCollectionBaseItem.IsCaptionStored: Boolean;
begin
  Result := True;
end;
 
procedure TCollectionBaseItem.SetCaption(const Value: string);
begin
  if FCaption <> Value then
  begin
    FCaption := Value;
    Changed(False);
  end;
end;
 
{ TMonTest }
 
constructor TMonTest.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
 
  FPanelCollection := GetCollectionClassFirst.Create(Self);
end;
 
function TMonTest.GetCollectionClassFirst: TPanelCollectionClass;
begin
  Result := TPanelCollection;
end;
 
function TMonTest.GetCollectionClassFirstItem: TPanelCollectionItemClass;
begin
  Result := TPanelCollectionItem;
end;
 
function TMonTest.GetCollectionClassSecondItem : TBtnCollectionItemClass;
begin
  Result := TBtnCollectionItem;
end;
 
procedure TMonTest.Set_PanelCollection(const Value: TPanelCollection);
begin
  FPanelCollection.Assign(Value);
end;
 
{ TPanelCollection }
 
function TPanelCollection.Add: TPanelCollectionItem;
begin
  Result := inherited Add as TPanelCollectionItem;
end;
 
constructor TPanelCollection.Create(AMonTest: TMonTest);
begin
  inherited Create(TPanelCollectionItem);
  FMonTest := AMonTest;
end;
 
function TPanelCollection.GetItem(Index: Integer): TPanelCollectionItem;
begin
  Result := TPanelCollectionItem(inherited GetItem(Index));
end;
 
function TPanelCollection.GetOwner: TPersistent;
begin
  Result := MonTest;
end;
 
procedure TPanelCollection.SetItem(Index: Integer;
  const Value: TPanelCollectionItem);
begin
   Inherited SetItem(Index,Value);
end;
 
{ TPanelCollectionItem }
 
procedure TPanelCollectionItem.Assign(Source: TPersistent);
var
  First : TPanelCollectionItem;
begin
  if Source is TPanelCollectionItem then
  begin
    First := Source as TPanelCollectionItem;
    InterfaceData := First.InterfaceData;
  end
  else
    inherited Assign(Source);
end;
 
constructor TPanelCollectionItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
 
  FBtnCollection := TBtnCollection.Create(Self);
end;
 
function TPanelCollectionItem.GetPanelCollection: TPanelCollection;
begin
  Result := TPanelCollection(Collection);
end;
 
function TPanelCollectionItem.GetMonTest: TMonTest;
begin
  Result := TPanelCollection(Collection).MonTest;
end;
 
procedure TPanelCollectionItem.Set_BtnCollection(
  const Value: TBtnCollection);
begin
  FBtnCollection.Assign(Value);
end;
 
{ TBtnCollection }
 
function TBtnCollection.Add: TBtnCollectionItem;
begin
  Result := inherited Add as TBtnCollectionItem;
end;
 
constructor TBtnCollection.Create(AFCollection: TPanelCollectionItem);
begin
  inherited Create(TBtnCollectionItem);
  FPanelCollectionItem := AFCollection;
end;
 
function TBtnCollection.GetItem(Index: Integer): TBtnCollectionItem;
begin
  Result := TBtnCollectionItem(inherited GetItem(Index));
end;
 
function TBtnCollection.GetOwner: TPersistent;
begin
  Result := FPanelCollectionItem;
end;
 
procedure TBtnCollection.SetItem(Index: Integer;
  const Value: TBtnCollectionItem);
begin
  inherited SetItem(Index,Value);
end;
 
{ TBtnCollectionItem }
 
procedure TBtnCollectionItem.Assign(Source: TPersistent);
begin
  if Source is TBtnCollectionItem then
  begin
    inherited Assign(Source);
    InterfaceData := (Source as TBtnCollectionItem).InterfaceData;
  end
  else
    inherited Assign(Source);
end;
 
function TBtnCollectionItem.GetPanelCollection: TPanelCollection;
begin
  Result := nil;
  if Collection <> nil then
    Result := TBtnCollection(Collection).PanelCollectionItem.Panels;
end;
 
function TBtnCollectionItem.GetMonTest: TMonTest;
begin
  Result := nil;
  if Collection <> nil then
    Result := TBtnCollection(Collection).FPanelCollectionItem.MonTest;
end;
 
{ TBtnBase }
 
procedure TBtnBase.Assign(Source: TPersistent);
begin
  if Source is TBtnBase then
  begin
    Caption := TBtnBase(Source).Caption;
  end
  else
    inherited Assign(Source);
end;
 
end.

Unité : MontestRegister.pas

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
 
unit MonTestRegister;
 
interface
 
uses Classes,MonTest;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Test',[TMonTest]);
end;
 
 
end.

[DXE] TCollection imbriqué : erreur lors de la suppression

Composants VCL Delphi

Vue hybride

Discussions similaires

Partager

Partager