Discussion :

[firejocker]

Bonjour,

j'ai modifier un peu cet exemple pour ajouter une TStringList et une TFont dedans,


Lorsque je clic sur ces propriétés quand le composant est installé, j'ai des erreurs et une instabilllité incroyable de l'ide :

>Impossible d'affecter nil à TFont.
>Impossible d'affecter nil à TRichEditStrings.

Mon code rajouté apparait en gras :

unit ColTest;
interface

// Note: TCollection and TCollectionItem are defined in Classes.Pas.

uses Classes, Graphics;

type

TMyComponent = class;

TMyCollectionItem = class(TCollectionItem)
private
FText: string;
FListColorMot : TStringList;
FColorFont : TFont;
FMoreStuff: LongInt;
function GetDisplayName: string; override;
procedure SetText(const Value: string);
procedure SetMoreStuff(const Value: LongInt);
Procedure writeListColorMot(lst : TStringList);
Procedure WriteColorFont(value : TFont);
public
constructor Create(Collection: TCollection); virtual;
destructor Destroy; override;
published
property Text: string read FText write SetText;
property ListColorMot : TStringList read FListColorMot write writeListColorMot;
property ColorFont : TFont read FColorFont write WriteColorFont;
property MoreStuff: LongInt read FMoreStuff write SetMoreStuff;
end;


TMyCollection = class(TCollection)
private
FMyComponent: TMyComponent;
function GetItem(Index: Integer): TMyCollectionItem;
procedure SetItem(Index: Integer; Value: TMyCollectionItem);
protected
function GetOwner: TPersistent; override;
public
constructor Create(MyComponent: TMyComponent);
function Add: TMyCollectionItem;
property Items[Index: Integer]: TMyCollectionItem
read GetItem write SetItem; default;
end;

TMyComponent = class(TComponent)
private
FItems: TMyCollection;
procedure SetItems(Value: TMyCollection);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Items: TMyCollection read FItems write SetItems;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Standard', [TMyComponent]);
end;


{ TMyCollectionItem }


// Note: Inherited default behavior of GetDisplayName is to
// return the classname.

constructor TMyCollectionItem.Create(Collection: TCollection);
begin
SetCollection(Collection);
FListColorMot := TStringList.Create;
FColorFont := TFont.Create;
end;


destructor TMyCollectionItem.Destroy;
begin
FListColorMot.Clear;
FListColorMot.Free;
FColorFont.Free;
SetCollection(nil);
inherited Destroy;
end;

function TMyCollectionItem.GetDisplayName: string;
begin
Result := Text;
if Result = '' then Result := inherited GetDisplayName;
end;

procedure TMyCollectionItem.SetText(const Value: string);
begin
if FText <> Value then
FText := Value;
end;

procedure TMyCollectionItem.SetMoreStuff(const Value: LongInt);
begin
if FMoreStuff <> Value then
FMoreStuff:= Value;
end;


{ TMyCollection }

constructor TMyCollection.Create(MyComponent: TMyComponent);
begin
inherited Create(TMyCollectionItem);
FMyComponent := MyComponent;
end;

function TMyCollection.Add: TMyCollectionItem;
begin
Result := TMyCollectionItem(inherited Add);
end;

function TMyCollection.GetItem(Index: Integer): TMyCollectionItem;
begin
Result := TMyCollectionItem(inherited GetItem(Index));
end;

procedure TMyCollection.SetItem(Index: Integer;
Value: TMyCollectionItem);
begin
inherited SetItem(Index, Value);
end;

// Note: You must override GetOwner in Delphi 3.x to get
// correct streaming behavior.
function TMyCollection.GetOwner: TPersistent;
begin
Result := FMyComponent;
end;


{ TMyComponent }

constructor TMyComponent.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FItems := TMyCollection.Create(Self);
end;

destructor TMyComponent.Destroy;
begin
FItems.Free;
inherited Destroy;
end;

procedure TMyComponent.SetItems(Value: TMyCollection);
begin
FItems.Assign(Value);
end;



Procedure TMyCollectionItem.WriteColorFont(value : TFont);
begin
if Assigned(FColorFont) then FColorFont.Assign(value);
end;

Procedure TMyCollectionItem.writeListColorMot(lst : TStringList);
begin
FListColorMot.Assign(lst);
end;

end.

Pour utiliser le gras choisir la balise Quote au lieu de Code mais dans ce cas on perd la mise en page.
Laurent Dardenne

[firejocker]

Personne ne sait ou se trouve mon erreur ?

[tourlourou]

Code :

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

1
2
3
4
5
6
7
8
destructor TMyCollectionItem.Destroy; 
begin 
      FListColorMot.Clear; 
 //     FListColorMot.Free; // devaient être détruites par inherited Destroy ?
 //     FColorFont.Free; 
      SetCollection(nil); 
      inherited Destroy; 
end;

[firejocker]

tiens ... vous ici ...

pourquoi ce code dans le destroy ?

l'erreur intervient quand je veux créer un nouvel item dans la collection

[firejocker]

bon, ben puisque personne trouve .... tant pis alors

merci quand meme

[Laurent Dardenne]

Salut,
pour la méthode

Code :

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

constructor TMyCollectionItem.Create(Collection: TCollection);

L'appel au constructeur hérité est-il optionnel ?

[firejocker]

comment ca ?

[Laurent Dardenne]

Tu l'as préciser dans le destructeur :

Code :

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

1
2
3
4
5
destructor TMyCollectionItem.Destroy; 
begin 
 ...
 inherited Destroy; 
end;

mais pas dans le constructeur :

Code :

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

1
2
3
4
5
constructor TMyCollectionItem.Create(Collection: TCollection);  
begin 
 inherited Create; 
...
end;

[firejocker]

non, en fait, j'avais deja testé ca, et c'est pas ca ...

mon code complet :

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
unit ColTest;
interface
 
//  Note: TCollection and TCollectionItem are defined in Classes.Pas.
 
uses Classes, Graphics;
 
type
 
  TMyComponent = class;
 
  TMyCollectionItem = class(TCollectionItem)
  private
    FText: string;
    FListColorMot : TStringList;
    FColorFont : TFont;
    FMoreStuff: LongInt;
    function GetDisplayName: string; override;
    procedure SetText(const Value: string);
    procedure SetMoreStuff(const Value: LongInt);
    Procedure writeListColorMot(lst : TStringList);
    Procedure WriteColorFont(value : TFont);
  public
    constructor Create(Collection: TCollection); virtual;
    destructor Destroy; override;
    Procedure ClassementDecroissant;
  published
    property Text: string read FText write SetText;
    property ListColorMot : TStringList read FListColorMot write writeListColorMot;
    property ColorFont : TFont read FColorFont write WriteColorFont;
    property MoreStuff: LongInt read FMoreStuff write SetMoreStuff;
  end;
 
 
  TMyCollection = class(TCollection)
  private
    FMyComponent: TMyComponent;
    function GetItem(Index: Integer): TMyCollectionItem;
    procedure SetItem(Index: Integer; Value: TMyCollectionItem);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(MyComponent: TMyComponent);
    function Add: TMyCollectionItem;
    property Items[Index: Integer]: TMyCollectionItem 
      read GetItem write SetItem; default;
  end;
 
  TMyComponent = class(TComponent)
  private
    FItems: TMyCollection;
    procedure SetItems(Value: TMyCollection);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Items: TMyCollection read FItems write SetItems;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Standard', [TMyComponent]);
end;
 
 
{ TMyCollectionItem }
 
 
// Note: Inherited default behavior of GetDisplayName is to 
// return the classname.
 
constructor TMyCollectionItem.Create(Collection: TCollection);
begin
      SetCollection(Collection);
      FListColorMot := TStringList.Create;
      FColorFont := TFont.Create;
end;
 
 
destructor TMyCollectionItem.Destroy;
begin
      FListColorMot.Clear;
      FListColorMot.Free;
      FColorFont.Free;
      SetCollection(nil);
      inherited Destroy;
end;
 
function TMyCollectionItem.GetDisplayName: string;
begin
  Result := Text;
  if Result = '' then Result := inherited GetDisplayName;
end;
 
procedure TMyCollectionItem.SetText(const Value: string);
begin
  if FText <> Value then
    FText := Value;
end;
 
procedure TMyCollectionItem.SetMoreStuff(const Value: LongInt);
begin
  if FMoreStuff <> Value then
    FMoreStuff:= Value;
end;
 
 
{ TMyCollection }
 
constructor TMyCollection.Create(MyComponent: TMyComponent);
begin
  inherited Create(TMyCollectionItem);
  FMyComponent := MyComponent;
end;
 
function TMyCollection.Add: TMyCollectionItem;
begin
  Result := TMyCollectionItem(inherited Add);
end;
 
function TMyCollection.GetItem(Index: Integer): TMyCollectionItem;
begin
  Result := TMyCollectionItem(inherited GetItem(Index));
end;
 
procedure TMyCollection.SetItem(Index: Integer; 
	Value: TMyCollectionItem);
begin
  inherited SetItem(Index, Value);
end;
 
// Note: You must override GetOwner in Delphi 3.x to get
// correct streaming behavior.
function TMyCollection.GetOwner: TPersistent;
begin
  Result := FMyComponent;
end;
 
 
{ TMyComponent }
 
constructor TMyComponent.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FItems := TMyCollection.Create(Self);
end;
 
destructor TMyComponent.Destroy;
begin
  FItems.Free;
  inherited Destroy;
end;
 
procedure TMyComponent.SetItems(Value: TMyCollection);
begin
  FItems.Assign(Value);
end;
 
 
 
Procedure TMyCollectionItem.WriteColorFont(value : TFont);
begin
      if Assigned(FColorFont) then FColorFont.Assign(value);
end;
 
Procedure TMyCollectionItem.writeListColorMot(lst : TStringList);
begin
      FListColorMot.Assign(lst);
      ClassementDecroissant;
end;
 
Procedure TMyCollectionItem.ClassementDecroissant;
var
    lstsorted : TStringList;
    i, j, lg, lgmax, jmax : Integer;
begin
      lstsorted := TStringList.Create;
      lstsorted.AddStrings(FListColorMot);
      lstsorted.Sorted := True;
 
      FListColorMot.Clear;
      lg := lstsorted.Count-1;
 
      // boucle d'insertion par ordre decroissant des mots
      for i := 0 to lg do
      begin
            lgmax := -1;
            for j := 0 to lstsorted.Count -1 do
            begin
                  if (length(lstsorted[j])>lgmax) Then
                  begin
                        jmax := j;
                        lgmax := length(lstsorted[j]);
                  end;
            end;
            FListColorMot.Add(lstsorted[jmax]);
            lstsorted.Delete(jmax);
      end;
end;
 
end.

[edit]
Jinh a trouvé mon erreur de benêt !
constructor Create(Collection: TCollection); virtual;
->
constructor Create(Collection: TCollection); override;