С Новым годом! Форум программистов, компьютерный форум, киберфорум
Pascal ABC
Форум программистов и сисадминов Киберфорум > Форум программистов > Pascal (Паскаль) > Pascal ABC
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.59/41: Рейтинг темы: голосов - 41, средняя оценка - 4.59
0 / 0 / 0
Регистрация: 13.01.2011
Сообщений: 10

Игра в Паскале

25.01.2011, 23:26. Показов 7738. Ответов 5
Метки нет (Все метки)
Студворк — интернет-сервис помощи студентам
Помогите пожалуйста исправить ошибки в программе

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

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168

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;
 
{-----------------------------------------------}
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.
0
cpp_developer
Эксперт
20123 / 5690 / 1417
Регистрация: 09.04.2010
Сообщений: 22,546
Блог
 25.01.2011, 23:26
Ответы с готовыми решениями:

Мини - игра на паскале
Игровая программа. Компьютер загадывает случайное число в диапазоне от 0 до 100. Пользователь должен угадать это число. Если угадал,то...

Простейшая игра на паскале
Здравствуйте, стало интересным создание своей игры на паскале.. не знаю с чего начать..может что изучить перед этим надо? Сложно ли сделать...

Игра в слова на Паскале, используя матрицу
Здравствуйте всем! Подскажите, пожалуйста, как написать игру в слова, используя матрицу на Паскале? Можно простой пример. И если вам не...

5
Почетный модератор
 Аватар для Puporev
64314 / 47610 / 32743
Регистрация: 18.05.2008
Сообщений: 115,168
26.01.2011, 08:08
Homeros, А в чем вопрос? Я смотрю в Вашем коде какая-то смесь АВС и Турбо Паскаля. У Вас вопрос какой-то или что?
0
0 / 0 / 0
Регистрация: 13.01.2011
Сообщений: 10
26.01.2011, 09:44  [ТС]
Мне нужно чтобы программа работала в ABC Паскале, написал что знаю, а он ошибки выдаёт...
Помогите пожалуйста исправить ошибки!
0
Почетный модератор
 Аватар для Puporev
64314 / 47610 / 32743
Регистрация: 18.05.2008
Сообщений: 115,168
26.01.2011, 11:42
Синтаксис я исправил, но программа абсолютно нерабочая, разбираться в ней я конечно не буду.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164

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:=windowwidth div 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]:=round(tr);
End;
 
{-----------------------------------------------}
Procedure INIT; {определение основных параметров и заполнение массива случайными шариками}
Var t:Integer;  {временная переменная для промежуточных расчетов}
        tr:Real;
Begin
        x1:=50;
        y1:=50;
        x2:=windowwidth-50;
        y2:=windowheight-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[i]*x[i]+b[i];
                t:=round(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;
 
{-----------------------------------------------}
Procedure Redraw(num:integer);
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]:=round(tr);
 
        {рисуем новый шарик}
        SetPenColor(c[num]);
        Circle(x[num],y[num],r[num]);
End;
 
{-----------------------------------------------}
BEGIN
        RANDOMIZE;
 
        ClrScr;
        INIT;
 
        REPEAT {Раскручиваем главный цикл}
        for speed:=1 to smax do
         Begin
          for i:=0 to maxq do
          If (s[i]>=speed)AND(a[i]=1) then Redraw(i);
         End;
         ukey:=ReadKey;
        If ukey=#27 then quit:=1; {если нажат ESC}
        If ukey=#43 then AddOne; {если нажат +}
        If ukey=#45 then DelOne; {если нажат -}
        UNTIL quit=0; {Точка выхода из главного цикла}
 
END.
0
5 / 5 / 4
Регистрация: 06.03.2010
Сообщений: 27
26.01.2011, 12:58
советую переписать программу и зачем стока массивов ? не легче создать запись и хранить эти записи в массиве
0
 Аватар для Г@риК
0 / 0 / 1
Регистрация: 26.01.2011
Сообщений: 7
31.01.2011, 23:46
Абсолютно не рабочая

Добавлено через 40 секунд
Она конечно запускается но выгод за пределы
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
 31.01.2011, 23:46
Помогаю со студенческими работами здесь

Моя игра на паскале
Делая свой арканойд с класным названием :) на паскале столкнулся с проблемами: шарик не отражается от кирпичей и от ракетки, и сама...

Игра камень,ножницы,бумага в Паскале
Составить программу камень,ножницы,бумага.Для двух играющих-пользователя и компьютера.Каждый из них должен выбрать 1 из 3-х упомянутых...

игра "БАШЕ" на паскале АБС
Добрый день, это программа для курсовой)) мне нужно добавить выход(начать заново) из программы, но что-то я не могу понять как....

Игра в паскале "Волк и яйца"
Пишу игру, вводный проект, но не могу разобраться с падающими яйцами. Пытаюсь сделать так, чтобы они появлялись в 4 местах и катились по...

Как работает join и split в Паскале? И есть ли такие аналоги Питону в Паскале?
a=input() #из ' Hello world ' делаю 'Hello, world' a.strip(' ') a=', '.join(a.split(' ')) В Паскале как такое сделать?


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
6
Ответ Создать тему
Новые блоги и статьи
Учёным и волонтёрам проекта «Einstein@home» удалось обнаружить четыре гамма-лучевых пульсара в джете Млечного Пути
Programma_Boinc 01.01.2026
Учёным и волонтёрам проекта «Einstein@home» удалось обнаружить четыре гамма-лучевых пульсара в джете Млечного Пути Сочетание глобально распределённой вычислительной мощности и инновационных. . .
Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост.
Programma_Boinc 28.12.2025
Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Налог на собак: https:/ / **********/ gallery/ V06K53e Финансовый отчет в Excel: https:/ / **********/ gallery/ bKBkQFf Пост отсюда. . .
Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США.
Programma_Boinc 26.12.2025
Нашел на реддите интересную статью под названием Anyone know where to get a free Desktop or Laptop? Ниже её машинный перевод. После долгих разбирательств я наконец-то вернула себе. . .
Thinkpad X220 Tablet — это лучший бюджетный ноутбук для учёбы, точка.
Programma_Boinc 23.12.2025
Рецензия / Мнение/ Перевод Нашел на реддите интересную статью под названием The Thinkpad X220 Tablet is the best budget school laptop period . Ниже её машинный перевод. Thinkpad X220 Tablet —. . .
PhpStorm 2025.3: WSL Terminal всегда стартует в ~
and_y87 14.12.2025
PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .
Как объединить две одинаковые БД Access с разными данными
VikBal 11.12.2025
Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.
Новый ноутбук
volvo 07.12.2025
Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro
 Музыка, написанная Искусственным Интеллектом
volvo 04.12.2025
Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .
От async/await к виртуальным потокам в Python
IndentationError 23.11.2025
Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .
Поиск "дружественных имён" СОМ портов
Argus19 22.11.2025
Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Поддержать - Реклама - Условия использования - Обратная связь
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru