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

 
 Ответить  Открыть новую тему 
> Игра. Аркада.
сообщение
Сообщение #1


Новичок
*

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

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


uses graph,crt;
type Point=record
    x:Word;
    y:word;
end;
   MasStar=array[1..2,1..300] of word;{Тип массива для звезд}
   BotMas=array [1..30] of char;{Тип массива для ботов}
   TargetMas=array [1..2] of word;{Тип массива для хранения координатов летящих ботов}
var
     Target:TargetMas;{массива для хранения координатов поподания в бототв}
       Napr:String;{переменая определяющая своим значением в какую сторону движутся боты}
       bots:BotMas;{массив для хронения состояния ботов}
        a,r:integer;{пременные осуществляющее перемещение пули}
      Polet:boolean;{признок палёта пули}
   gr,dr,io:integer;{переменные модуля граф}
          x:integer;{переменная для движения коробля}
          i:integer;{для цикла вывода звезд на экран}
        Bot:array[1..5] of point;{массив для хранения координат вершин бота}
        pol:array[1..4] of point;{массив для хранения вершин коробля}
          c:char;{переменная для хранения символа нажатой клавиши}
  stars_x_y:MasStar;{Массив для хронания координат звезд}
          b:integer;{переменная для хронения значения смещения ботов}
        pow:real;{переменная для повтора цикла перемещения ботов}
{==============================ПРОЦЕДУРЫ===============================
=====}


procedure fire(var x,y:integer);{Процедура осуществляющяя перемищения пули}
var y1:integer;
begin
    setcolor(12);
    line(x,y,x,y-10);
    setcolor(0);
    line(x,y,x,y+10);
    nosound;

end;

procedure stars (var a:MasStar);{Поцедуро выводящяя на экран Звезды}
var x,y:word;
begin

   for i:=1 to 300 do
   begin
       x:=a[1,i];
       y:=a[2,i];
       putpixel(x,y,random(640));
   end;
end;

procedure Boti (a:BotMas; y:word);{процидура осуществляющая вывод на экран ботов}
var i,x:word;
begin
   SetfillStyle(1,0);
   bar(0,0,650,170);
   x:=0;
   for i:=1 to 20 do
   begin
       x:=x+40;
       if a[i]='a' then
       begin
           setcolor(2);
           bot[1].x:=100+x+y; bot[1].y:=130;
           bot[2].x:=110+x+y; bot[2].y:=140;
           bot[3].x:=100+x+y; bot[3].y:=150;
           bot[4].x:=90+x+y; bot[4].y:=140;
           bot[5].x:=100+x+y; bot[5].y:=130;
           DrawPoly(5,bot);
           setfillstyle(solidfill,2);
           FloodFill(100+x+y,140,2);
       end;
    end;
    x:=0;
       for i:=11 to 20 do
       begin
           x:=x+40;
           if a[i]='b' then
           begin
               setcolor(1);
               bot[1].x:=100+x+y; bot[1].y:=90;
               bot[2].x:=110+x+y; bot[2].y:=100;
               bot[3].x:=100+x+y; bot[3].y:=110;
               bot[4].x:=90+x+y; bot[4].y:=100;
               bot[5].x:=100+x+y; bot[5].y:=90;
               DrawPoly(5,bot);
               setfillstyle(solidfill,1);
               FloodFill(100+x+y,100,1);
           end;
       end;
       x:=0;
       for i:=21 to 30 do
       begin
           x:=x+40;
           if a[i]='c' then
           begin
               setcolor(6);
               bot[1].x:=100+x+y; bot[1].y:=50;
               bot[2].x:=110+x+y; bot[2].y:=60;
               bot[3].x:=100+x+y; bot[3].y:=70;
               bot[4].x:=90+x+y; bot[4].y:=60;
               bot[5].x:=100+x+y; bot[5].y:=50;
               DrawPoly(5,bot);
               setfillstyle(solidfill,6);
               FloodFill(100+x+y,60,6);
           end;
       end;

end;

Procedure Hit ( x:integer; y,z:integer; var b:BotMas; var est:boolean);
var w:word;
begin
   w:=0;
   if y=150 then
      if est=true then
      For i:=1 to 10 do
      begin
          w:=w+40;
          if b[i]='a' then
          if (z<=110+w+x) and (z>=90+w+x) Then
          begin
              b[i]:='x';
              est:=false;
              setfillstyle(1,7);
              fillellipse(100+w+x,140,20,20);
              sound(190);
          end;
      end;

      w:=0;
      if y=110 then
      if est=true then
      For i:=11 to 20 do
      begin
          w:=w+40;
          if b[i]='b' then
          if (z<=110+w+x) and (z>=90+w+x) Then
          begin
              b[i]:='x';
              est:=false;
              setfillstyle(1,7);
              fillellipse(100+w+x,100,20,20);
              sound(190);
          end;
      end;

      w:=0;
      if y=70 then
      if est=true then
      For i:=21 to 30 do
      begin
          w:=w+40;
          if b[i]='c' then
          if (z<=110+w+x) and (z>=90+w+x) Then
          begin
              b[i]:='x';
              est:=false;
              setfillstyle(1,7);
              fillellipse(100+w+x,60,20,20);
              sound(190);
          end;
      end;
end;

{==========================Начало программы==============================}

Begin
{===================подключение графического модуля========================}
   gr:=detect;
   initgraph(gr,dr,'E:\Distant\tp7\BGI');
   directvideo:=false;
   for i:=1 to 10 do{4 цикла задоющих начального состояния ботов}
   bots[i]:='a';
   for i:=11 to 20 do
   bots[i]:='b';
   for i:=21 to 30 do
   bots[i]:='c';
   for i:=1 to 300 do {Занесения в массив координат Звезд случайным вбором}
   begin
       stars_x_y[1,i]:=random(640);
       stars_x_y[2,i]:=random(480);
   end;
   stars(stars_x_y);{вывод на экран звёзд}
   setcolor(7);{заполнение массива pol координатами вершин треугольника}
   pol[1].x:=320; pol[1].y:=420;
   pol[2].x:=310; pol[2].y:=440;
   pol[3].x:=330; pol[3].y:=440;
   pol[4].x:=320; pol[4].y:=420;
   DrawPoly(4,pol);{рисование треугольника и заливка его красным цветом}
   setfillstyle(solidfill,red);
   FloodFill(320,439,7);
   b:=-150;{начальное смещение ботов}

   repeat{начало главного цикла программы}

   Case b of{оператор выбора опредиляет дошли ли боты до конца экрана и в какую сторону им двиготься}
    100:Napr:='l';
   -130:Napr:='r';
   end;
   if pow=10 then
   begin
       if Napr='l' then b:=b-5 {движение ботов путем изменения значения их смещения}
       else b:=b+5;
       Boti (bots,b);
       pow:=0;
   end;
   stars(stars_x_y);{вывод на экран звезд}
   if polet=true then {проверка условия находится ли пуля в полёте или нет}
   begin
       if r<=0 then begin polet:=false;end{если пуля столкнулась с какимнибуть
       объектом или достигла конца экрана то полёт
       прекрощается иначе продолжается её перемещение}
       else
       begin
           r:=r-10;
           fire(a,r);
       end;
   end;
   Hit(b,r,a,bots,polet);{Обращение к процидуре которая определяет попала ли пуля в цель}
{========================================================================}
   if keypressed then{проверка условия былали нажата клавиша}
   begin
       c:=readkey;{присваевание переменной с значение нажатой клавиши}
       case c of{в зависимости от того какая клавиша была нажата оператором выбора выберается действие}
       #75:if x>-300 then x:=x-7;{уменьшить значение х если была нажата клавиша в лево}
       #77:if x<300 then x:=x+7; {увеличить значение х если была нажата клавиша в право}
       #32:if polet=false then begin  sound(1700); a:=x+320; r:=420;  polet:=true; end;
{если был нажат пробел то производится выстрел из вершины треугольника}
       end;
       setcolor(0);{закрашивание предыдущего треугольника}
       DrawPoly(4,pol);
       setfillstyle(solidfill,0);
       FloodFill(320+x,439,0);
       setcolor(7);{вывод на экран нового треугольника с новыми координатами}
       pol[1].x:=320+x; pol[1].y:=420;
       pol[2].x:=310+x; pol[2].y:=440;
       pol[3].x:=330+x; pol[3].y:=440;
       pol[4].x:=320+x; pol[4].y:=420;
       DrawPoly(4,pol);
       setfillstyle(solidfill,red);
       FloodFill(320+x,439,7);
   end;
   delay(5000);
   nosound;
   pow:=pow+1;
   until c=#27;{конец главного цикла если была нажата клавиша Esc}
   closegraph;{закрытие модуля graph}
end.{конец программы}


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

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

 





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