Détruire des objets créés dynamiquement ne fonctionne pas toujours bien

**Jipété** · 08/10/2021, 12h21

Bonjour,

je n'ai pas trop eu le temps de venir par ici ces derniers jours, une application me monopolisant à 200 %...

Mais maintenant je fais face à un os sévère et je vais avoir besoin de vos lumières : le problème est présent dans la vieille machine 32 bits Laz 1.4 et dans la nouvelle 64 bits / Laz 2.0.12 :

Soit une procédure qui crée dynamiquement des TFrames posées alClient dans des TPanels créés eux aussi dynamiquement avec alTop et tout se passe bien (c'est pour afficher des trucs genre Audacity).

Sauf quand je veux détruire les frames présentes pour en créer des nouvelles, après chargement d'autres fichiers, et là ça coince grave :

Soit une liste de 3 fichiers, et un code où j'appelle ShowMessage avant et après Objet.Free.
je fais F9 et tout se passe bien jusqu'à la destruction des objets existants puis la tentative de recréation de 2 (ou autres, ça n'a pas d'incidence) objets et là, bim ! :

Envoyé par Lazarus

Le projet a levé une classe d'exception "EComponentError" avec le message :
Duplicate name : A component named "frm2" already exists.

Le plus bizarre c'est que si je demande à voir les objets contenus dans le Parent de la frame courante (le TPanel créé dynamiquement), il n'y a pas de Components.
Et pourtant j'ai ce message à la noix...

J'ai essayé avec .Destroy au lieu de .Free et vous le devinez, c'est pareil, tout comme avec FreeAndNil. Je ne sais plus quoi faire pour virer ces objets inexistants mais toujours présents quelque part

La proc dans la presque intégralité :

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 TForm1.CreationFrame(idx: cardinal; dest: TWinControl);
var
  frame: TFrm;
begin
  frame:= TFrm.Create(nil); // ces 5 lignes n'existent pas, au départ : je comptais sur le Free...
  frame.Name := 'frm'+IntToStr(idx);
  if assigned(frame) then ShowMessage(frame.Name+' avant frame.Free'); // toujours vu
  if assigned(frame) then frame.Free;
  if assigned(frame) then ShowMessage(frame.Name+' après frame.Free'); // également vu MAIS PAS le NAME ! donc frame est encore à moitié "assigned"
 
  frame := CreateNewFrame(Self, Dest, 'frm'+IntToStr(idx)); // 1er passage tout va bien, second passage le message + haut.
  with frame do begin
  // qq lignes virées pour ne pas alourdir ici, elles n'ont rien à voir avec le pb
  end;
end;

Cerise sur la gâteau de l'incompréhension, je détruis également le Parent de l'objet, donc l'objet devrait l'être également, non ?
Ce qui est curieux, c'est qu'il doit l'être à moitié car son nom n'est pas affiché au second ShowMessage.

Une bonne idée, quelqu'un, pour détruire totalement ces objets récalcitrants ?

Merci,

**BeanzMaster** · 08/10/2021, 16h56

Salut JP

Voici comment je fait pour créer mes TFrame dynamique dans un de mes projets

En 1 j'ai mon unité décrivant mon TFrame (je n'ai pas tout mis, pour ne pas alourdir le code) :

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
unit uMyFrame;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  LCLType, Classes, SysUtils, Forms, Controls, ExtCtrls, StdCtrls, Spin, ComCtrls, Dialogs,
  Graphics;
 
type
 
  { TMyFrame }
 
  TMyFrame = class(TFrame)
 pnlTitle : TPanel;
    imgTitleFilterGlyph : TImage;
    lblTitleFrame : TLabel;
    gbxSelectTone : TGroupBox;
    chkShadowTone : TCheckBox;
    chkMidTone : TCheckBox;
    chkHighlightTone : TCheckBox;
    Bevel1 : TBevel;
    pnlParam1 : TPanel;
    lblParam1 : TLabel;
    fseFactor1 : TFloatSpinEdit;
    tbFactor1 : TTrackBar;
    //...
    procedure DoNotifyChange(Sender : TObject);
    procedure SliderChange(Sender : TObject);
    procedure tbFactor1MouseUp(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
  private
     FOnParamChange : TNotifyEvent;
 
 
  public
    DoApplyChange : Boolean;
    FDataChangeCount : Byte;
 
    function ApplyOnShadowTone : Boolean;
    function ApplyOnMidTone : Boolean;
    //...
 
    function GetParam1 : Single;
    function GetParam2 : Single;
    function GetColorA : TBZColor;
    //...
    function GetColorB : TBZColor;
 
    property OnParamChange : TNotifyEvent read FOnParamChange write FOnParamChange;
  end;
 
  // fonction pour créer dynamiquement mon TFrame et initialiser les valeurs des composants et autres propriétés
  function CreateMyFrame(TheOwner :  TComponent; Title : String; GlyphTitle : TBitmap; ShowSelectTone, ShadowTone, MidTone, HighlightTone, PreserveLum, ShowPreserveLum : Boolean; ParamLabel1, ParamLabel2, ParamLabel3, ParamLabel4, ColorLabel1, ColorLabel2, CheckLabel : String; ParamChangeEvent : TNotifyEvent) : TFrame;
 
implementation
 
uses
  BZMath;
 
function CreateCommonFilterExFrame(TheOwner :  TComponent; Title : String; GlyphTitle : TBitmap; ShowSelectTone, ShadowTone, MidTone, HighlightTone, PreserveLum, ShowPreserveLum : Boolean; ParamLabel1, ParamLabel2, ParamLabel3, ParamLabel4, ColorLabel1, ColorLabel2, CheckLabel : String; ParamChangeEvent : TNotifyEvent) : TFrame;
Var
  Frame : TMyFrame;
  cnt : Byte;
begin
  cnt := 0;
  Frame := TCommonFilterExFrame.Create(TheOwner);
  Frame.lblTitleFrame.Caption := Title;
  Frame.chkPreserveLuminosity.Checked := PreserveLum;
  Frame.chkPreserveLuminosity.Visible := ShowPreserveLum;
  Frame.chkShadowTone.Checked := ShadowTone;
  Frame.chkMidTone.Checked := MidTone;
  Frame.chkHighlightTone.Checked := HighlightTone;
  Frame.gbxSelectTone.Visible := ShowSelectTone;
 
  Frame.imgTitleFilterGlyph.Picture.Bitmap.Assign(GlyphTitle);
  Frame.DoApplyChange := False;
  Frame.FDataChangeCount := 0;
  if ParamLabel1 <> '' then
  begin
    Frame.lblParam1.Caption := ParamLabel1;
    Frame.pnlParam1.Visible := True;
    inc(cnt);
  end;
  if ParamLabel2 <> '' then
  begin
    Frame.lblParam2.Caption := ParamLabel2;
    Frame.pnlParam2.Visible := True;
    inc(cnt);
  end;
  //...
  Frame.Constraints.MaxHeight := Max(Frame.Constraints.MinHeight, Frame.Constraints.MaxHeight - (cnt * 28));
  Frame.Height := Frame.Constraints.MaxHeight;
 
  Frame.OnParamChange := ParamChangeEvent;
  Result := Frame;
end;
//...
end.

Ensuite dans ma fiche principale

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
unit uMainForm;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Types, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Menus, ComCtrls, ActnList, StdCtrls, ShellCtrls, ExtDlgs, Buttons,
  XMLPropStorage, LazFileUtils //...;
 
type
 
  { TMainForm }
  TFrameType = (fstCommonFilter, fstCommonFilterEx, fstCommonFilterBlur, fstMotionFilterBlur);
 
  TMainForm = class(TForm)
    pnlFrame : TPanel; // Si tu les panels sont créés dynamiquement déclarer un array of TPanle dans la section private
  private
    FInternalFrame : TFrame; // si tu plusieurs frame en même temps il faut faire un array of TFrame
    procedure InitFrame(Idx : Integer); // ou par exemple en paramètre tu peux passer le TframeType + d'autres parmètres supplémentaire que tu as besoin
  end;
 
var
  MainForm : TMainForm;
 
implementation
 
{$R *.lfm}
 
Uses
  uMyFrame;
 
procedure TMainForm.InitFilterUI(Idx : Integer);
Var
  bmp : TBitmap;
  sl : TStringList;
begin
  if Assigned(FInternalFrame) then // ici il est important de vérifier si ta frame existe déja
  begin
    FreeAndNil(FInternalFrame); // si oui on libère avec FreeAndNil c'est important de mettre la variable à NIL
  end;
  Case Idx of
    0 :  // Ajustement du Contraste
    begin
      bmp := TBitmap.Create;
      DMMain.ImageList.GetBitmap(38, Bmp);
      pnlSettingsTool.Height := 180;
      FInternalFrame := CreateMyFrame(pnlSettingsTool,'Ajuster le contraste',bmp,True,true,true, true, false, true,'Facteur : ','','','','','','', @HandleFilterChangeSettings);
      pnlSettingsTool.Height := 35 + FInternalFrame.Constraints.MaxHeight;
      FInternalFrame.Parent := pnlSettingsTool;
      FInternalFrame.Align := alClient;
      Bmp.Free;
    end;
    1 :  // Ajustement de la luminositée
    begin
      bmp := TBitmap.Create;
      DMMain.ImageList.GetBitmap(39, Bmp);
      pnlSettingsTool.Height := 180;
      FInternalFrame := CreateMyFrame(pnlSettingsTool,'Ajuster la luminosité',bmp,True,true,true, true, false, false,'Facteur : ','','','','','','', @HandleFilterChangeSettings);
      pnlSettingsTool.Height := 35 + FInternalFrame.Constraints.MaxHeight;
      FInternalFrame.Parent := pnlSettingsTool;
      FInternalFrame.Align := alClient;
      Bmp.Free;
    end;
    //...
  end;
  pnlSettingsTool.Visible := True;
end;
 
//...
end.

Comme tu le vois je ne set pas le name de la frame, je laisse Lazarus gérer en interne.

Petite question la fonction CreateNewFrame ca vient de Lazarus ? je ne me souviens plus.

Ensuite lors de la destruction de ton panel tu devrais avoir un truc dans le genre qui devrait suffire :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
function DestroyFrame(idx : integer);
begin
  //FMyFrames : array of TMyFrame;
   if Assigned(FMyFrames[idx]) then 
  begin
    FreeAndNil(FMyFrames[idx]); 
  end;
  // FMyPanels : array of TPanel; 
  if assigned(FMyPanels[idx]) then
  begin
   freeAndNil(FMyPanels[idx]
  end;
end;

Voilà j'espère que cela t'aidera

A mon avis le problème viendrait du fait que que le cache de l'application n'est pas mis à jour automatiquement. As tu essayé de mettre un application.processMessages ? histoire de voir.
Je sais qu'il y a truc avec les frames, car j'avais eu un soucis similaire et j'avais bien galéré si je me souviens bien

A+
Jérôme

**Jipété** · 08/10/2021, 19h58

Bonsoir Jérôme,

Merci pour ta réponse.
Ce qui m'a surpris c'est "je ne set pas le name de la frame, je laisse Lazarus gérer en interne."

Partant de là, j'ai mis en commentaire l'affectation d'un nom explicite aux frames que je crée, j'ai fait tourner et ça n'a pas traîné : la même erreur de recréation d'un objet déjà existant car mal détruit...
La seule différence c'est que ça m'envoie bouler avec "duplicate name frm" au lieu de frm1 frm2 etc.

J'ai tenté avec if Assigned(FMyFrame) then FreeAndNil(FMyFrame); (après tout, je n'ai qu'une frame par panel) mais le résultat est identique.
Tout comme avec if assigned(frame) then begin frame.Free; frame := nil; end; trouvé là https://stackoverflow.com/questions/...create-destroy et comme on y cause de Delphi, j'en conclus que ça fonctionne sous Windows, et pas sous Linux, truc de malade !

On récapitule :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
procedure TForm1.CreationFrame(idx: cardinal; dest: TWinControl);
var
  frame: TFrm;
begin
  frame:= TFrm.Create(nil);
  frame.Name := 'frm'+IntToStr(apc-idx);
  if assigned(frame) then ShowMessage(frame.Name+' avant destruction');  // frm1 avant destruction -- toujours vu, normal
  if assigned(frame) then begin frame.Free; frame := nil; end;
  //if assigned(frame) then frame.Destroy;
  //if assigned(frame) then FreeAndNil(frame);
  if assigned(frame) then ShowMessage(frame.Name+' après destruction'); // vu après Frame.Destroy
  // pas vu après frame.free; frame:=nil; ni après FreeAndNil(frame) mais malgré ce qu'on pourrait croire ("ouais, la frame est bien détruite"), 
  // hé bien non, car l'erreur "Duplicate name frmX (ou frm, selon que le Name est utilisé ou pas)" continue à apparaître...

Envoyé par BeanzMaster

Petite question la fonction CreateNewFrame ca vient de Lazarus ? je ne me souviens plus.

La réponse est "non" mais je ne me souviens pas d'où ça sort.

Envoyé par BeanzMaster

A mon avis le problème viendrait du fait que que le cache de l'application n'est pas mis à jour automatiquement. As-tu essayé de mettre un application.processMessages ? histoire de voir.

Pareil,

Et c'est quoi cette histoire de "cache de l'application" ?

Envoyé par BeanzMaster

Je sais qu'il y a truc avec les frames, car j'avais eu un souci similaire et j'avais bien galéré si je me souviens bien

Ce qui ne me rassure pas...

**BeanzMaster** · 08/10/2021, 20h46

Envoyé par Jipété

Bonsoir Jérôme,

Merci pour ta réponse.
Ce qui m'a surpris c'est "je ne set pas le name de la frame, je laisse Lazarus gérer en interne."

Envoyé par Jipété

Partant de là, j'ai mis en commentaire l'affectation d'un nom explicite aux frames que je crée, j'ai fait tourner et ça n'a pas traîné : la même erreur de recréation d'un objet déjà existant car mal détruit...
La seule différence c'est que ça m'envoie bouler avec "duplicate name frm" au lieu de frm1 frm2 etc.

J'ai tenté avec if Assigned(FMyFrame) then FreeAndNil(FMyFrame); (après tout, je n'ai qu'une frame par panel) mais le résultat est identique.
Tout comme avec if assigned(frame) then begin frame.Free; frame := nil; end; trouvé là https://stackoverflow.com/questions/...create-destroy et comme on y cause de Delphi, j'en conclus que ça fonctionne sous Windows, et pas sous Linux, truc de malade !

La réponse est "non" mais je ne me souviens pas d'où ça sort.

Le problème a mon avis c'est que tu mets nil à la création de ta FRAME dans mon exemple le Owner est le TPanel au pire faudrait mettre la MainForm.

Envoyé par Jipété

Pareil,

Et c'est quoi cette histoire de "cache de l'application" ?

Lazarus stocke les objet créé dans un tableau pour garder la trace ca serai la propriétés Controls/Components dans les objets

Envoyé par Jipété

Ce qui ne me rassure pas...

Oui, mais au final j'ai trouvé et c'est le code que j'ai mis précédemment et ca fonctionne nickel sous Windows et Linux

Essayes juste comme ça :

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
TMainForm = class(TForm)
private
  FMyFrame : TFrame;
 
  procedure CreationFrame(dest: TPanel);
end;
 
implementation
 
uses uFrm;
 
procedure TForm1.CreationFrame(dest: TPanel);
begin
  if Assigned(FMyFrame) then 
  begin
    FreeAndNil(FMyFrame); 
  end;
  FMyFrame = TFrm.Create(dest); // ou TFrm.Create(MainForm) ce qui devrait permettre de changer de panel car le parent sera global et non plus lié a un panel précis 
  FMyFrame.Parent := dest;
  FMyFrame.Align := alClient;
end;

Attention ici tu peux assigner que une seule frame sur un seul panel. Car si tu change de Panel, l'instance précédemment créer sera détruite. D'ou de faire un array of TFrame pour gérer tes idx

**Jipété** · 09/10/2021, 14h30

Salutàtous !

Envoyé par BeanzMaster

Le problème à mon avis c'est que tu mets nil à la création de ta FRAME dans mon exemple le Owner est le TPanel au pire faudrait mettre la MainForm.

Bien vu ! Ça va très bien avec le TPanel car c'est lui qui est détruit en cas de re-création, et il entraîne sa frame-enfant dans sa chute.

Et voili et voilou, et bon week-end et merci pour tout !

Détruire des objets créés dynamiquement ne fonctionne pas toujours bien [Lazarus]

Lazarus Pascal

Discussions similaires

Partager

Partager