uses crt,sysutils;
var n,i,j,time,score,diemcaonhat,tocdo:integer;
key,datakey,x,y,foodx,foody:byte;
ten:string;
cot,hang,xy:Shortint;
stop:boolean;
ran:array[1..1000,1..2]of integer;
box:array[1..100,1..100]of integer;
{Ve ran ban dau && noi duoi ran}
procedure ve;
begin
for i:=1 to n do
begin
gotoxy(ran[i,1],ran[i,2]);
textcolor(2);
write('0');
textcolor(15);
end;
gotoxy(ran[n,1],ran[n,2]);
textcolor(10);
write('0');
textcolor(15);
gotoxy(1,1);
end;
procedure xoa(x,y:integer);
begin
gotoxy(x,y);
write(' ');
end;
procedure ranxy;
begin
for i:=1 to n do
begin
ran[i,1]:=ran[i+1,1];
ran[i,2]:=ran[i+1,2];
end;
end;
{==============================================}
{thao tac phim}
procedure xuong;
begin
if hang<>-1 then
begin
hang:=1; cot:=0;
time:=tocdo+round(tocdo/2);
end
end;
procedure len;
begin
if hang<>1 then
begin
hang:=-1; cot:=0;
time:=tocdo+round(tocdo/2);
end
end;
procedure trai;
begin
if cot<>1 then
begin
cot:=-1; hang:=0;
time:=tocdo;
end
end;
procedure phai;
begin
if cot<>-1 then
begin
cot:=1; hang:=0;
time:=tocdo;
end
end;
procedure pause;
begin
gotoxy(15,1);
write('Nhan phim di chuyen de tiep tuc hoac Esc de thoat');
repeat
key:=ord(readkey);
until (key=80)or(key=72)or(key=75)or(key=77)or(key=27);
gotoxy(15,1);
write(' ');
gotoxy(1,1);
end;
{==============================================}
{ve khung cho ran}
procedure khung;
begin
for i:=2 to 60 do
begin
box[2,i]:=1;
box[24,i]:=1;
end;
for i:=2 to 24 do
begin
box[i,2]:=1;
box[i,60]:=1;
end;
end;
procedure vekhung;
begin
khung;
for i:=1 to 24 do
for j:=1 to 60 do
if box[i,j]=1 then
begin
gotoxy(j,i);
textcolor(5);
write('#');
textcolor(15);
end
end;
{==============================================}
{lam thuc an cho ran}
function ktfood:boolean;
begin
ktfood:=true;
for i:=1 to n do
if (ran[i,1]=foodx)and(ran[i,2]=foody) then
ktfood:=false;
end;
procedure food;
begin
randomize;
repeat
foody:=random(21)+3;
foodx:=random(58)+2;
until (box[foodx,foody]<>1)and(ktfood);
gotoxy(foodx,foody);
textcolor(4);
write('@');
textcolor(15);
gotoxy(1,1);
end;
{==============================================}
{ghi diem ra man hinh}
procedure diembd;
begin
gotoxy(63,5);
textcolor(9);
write('DIEM : ');
textcolor(15);
gotoxy(1,1);
end;
procedure ghidiem;
begin
gotoxy(70,50);
write(' ');
gotoxy(70,5);
textcolor(9);
write(score);
textcolor(15);
gotoxy(1,1);
end;
{==============================================}
{kiem tra ran tu can}
function rancan:boolean;
begin
rancan:=false;
for i:=1 to n-1 do
if (ran[i,1]=x)and(ran[i,2]=y) then
rancan:=true;
end;
{==============================================}
{??????????????????????????????????????????????}
procedure dev;
begin
gotoxy(62,23);textcolor(14);
write('DEV by LongVox')
end;
{==============================================}
procedure ketthuc;
begin
gotoxy(25,13);
textcolor(9);
write('GAME OVER!!!');
textcolor(15);
gotoxy(1,1);
stop:=true;;
end;
{Diem cao nhat}
procedure diemmax;
var f:text;
begin
if fileExists('max.dat') then
begin
assign(f,'max.dat');
reset(f);
readln(f,diemcaonhat,ten);
close(f);
end
else begin
diemcaonhat:=0;
ten:='Noname';
end;
end;
procedure xuatdiemmax;
var f:text;
begin
if score>diemcaonhat then
begin
diemcaonhat:=score;
gotoxy(62,18);
textcolor(11);
write('Nhap ten:');
gotoxy(62,19);
read(ten);
textcolor(15);
gotoxy(1,1);
assign(f,'max.dat');
rewrite(f);
write(f,diemcaonhat,' ',ten);
close(f);
end
end;
procedure ghidiemmax;
begin
gotoxy(63,12);
textcolor(3);
write('Diem cao nhat:');
gotoxy(63,13);
write(diemcaonhat);
gotoxy(68,13);
write(ten);
textcolor(15);
gotoxy(1,1);
end;
{==============================================}
{toa do kho}
procedure dokho;
begin
gotoxy(63,7);
write('Do kho:');
gotoxy(65,8);
write('[*] de');
gotoxy(65,9);
write('[ ] trung binh');
gotoxy(65,10);
write('[ ] kho');
gotoxy(1,1);
xy:=0;
repeat
gotoxy(66,8);write(' ');
gotoxy(66,9);write(' ');
gotoxy(66,10);write(' ');
gotoxy(66,xy+8);write('*');
gotoxy(1,1);
datakey:=ord(readkey);
case datakey of
80: xy:=(xy+1) mod 3;
72: if xy =0 then xy:=2
else xy:=(xy-1) mod 3;
end;
until datakey=13;
case xy of
0: tocdo:=150;
1: tocdo:=100;
2: tocdo:=50;
end;
end;
{==============================================}
{khởi tạo giá tri và in màn hình ban đầu}
procedure khoitao;
begin
clrscr;score:=0;
cot:=1; hang:=0;
x:=16; y:=13;
ran[1,1]:=14;
ran[1,2]:=13;
ran[2,1]:=15;
ran[2,2]:=13;
ran[3,1]:=16;
ran[3,2]:=13;
n:=3;
stop:=false;
fillchar(box,sizeof(box),0);
ve;
vekhung;
food;
diembd;
ghidiem;
dev;
diemmax;
ghidiemmax;
dokho;
time:=tocdo;
end;
{==============================================}
procedure dichuyenran;
begin
{kiem tra ran co an thuc an}
if (foodx=x)and(foody=y) then
begin
n:=n+1;
x:=x+cot;
y:=y+hang;
ran[n,1]:=x;ran[n,2]:=y;
food;
score:=score+10;
ghidiem;
end
else
begin
xoa(ran[1,1],ran[1,2]);
x:=x+cot;
y:=y+hang;
ranxy;
ran[n,1]:=x;ran[n,2]:=y;
end;
{kiem tra loi chet cua ran}
if (box[y,x]=1)or(rancan) then ketthuc
else
begin
gotoxy(ran[n-1,1],ran[n-1,2]);
textcolor(2);
write('0');
textcolor(15);
gotoxy(ran[n,1],ran[n,2]);
textcolor(10);
write('0');
textcolor(15);
gotoxy(1,1);
delay(time);
end;
end;
begin
khoitao;
repeat
repeat
dichuyenran;
until (keypressed)or(stop);
if keypressed then
begin
key:=ord(readkey);
IF key=0 THEN key:=ord(readkey);
case key of
80: xuong;
72: len;
75: trai;
77: phai;
32: pause;
end;
end;
until (key=27)or(stop);
xuatdiemmax;
write('Nhan phim bat ki de thoat.');
repeat until keypressed;
clrscr;
gotoxy(23,12);
write('Thank you for playing game!!!!!!');
delay(1500);
clrscr;
end.
Be the first to comment
You can use [html][/html], [css][/css], [php][/php] and more to embed the code. Urls are automatically hyperlinked. Line breaks and paragraphs are automatically generated.