Правила форума
Исчезающие цели для змейки, курсовая работа
Unit Snake;
interface
uses graph,crt,nmenu_2;
procedure Delay(time:longint);
procedure prov;
procedure In_rec(points:integer);
procedure Records;
procedure zmeika;
Type
Rec = record
Name : string ;
Points : integer;
end;
var
x_min, y_min, x_max, y_max, x, y, score, best: word;
size,level,zvet: byte;
food:longint;
v, k: word;
way_x, way_y: shortint;
points_str, best_str: string[6];
ch, level_ch: char;
stop,point,quit:boolean;
koor: array[1..400,1..2] of word;
nm:pmenu;
dln:word;
points:integer;
implementation
procedure Delay(time:longint);
var
ctime,time2:Longint;
begin
ctime:=meml[$40:$006c];
time2:=time div 55+ctime;
while time2>meml[$40:$006c] do;
end;
{============Proverka=======================}
{proverka na nali4ie rec.rec }
Procedure prov;
var
f : file of rec;
temp : rec;
i : byte;
begin
Assign( F , 'Rec.snk');
{$I-}
reset(f);
If IoResult <> 0 then begin
rewrite(f);
temp.name:='NoName';
temp.points:=0;
for i:=1 to 10 do
write(f,temp);
end;
close(f);
{$I+}
end;
{===========================================}
{===============In Records==================}
{ add in rec }
Procedure In_Rec(Points : integer);
{-----------------------------------------------}
Function ReadName : String;
Var
CH : Char;
Name : String;
Begin
Name :='';
Bar(190,150,299,170);
repeat
CH:=readkey;
Bar(175,140,299,190);
If CH in ['a'..'z','A'..'Z','0'..'9'] then
Name:=Name+CH;
If CH = #8 then begin
Name:='';
Bar(175,140,299,190);
end;
If Length( Name ) > 8 Then Delete( Name , 9 , 1 );
OutTextXY(230,150,Name);
until ( CH = #13 ) ;
ReadName := Name;
End;
{-----------------------------------------------}
var
temp,Help : rec;
f : file of rec;
i : byte;
CH : char;
tem : rec;
begin
prov;
Assign( F , 'Rec.snk');
reset(f);
SetFillStyle( 1,green );
Bar( 0,0,640,480 );
SetFillStyle( 1,yellow );
Bar( 170,100,470,200 );
Rectangle(170,100,470,200);
Seek( F , FileSize( F ) - 1 );
Read( F , Temp );
if (points<= temp.points) then exit;
Seek( F , 0 );
OutTextXY(260,120,'‚ўҐ¤ЁвҐ бў®с Ё¬п');
Temp.Name := ReadName;
{-----------------Cheat---------------------}
If Temp.Name = 'PCheat' Then Begin
OutTextXY(200,120,'‚ўҐ¤ЁҐв бў®Ґ Ё¬п Ґйс а §');
Bar(190,150,299,170);
Temp.Name := ReadName;
Bar( 200 , 110 , 400 , 140 );
OutTextXY(230,120,'‚ўҐ¤ЁвҐ ®зЄЁ');
ReadLn( Points );
End;
{-------------------------------------------}
For i:=0 to 9 do begin
read(f,Help);
if ( Help.points < points ) then begin
seek(f,i);
Dec( I );
break;
end;
end;
temp.points:=points;
For i:=i+1 to 9 do begin
read(f,tem);
seek(f,i);
write(f,temp);
temp:=tem;
end;
close(f);
end;
{===========================================}
{==================Records==================}
{write rec }
Procedure Records;
var
f : file of rec ;
temp : rec ;
i : byte ;
s : string ;
begin
prov;
Assign( F , 'Rec.snk');
reset(f);
SetfillStyle( 1,blue );
Bar(0,0,640,480);
SetFillStyle( 1,yellow );
Bar( 195,90,445,390 );
setlinestyle(solidln,15,thickwidth);
setcolor(green);
Rectangle( 195,90,445,390 );
setcolor(darkgray);
OutTextXY( 250,100,'?¬п');
OutTextXY( 395,100,'ЋзЄЁ');
setcolor(green);
Line ( 345,90,345,390 );
for i:=1 to 10 do begin
read(f,temp);
str(temp.points,s);
setcolor(green);
Line( 195,140+(i-1)*25+2,445,140+(i-1)*25+2 );
setcolor(darkgray);
OutTextXY( 250,150+(i-1)*25+2,temp.name);
OutTextXY( 395,150+(i-1)*25+2,s);
end;
Close( F );
repeat
ch:=readkey;
until ch=#13;
Setlinestyle(solidln,15,normwidth);
End;
Procedure Pause;
{Џ г§ ў ЁЈаҐ}
begin
SetFillStyle(1,red);
bar(250,305,360,340);
SetColor(14);
SetTextStyle(7,0,3);
OutTextXY(300,315,'Џ г§ ');
SetFillStyle(1,red);
bar(80,355,540,390);
SetColor(14);
SetTextStyle(7,0,3);
OutTextXY(313,370,'„«п Їа®¤®«¦ҐЁп ¦¬ЁвҐ Enter');
repeat
ch:=readkey;
until ch=#13;
SetTextStyle(0,0,0);
SetFillStyle(1,green);
bar(250,305,360,340);
bar(80,355,540,390);
end;
procedure zmeika;
begin
zvet:=random(10);
points:=0;
x_min:=30;
y_min:=45;
x_max:=600;
y_max:=450;
k:=15;
setbkcolor(blue);
setfillstyle(1,lightgray);
bar(x_min-15,y_min-15,x_max+15,y_max+15);{бҐа п а ¬¬®зЄ ў®ЈагЈ Ї®«п}
setfillstyle(1,green);
bar(x_min,y_min,x_max,y_max);{ЁЈа®ў®Ґ Ї®«Ґ}
size:=5;{hfpvth pvtqrb}
x:=x_min+size*k;
y:=y_max div 2;
setfillstyle(1,14);
bar(x-size*k,y,x,y+k);{ з «млҐ ¬Ґбв®Ї®«®¦ҐЁҐ §¬Ґ©ЄЁ нЄа Ґ}
way_x:=1;
way_y:=0;
for v:=1 to size do
begin
koor[v,1]:=x-v*k+k;
koor[v,2]:=y
end;
point:=false;
settextstyle(0,0,1); { ’ҐЄбв ўҐpег }
setcolor(red);
setlinestyle(solidln,15,thickwidth);
setfillstyle(1,yellow);
bar(15,0,100,29);
rectangle(15,0,102,29);
bar(103,0,300,29);
bar(303,0,615,29);
rectangle(302,0,615,29);
rectangle(102,0,302,29);
setcolor(blue);
outtextxy(50,15,'ЋзЄЁ: ');
outtextxy(80,15,'0');
outtextxy(200,15,'‚лЎҐаЁвҐ га®ўҐм ®в 1-9');
outtextxy(450,10,'‡ ўҐаиҐЁп ЁЈал ¦¬ЁвҐ Esc');
outtextxy(450,20,'„«п Ї г§л ¦вЁвҐ P');
repeat
level_ch:=readkey;
until (level_ch>=#49) and (level_ch<=#57);
val(level_ch,level,v);
setfillstyle(1,yellow);
bar(107,5,297,23);
setcolor(blue);
outtextxy(185,15,'“p®ўҐм:');
setcolor(blue);
outtextxy(235,15,level_ch);
repeat
if keypressed then ch:=readkey;
case ch of
#72: if way_y=0 then
begin
way_x:=0;
way_y:=-1
end;
#75: if way_x=0 then
begin
way_x:=-1;
way_y:=0
end;
#77: if way_x=0 then
begin
way_x:=1;
way_y:=0
end;
#80: if way_y=0 then
begin
way_x:=0;
way_y:=1
end;
#27: break;
#112: pause;
end;
{бвЁа ЁҐ § б®Ў®© б«Ґ¤ }
setfillstyle(1,green);
bar(koor[size,1]-k, koor[size,2], koor[size,1], koor[size,2]+k);
for v:=size downto 2 do { ПЕРСЧЁТ КООРДИНАТ }
begin
koor[v,1]:=koor[v-1,1];
koor[v,2]:=koor[v-1,2]
end;
koor[1,1]:=koor[1,1]+way_x*k;
koor[1,2]:=koor[1,2]+way_y*k;
if (koor[1,1]>x_max) or (koor[1,2]=y_max) or (koor[1,1]=x_min) or
(koor[1,2]<y_min) then { ПОПАДАНИЕ В СЕТНУ }
begin
sound(100);
delay(100);
nosound;
break
end;
if point=false then { РИСОВАНИЕ ЦЕЛЕЙ }
begin
repeat
randomize;
x:=(random((x_max-x_min) div k)+1)*k+x_min;
y:=(random((y_max-y_min) div k)+1)*k+y_min;
point:=true;
for v:=1 to size do
if (x=koor[v,1]) and (y=koor[v,2]+k) then point:=false
until point;
setfillstyle(1,red);{梥в 楫Ё}
setcolor(white);
fillellipse(x-7,y-7,6,6);{д®а¬ 楫Ё}
setcolor(0);
line(0,0,0,15)
end;
if (x=koor[1,1]) and (y=koor[1,2]+k) then { СЪЕДАНИЕ ЦЕЛЕЙ }
begin
sound(900);
inc(size);
setfillstyle(1,yellow);
bar(70,4,100,22);
inc(points,5);
str(points,points_str);
setcolor(blue);
outtextxy(80,15,points_str);
point:=false
end;
for v:=2 to size do { САМОПЕРСЕЧЕНИЕ }
if (koor[1,1]=koor[v,1]) and (koor[1,2]=koor[v,2]) then
begin
sound(150);
delay(100);
nosound;
quit:=true;
break
end;
setfillstyle(1,14);
bar(koor[1,1]-k, koor[1,2], koor[1,1], koor[1,2]+k);
delay(181-9*level);
if point=false then nosound;
if keypressed then ch:=readkey
until (ch=#27) or quit ;
prov;
setfillstyle(1,yellow);
if points>50 then begin
setfillstyle(1,yellow);
setcolor(blue);
setlinestyle(solidln,15,thickwidth);
rectangle(168,148,462,302);
bar(170,150,460,300);
setcolor(blue);
settextstyle(0,horizdir,3);
outtextxy(314,220,'Y O U W I N');
readkey;
settextstyle(0,horizdir,1);
In_rec(points);
bar(0,0,640,480);
settextstyle(0,horizdir,1);
records;
end
else begin
setfillstyle(1,yellow);
setcolor(red);
setlinestyle(solidln,15,thickwidth);
rectangle(168,148,462,302);
bar(170,150,460,300);
setcolor(red);
settextstyle(0,horizdir,2);
outtextxy(314,220,'G A M E O V E R');
readkey;
bar(0,0,640,480);
settextstyle(0,horizdir,1);
records;
end;
settextstyle(0,horizdir,1);
setlinestyle(solidln,0,normwidth);
end;
end.
SNAKE.PAS ( 9.34 килобайт )
Кол-во скачиваний: 689
