IPB
ЛогинПароль:

 
 Ответить  Открыть новую тему 
> Исчезающие цели для змейки, курсовая работа
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 14
Пол: Мужской
Реальное имя: Алексей

Репутация: -  0  +


Короче говоря мне нужно сделать для курсовой следующее. В этом модуле нужно сделать так чтбы объекты для поедания змейки появлялись и исчезали через некоторе время. Тое есть если не успел доползти, цель исчезает и появляется в другом месте)))))). И чтобы при съедении размер увеличивался на разную величину)))) Помогите позалуйста, а то я уже не знаю как мона это сделать

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 килобайт ) Кол-во скачиваний: 540

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

Репутация: -  62  +


1. Есть тег code
2. Что за модуль nmenu_2?
3. Надо просто, чтобы каждая цель знала и координаты, и своё время жизни.


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 14
Пол: Мужской
Реальное имя: Алексей

Репутация: -  0  +


Модуль nmenu_2 - это модуль меню игры,он здесь роли не играет. А как сделать так 4тобы цель знала свои координаты и время жизни в этом модуле. Можете написать позалуйста. А то курса4 уже завтра сдавать нада:-(:-(
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Вот код модуля Snake

Код
Unit Snake;
interface
uses graph,crt,nmenu_2;
procedure Delay(time:longint);
procedure prov;
procedure In_rec(points:integer);
procedure Records;
procedure Pause;
procedure zmeika;


Type
     Rec = record
       Name   : string;
       Points : integer;
     end;


var

    x_min, y_min, x_max, y_max, x, y,zvet,food: word;
    size,level: byte;
    v, k: word;
    way_x, way_y: shortint;
    points_str: string[6];
    ch, level_ch: char;
    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;


{===========================================}
{===============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;
            If CH in ['a'..'z','A'..'Z','0'..'9'] then
               Name:=Name+CH;
            If CH = #8 then begin
               Name:='';
               Bar(190,150,299,180);
            end;
            If Length( Name ) > 8 Then Delete( Name , 9 , 1 );
               OutTextXY(200,150,Name);
         until ( CH = #13 ) and ( Name <> '' );
    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
   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;{размер змеи}
   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);               { Текст наверху }
   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,15,Для завершения игры нажмите'Esc');


   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,'Уровень:');
   setcolor(blue);
   outtextxy(235,15,level_ch);

   randomize;
   repeat
      zvet:=random(10);
      food:=random(3);
      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;
             #112:  pause;

             #27: break                    {Завершение игры}
          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,zvet);{Цвет цели}
         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,food);{увеличение размера змеи}

         setfillstyle(1,yellow);
         bar(70,4,100,22);
         inc(points,5);{увеличение очков на 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>500 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,'Вы выиграли');
       readkey;
       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.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

Группа: Пользователи
Сообщений: 18
Пол: Мужской

Репутация: -  0  +


часть кода мне явно что-то напоминает smile.gif

Сообщение отредактировано: Gonz -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Новичок
*

Группа: Пользователи
Сообщений: 11
Пол: Мужской
Реальное имя: Саня

Репутация: -  0  +


Цитата(Gonz @ 7.06.2007 19:59) *

часть кода мне явно что-то напоминает smile.gif


Да, где-то я тоже это уже видел.....;).....Может, в своем курсаче.....;)


--------------------
Rise and shine!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 22.01.2021 10:44
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name