Pb avec TObjectList

**qi130** · 20/03/2006, 22h48

Ce composant est-il fugitif ?

Ainsi si j'en créé une dans 1 procedure:

Code :

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

1
2
3
4
5
6
procedure TForm1.CreerListe(utilisateur:string);
var i:integer;
begin
     with TObjectList.Create do begin // création de la liste des droits
        Name:=utilisateur+'List';
        end;

Je pense avoir créer un ObjectList ayant pour nom xxxxList (xxxx=contenu de la variable utilisateur = ok en debug)

Or, plus loin dans mon prog, si je tente

Code :

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

TObjectList(FindComponent(utilisateur+'List')).Clear;

J'ai une exception...
par contre, le Free passe sans pb !

De même:

Code :

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

1
2
3
var  OL:TObjectList;
begin                  // mémorisation pour l'utilisateur cédant
     OL:=TObjectList(FindComponent(utilisateur+'List'));

OL=nil

(mais ça explique l'exception

)

Alors, où se trouve mon ObjectList, et comment y accéder ?

**Pedro** · 20/03/2006, 23h20

Salut

Je pense avoir la solution:
TObjectList descends de TList qui lui même descend directement de TObject. Or FindComponent renvoie un type TComponent. Il y a peut-être un problème au niveau du cast... Essaie de caster avec as pour contrôler la faisabilité du cast...
A vrai dire, je ne comprends pas pourquoi tu n'utilises pas une variable globale ou membre pour y mettre ta TObjectList

**qi130** · 21/03/2006, 09h23

Envoyé par Pedro

pourquoi tu n'utilises pas une variable globale ou membre pour y mettre ta TObjectList

Parce que j'ai affaire à un pagecontrol ayant un nb variable d'onglets, chaque onglet affiche un grid ayant un nb variable de lignes.

Plutôt que de créer un grid par onglet, je réutilise le 1er en changeant son parent, mais entre temps, je dois mémoriser le contenu de l'onglet "cédant" et l'alimenter avec le contenu de l'onglet "prenant".

Le grid est un NextGrid (avec 1 colonne texte et 4 colonnes checkbox). J'ai donc
- déclaré une Class ayant cette description
- créer une variable pour cette classe qui me sert de matrice pour alimenter l'objectlist

J'espère avoir été clair

Pour le cast, j'essaierai avec as, et c'est vrai que le Findcomponent n'est pas suffisamment documenté: l'objectlist est-il un composant non-visuel récupérable ainsi ?

**LadyWasky** · 21/03/2006, 10h24

Salut, j'ai hier mis en ligne sur mon espace perso (http://waskol.developpez.com) un petit utilitaire (un créateur de classe) qui te permettra de générer automatiquement (entre autre) un TComponentList ou un TContolList personalisé pour ton besoin.

Jettes-y un oeil, ça ne mange pas de pain, c'est juste un fichier à dézipper, l'aide est incluse dans l'utilitaire avec des exemples.

L'utilitaire se base, entre autre, sur l'utilisation de TObjectList.

Peut-être que celà te sera utile.

Bon dev.

**qi130** · 21/03/2006, 11h37

Merci pour l'outil

petite remarque: manquerait un VScrollBar pour le mode d'emploi

Cependant, un de mes soucis est de pouvoir récupérer ma liste en fonction de xxxxxx (variable).

Ce que tu proposes est-il compatible avec une sorte de FindComponent ?

**LadyWasky** · 21/03/2006, 12h01

On doit pouvoir y arriver

Je te répond cet après midi, là je dois aller chercher mon petit bout de choux qui a 18 mois à la crêche

A+

sinon, vite fait :

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
var UnItem:TDroitsUtilisateur;
...
//Création d'une Liste de droits
begin
  UnItem:=TDroitsUtilisateur.Create;
  UNItem.Name:=utilisateur+'List';
  TDroitsUtilisateurList.Add(UnItem);
end;
 
function TrouveComposant(utilisateur:string):integer;
var i:integer;
begin
  result:=-1;
  i:=0;
  while (i<TaListe.count-1) and (result=-1) do
  begin
     if (utilisateur+'List'=DroitsUtilisateurList.items[i].Name then result:=i;
     inc(i);
  end; 
end;

si la fonction retourne -1, le composant n'a pas été trouvé sinon :

Code :

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

1
2
3
4
5
6
7
8
var index:integer;
begin
  index:=TrouveComposant(utilisateur);
  if index=-1
  then showmessage('Pas trouvé')
  else UnItem:=DroitsUtilisateurList.items[index];
 ...
end;

PS: je tiens compte de ta remarque pour la scrollbar

**qi130** · 21/03/2006, 14h04

Ce que tu proposes est une sorte de liste (TDroitsUtilisateurList) mémorisant des listes ?

**LadyWasky** · 21/03/2006, 14h18

Envoyé par qi130

Ce que tu proposes est une sorte de liste (TDroitsUtilisateurList) mémorisant des listes ?

Exactement, pourquoi pas ?

Une liste de listes... en gros c'est ta problématique n'est ce pas ?

**qi130** · 21/03/2006, 14h48

Oui, c'est mon pb....

Du moment que je peux allouer, écrire, lire et supprimer...

En fait on se substitue au FindComponent

?

**LadyWasky** · 21/03/2006, 14h59

OK, donc à partir de là on va avoir cette arborescence :

DroitsUtilisateursList:TDroitsUtilisateursList
[list:28b287b776]
UtilisateurListe1:TUtilisateurListe
[list:28b287b776]
Droits1:TDroit
Droits2:TDroit

[*]UtilisateurListe2:TUtilisateurListe[*]...[/list:u:28b287b776][/list:u:28b287b776]

Ma seule question est, qu'est-ce que TDroit ???
Un entier, un ensemble, un boolean, un record, une classe particulière ?

Et ensuite on va pouvoir générer le code dont tu as besoin...

**qi130** · 21/03/2006, 15h11

Merci de t'intéresser à mon cas perso

Un TDroit ressemblerait assez à un record:
genre ( à corriger pour en faire une classe ?))

Code :

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

1
2
3
4
type TDroit=record
   table:string;
   select,insert,update,delete:boolean;
  end;

Initialement traduit en (de mémoire):

Code :

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

1
2
3
4
type TDroit=Class
   table:string;
   select,insert,update,delete:boolean;
  end;

**LadyWasky** · 21/03/2006, 15h29

Envoyé par qi130

Merci de t'intéresser à mon cas perso

à corriger pour en faire une classe ?

Pas besoin, ça me suffit ;P

**LadyWasky** · 21/03/2006, 16h12

Dans 5 Minutes...

**LadyWasky** · 21/03/2006, 16h18

Et hop ! :

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
unit UnitListesDeDroits;
 
interface
uses Sysutils, Classes, Contnrs, StdCtrls;
 
type
  TDroits=record
    table:string[50]; //<--Super important !
    select,insert,update,delete:boolean;
  end;
 
  PTDroits = ^TDroits;
 
  TDroitsList = class(TObject)
  private
    FList:TList;
    FUtilisateur: string;
    function GetItem(Index: Integer): TDroits;
    procedure SetItem(Index: Integer; const Value: TDroits);
    function GetCount: Integer;
    procedure SetCount(const Value: Integer);
  protected
  public
    constructor Create;
    destructor Destroy; override;
    function Add(Item:TDroits): Integer;
    procedure Delete(Index: Integer);
    procedure Insert(Index: Integer; Item: TDroits);
    procedure Move(CurIndex, NewIndex: Integer);
    procedure Exchange(Index1, Index2: Integer);
    procedure Clear;
    function ItemsByTableName(TableName:string):TDroits;
    function IndexOfTableName(TableName:string):Integer;
    function RemoveByTableName(TableName:string):integer;
    function IndexOf(const Value: TDroits): Integer;
    property Items[Index:Integer]:TDroits read GetItem write SetItem;default;
    property Count: Integer read GetCount write SetCount;
    property Utilisateur:string read FUtilisateur write FUtilisateur;
  end;
 
TDroitsUtilisateurList = class(TObjectList)
  private
 
  protected
    function GetItem(Index: integer): TDroitsList;
    procedure SetItem(Index: Integer; Item: TDroitsList);
  public
    constructor Create;
    function Add(Item: TDroitsList): Integer;
    function Remove(Item: TDroitsList): Integer;
    function IndexOf(Item: TDroitsList): Integer;
    function ItemsByUser(utilisateur:string):TDroitsList;
    function IndexOfUser(utilisateur:string):Integer;
    function NewUser(utilisateur:string):TDroitsList;
    function RemoveUser(utilisateur:string):integer;
    procedure Insert(Index: Integer; Item: TDroitsList);
    property Items[Index: Integer]: TDroitsList read GetItem write SetItem; default;
  end;
 
implementation
uses Dialogs;
{ TDroitsList }
 
function TDroitsList.Add(Item:TDroits): Integer;
var
  p:PTDroits;
begin
  GetMem(p,SizeOf(Item));
  p^ := Item;
  result := FList.Add(p);
end;
 
procedure TDroitsList.Clear;
var
  i:integer;
begin
  for i := 0 to FList.Count-1 do FreeMem(FList[i]);
  FList.Clear;
end;
 
constructor TDroitsList.Create;
begin
  FList := TList.Create;
end;
 
procedure TDroitsList.Delete(Index: Integer);
begin
  FreeMem(FList[Index]);
  FList.Delete(Index);
end;
 
destructor TDroitsList.Destroy;
begin
  Clear;
  FList.Free;
  inherited;
end;
 
procedure TDroitsList.Exchange(Index1, Index2: Integer);
begin
  FList.Exchange(Index1, Index2);
end;
 
function TDroitsList.GetCount: Integer;
begin
  result := FList.Count;
end;
 
function TDroitsList.GetItem(Index: Integer): TDroits;
begin
  result := PTDroits(FList[Index])^;
end;
 
function TDroitsList.IndexOf(const Value: TDroits): Integer;
var i: Integer;
    found:Boolean;
    AnItem:TDroits;
begin
  Result := -1;
  found:=False;
  i:=0;
  while ((i<FList.Count) and (not found)) do
  begin
    AnItem:=GetItem(i);
    found:=CompareMem(@Value,@AnItem,SizeOf(TDroits));
    if not found then Inc(i);
  end;
  if found then Result:=i;
end;
 
function TDroitsList.IndexOfTableName(TableName: string): Integer;
var i:integer;
begin
  //Recherche
  Result:=-1;
  i:=0;
  while (i<Count-1) and (Result=-1) do
  begin
     if (TableName=Items[i].table) then result:=i;
     inc(i);
  end;
end;
 
procedure TDroitsList.Insert(Index: Integer; Item: TDroits);
var
  p: PTDroits;
begin
  GetMem(p, SizeOf(Item));
  p^ := Item;
  FList.Insert(Index, p);
end;
 
function TDroitsList.ItemsByTableName(TableName: string): TDroits;
var index:integer;
begin
  index:=IndexOfTableName(TableName);
  Result.table:='';
  //Résultat de La recherche
  if index=-1
  then ShowMessage('Table inconnue');
  else Result:=Items[index];
end;
 
procedure TDroitsList.Move(CurIndex, NewIndex: Integer);
begin
  FList.Move(CurIndex, NewIndex);
end;
 
function TDroitsList.RemoveByTableName(TableName: string): integer;
var index:integer;
begin
  index:=IndexOfTableName(TableName)
  if index>=0 then Delete(index);
end;
 
procedure TDroitsList.SetCount(const Value: Integer);
var
  i, ListCount: Integer;
  p: PTDroits;
begin
  if FList.Count = Value then
    Exit
  else
  if Value < FList.Count then
  begin
    ListCount := FList.Count;
    for i := ListCount downto Value+1 do
    begin
      FList.Delete(i);
    end;
  end else
  if FList.Count < Value then
  begin
    for i := FList.Count+1 to Value do
    begin
      GetMem(p, SizeOf(TDroits));
      FillChar(p^, SizeOf(TDroits), 0);
      FList.Add(p);
    end;
  end;
end;
 
procedure TDroitsList.SetItem(Index: Integer; const Value: TDroits);
begin
  PTDroits(FList[Index])^ := value;
end;
 
{ TDroitsUtilisateurList }
 
function TDroitsUtilisateurList.Add(Item: TDroitsList): integer;
begin
  Result := inherited Add(Item);
end;
 
 
constructor TDroitsUtilisateurList.Create;
begin
  inherited Create(True);
end;
 
function TDroitsUtilisateurList.GetItem(Index: Integer): TDroitsList;
begin
  Result :=TDroitsList(inherited Items[Index]);
end;
 
function TDroitsUtilisateurList.IndexOf(Item: TDroitsList): Integer;
begin
  Result := inherited IndexOf(Item);
end;
 
function TDroitsUtilisateurList.IndexOfUser(utilisateur: string): Integer;
var i:integer;
begin
  //Recherche
  Result:=-1;
  i:=0;
  while (i<Count-1) and (Result=-1) do
  begin
     if (utilisateur=Items[i].Utilisateur) then result:=i;
     inc(i);
  end;
end;
 
procedure TDroitsUtilisateurList.Insert(Index: Integer; Item: TDroitsList);
begin
  inherited Insert(Index, Item);
end;
 
function TDroitsUtilisateurList.ItemsByUser(utilisateur: string): TDroitsList;
var index:integer;
begin
  index:=IndexOfUser(utilisateur);
  Result:=nil;
  //Résultat de La recherche
  if index=-1
  then ShowMessage('Utilisateur inconnu')
  else Result:=Items[index];
end;
 
function TDroitsUtilisateurList.NewUser(utilisateur: string): TDroitsList;
var UneListeDeDroits:TDroitsList;
begin
  UneListeDeDroits:=TDroitsList.Create;
  UneListeDeDroits.Utilisateur:=utilisateur;
  Result:=UneListeDeDroits;
  Add(UneListeDeDroits);
end;
 
function TDroitsUtilisateurList.Remove(Item: TDroitsList): Integer;
begin
  Result := inherited Remove(Item);
end;
 
function TDroitsUtilisateurList.RemoveUser(utilisateur: string): integer;
var index:integer;
begin
  index:=IndexOfUser(utilisateur);
  if index>=0 then Delete(index);
end;
 
procedure TDroitsUtilisateurList.SetItem(Index: Integer; Item: TDroitsList);
begin
  inherited Items[Index] := Item;
end;
 
end.

Edit : Bugs corrigés

**qi130** · 21/03/2006, 16h44

Envoyé par waskol

Dans 5 Minutes...

Hé hé ça en fait 6

Merci, je teste tout ça...

**LadyWasky** · 21/03/2006, 16h58

Je me suis aperçu à l'occasion, que les templates de mon utilitaire avaient des manques... Je m'y attèle ce soir.

Enfin bref, Comment ça marche ?

Tout d'abord on va avoir cette arborescence :

DroitsUtilisateursList:TDroitsUtilisateursList
[list:81aaa26dfc]
ListedeDroits1:TDroitsListe
[list:81aaa26dfc]
Droits1:TDroits
ListedeDroits2:TDroits

[*]UtilisateurListe2:TUtilisateurListe[*]...[/list:u:81aaa26dfc][/list:u:81aaa26dfc]

J'ai un peu changer les dénomination de classe.

Un petit exemple (une fiche avec un bouton)

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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,Unit2, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
    DroitsUtilisateursList:TDroitsUtilisateurList;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  DroitsUtilisateursList:=TDroitsUtilisateurList.Create;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  DroitsUtilisateursList.Free;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var ListedeDroits:TDroitsList;
    Droits:TDroits;
    NbreDeUsers:Integer;
begin
  //Ajout de quelques utilisateurs
 
  DroitsUtilisateursList.NewUser('Capitaine Flam');
  DroitsUtilisateursList.NewUser('Toto');
  DroitsUtilisateursList.NewUser('Popeye');
  DroitsUtilisateursList.NewUser('Mickey');
  DroitsUtilisateursList.NewUser('Mario');
  DroitsUtilisateursList.NewUser('Albator');
  NbreDeUsers:=DroitsUtilisateursList.Count;
  ShowMessage('Il y a '+IntToStr(NbreDeUsers)+' utilisateurs');
 
  //on supprime Mickey :)
  DroitsUtilisateursList.RemoveUser('Mickey');
 
  NbreDeUsers:=DroitsUtilisateursList.Count;
  ShowMessage('Il y a '+IntToStr(NbreDeUsers)+' utilisateurs (on à supprimé Mickey)');
 
  //affectation de droits
  ListedeDroits:=DroitsUtilisateursList.ItemsByUser('Popeye');
  if ListedeDroits<>nil then
  begin
     Droits.table:='Clients';
     Droits.select:=True;
     Droits.delete:=False;
     ListedeDroits.Add(Droits);
     Droits.table:='Produitss';
     Droits.select:=True;
     Droits.delete:=true;
     ListedeDroits.Add(Droits);
  end;
 
  //recherche de droits
  ListedeDroits:=DroitsUtilisateursList.ItemsByUser('Popeye');
  if ListedeDroits<>nil then
  begin
     Droits:=ListedeDroits.ItemsByTableName('Clients');
     if Droits.table<>'' then
     begin
       //Affiche droits pour Popey et la table Clients
     end;
     //detruit les droits correspondant à cette table
     ListedeDroits.RemoveByTableName('Clients');
  end;
end;
 
end.

**LadyWasky** · 21/03/2006, 17h02

Envoyé par qi130

Envoyé par waskol

Dans 5 Minutes...

Hé hé ça en fait 6

Merci, je teste tout ça...

N'oublie pas de déclarer ton record comme ceci :

Code :

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

1
2
3
4
TDroits=record
    table:string[50]; //<--mettre une taille à ta string, Super important !
    select,insert,update,delete:boolean;
  end;

**qi130** · 21/03/2006, 21h59

Bon, je viens d'intégrer tout ça dans mon appli

et les premiers tests révèlent que:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
function TDroitsList.IndexOfTableName(TableName: string): Integer;
var i:integer;
begin
  //Recherche
  Result:=-1;
  i:=0;
  while (i<Count-1) and (Result=-1) do
  begin
     if (TableName=Items[i].table) then result:=i;
     inc(i);
  end;
end;

contient 2 bugs:
1/ si le if est vérifié, la valeur de i est quand même incrémentée (un break s'impose ? ou mieux : mettre inc(i) dans un else )
2/ quand il n'y a qu'un item dans la liste, le résultat est toujours -1 à cause de while (i<Count-1) changer l'opérateur par <= ?

tiens-moi au courant

**qi130** · 21/03/2006, 22h13

A priori, même punition là:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
function TDroitsUtilisateurList.IndexOfUser(utilisateur: string): Integer;
var i:integer;
begin
  //Recherche
  Result:=-1;
  i:=0;
  while (i<Count-1) and (Result=-1) do
  begin
     if (utilisateur=Items[i].Utilisateur) then result:=i;
     inc(i);
  end;
end;

**LadyWasky** · 21/03/2006, 22h28

1) Non, il n'y a pas de bug, puisque l'index trouvé est stocké dans la variable Result, qui est aussi utilisée pour sortir de la boucle While si elle vaut autre chose que -1

2) oui, bien vu, là il y en a un (vilain pas beau) : il faut écrire i<count et non pas i<count-1

Bien vu !!!! Ca m'avait échappé

Pb avec TObjectList

Langage Delphi

Discussions similaires

Partager

Partager