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
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
