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

> Первая игра моей девушки !
сообщение
Сообщение #1


Гость






Код

Program Game;
Uses crt;
Var m,n,i,j,k,x,y,x1,x2,y1,y2: integer; a: char;
   flag:boolean;t: longint;
PROCEDURE clr;
Begin
 window(1,1,80,25); textbackground(0);clrscr;
End;
PROCEDURE Wait(t: Longint);
Begin
 t:=t*9000;
 While t>0 do
 t:=t-1;
End;
PROCEDURE musik(h:word);
Begin
 Sound(h); Delay(50000);NoSound;
End;
PROCEDURE eat;
Begin
 if flag=false then begin i:=random(x2-x1-1); j:=random(y2-y1-2);end;
 if ((i mod 2)=0) then i:=i+1;if (i=0) or (i=1) then i:=i+4;
 if (j=0) or (j=1) then j:=j+3;
 gotoxy(i,j);Textcolor(4);Write(#3);Textcolor(14);
End;
PROCEDURE Pole;
Begin
 Window(x1,y1,x2,y2);Textbackground(2);Textcolor(15);Clrscr;
 Write(#201);For k:=1 to x2-x1-1 do write(#205);Write(#187);
 For k:=1 to y2-y1-1 do begin gotoxy(1,k+1);write(#186);end;Gotoxy(1,k+1);write(#200);
 For k:=1 to y2-y1-1 do begin gotoxy(x2-x1+1,k+1);write(#186);end;gotoxy(x2-x1+1,k+1);write(#188);
 Gotoxy(2,y2-y1);For k:=1 to x2-x1-1 do write(#205);
 Gotoxy((x2-x1)div 2 -2,1);Textcolor(14);Write(' Game ');
 Gotoxy(x2-x1-4,y2-1);Writeln(' ',n,' ');Textcolor(14);Write('  Esc ');Textcolor(15);
 Write('to exit');Textcolor(14);eat;flag:=true;
End;
PROCEDURE Gameover;
Begin Musik(494);Window(1,1,80,25);Textbackground(0);Textcolor(4);Clrscr;
      GotoXY(36,8);Write('Game over');GotoXY(37,9);Write(n,' balls');readkey;
      Halt;
End;
PROCEDURE dvig80;
Begin While keypressed=false do
      Begin Pole;y:=y+1;Gotoxy(x,y);Write(#2);Gotoxy(14,y2-y1+1);Wait(t);
            if(x=i)and(y=j)then begin flag:=false;n:=n+1;Musik(294);
            if ((n mod 10)=0) and (t>560) then  t:=t-560;end;
            if y=y2-1 then gameover;
      End;
End;
PROCEDURE dvig72;
Begin While keypressed=false do
      Begin Pole;y:=y-1;Gotoxy(x,y);Write(#2);Gotoxy(14,y2-y1+1);Wait(t);
            if(x=i)and(y=j)then begin flag:=false;n:=n+1;Musik(294);
            if ((n mod 10)=0) and (t>560) then t:=t-560;end;
            if y=1 then gameover;
      End;
End;
PROCEDURE dvig75;
Begin While keypressed=false do
      Begin Pole;x:=x-2;Gotoxy(x,y);Write(#2);Gotoxy(14,y2-y1+1);Wait(t);
            if(x=i)and(y=j)then begin flag:=false;n:=n+1;Musik(294);
            if ((n mod 10)=0) and (t>560) then t:=t-560;end;
            if x=1 then gameover
      End;
End;
PROCEDURE dvig77;
Begin While keypressed=false do
      Begin pole;x:=x+2;Gotoxy(x,y);Write(#2);Gotoxy(14,y2-y1+1);Wait(t);
            if(x=i)and(y=j)then begin flag:=false;n:=n+1;Musik(294);
            if ((n mod 10)=0) and (t>560) then t:=t-560;end;
            if x=x2-x1+1 then gameover;
      End;
End;
BEGIN Clr;
n:=0;t:=5600;
i:=24;j:=5;flag:=true;
x1:=15;y1:=1;x2:=65;y2:=25;Pole;
x:=(x2-x1) div 2; y:=(y2-y1) div 2;
Gotoxy(x,y);Write(#2);Gotoxy(14,y2-y1+1);
While true do
Begin a:=readkey;
     case a of
     #80: dvig80;
     #72: dvig72;
     #75: dvig75;
     #77: dvig77;
     #27: exit;
     end;
End;
END.
 К началу страницы 
+ Ответить 

Сообщений в этой теме
Clane   Первая игра моей девушки !   26.03.2003 15:50
AlaRic   Re: Первая игра моей девушки !   26.03.2003 23:22
Ivs   Re: Первая игра моей девушки !   26.03.2003 23:24
Clane   Re: Первая игра моей девушки !   26.03.2003 23:28
AlaRic   Re: Первая игра моей девушки !   26.03.2003 23:29
Slam   Re: Первая игра моей девушки !   26.03.2003 23:41
Гость   В догонку:[code]      x:=10;      y:=10; x1:=r…   1.04.2006 15:12
Shegrou   Точнее как сделать так,что бы он по заданому полю …   1.04.2006 16:20
Slam   Re: Первая игра моей девушки !   26.03.2003 23:45
fagot   Re: Первая игра моей девушки !   30.03.2003 23:21
Gremlin   Re: Первая игра моей девушки !   22.06.2003 10:12
Clane   Re: Первая игра моей девушки !   22.06.2003 13:19
I love Prolog =)   Re: Первая игра моей девушки !   27.06.2003 21:07
GLuk   Re: Первая игра моей девушки !   27.06.2003 21:14
I love Prolog =)   Re: Первая игра моей девушки !   16.08.2003 19:15
Stokly   Можешь написать на Паскале игру Lines :wink:   2.04.2006 17:49
Shegrou   Можешь написать на Паскале игру Lines :wink: Нап…   3.04.2006 2:03
Shegrou   Ну дак что,ожет ктонить поможет))???оч прошу...   5.04.2006 2:26
Кот   Ну дак что,ожет ктонить поможет))???оч прошу... …   8.04.2006 0:45


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

 





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