Free Pascal szálasítás? Lehetséges?

Lehetséges szálakat programozni Free Pascalban. Van rá objetum orientált megoldás is és nem objektumorientált is.

Ezt már egyszer bemásoltam ide a GYK-re. A szálkezelés nem objektumorientált megvalósítását láthatod benne. A Kódot Linuxon teszteltem, ott működik (mondjuk kisebb hibák vannak benne)

program jatek;

uses crt, SysUtils {$ifdef unix},cthreads{$endif};

var

a,b :integer;

c:char;

hatravan:longint;

function Idozito(ido : pointer):longint;

var

i : longint;

x,y : smallint;

begin

for i:=longint(ido^) downto 0 do

begin

x:=WhereX;

y:=WhereY;

GotoXY(1,1);

TextColor(14);

TextBackGround(4);

clreol;

GotoXY(40,1);

Write('Meg ',i,' masodperced maradt, hogy kitalald');

TextBackGround(blue);

GotoXY(x,y);

hatravan:=i;

//Application.ProcessMessages;

Delay(1000);

if a=b then EndThread;

end;

window(1,1,80,25);

TextBackGround(4);

TextColor(14);

clrscr;

gotoxy(1,2);

writeln(' Lejart az idod...');

writeln(' ---Uss ENTER-t---');

readln;

window(1,1,80,25);

TextBackGround(Blue);

clrscr;

end;

var

Meddig, h : longint;

procedure jatek(const Hatar : longint);

var

IdoSzal: TThreadID;

begin

a:=random(Hatar)+1;

repeat

writeln('Indulhat a jatek? (I/N) ');

c:=readkey;

until c in ['i','n','I','N'];

writeln;

if c in ['i','I'] then

begin

IdoSzal:=BeginThread(@Idozito,pointer(@Meddig));

writeln('Gondoltam egy szamra 1 es ',Hatar,' kozott, vajon mi az a szam amire gondoltam?');

repeat

if hatravan<=0 then

begin

//writeln('Lejart az idod...');

exit;

end

else

begin

repeat

write('Kerem a tippedet! : ');

{$i-}

readln(b);

{$i+}

If IOResult<>0 then Writeln('Csak egesz szamok adhatok meg!!!');

until IOResult=0;

end;

if a<b then writeln('A tipped nagyobb, mint a gondolt szam, probald ujra!');

if a>b then writeln('A tipped kisebb, mint a gondolt szam, probald ujra!');

if a=b then writeln('Ki hitte volna, kitalaltad!');

until a=b;

end;

end;

begin

Randomize;

TextBackGround(1);

TextColor(14);

repeat

clrscr;

repeat

write('Kerek egy szamot 10 es 2000 kozott, ez lesz a felso hatara a kitalalando szamnak : ');

{$i-}

readln(h);

{$i+}

if IOResult <>0 then

begin

writeln('Csak 10 es 2000 kozotti egesz szamok adhatoak meg!');

h:=0;

end;

until (h>=10) and (h<=2000);

repeat

write('Hany masodpercig tartson a jatek? (10-120) : ');

{$i-}

readln(Meddig);

{$i+}

if IOResult<>0 then Meddig:=0;

until Meddig in [10..120];

clrscr;

Hatravan:=Meddig;

jatek(h);

repeat

writeln('Jatszol meg egyet? (I/N) ');

c:=readkey;

until c in ['n','N','i','I'];

until c in ['n','N'];

TextColor(7);

TextBackGround(0);

clrscr;

end.