unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
const
threadcount = 100;
stringlen = 10000;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
public
end;
myrec = record
i : longint;
s : string;
end;
Pmyrec = ^myrec;
var
Form1: TForm1;
finished : longint;
threadvar
thri : ptrint;
implementation
{$R *.lfm}
uses
Windows; // for AllocConsole
type
{ TMyThread }
TMyThread = class(TThread)
private
fr: myrec; // Private copy of myrec
public
constructor Create(var r: myrec);
procedure Execute; override;
end;
{ TForm1 }
function f(p : Pointer) : ptrint;
var
s : ansistring;
thisrec : ^myrec;
begin
thisrec := Pmyrec(p);
Writeln('thread ', longint(thisrec^.i), ' started');
thri:=0;
while (thri<stringlen) do
begin
s:=s+'1';
inc(thri);
end;
Writeln('thread ',thisrec^.i,' finished with',thisrec^.s);
InterLockedIncrement(finished);
f:=0;
writeln('end of function');
end;
{ TMyThread }
constructor TMyThread.Create(var r: myrec);
begin
fr := r; // Preserve into the private copy
FreeOnTerminate := True; // Free when terminated
inherited Create(False); // Create and run
end;
procedure TMyThread.Execute;
begin
f(@fr); // Call f() with a pointer to the private copy
end;
procedure TForm1.Button1Click(Sender: TObject);
var
r : myrec;
x : longint;
begin
finished:=0;
r.s := ' test ';
for x :=1 to threadcount do
begin
r.i := x;
BeginThread(@f,@r);
writeln('ready for nex t');
end;
while finished<threadcount do ;
Writeln('goopend ' + IntToStr(finished));
end;
procedure TForm1.Button2Click(Sender: TObject);
var
r : myrec;
x : longint;
begin
finished:=0;
r.s := ' test ';
for x :=1 to threadcount do
begin
r.i := x;
TMyThread.Create(r);
writeln('ready for nex t');
end;
while finished<threadcount do ;
Writeln('goopend ' + IntToStr(finished));
end;
// Following lines are to make WriteLn work on Windows GUI App
initialization
// Allocate console in Windows
AllocConsole; // in Windows unit
IsConsole:=True; // in System unit
SysInitStdIO; // in System unit
end.