Purge de composants dynamiques sur formulaire

**Benzouye** · 26/05/2016, 11h09

Bonjour,

Sur un formulaire, à l'événement ShowForm, je crée dynamiquement des objets TMemo. A l'événement FormClose, je voudrais supprimer définitivement et proprement ces TMemo.

J'ai commencé à travailler ainsi :

Code :

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

1
2
3
4
5
6
7
8
procedure Tf_comment.FormClose(Sender: TObject; var CloseAction: TCloseAction);
var
    i:integer;
begin
    for i := 0 to ComponentCount - 1 do
        if Components[i] is TMemo then
            Components[i].Free;
end;

Mais je me retrouve avec une erreur au runtime.

Alors qu'avec ce code :

Code :

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

1
2
3
4
5
6
7
8
procedure Tf_comment.FormClose(Sender: TObject; var CloseAction: TCloseAction);
var
    i:integer;
begin
    for i := 0 to ComponentCount - 1 do
        if Components[i] is TMemo then
            showmessage( Components[i].Name );
end;

Je n'ai pas d'erreur et j'ai bien x messages avec le nom de mes x TMemo créés ...

Si vous pouviez jeter un œil et me conseiller.

D'avance merci.

**Jipété** · 26/05/2016, 11h30

Bonjour,

C'est un grand classique : tu supprimes des composants, donc ton ComponentCount évolue (diminue, en l'espèce), donc en bout de boucle tu pointes sur rien si des composants ont été supprimés, chose qui ne se produit pas avec le ShowMessage.

Faut parcourir la boucle à l'envers : for i := MaxValue downto 0 do....

PS : pourquoi des guillemets autour de Purge dans le titre ?

**e-ric** · 26/05/2016, 12h08

Salut

La réponse de Jipété est pertinente.

En invoquant Free sur ton composant, la LCL met à jour la liste des composants en supprimant le poste correspondant d'une part et dans le for, les bornes de l'itération sont évaluées au début de l'itération et non réévaluées pendant l'itération, d'où un déphasage entre la situation initiale et la situation au cours des différentes suppressions.

Dans ce cas de figure, où les bornes de l'itération peuvent varier, j'aurais préconisé l'emploi d'un while:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
procedure Tf_comment.FormClose(Sender: TObject; var CloseAction: TCloseAction);
var
  i: integer;
begin
  i := 0;
  while (i<ComponentCount) do
    if Components[i] is TMemo then
      Components[i].Free
    else
      Inc(i);
end;

Fais quand même un test, je ne peux pas le faire.

Cdlt

**Benzouye** · 26/05/2016, 12h20

Envoyé par Jipété

ComponentCount évolue (diminue, en l'espèce)

Comme c'est évident ! Honteux de ne pas avoir trouvé cela avant de poster

Envoyé par Jipété

Faut parcourir la boucle à l'envers

Ok, j'avais trouvé un bout de code avec downto et je le trouvais étrange et l'avais remplacé ...

Du coup je modifie mon code ainsi :

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
procedure Tf_comment.FormClose(Sender: TObject; var CloseAction: TCloseAction);
var
    i:integer;
begin
    showmessage( 'Composants : '+IntToStr(ComponentCount) );
    for i := ComponentCount - 1 downto 0 do
    begin
        showmessage( 'i='+IntToStr( i )+' nb='+IntToStr(ComponentCount) );
        if Components[i] is TMemo then
        begin
            showmessage( 'Free' );
            Components[i].Free;
        end;
    end;
end;

Mais il plante toujours ...
Sur un formulaire avec un seul TMemo s'affiche 3 messages :

Envoyé par showmessage

Composants : 7

Envoyé par showmessage

i=6, nb=7

Envoyé par showmessage

Free

Et plantage ... Apparemment sur le Free ...

Une idée ?

Envoyé par Jipété

pourquoi des guillemets autour de Purge dans le titre ?

Je trouvais le mot trop violent

**e-ric** · 26/05/2016, 12h52

Peux-tu nous montrer le code de création des composants TMemo (événement OnFormShow) ?

Cdlt

**ThWilliam** · 26/05/2016, 13h04

Bonjour,

ton dernier code (FormClose) ne provoque pas d'erreur chez moi (Win 7).

Cela dit, il est préférable de coder : (Components[i] as TMemo).Free;

Remarque :
Si tu as assigné un Owner à tes Memo, c'est lui qui va se charger de la libération. Donc pas de code "free".
Le free des TMemo ne s'impose que si ils n'ont pas d'Owner :

Memo1:= TMemo.Create(nil);

Cordialement
Thierry

**Benzouye** · 26/05/2016, 13h06

A partir de la ligne 70 :

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
procedure Tf_comment.FormShow(Sender: TObject);
var
    h_depart, pos_top, w_marge, w_comment, h_total,
      h_comment, w_label, h_label, id_util, nb_comment : integer;
    nom_util:String;
    n_date, n_util: TLabel;
    n_comment: TMemo;
begin
    // Initialisation des variables de mise en forme
    h_depart := 50;
    pos_top := h_depart;
    nb_comment := 0;
    h_comment := 110;
    w_comment := 400;
    h_label := 20;
    w_marge := 20;
    w_label := 70;
 
    txt_dem.Caption := IntToStr(annee)+' - '+IntToStr(demande);
 
    // Récupération des données dans DBF
    ds_comment.DataSet.Open;
    ds_comment.DataSet.Filtered := false;
    ds_comment.DataSet.Filter:='annee='+IntToStr(annee)+' AND id='+IntToStr(demande);
    ds_comment.DataSet.Filtered := true;
    ds_comment.DataSet.Last;
 
    // Boucle sur les données à afficher
    while not ds_comment.DataSet.BOF do
    begin
      nb_comment := nb_comment + 1;
 
      // TLabel pour date
      n_date := TLabel.Create(self);
      with n_date do
      begin
           name:= 'l_date_'+IntToStr(nb_comment);
           parent:=self;
           Top:=pos_top;
           Left:=w_marge;
           Autosize:=false;
           Wordwrap:=true;
           Width:= w_label;
           Caption:=ds_comment.DataSet.FieldByName('date_heure').AsString;
           Height:= h_label;
      end;
 
      // TLabel pour utilisateur
      n_util := TLabel.Create(self);
      id_util := ds_comment.DataSet.FieldByName('id_user').AsInteger;
      if ds_user.DataSet.Locate('id_user', varArrayOf([id_util]),[]) = true then
         nom_util := ds_user.DataSet.FieldByName('username').AsString
      else
         nom_util := 'Inconnu';
 
      with n_util do
      begin
           name:= 'l_util_'+IntToStr(nb_comment);
           parent:=self;
           Top:=pos_top + h_label;
           Left:=w_marge;
           Autosize:=false;
           Wordwrap:=true;
           Width:=w_label;
           Caption:= nom_util;
           Height:= h_label;
      end;
 
      // TMemo pour commentaires
      n_comment := TMemo.Create(self);
      with n_comment do
      begin
           name:= 'm_memo_'+IntToStr(nb_comment);
           parent:=self;
           Top:=pos_top;
           Left:= w_label + ( 2 * w_marge );
           Width:=w_comment;
           Text:=ds_comment.DataSet.FieldByName('commentair').AsString;
           Height:=h_comment;
           ScrollBars:= ssAutoVertical;
           ReadOnly:=true;
      end;
 
      pos_top := pos_top + h_comment + w_marge;
      ds_comment.DataSet.Prior;
    end;
    ds_comment.DataSet.Close;
 
    // Positionnement de la fenêtre formulaire
    h_total:= h_depart + ( nb_comment * ( h_comment + w_marge ) );
    if h_total > hauteur_ecran then
        height := hauteur_ecran
    else
       height := h_total;
    top := round( ( hauteur_ecran - Height )/2);
    left := largeur_ecran-width;
end;

Merci pour le temps passé

**Benzouye** · 26/05/2016, 13h38

Si je teste mon code avec un formulaire qui a plus d'un TMemo attachés, le code ne plante que sur le dernier, mais si je force l'exécution après l'erreur, tous les TMemo sont bien supprimé (?!), puis l'appli se ferme brutalement (!?) à i=0 ...

Envoyé par ThWilliam

Si tu as assigné un Owner à tes Memo, c'est lui qui va se charger de la libération.

A quel moment ? Quel événement ?
Mon formulaire lui n'est pas créé dynamiquement, il est ouvert et fermé potentiellement plusieurs fois au runtime ... Mauvaise pratique ?
Sinon je passe toujours self à la création c'est donc le formulaire qui est owner ici.

**e-ric** · 26/05/2016, 13h40

Envoyé par ThWilliam

Cela dit, il est préférable de coder : (Components[i] as TMemo).Free;

Cela ne me semble pas nécessaire, car Free (méthode non virtuelle) invoque Destroy qui est virtuelle donc a priori adaptée à l'objet cible.

Envoyé par ThWilliam

Si tu as assigné un Owner à tes Memo, c'est lui qui va se charger de la libération. Donc pas de code "Free".
Le free des TMemo ne s'impose que si ils n'ont pas d'Owner :

Memo1:= TMemo.Create(nil);

Oui, j' y ai pensé au début mais je me suis ravisé, car les TMemo ne suivent pas le cycle de vie de la fiche, ils sont instanciés au FormShow et libérés dans le FormClose, ce qui ne suppose pas la libération de la fiche.
-> Mais, est-ce que la fiche est libérée après la fermeture ?

Je ne vois pas trop d'où vient ton problème, d'autant que Thierry n'a pas reproduit l'erreur dans son essai. Est-ce le code du FormClose est complet ou as-tu éliminé certaines instruction pour le publier dans cette discussion ?

As-tu essayé le code que j'avais proposé même si je suis assez pessimiste, vu la bizarrerie de ton problème.

Cdlt

**e-ric** · 26/05/2016, 13h46

Envoyé par Benzouye

Mon formulaire lui n'est pas créé dynamiquement, il est ouvert et fermé potentiellement plusieurs fois au runtime ... Mauvaise pratique ?
Sinon je passe toujours self à la création c'est donc le formulaire qui est owner ici.

Effectivement, cela ne devrait pas poser problème. As-tu d'autres composant TMemo mais qui seraient placés en conception ?

Une idée serait de déboguer en utilisant les bibliothèques de débogage pour voir à partir d'où cela plante.

Cdlt

**Benzouye** · 26/05/2016, 13h47

Le code du formShow est bien complet.

Envoyé par Benzouye

Mon formulaire lui n'est pas créé dynamiquement, il est ouvert et fermé potentiellement plusieurs fois au runtime ... Mauvaise pratique ?

Je fais cette démarche de libération car sinon les TMemo s'empilaient à chaque réouverture du formulaire.
Dans un premier temps j'ai fais du Hide dans la boucle, mais je me suis dis que Free serait quand même plus pertinent ...

Envoyé par Benzouye

Si je teste mon code avec un formulaire qui a plus d'un TMemo attachés, le code ne plante que sur le dernier, mais si je force l'exécution après l'erreur, tous les TMemo sont bien supprimé (?!), puis l'appli se ferme brutalement (!?) à i=0 ...

ça me déroute complètement ...
La première erreur m'ouvre le fichier custommemo.inc sur la procédure TCustomMemo.RealSetText ...
Si je continue l'exécution malgré tout, l'appli se ferme brutalement sans message comme si un Application.Terminate était exécuté ...

**e-ric** · 26/05/2016, 14h03

Peux-tu essayer cela ?

Code :

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

1
2
3
4
5
6
7
8
9
10
11
procedure Tf_comment.FormClose(Sender: TObject; var CloseAction: TCloseAction);
var
  i: integer;
begin
  i := 0;
  while (i<ComponentCount) do
    if Components[i] is TMemo then
      Components[i].Free
    else
      Inc(i);
end;

NB : le compteur n'est modifié que si l'on ne supprime pas le composant désigné.

Cdlt

**ThWilliam** · 26/05/2016, 14h16

Re-bonjour,

Evidemment, il faut savoir de quelle Form on parle !

S'il s'agit de la fiche principale du programme : le FormClose va entrainer le FormDestroy et le programme va s'arrêter.
S'il s'agit d'une fiche secondaire, mais créée automatiquement : le FormClose ne va pas libérer ses composants, la fiche va simplement devenir invisible, elle ne se libère pas. Donc il est normal, à chaque formShow d'avoir une création supplémentaire de TMemo. Pourquoi créer les memos dans FormShow et non pas dans FormCreate ? Là, on les crée une fois pour toutes.

Petit code démontrant que les composants créés dynamiquement avec déclaration d'Owner sont bien libérés lors du Destroy de la fiche.

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
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    procedure FormShow(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
 
  TMyPanel = class(TPanel)
    public
      destructor Destroy; override;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
destructor TMyPanel.Destroy;
begin
   Showmessage('free de mypanel');
   inherited destroy;
end;
 
procedure TForm1.FormShow(Sender: TObject);
begin
   with TMyPanel.Create(self) do
   begin
      Parent:= self;
      Left:= 100;
      Top:= 100;
   end;
end;
 
end.

Cordialement
Thierry

**Benzouye** · 26/05/2016, 14h41

Envoyé par e-ric

Peux-tu essayer cela ?

Même punition ...

Envoyé par e-ric

Une idée serait de déboguer en utilisant les bibliothèques de débogage pour voir à partir d'où cela plante.

Je ne sais pas de quoi l'on parle ici, mais cela m'intéresse ... Connais-tu un lien vers une ressource pour mettre en place un débogage plus poussé ?
Directement dans les options de débogage ?

Envoyé par ThWilliam

Pourquoi créer les memos dans FormShow et non pas dans FormCreate ?

Pour expliquer un peu plus. Mon appli permet de créer des demandes d'intervention. Chaque demande peut se voir ajouter des commentaires (date, nom et mémo).
Depuis la fiche d'une demande (formulaire) un bouton permet de visualiser les commentaires associés (ceci dans le fameux formulaire qui me pose problème).
Ce formulaire est fixe pour une partie, mais variable dans son contenu. Lorqu'il s'ouvre je recherche les commentaires liés à la demande en cours et les affiches sous forme de mémo (ce type n'est pas imposé d'ailleurs). Lorsque l'on ferme ce formulaire, il me faut le purger en prévision d'une prochaine ouverture avec une autre demande donc d'autres commentaires ...

Je suis ouvert à critique sur cette organisation, mais je suis vraiment débutant avec FreePascal et Lazarus, en pleine courbe d'apprentissage

**ThWilliam** · 26/05/2016, 15h00

Je n'ai pas testé, mais le problème pourrait être à la création des memos.
Pour tous tes mémos, tu utilises la même variable (n_comment).
Voilà, je crois, ce qui devrait désorienter le plus fin des compilateurs.

Dans ton code, supprime ceci :

Code :

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

1
2
n_comment := TMemo.Create(self);
 with n_comment do

et remplace par :

Code :

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

with TMemo.Create(self) do

**Benzouye** · 26/05/2016, 15h33

Envoyé par ThWilliam

Code :

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

with TMemo.Create(self) do

Même punition.

Pour test, j'ai remplacer mes TMemo par des TLabel (ce qui ne me convient pas dans ce contexte) et plus d'erreur ...

C'est donc un problème avec la libération de TMemo ... non ?

**e-ric** · 26/05/2016, 16h24

Peut-être un bug de la LCL, ce ne serait pas le premier, d'autant plus que ton code semble bon.

Pourquoi n'utilises-tu pas un DBGrid ? de quel type (au sens de la base de données) est le champ commentair ?

quelle version de Lazarus utilises-tu ?

**Benzouye** · 26/05/2016, 17h00

Ma colonne DBF est de type ftMemo. Je n'utilise pas de DBGrid car je n'ai pas réussi à afficher correctement un texte long (jusqu'à 12 lignes sur une largeur de 400) dans une cellule ...
Dans un premier temps j'étais parti là-dessus, sauf qu'en standard le DBGrid affiche "(MEMO)" au lieu du contenu. J'ai réussi à résoudre ce problème en surchargeant DrawColumnCell et PrepareCanvas.
De plus, en standard le DBGrid n'adapte pas la hauteur des lignes au contenu multilignes. Je n'ai pas réussi à résoudre ce problème ... donc je suis parti sur un formulaire séparé avec des Memo avec scrollbars ...
Si tu as une astuce pour modifier ligne à ligne la hauteur en fonction du contenu, je suis preneur

Après le problème avec les TMemo, je suis passé sur des TLabel que je dimensionne en hauteur en fonction du texte contenu et cela fonctionne suffisamment bien ... Mais je suis un peu déçu de ne pas y arriver ...

Et j'utilise la v1.6RC2 de Lazarus (fpc 3 il me semble) sur win7 64.

**anapurna** · 26/05/2016, 17h35

bonsoir,

le code dans le formShow ce n'est pas forcement on bonne idée ...
dans ton cas je préfère créer une Méthode du

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
Procedure Tf_comment.GenereAndShow(annee,demande : Integer);
var
  h_depart, pos_top, w_marge, w_comment, h_total,h_comment, w_label, h_label, id_util, nb_comment : integer;
  nom_util:String;
  n_date, n_util: TLabel;
  n_comment: TMemo;
begin
  // Initialisation des variables de mise en forme
  h_depart := 50;
  pos_top := h_depart;
  nb_comment := 0;
  h_comment := 110;
  w_comment := 400;
  h_label := 20;
  w_marge := 20;
  w_label := 70;
 
  txt_dem.Caption := IntToStr(annee)+' - '+IntToStr(demande);
 
  // Récupération des données dans DBF
  ds_comment.DataSet.Open;
  ds_comment.DataSet.Filtered := false;
  ds_comment.DataSet.Filter:='annee='+IntToStr(annee)+' AND id='+IntToStr(demande);
  ds_comment.DataSet.Filtered := true;
  ds_comment.DataSet.Last;
 
  // Boucle sur les données à afficher
  while not ds_comment.DataSet.BOF do
  begin
    nb_comment := nb_comment + 1;
    // TLabel pour date
    n_date := TLabel.Create(self);
    with n_date do
    begin
      name:= 'l_date_'+IntToStr(nb_comment);
      parent:=self;
      Top:=pos_top;
      Left:=w_marge;
      Autosize:=false;
      Wordwrap:=true;
      Width:= w_label;
      Caption:=ds_comment.DataSet.FieldByName('date_heure').AsString;
      Height:= h_label;
    end;
 
      // TLabel pour utilisateur
    n_util := TLabel.Create(self);
    id_util := ds_comment.DataSet.FieldByName('id_user').AsInteger;
    if ds_user.DataSet.Locate('id_user', varArrayOf([id_util]),[]) = true then
       nom_util := ds_user.DataSet.FieldByName('username').AsString
    else
      nom_util := 'Inconnu';
 
    with n_util do
    begin
      name:= 'l_util_'+IntToStr(nb_comment);
           parent:=self;
           Top:=pos_top + h_label;
           Left:=w_marge;
           Autosize:=false;
           Wordwrap:=true;
           Width:=w_label;
           Caption:= nom_util;
           Height:= h_label;
      end;
 
      // TMemo pour commentaires
      n_comment := TMemo.Create(self);
      with n_comment do
      begin
           name:= 'm_memo_'+IntToStr(nb_comment);
           parent:=self;
           Top:=pos_top;
           Left:= w_label + ( 2 * w_marge );
           Width:=w_comment;
           Text:=ds_comment.DataSet.FieldByName('commentair').AsString;
           Height:=h_comment;
           ScrollBars:= ssAutoVertical;
           ReadOnly:=true;
      end;
 
      pos_top := pos_top + h_comment + w_marge;
      ds_comment.DataSet.Prior;
    end;
    ds_comment.DataSet.Close;
 
    // Positionnement de la fenêtre formulaire
    h_total:= h_depart + ( nb_comment * ( h_comment + w_marge ) );
    if h_total > hauteur_ecran then
        height := hauteur_ecran
    else
       height := h_total;
  top := round( ( hauteur_ecran - Height )/2);
  left := largeur_ecran-width;
  Show;// ou showmodal le cas écheant 
end;

**ThWilliam** · 26/05/2016, 17h39

Avec des labels, pas de problèmes ?

A la différence d'un TLabel, un TMemo est un composant focalisable.
Serait-ce un problème de libération du memo qui a le focus ?
En principe, non... mais...

Si sur ta fiche, tu as un composant focalisable, attribue-lui le focus au début de ta procedure OnClose.
Sinon, pour tester, tu places un TButton (qui ne sert à rien) et tu lui donnes le focus.

Purge de composants dynamiques sur formulaire

Lazarus Pascal

Discussions similaires

Partager

Partager