theboywholived
07-01-2011, 19:32
Trò này mình lấy trong sách đó, bà con chơi thử nha !
program ransanmoi;
uses crt,dos;
var ran:array[1..100] of record x,y:byte; end;
x,y,x1,y1,L,huong:byte;
tocdo,diem:integer;
kt:char;
die:boolean;
procedure setcusor(bot,top:byte);
var regs:registers;
begin
regs.ah:=1;
regs.ch:=bot;
regs.cl:=top;
end;
procedure ngaunhien;
begin
x1:=random(30)+5;
y1:=random(20)+2;
kt:=chr(random(25)+65);
gotoxy(x1,y1);
write(kt);
end;
procedure vekhung;
var j:byte;
begin
clrscr;
textcolor(white);
gotoxy(1,1);
for j:=1 to 40 do write(#177);
gotoxy(1,24);
for j:=1 to 40 do write(#177);
for j:=2 to 23 do
begin
gotoxy(1,j);
writeln(#177);
gotoxy(40,j);
write(#177);
end;
gotoxy(8,24);
textcolor(lightred);
writeln('Nhan ESC de thoat');
end;
procedure ranchay;
var rk:char;
begin
if keypressed then
begin
rk:=readkey;
if rk=#27 then halt(1);
if rk=#0 then rk:=readkey;
huong:=ord(rk);
end;
case huong of
80:inc(y); {di xuong}
72:dec(y); {di len}
77:inc(x); {qua phai}
75:dec(x); {qua trai}
end;
if (y=1)or(y=24)or(x=40)or(x=1) then die:=true;
end;
procedure init;
var j:byte;
begin
randomize;
textmode(co40);
tocdo:=200;
diem:=0;
vekhung;
l:=3;
x:=10;
y:=10;
for j:=1 to l+1 do
begin
ran[j].x:=30+j;
ran[j].y:=10;
end;
ngaunhien;
setcusor(32,3);
die:=false;
end;
procedure thuchien;
var i:byte;
begin
init;
i:=4;
repeat
ranchay;
dec(i);
gotoxy(ran[i].x,ran[i].y);
write(' ');
ran[i].x:=x;
ran[i].y:=y;
textcolor(lightred);
gotoxy(4,1);
write(' DIEM ',diem);
if (diem>0) and (diem mod 200=0) then
begin
diem:=diem+50;
gotoxy(6,12);
textcolor(white);
textbackground(red);
writeln(' MOI BAN TIEP TUC ');
repeat until keypressed;
textbackground(0);
clrscr;
vekhung;
if tocdo>=100 then tocdo:=tocdo-50;
if diem>=400 then l:=3;
i:=l;
end;
if (x=x1)and(y=y1) then
begin
l:=l+1;
ngaunhien;
diem:=diem+10;
end;
gotoxy(x1,y1);
write(kt);
textcolor(lightcyan);
gotoxy(ran[i].x,ran[i].y);
write({#219}'o');
if i=1 then i:=l+1;
delay(tocdo);
until die;
gotoxy(15,11);
write(' BAN DA THUA ');
gotoxy(5,12);
write(' Nhan phim bat ki de choi tiep ');
end;
BEGIN
repeat
clrscr;
thuchien;
kt:=readkey;
until kt=#27;
clrscr
END.
program ransanmoi;
uses crt,dos;
var ran:array[1..100] of record x,y:byte; end;
x,y,x1,y1,L,huong:byte;
tocdo,diem:integer;
kt:char;
die:boolean;
procedure setcusor(bot,top:byte);
var regs:registers;
begin
regs.ah:=1;
regs.ch:=bot;
regs.cl:=top;
end;
procedure ngaunhien;
begin
x1:=random(30)+5;
y1:=random(20)+2;
kt:=chr(random(25)+65);
gotoxy(x1,y1);
write(kt);
end;
procedure vekhung;
var j:byte;
begin
clrscr;
textcolor(white);
gotoxy(1,1);
for j:=1 to 40 do write(#177);
gotoxy(1,24);
for j:=1 to 40 do write(#177);
for j:=2 to 23 do
begin
gotoxy(1,j);
writeln(#177);
gotoxy(40,j);
write(#177);
end;
gotoxy(8,24);
textcolor(lightred);
writeln('Nhan ESC de thoat');
end;
procedure ranchay;
var rk:char;
begin
if keypressed then
begin
rk:=readkey;
if rk=#27 then halt(1);
if rk=#0 then rk:=readkey;
huong:=ord(rk);
end;
case huong of
80:inc(y); {di xuong}
72:dec(y); {di len}
77:inc(x); {qua phai}
75:dec(x); {qua trai}
end;
if (y=1)or(y=24)or(x=40)or(x=1) then die:=true;
end;
procedure init;
var j:byte;
begin
randomize;
textmode(co40);
tocdo:=200;
diem:=0;
vekhung;
l:=3;
x:=10;
y:=10;
for j:=1 to l+1 do
begin
ran[j].x:=30+j;
ran[j].y:=10;
end;
ngaunhien;
setcusor(32,3);
die:=false;
end;
procedure thuchien;
var i:byte;
begin
init;
i:=4;
repeat
ranchay;
dec(i);
gotoxy(ran[i].x,ran[i].y);
write(' ');
ran[i].x:=x;
ran[i].y:=y;
textcolor(lightred);
gotoxy(4,1);
write(' DIEM ',diem);
if (diem>0) and (diem mod 200=0) then
begin
diem:=diem+50;
gotoxy(6,12);
textcolor(white);
textbackground(red);
writeln(' MOI BAN TIEP TUC ');
repeat until keypressed;
textbackground(0);
clrscr;
vekhung;
if tocdo>=100 then tocdo:=tocdo-50;
if diem>=400 then l:=3;
i:=l;
end;
if (x=x1)and(y=y1) then
begin
l:=l+1;
ngaunhien;
diem:=diem+10;
end;
gotoxy(x1,y1);
write(kt);
textcolor(lightcyan);
gotoxy(ran[i].x,ran[i].y);
write({#219}'o');
if i=1 then i:=l+1;
delay(tocdo);
until die;
gotoxy(15,11);
write(' BAN DA THUA ');
gotoxy(5,12);
write(' Nhan phim bat ki de choi tiep ');
end;
BEGIN
repeat
clrscr;
thuchien;
kt:=readkey;
until kt=#27;
clrscr
END.