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

 
 Ответить  Открыть новую тему 
> Игра. Аркада.
killerfriz
сообщение 28.04.2004 10:31
Сообщение #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 - 14.01.2010 13:11
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 

- Текстовая версия 28.07.2025 11:47
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"