My program has a problem and I don't see my mistake: my program can open 2 dynamically created forms (to show some informations) with the following rules:
- it is allowed that both forms are opened at the same time
- it is not allowed that the same form is opened more than once
- the forms should be opened non-modal
- when the main program terminates, both forms must be closed automatically
// This program makeks no sense. It's only an extract of a bigger
// program and reduced to the minimum to demonstrate the problem.
{$mode objfpc}{$H+}
{$apptype console}
unit Unit1;
interface
uses SysUtils, Forms, StdCtrls; {reduced to the minimum}
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
private { private declarations }
public { public declarations }
end;
var Form1: TForm1;
implementation
{$R *.lfm}
type {class for a dynamically created form: }
TFormX = class(TForm) {procedure for every close of the Form: }
procedure CloseX(Sender: TObject; var CloseAction: TCloseAction);
private { private declarations }
pStop: ^boolean; {control variable for to close the form}
public { public declarations }
end;
procedure TFormX.CloseX(Sender: TObject; var CloseAction: TCloseAction);
{called by event "OnClose" of the dynamically created forms}
begin
writeln('CloseX');
pStop^:=true; {stopps the waiting loop in show_Form()}
end;
procedure show_Form(msg: string; x0: integer; var stop: boolean);
{creates a Form dynamically and waites for closing the Form}
var FormX: TFormX;
begin
FormX:=TFormX.CreateNew(nil);
FormX.pStop:=@stop; {control variable for to close the form}
FormX.OnClose:=@FormX.CloseX; {procedure for event "OnClose"}
FormX.Caption:=msg; {show something in the form...}
FormX.SetBounds(x0,300,150,150);
FormX.Show; {show the new form}
writeln('started waiting for close');
stop:=false; {wait for the closing of the form: }
repeat Application.ProcessMessages;
sleep(1); {avoid high CPU-load}
until stop; {variable changed in CloseX()}
writeln('stopped waiting');
FreeAndNil(FormX);
end; {show_Form}
var stop1,stop2: boolean;
procedure TForm1.Button1Click(Sender: TObject);
const activ1: boolean = false;
begin
if activ1 then writeln('still running #1') else
begin
activ1:=true;
show_Form('hello-1', 300, stop1);
writeln('finished #1');
activ1:=false;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
const activ2: boolean = false;
begin
if activ2 then writeln('still running #2') else
begin
activ2:=true;
show_Form('hello-2', 500, stop2);
writeln('finished #2');
activ2:=false;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
writeln('Form1_Close');
stop1:=true; {stopps waiting loop in show_Form()}
stop2:=true; {stopps waiting loop in show_Form()}
end;
end.
When you do the following:
- click button 1 (opens form 1)
- close form 1
- click button 2 (opens form 2)
- close form 2
- click button 1 (opens form 1 again)
everything is fine. The output shows:
started waiting for close
CloseX
stopped waiting
finished #1
started waiting for close
CloseX
stopped waiting
finished #2
started waiting for close
But when you do the following:
- click button 1 (opens form 1)
- click button 2 (opens form 2)
- close form 1
- click button 1 (should open form 1 again)
nothing happens. The output shows:
started waiting for close
started waiting for close
CloseX
still running #1
That means, closing of form #1 did not work correctly. After "CloseX" we should see "stopped waiting" and "finished #1", but this is not excecuted. Why?
To control the closing of the 2 forms, 2 global variables "stop1" and "stop2" are used. They are submitted to each form as a parameter and they are set to True in FormClose() when the main program terminates. The benefit is: FormClose() must not know 'TFormX' and it works independent of the dynamically forms having ever been created or not.
I'm using Lazarus 1.8.0 RC5 with FPC 3.0.4 but had the same results with Lazarus 1.6.2 and FPC 3.0.0. Both on Windows 7 32 bit. I attached a small project. Thanks a lot in advance.