I'm working in Delphi 1, version 1.47.136.0, under Windows 3.1. Here is
a new bug I've found, one that was not on the Delphi Bug List maintained
in the Netherlands, and I have now reported it to them.
I'm dynamically creating MDI child forms, putting panels on the forms,
and putting tBitBtns on the panels. I was getting GPFs under some
circumstances when trying to free the tBitBtns. These GPFs do not occur
if the panel is made invisible or if it is given a non-MDI-Child parent
before the button is deleted.
Here is the code for a small test project that creates the forms,
panels, and buttons and that gives the user a choice of circumstances to
try deleting the tBitBtn. Further operating instructions are in the
comments at the top of the program. Note that sometimes the first
attempt to delete the button works without a problem, and that the
problem occurs only on the second attempt.
------------------ start code here -----------------------------------
unit Bug02;
{Demonstration of a very obscure Delphi 1 bug. If a tBitBtn is placed
on a
tPanel on an MDI child form, then freeing the button causes a GPF if
the
panel is visible and its parent is the child form. However, changing
either the visibility or the parentage of the panel avoids the GPF.
The
problem does not occur if the panel is on the base form, only on one of
the child forms.
To see the demonstration of the problem, click the "Create MDI child"
button
at least six times. Set the radio button to "Visible, on MDI parent"
and
click "Delete top MDI child". It will work delete properly. Set the
radio
button to "Invisible, on MDI child" and click "Delete top MDI child"
again.
It will still work. Set the radio button to "Visible, on MDI child"
and
press "Delete fixed panel". It will work. Now click on "Delete top MDI
child" one last time. You will not always get a GPF the first time,
but
you will eventually get one. Also, if you have only one child form at
the time, you may not get it.}
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, StdCtrls, ExtCtrls, Buttons, Menus;
type
TForm1 = class(TForm)
CreateButton: TButton;
Scroller: TMemo;
DelTopButton: TButton;
FixedPanel: TPanel;
DelFixedButton: TButton;
DeletionModeGroup: TRadioGroup;
procedure CreateButtonClick(Sender: TObject);
procedure RefocusButtonClick(Sender: TObject);
procedure DelTopButtonClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
procedure Beep(Sender: tObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
Child1: TForm;
implementation
{$R *.DFM}
type ItProc=Procedure(Sender: Pointer);
procedure TForm1.Beep(Sender: tObject);
begin
Scroller.Lines.Add((Sender as tForm).Caption+' activated');
MessageBeep(0)
end;
procedure TForm1.CreateButtonClick(Sender: TObject);
const N: integer=0;
var Form: tForm;
Panel: tPanel;
Thing: tBitBtn;
begin
if (Sender=nil) then
Panel:=FixedPanel
else begin
Inc(N);
Form:=tForm.Create(Self);
Form.Name:='Form_'+IntToStr(N);
Form.FormStyle:=fsMDIChild;
Form.Height:=200;
Form.Width:=200;
Form.Top:=20*MDIChildcount;
Form.Left:=20*MDIChildcount;
Form.OnActivate:=Beep;
if (N=1) then
Child1:=Form;
Panel:=tPanel.Create(Self);
Panel.Align:=alClient;
Panel.Parent:=form
end;
Thing:=tBitBtn.Create(Self);
Thing.Parent:=Panel;
Thing.Top:=0;
Thing.Caption:='Do nothing';
end;
procedure TForm1.RefocusButtonClick(Sender: TObject);
var N,
Loops: integer;
Target: tForm;
begin
if (MDIChildCount<2) then
Exit;
for Loops:=1 to 10 do begin
Application.ProcessMessages;
N:=Random(MDIChildCount);
if (MDIChildren[N]<>ActiveMDIChild) then begin
Target:=MDIChildren[N];
Scroller.Lines.Add('');
Scroller.Lines.Add('--- refocusing to '+Target.Caption+' ---');
Target.BringToFront;
Scroller.Lines.Add('Brought to front');
Target.SetFocus;
Scroller.Lines.Add('Focus now reset');
Break
end
end
end;
procedure TForm1.DelTopButtonClick(Sender: TObject);
var Form: tForm;
Panel: tPanel;
begin
Scroller.Lines.Add('');
if (Sender=DelTopButton) then begin
Form:=MDIChildren[0];
Panel:=Form.Controls[0] as tPanel;
Scroller.Lines.Add('About to free the items on '+Form.Caption)
end
else begin
Panel:=FixedPanel;
Scroller.Lines.Add('About to free the items on the fixed panel')
end;
if (DeletionModeGroup.ItemIndex=1) then begin
Scroller.Lines.Add('Deleting button from invisible panel on MDI
child');
Panel.Visible:=false
end
else if (DeletionModeGroup.ItemIndex=2) then begin
Scroller.Lines.Add('Deleting button from visible panel on MDI
parent');
Panel.Parent:=Form1
end
else
Scroller.Lines.Add('Deleting button from visible panel on MDI
child');
(Panel.Controls[0] as tBitBtn).Free;
Panel.Free;
if (Sender=DelTopButton) then begin
Scroller.Lines.Add('About to free the form');
Form.Free;
Scroller.Lines.Add('Done freeing the form')
end
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
CreateButtonClick(nil);
OnActivate:=nil
end;
initialization
end.
------------- end code here, start form here ------------------------
object Form1: TForm1
Left = 129
Top = 549
Width = 756
Height = 393
Caption = 'Form1'
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'System'
Font.Style = []
FormStyle = fsMDIForm
PixelsPerInch = 96
Position = poScreenCenter
OnActivate = FormActivate
OnClick = RefocusButtonClick
TextHeight = 16
object CreateButton: TButton
Left = 228
Top = 16
Width = 157
Height = 33
Caption = 'Create MDI child'
TabOrder = 0
OnClick = CreateButtonClick
end
object Scroller: TMemo
Left = 392
Top = 8
Width = 345
Height = 201
TabOrder = 1
end
object DelTopButton: TButton
Left = 228
Top = 56
Width = 157
Height = 33
Caption = 'Delete top MDI child'
TabOrder = 2
OnClick = DelTopButtonClick
end
object FixedPanel: TPanel
Left = 504
Top = 216
Width = 225
Height = 97
Caption = 'Fixed Panel'
TabOrder = 3
end
object DelFixedButton: TButton
Left = 507
Top = 320
Width = 174
Height = 33
Caption = 'Delete fixed panel'
TabOrder = 4
OnClick = DelTopButtonClick
end
object DeletionModeGroup: TRadioGroup
Left = 256
Top = 216
Width = 201
Height = 105
Caption = 'Delete button with panel ...'
ItemIndex = 0
Items.Strings = (
'Visible, on MDI child'
'Invisible, on MDI child'
'Visible, on MDI parent')
TabOrder = 5
end
end
------------------------- end form here
-----------------------------------
I do not have the Delph1 1 VCL source, and I do not know what causes
this problem. The workaround I am using is to make the panel invisble
first. The workaround is easy; the difficult part was figuring out what
the problem was.
--
Howard L. Kaplan
Psychopharmacology and Dependence Research Unit
Women's College Hospital
76 Grenville Street, 9'th floor
Toronto, Ontario
Canada M5S 1B2
(416)323-6400, ext 4915
howard.kap...@utoronto.ca
