[fpc-pascal] Freeing dynamic controls

[Frederic Da Vitoria]

Hello,

In the following program, I get a runtime error I don't understand. This is
a stripped down version of the code. This was written in Delphi 1, I'll end
up rewriting this in a completely different manner, but for the sake of
understanding, could someone explain to me what is wrong here?

The program dynamically creates and frees controls. To make it simple,
dynamically created ShapeButtons are inserted as children of a dynamically
created Panel, and the code only frees this Panel, hoping that this will
trigger freeing the children controls. IIUC, this hasn't changed since
Delphi 1 and it is still how it is supposed to work. When I put a
breakpoint in line 79, I do see the Panel being freed. Furthermore, if I
debug the program in 1.0.14, the program breaks 12 times on wincontrol.inc
line 5214, this being triggered by the call to RemoveControl on line 78. I
can't make it break on the matching line 5209 in 1.2RC1.

But (and this is my issue) the program triggers a "Duplicate name"
exception on line 60. So although the successful v1.0.14 breakpoint in
wincontrol.inc seems to mean that the controls were freed, the "Duplicate
Name" would mean that this was not true.

Can someone explain what is going on here?

unit Memoire2;

{$MODE Delphi}

interface

  uses
    Sysutils, Forms, ExtCtrls, Controls, StdCtrls, Classes, Buttons;

  type

    TForm1 = class(TForm)
      btn_New: TBitBtn;
      procedure DisplayForm ;
      procedure FormInit (Sender: TObject);
      procedure btn_NewClick(Sender: TObject);
    private
      { Private declarations }
    public
      { Public declarations }
    end;

    TShapeButton = class(TButton)
    private
      { Private declarations }
    public
      { Public declarations }
      Col, Lin : integer ;
    end;

  var
    b_Columns : byte ;
    b_Lines : byte ;
    Col1, Lin1, Col2, Lin2 : integer ;
    Form1: TForm1;
    tp_Panel : TPanel ;

  const
    FORM_MARGIN = 10 ;
    MAIN_FRAME_TAG = 999 ;

implementation

  {$R *.lfm}

  procedure TForm1.DisplayForm ;
  var
    wh, ww : integer ;
    procedure SetButton (pc, pl : byte) ;
    var
      newbutton : TShapeButton ;
      wt, wl : integer ;
    begin
      newbutton := TShapeButton.Create (Self) ;
      wt := (pl-1) * (tp_Panel.Height-1) div b_Lines ;
      wl := (pc-1) * (tp_Panel.Width-1) div b_Columns ;
      with newbutton do begin
        name := 'sb'+inttostr(pc)+'_'+inttostr(pl) ;
        caption := '' ;
        SetBounds (wl, wt, wh, ww) ;
      end {with} ;
      newbutton.col := pc ;
      newbutton.lin := pl ;
      newbutton.Parent := tp_Panel
//      tp_Panel.InsertControl (newbutton) { old code, does not work any
better }
    end ;
  var
    c1, l1 : byte ;
    wc : TControl ;
  begin
    c1 := 0 ;
    while c1 < (ControlCount) do begin
      if Controls [c1] .Tag = MAIN_FRAME_TAG
        then begin
          wc := Controls [c1] ;
          RemoveControl (wc) ;
          wc.Free
        end {then}
        else Inc (c1)
    end {while} ;
    wh := (Form1.ClientHeight - 2*FORM_MARGIN) div b_Lines ;
    ww := (btn_New.Left - 2*FORM_MARGIN) div b_Columns ;
    if wh < ww { rend les cases carrées }
      then ww := wh
      else wh := ww ;
    tp_Panel := TPanel.Create (Self) ;
    tp_Panel.ParentColor := TRUE ;
    tp_Panel.Tag := MAIN_FRAME_TAG ; { tags the control for deletion }
    with tp_Panel do begin
      SetBounds (FORM_MARGIN, FORM_MARGIN, ww*b_Columns, wh*b_Lines) ;
      BevelOuter := bvNone
    end {with} ;
    wh := (tp_Panel.Height-1) div b_Lines - 3 ;
    ww := (tp_Panel.Width-1) div b_Columns - 3 ;
    if wh < ww
      then ww := wh
      else wh := ww ;
    for c1 := 1 to b_Columns do
      for l1 := 1 to b_Lines do
        SetButton (c1, l1) ;
    InsertControl (tp_Panel) ;
    btn_New.Enabled := TRUE
  end;

  procedure TForm1.FormInit (Sender: TObject);
  begin
    DisplayForm ;
  end;

  procedure TForm1.btn_NewClick(Sender: TObject);
  begin
    DisplayForm ;
  end;

begin
  b_Lines := 3 ;
  b_Columns := 4 ;
end.

-- 
Frederic Da Vitoria
(davitof)

Membre de l'April - « promouvoir et défendre le logiciel libre » -
http://www.april.org
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freepascal.org/pipermail/fpc-pascal/attachments/20131217/c482c007/attachment.html>