Free Pascal szálasítás? Lehetséges?
Azt szeretném megkérdezni hogyan lehet freepascalban egymástól független szálakat létrehozni?
Például irányítasz egy ágyút, és egy külön szálon fut az ellenség mozgása stb.
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.
Kapcsolódó kérdések:
Minden jog fenntartva © 2025, www.gyakorikerdesek.hu
GYIK | Szabályzat | Jogi nyilatkozat | Adatvédelem | Cookie beállítások | WebMinute Kft. | Facebook | Kapcsolat: info(kukac)gyakorikerdesek.hu
Ha kifogással szeretne élni valamely tartalommal kapcsolatban, kérjük jelezze e-mailes elérhetőségünkön!