unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Idle(Sender: TObject; var Done: boolean);
procedure Timer1Timer(Sender: TObject);
private
threadcreated: boolean;
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
const
appTerminate: boolean = false;
type
TThread1 = class(TThread)
protected
procedure Execute; override;
public
Constructor Create(CreateSuspended : boolean);
end;
constructor TThread1.Create(CreateSuspended : boolean);
begin
inherited Create(CreateSuspended); // Normally inherit parent constructor first
FreeOnTerminate := True;
//inherited Create(CreateSuspended);
end;
procedure TThread1.Execute;
var
i, j: integer;
begin
j:=0;
//for i:=0 to 200000000 do begin
for i:=0 to 200 do begin // Test with smaller value first, does it freeze?
j:=j+1;
//if (j and $FFFF=0) then threadswitch;
end;
appTerminate:=true;
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
//TThread1.Create(false);
end;
procedure TForm1.Idle(Sender: TObject; var Done: boolean);
begin
Done:=true; // Set first, otherwise it will remain false when it terminates
if (appTerminate) then begin
appTerminate:=false; // Just making sure it won't do this again, it's idle event afterall, who knows how often it's called
Application.Terminate;
exit;
end;
//Done:=true;
if (threadcreated) then exit;
//threadcreated:=true; TThread1.Create(false);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if (threadcreated) then exit;
//threadcreated:=true; TThread1.Create(false);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
threadcreated:=false;
Application.OnIdle:={$IFDEF FPC}@{$ENDIF}Idle;
threadcreated:=true; TThread1.Create(false);
end;
end.
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads, cmem,
{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.