Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 26.01.2011, 11:05   #1
Homeros
Новичок
Джуниор
 
Регистрация: 26.01.2011
Сообщений: 3
По умолчанию Игра в ABC Паскале

Написал программу, выдаёт ошибку, помогите пожалуйста исправить


текст задачи:
Дана прямоугольная область в которой происходит движение шариков. Каждый шарик имеет свой диаметр, цвет, скорость перемещения и начальное направление движения. При достижении шариком границы области происходит изменение направления движения по закону отражения, причём воодится помеха -5% +5%. Предусмотреть добавление и удаление шариков, изменение цвета шариков.

Код:
Program Shariki;
USES GraphABC, CRT;
VAR {каждый i-й шарик характеризуется i-ми параметрами следущих массивов}
        x:Array[0..49] of Integer; {координата по X}
        y:Array[0..49] of Integer; {координата по Y}
        r:Array[0..49] of Integer; {радиус, может быть от rmin до rmax}
        c:Array[0..49] of Integer; {цвет, код цвета от 1 до 15 (0 - черный)}
        s:Array[0..49] of Integer; {скорость, может быть от 1 до smax}
        d:Array[0..49] of Integer; {направление, может быть 1 или -1}
        k:Array[0..49] of Real; {угловой коэффициент вектора направления}
        b:Array[0..49] of Real; {линейный сдвиг вектора направления}
        a:Array[0..49] of Integer; {активность, может быть 1 или 0 (летает шарик, или удален)}
 
        {общие параметры алгоритма}
        x1,y1:Integer; {координаты верхне-левого угла зоны}
        x2,y2:Integer; {координаты нижне-правого угла зоны}
        maxq:Integer; {максимальное количество шариков (исходя из заданных массивов - 50)}
        smax:Integer; {максимально возможная скорость шарика}
        cmax:Integer; {максимально возможный код цвета}
        rmin,rmax:Integer; {макс и мин радиус}
        speed,i:Integer; {параметры циклов}
        quit:Integer; {разрешение на выход}
        ukey:Char; {переменная кода кнопки}
        q:Integer; {количество шариков на поле в данный момент}
 
{-----------------------------------------------}
Procedure Generate(z:Integer);
Var t:Integer;
        tr:Real;
Begin
        t:=FloatToStr(GetMaxX/2);
        x[z]:=Random(100)-50+t;
        t:=rmax-rmin;
        r[z]:=Random(t)+rmin;
        t:=cmax-1;
        c[z]:=Random(t)+1;
        t:=smax-1;
        s[z]:=Random(smax)+1;
        d[z]:=Random(1);
        If d[z]=0 then d[z]:=-1;
        t:=Random(100);
        k[z]:=t/10-5;
        t:=Random(100);
        b[z]:=t/10-5;
        a[z]:=1;
 
        tr:=k[z]*x[z]+b[z];
        y[z]:=ОКРУГЛИТЬ(tr);
End;
 
{-----------------------------------------------}
Procedure INIT; {определение основных параметров и заполнение массива случайными шариками}
Var t:Integer;  {временная переменная для промежуточных расчетов}
        tr:Real;
Begin
        x1:=50;
        y1:=50;
        x2:=GetMaxX-50;
        y2:=GetMaxY-50;
        maxq:=50;
        smax:=10;
        cmax:=15;
        rmin:=1;
        rmax:=30;
        q:=10;
 
        for i:=0 to 9 do {генерируем 10 шариков для начала}
        Begin
                Generate(i);
                SetPenColor(c[i]);
                tr:=k[z]*x[i]+b[i];
                t:=ОКРУГЛИТЬ(tr);
                Circle(x[i],t,r[i]);
        End; {первые 10 шариков сгенерированы и нарисованы}
End;
 
{-----------------------------------------------}
Procedure AddOne;
Var t:Integer;
Begin
        t:=0;
        Repeat
                If a[t]=0 then
                Begin
                        Generate(t);
                        t:=maxq;
                        q:=q+1;
                End;
        Until t<>maxq;
End;
 
{-----------------------------------------------}
Procedure DelOne;
Var t,tt:Integer;
Begin
If q>1 then
Begin
        t:=q-1
        t:=Random(t)+1;
        tt:=-1;
        Repeat
                tt:=tt+1;
                If a[tt]=1 then t:=t-1
                If t=0 then
                Begin
                        a[tt]:=0;
                        SetPenColor(0);
                        Circle(x[tt],y[tt],r[tt]);
                        tt:=maxq;
                End;
        Until tt<>maxq;
End;
End;
 
{-----------------------------------------------}

Последний раз редактировалось Serge_Bliznykov; 26.01.2011 в 13:57.
Homeros вне форума Ответить с цитированием
Старый 26.01.2011, 11:05   #2
Homeros
Новичок
Джуниор
 
Регистрация: 26.01.2011
Сообщений: 3
По умолчанию

Продолжение:
Код:
Procedure Redraw(num);
Var tr:Real;
Begin
        {стираем старый шарик}
        SetPenColor(0);
        Circle(x[num],y[num],r[num]);
 
        {вычисляем новые координаты}
        If ((y[num]-r[num])<=y1)OR((y[num]+r[num])>=y2) then
        Begin {когда шарик достиг ВЕРХНЕЙ или НИЖНЕЙ границы зоны}
                tr:=(Random(10)-5)/100;
                k[num]:=-k[num]*tr; {вносим погрешность}
        End;
        If ((x[num]-r[num])<=x1)OR((x[num]+r[num])>=x2) then
        Begin {когда шарик достиг ЛЕВОЙ или ПРАВОЙ границы зоны}
                tr:=(Random(10)-5)/100;
                k[num]:=-k[num]+tr; {вносим погрешность}
                b[num]:=-b[num];
                d[num]:=-d[num];
        End;
        x[num]:=x[num]+d[num];
        tr:=k[num]*x[num]+b[num];
        y[num]:=ОКРУГЛИТЬ(tr);
 
        {рисуем новый шарик}
        SetPenColor(c[num]);
        Circle(x[num],y[num],r[num]);
End;
 
{-----------------------------------------------}
BEGIN
        RANDOMIZE;
        InitGraph({указать режим});
        ClrScr;
        INIT;
 
        REPEAT {Раскручиваем главный цикл}
        for speed:=1 to smax do
        Begin
                for i:=0 to maxq do
                Begin
                        If (s[i]>=speed)AND(a[i]=1) then Redraw(i);
                End;
 
        End;
 
        ReadKey(ukey);
        If ukey=27 then quit:=1; {если нажат ESC}
        If ukey=43 then AddOne; {если нажат +}
        If ukey=45 then DelOne; {если нажат -}
        UNTIL quit=0; {Точка выхода из главного цикла}
 
END.

___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

Последний раз редактировалось Serge_Bliznykov; 26.01.2011 в 13:57.
Homeros вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
паскаль.Как подключить модуль ''graph'' в паскале abc? AndrewPl Помощь студентам 11 22.03.2013 19:11
игра на паскале! olikik Паскаль, Turbo Pascal, PascalABC.NET 3 01.06.2010 15:51
игра на паскале alex(21) Gamedev - cоздание игр: Unity, OpenGL, DirectX 6 26.06.2009 17:14
Игра на Паскале МаксимNEWProgramm Gamedev - cоздание игр: Unity, OpenGL, DirectX 2 02.05.2008 11:12
Игра на Паскале! Guar Помощь студентам 6 14.10.2007 00:20