Commentaires sur une source : MAKE CAB + CHECKLISTBOX

cs_Forman

Messages postés: 600
Date d'inscription: samedi 8 juin 2002
Statut: Membre
Dernière intervention: 6 avril 2010

1
29 juin 2006 à 19:53

Une autre solution pour ne pas avoir à se soucier de la libération de la mémoire est la suivante:

type
IStrings=interface
function GetCount:Integer;
property Count:Integer read GetCount;

function GetItem(const Index:Integer):string;
procedure SetItem(const Index:Integer;const Value:string);
property Item[Index:Integer]:string read GetItem write SetItem;
end;

TStringsImplementation=class(TInterfacedObject,IStrings)
function GetCount:Integer;
function GetItem(const Index:Integer):string;
procedure SetItem(const Index:Integer;const Value:string);
destructor Destroy;override;
end;

...faire l'implémentation de l'objet TStringsImplementation...

On pourrait alors déclarer la fonction qui renvoie une liste de chaînes de la fonction suivante:

function TCheckListBox.GetChecks:IStrings;
begin
Result:=TStringsImplementation.Create;
Result.Add(...);
end;

Lorsque quelqu'un utilise la fonction ainsi:

with CheckListBox1.GetChecks do begin
ShowMessage('Il y a '+IntToStr(Count)+' items sélecionnés');
end;

la mémoire sera libérée, car il y a des appels implicites à _AddRef et _Release qui font -avec le mécanisme de comptage de référence des interfaces- qu'à l'issue de cet appel, l'objet TStringsImplementation est détruit. C'est une solution propre et élégante, mais qui nécessite toutefois d'écrire un peu plus de code (ceci dit écrire l'implémentation de TStringsImplementation ne me paraît pas très difficile...).

cs_Forman

Messages postés: 600
Date d'inscription: samedi 8 juin 2002
Statut: Membre
Dernière intervention: 6 avril 2010

1
29 juin 2006 à 19:44

procedure AddToList(List : TStrings);
begin
List.BeginUpdate;
try
List.Add(...);
finally
List.EndUpdate;
end;
end;

"AddToList" a l'avantage d'être un nom explicite. BeginUpdate...EndUpdate permet de ne pas dégrader les performances avec des TStrings associés à des contrôles par exemple.

f0xi

Messages postés: 4205
Date d'inscription: samedi 16 octobre 2004
Statut: Modérateur
Dernière intervention: 12 mars 2022

38
23 avril 2006 à 22:04

heu il me semble que tu parle de cette phrase : "Avantage du point que souleve Nono, c'est que si on ecrit tout de meme une fonction, elle permet de liberer la valeur du resultat pour passer un retour de control booléen ou tout autre retour."

en fait je parler de rendre disponible le retour de la fonction pour l'utiliser comme control ou comme information.

pour ce que tu dis :

La création est inutile ici.
procedure SetList(List : TStrings);
begin
list.Clear
List.Add(...);
end;

attention, toute fois, si il s'agit d'une liste non visuelle, pas de probleme, par contre si il s'agit d'un composant visuel, le fait de faire des ADD vas rafraichir le compo et degradé les preformance d'ou le buffer de type TStringList pour d'abord créer la liste puis envoyer la liste a l'objet en argument.

cs_Nono40

Messages postés: 962
Date d'inscription: mercredi 3 avril 2002
Statut: Membre
Dernière intervention: 12 septembre 2006

2
21 avril 2006 à 22:10

Merci je sais la différence entre un Whiol et un repeat....

Regarde ma solution de près et tu veras que le code Repeat Until n'est appelé que si le If est vrai. Le traitement ne seront donc bien effectué que sur le premier élément.

Pour ta solution
procedure SetList(List : TStrings);
var TMPLIST : TStringList;
begin
try
TMPLIST := TStringList.Create;
...
TMPLIST.Add(...);
...
List.Assign(TMPLIST);
finally
TMPLIST.Free;
end;
end;

La création est inutile ici.
procedure SetList(List : TStrings);
begin
list.Clear
List.Add(...);
end;

Pour répondre à un point au dessus aussi, tu dis que le résultat est libéré car c'est une variable locale. C'est FAUX. Seules les chaines et les tableaux dynamiques sont dans ce cas, dans tous les autres c'est à toi de le gérer.

f0xi

Messages postés: 4205
Date d'inscription: samedi 16 octobre 2004
Statut: Modérateur
Dernière intervention: 12 mars 2022

38
21 avril 2006 à 11:02

>>> J'ai pas compris où est mon erreur sur le getselection ?

Erreur que j'ai répétée et que nono a corrigée, c'est qu'un retour de ce type ne serat jamais libéré durant l'execution, soit, pas liberée en memoire.

donc si la liste pese 15Koctet et qu'on appel 100 fois la fonction, on provoque une fuite de memoire de 1500 Ko (1.5Mo)

donc il faut faire comme on vient de te le dire, passer la List dans les arguments et non dans le retour de fonction.

soit :

procedure TCheckListBox.GetSelection(OutList : TStrings);
var
i : Integer;
TPL : TStringList;
begin
try
TPL : TStringList;
For i := 0 to Items.Count - 1 do
if Checked[i] then TPL.Add(Items.Strings[i]);
OutList.Assign(TPL);
finally
TPL.free;
end;
end;

>> J'ai mis le sender sur le CheckAll pour pouvoir l'appeler directement avec le click sur le menuitem "Tout cocher" mais peut etre qu'il y a un autre moyen ?

pas besoin, Tu crée la methode "TouCocher1Click" et tu place le code CheckList.CheckAll;
dedans.
ce serat plus propre car comme je te l'ai dis, ce sont des methodes et non des evenements. nuance.
en plus, cela permet de ne pas passer un argument inutile aux methodes ...
car un il ne faut pas oublier qu'un argument inutile prend de la place pour rien en memoire.

donc tu auras :

procedure TForm1.ToutCocher1Click(Sender : TObject);
begin
CheckList.CheckAll;
end;

et non dans l'inspecteur d'objet :
OnClick >> CheckList.CheckAll

f0xi

Messages postés: 4205
Date d'inscription: samedi 16 octobre 2004
Statut: Modérateur
Dernière intervention: 12 mars 2022

38
21 avril 2006 à 10:47

oui Nono, mais attention a la difference entre While et Repeat :

Repeat Until execute l'instruction qu'elle contient au moins une fois meme si l'expression est fausse ... ce qui peu provoquer des erreurs si on ne control pas avant l'entrée dans la boucle.

While Do n'execute l'instruction qu'elle contient que si et seulement si l'expression est vraie. CAD, il faut que l'expression soit vraie dés le depart pour pourvoir rentrer dans la boucle.

avantage de Repeat Until c'est qu'on ne repete pas non plus le code pour FindFirst vus qu'on entre au moins une fois dans le Repeat Until, donc le premier elements trouver est toujours traiter, sauf si bien sur FindFirst <> 0 dans la condition If ...

par contre la ou je ne suis pas vraiment d'accord, c'est qu'un FindFirst,FindNext doit etre toujours dans un Try et FindClose dans le Finally vus que FindClose libere la memoire alloué par FinFirst ET FindNext ... et en cas d'erreur (on ne sait jamais) FindClose serat toujours executé.

procedure FindClose(var F: TSearchRec);
begin
{$IFDEF MSWINDOWS}
if F.FindHandle <> INVALID_HANDLE_VALUE then
begin
Windows.FindClose(F.FindHandle);
F.FindHandle := INVALID_HANDLE_VALUE;
end;
{$ENDIF}
{$IFDEF LINUX}
if F.FindHandle <> nil then
begin
closedir(F.FindHandle);
F.FindHandle := nil;
end;
{$ENDIF}
end;

meme si FindFirst et FindNext ne sont pas executé FindClose ne provoque pas d'erreur (<> INVALID_HANDLE_VALUE)

...

procedure Find(FilePath : string; List : TStrings);
var Rec : TSearchRec;
TLS : TStringList;
begin
try
TLS := TStringList.Create;
if FindFirst(FilePath,faAnyfile,Rec) = 0 then begin
repeat
TLS.Add(Rec.Name); // dans un repeat until cette ligne serait executée!!!
until FindNext(Rec) <> 0;
end;
List.Assign(TLS);
finally
FindClose(Rec);
TLS.Free;
end;
end;

tu as egalement raison sur les TStringList et tu me permet de corriger une erreur que je fais assé souvent d'ailleur, je t'en remercis.

procedure SetList(List : TStrings);
var TMPLIST : TStringList;
begin
try
TMPLIST := TStringList.Create;
...
TMPLIST.Add(...);
...
List.Assign(TMPLIST);
finally
TMPLIST.Free;
end;
end;

procedure AddToList(List : TStrings);
var TMPLIST : TStringList;
begin
try
TMPLIST := TStringList.Create;
...
TMPLIST.Add(...);
...
List.AddStrings(TMPLIST);
finally
TMPLIST.Free;
end;
end;

merci d'avoir corriger ce point important.

rappel : l'argument List ne doit pas etre declarer en Var ou Out ou encore Const si on veux pourvoir passé les propriétés de Type TStrings des composants dans les procedures.

Avantage du point que souleve Nono, c'est que si on ecrit tout de meme une fonction, elle permet de liberer la valeur du resultat pour passer un retour de control booléen ou tout autre retour.

exemple :

function AddToList(List : TStrings) : integer; // renvois ne nombre d'elements ajoutés
var TMPLIST : TStringList;
begin
result := 0;
try
TMPLIST := TStringList.Create;
...
TMPLIST.Add(...);
...
Result := TMPLIST.Count;
List.AddStrings(TMPLIST);
finally
TMPLIST.Free;
end;
end;

l'objet TMPLIST sert de buffer pour eviter de travailler directement sur un composant TListBox ou TMemo ou autre ... ce qui eviteras les "refresh" intempestif du composant qui vas de par le fait degrader fortement les performances.

voila voila, merci a nono.

f0xi

Messages postés: 4205
Date d'inscription: samedi 16 octobre 2004
Statut: Modérateur
Dernière intervention: 12 mars 2022

38
20 avril 2006 à 18:33

petite erreur dans cette fonction :

function TCheckListBox.GetSelection : TStringList;
var
i : Integer;
begin
Result := TStringList.Create;
For i := 0 to Items.Count - 1 do
if Checked[i] then Result.Add(Items.Strings[i]);
end;

le retour peut etre en TStringList c'est mieux de faire ainsi.

petit renomage aussi elle devrait plutot s'appelée GetCheckeds et non GetSelection.
Selection c'est pour les elements Selectionné (highlight) et non Cochés (checked)

tu pourrais egalement ajouter une petit fonction du meme ordre que CheckAll ou UncheckAll :

procedure TCheckListBox.SwapCheck;
var
i : Integer;
begin
if Items.Count > 0 then begin
For i := 0 to Items.Count - 1 do Checked[i] := not Checked[i];
end;
Click;
end;

ce qui auras pour effet d'inverser la selection, peut etre trés pratique.

d'ailleur ces methodes n'ont pas besoin de (Sender : TObject) vus que ce ne sont pas des evenements mais bel et bien des methodes simple.

pour ta methode :

function IsFile(R : TSearchRec) : boolean;
begin
result := (not (R.Attr and 16)) and (not (R.Attr and 8)) and
(R.Name <> '.') and (R.Name <> '..');
end;

voilou...
procedure TFDepart.JVDL1Change(Sender: TObject);
var
MyList : TStringlist;
Rech : TSearchRec;
Begin
MyList := TStringList.Create;
// les fichiers, c'est sensible alors on traite en bloc Try .. Finally..
Try
if findFirst(JVDL1.Directory + '\*.*', faAnyFile, Rech) = 0 then
if IsFile(Rech) then MyList.Add(Rech.Name);
while FindNext(rech) = 0 do Begin
if IsFile(Rech) then MyList.Add(Rech.Name);
End;
finally
SysUtils.FindClose(Rech); // par precaussion on force SysUtils.FindClose
end;
CLB_Fich.Items.Assign(MyList); // ecrase les anciennes données
CLB_Fich.CheckAll; // on a viré le sender qui sert a rien
MyList.Free;
end;