Форум программистов, компьютерный форум, киберфорум
Pascal ABC
Форум программистов и сисадминов Киберфорум > Форум программистов > Pascal (Паскаль) > Pascal ABC
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.55/11: Рейтинг темы: голосов - 11, средняя оценка - 4.55
31 / 31 / 16
Регистрация: 02.11.2011
Сообщений: 216

В конце программы фигуры стирают линию финиша

03.02.2012, 20:37. Показов 2028. Ответов 2
Метки нет (Все метки)
Студворк — интернет-сервис помощи студентам
В конце программы фигуры стирают линию финиша. исправте программу пожалуйста.
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

uses
    crt,Graph;
var
    x,k,l,m,sk,sl,sm,p1,p2,p3: integer;
    grDriver: Integer; grMode: Integer;
    ErrCode: Integer;
    res: integer;
    p:char;
procedure Stadion;
begin
 SetBkColor(green);
 setcolor(LightGray);
 SetFillStyle(1,LightGray);
 Bar(0,65,4,165);
 Bar(0,200,4,300);
 Bar(0,330,4,430);
 Bar(36,65,584,165);
 Bar(36,200,584,300);
 Bar(36,330,584,430);
 Bar(606,65,675,165);
 Bar(606,200,675,300);
 Bar(606,330,675,430);
 setcolor(white);
 SetFillStyle(1,white);
 Bar(5,55,35,455);
 Bar(585,55,605,455);
 setcolor(red);
 OutTextXY(20,175,'S');
 OutTextXY(20,195,'T');
 OutTextXY(20,215,'A');
 OutTextXY(20,235,'R');
 OutTextXY(20,255,'T');
 OutTextXY(590,175,'F');
 OutTextXY(590,195,'I');
 OutTextXY(590,215,'N');
 OutTextXY(590,235,'I');
 OutTextXY(590,255,'S');
 OutTextXY(40,110,'1');
 OutTextXY(40,250,'2');
 OutTextXY(40,380,'3');
end;
procedure Kadr(x,k,l,m: integer);
begin
 setcolor(red);
 SetFillStyle(1,red);
 circle(x+k,110,10);
 circle(x+l,250,10);
 circle(x+m,380,10);
 delay(1500);
 setcolor(LightGray);
 SetFillStyle(1,LightGray);
 circle(x+k,110,10);
 circle(x+l,250,10);
 circle(x+m,380,10);
end;
begin
 grDriver := detect;
 InitGraph(grDriver, grMode,'D:\BP\BGI\');
 ErrCode := GraphResult;
if ErrCode = grOk then
begin
 randomize;
 Stadion;
 OutTextXY(200,250,'press Enter to start challenge');
 x:=65; k:=0; l:=0; m:=0; sk:=0; sl:=0; sm:=0;
 setcolor(red);
 SetFillStyle(1,red);
 circle(x+k,110,10);
 circle(x+l,250,10);
 circle(x+m,380,10);
 p:=readkey;
 Stadion;
if p=#13 then
begin
 for x:=65 to 165 do
    Kadr(x,k,l,m);
 for x:=165 to 655 do
    begin
    if (x mod 100=0) and (x<555) then
       begin
        k:=random(21); sk:=sk+k;
        l:=random(21); sl:=sl+l;
        m:=random(21); sm:=sm+m;
       end;
    Kadr(x,k,l,m);
    end;
 Stadion;
if (sk>sl) and (sk>sm) then
   begin
    OutTextXY(200,230,'winner is 1 sportsman');
    if sl>sm then
       begin
        OutTextXY(200,250,'2 sportsman - 2 plase');
        OutTextXY(200,270,'3 sportsman - 3 plase');
       end
    else
       begin
        OutTextXY(200,250,'3 sportsman - 2 plase');
        OutTextXY(200,270,'2 sportsman - 3 plase');
       end;
   end
   else
   if (sl>sm) and (sl>sk) then
   begin
    OutTextXY(200,230,'winner is 2 sportsman');
    if sk>sm then
      begin
       OutTextXY(200,250,'1 sportsman - 2 plase');
       OutTextXY(200,270,'3 sportsman - 3 plase');
      end
      else
      begin
       OutTextXY(200,250,'3 sportsman - 2 plase');
       OutTextXY(200,270,'1 sportsman - 3 plase');
      end;
   end
   else
   begin
    OutTextXY(200,230,'winner is 3 sportsman');
    if sk>sl then
      begin
       OutTextXY(200,250,'1 sportsman - 2 plase');
       OutTextXY(200,270,'2 sportsman - 3 plase');
      end
      else
      begin
       OutTextXY(200,250,'2 sportsman - 2 plase');
       OutTextXY(200,270,'1 sportsman - 3 plase');
      end
   end;
end;
readkey;
end;
CloseGraph;
end.
0
Programming
Эксперт
39485 / 9562 / 3019
Регистрация: 12.04.2006
Сообщений: 41,671
Блог
 03.02.2012, 20:37
Ответы с готовыми решениями:

Как отрисовывать линию, соединяющую две фигуры, так, чтобы она не пересекала эти фигуры и другие линии
Подскажите, пожалуйста, как отрисовывать линию, соединяющую две фигуры, так, чтобы она не пересекала эти фигуры и другие соединительные...

Как нарисовать линию позади фигуры?
Есть окружности, залитые цветом. Я хочу связать их центры линией, но чтобы она была видна лишь за пределами окружностей. Как это сделать?...

Прекратить рисовать линию, если ее конец достиг другой нарисованной фигуры (круга)
Доброго времени суток! Рисую в GDI. Мне необходимо нарисовать окружность и стрелку к ней (стрелка может быть нарисована в любой части...

2
Почетный модератор
 Аватар для Puporev
64316 / 47612 / 32743
Регистрация: 18.05.2008
Сообщений: 115,167
03.02.2012, 22:05
Чего влез в АВС с Турбо?
Можно сделать финиш отдельной процедурой.
Вставил ее везде, хотя можно только с момента когда первый дойдет до финиша, но это уже сам.
И задержка у тебя 1500 ненормальная, это кривые модули .tpl нормально когда delay(1000)= 1 секунде.
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

uses
    crt,Graph;
var
    x,k,l,m,sk,sl,sm,p1,p2,p3: integer;
    grDriver: Integer; grMode: Integer;
    ErrCode: Integer;
    res: integer;
    p:char;
procedure Stadion;
begin
 SetBkColor(green);
 setcolor(LightGray);
 SetFillStyle(1,LightGray);
 Bar(0,65,4,165);
 Bar(0,200,4,300);
 Bar(0,330,4,430);
 Bar(36,65,584,165);
 Bar(36,200,584,300);
 Bar(36,330,584,430);
 Bar(606,65,675,165);
 Bar(606,200,675,300);
 Bar(606,330,675,430);
 setcolor(white);
 SetFillStyle(1,white);
 Bar(5,55,35,455);
 setcolor(red);
 OutTextXY(20,175,'S');
 OutTextXY(20,195,'T');
 OutTextXY(20,215,'A');
 OutTextXY(20,235,'R');
 OutTextXY(20,255,'T');
end;
procedure Finish;
begin
setcolor(white);
SetFillStyle(1,white);
Bar(585,55,605,455);
setcolor(red);
OutTextXY(590,175,'F');
OutTextXY(590,195,'I');
OutTextXY(590,215,'N');
OutTextXY(590,235,'I');
OutTextXY(590,255,'S');
OutTextXY(40,110,'1');
OutTextXY(40,250,'2');
OutTextXY(40,380,'3');
end;
procedure Kadr(x,k,l,m: integer);
begin
 setcolor(red);
 SetFillStyle(1,red);
 circle(x+k,110,10);
 circle(x+l,250,10);
 circle(x+m,380,10);
 delay(1500);
 setcolor(LightGray);
 SetFillStyle(1,LightGray);
 circle(x+k,110,10);
 circle(x+l,250,10);
 circle(x+m,380,10);
end;
begin
 grDriver := detect;
 InitGraph(grDriver, grMode,'D:\BP\BGI\');
 ErrCode := GraphResult;
if ErrCode = grOk then
begin
 randomize;
 Stadion;
 Finish;
 OutTextXY(200,250,'press Enter to start challenge');
 x:=65; k:=0; l:=0; m:=0; sk:=0; sl:=0; sm:=0;
 setcolor(red);
 SetFillStyle(1,red);
 circle(x+k,110,10);
 circle(x+l,250,10);
 circle(x+m,380,10);
 p:=readkey;
 Stadion;
 Finish;
if p=#13 then
begin
 for x:=65 to 165 do
    Kadr(x,k,l,m);
 for x:=165 to 655 do
    begin
    if (x mod 100=0) and (x<555) then
       begin
        k:=random(21); sk:=sk+k;
        l:=random(21); sl:=sl+l;
        m:=random(21); sm:=sm+m;
       end;
    Finish;
    Kadr(x,k,l,m);
    end;
 Stadion;
 Finish;
if (sk>sl) and (sk>sm) then
   begin
    OutTextXY(200,230,'winner is 1 sportsman');
    if sl>sm then
       begin
        OutTextXY(200,250,'2 sportsman - 2 plase');
        OutTextXY(200,270,'3 sportsman - 3 plase');
       end
    else
       begin
        OutTextXY(200,250,'3 sportsman - 2 plase');
        OutTextXY(200,270,'2 sportsman - 3 plase');
       end;
   end
   else
   if (sl>sm) and (sl>sk) then
   begin
    OutTextXY(200,230,'winner is 2 sportsman');
    if sk>sm then
      begin
       OutTextXY(200,250,'1 sportsman - 2 plase');
       OutTextXY(200,270,'3 sportsman - 3 plase');
      end
      else
      begin
       OutTextXY(200,250,'3 sportsman - 2 plase');
       OutTextXY(200,270,'1 sportsman - 3 plase');
      end;
   end
   else
   begin
    OutTextXY(200,230,'winner is 3 sportsman');
    if sk>sl then
      begin
       OutTextXY(200,250,'1 sportsman - 2 plase');
       OutTextXY(200,270,'2 sportsman - 3 plase');
      end
      else
      begin
       OutTextXY(200,250,'2 sportsman - 2 plase');
       OutTextXY(200,270,'1 sportsman - 3 plase');
      end
   end;
end;
readkey;
end;
CloseGraph;
end.
0
31 / 31 / 16
Регистрация: 02.11.2011
Сообщений: 216
04.02.2012, 16:57  [ТС]
просто у меня 7 и эта программа на BP не идёт. скачал dosbox и эта программа там идёт очень медменно.

Добавлено через 2 часа 33 минуты
я не ту программу отправил. 1 программа на BP, а 2 - на АВС.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
inter-admin
Эксперт
29715 / 6470 / 2152
Регистрация: 06.03.2009
Сообщений: 28,500
Блог
 04.02.2012, 16:57
Помогаю со студенческими работами здесь

Найти "среднюю линию" плоской фигуры по координатам
Добрый день! Помогите пожалуйста решить задачу. Исходные данные: 4 узловая плоская фигура (известны координаты 4 узлов (x,y,z), не...

Ошибка в конце программы
Uv := 30; Koc2 := 2300; Kpe1 := 1.5; J1 := 0.13e-5; Kmi2 := .48; be := 0.12298e-2; Kqp := .25*10^(-12); Vk := 1.5*10^(-6); Ek := 6*10^8; mu...

Ошибка в конце программы
Добрый день дамы и господа эксперты. Я продолжаю изучать Лафоре. И вообщем делал очередной шаблон и какае-то ерунда случилась. ...

Пересечение финиша
Скажите как сделать чтоб когда одна из трех картинок пересекала shape(финиш) выдавалось сообщение что именно эта пересекла procedure...

Исправить ошибочку в конце программы
//Даны N точек на плоскости. Найти среди них точки являющиеся вершинами фигуры, содержащей максимальное число заданных точек. //Фигура -...


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

Или воспользуйтесь поиском по форуму:
3
Ответ Создать тему
Новые блоги и статьи
Знаешь почему 90% людей редко бывают счастливыми?
kumehtar 14.04.2026
Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.
Фиксация колонок в отчете СКД
Maks 14.04.2026
Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .
Настройки VS Code
Loafer 13.04.2026
{ "cmake. configureOnOpen": false, "diffEditor. ignoreTrimWhitespace": true, "editor. guides. bracketPairs": "active", "extensions. ignoreRecommendations": true, . . .
Оптимизация кода на разграничение прав доступа к элементам формы
Maks 13.04.2026
Алгоритм из решения ниже реализован на нетиповом документе, разработанного в конфигурации КА2. Задачи, как таковой, поставлено не было, проделанное ниже исключительно моя инициатива. Было так:. . .
Контроль заполнения и очистка дат в зависимости от значения перечислений
Maks 12.04.2026
Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .
Архитектура слоя интернета для сервера-слоя.
Hrethgir 11.04.2026
В продолжение https:/ / www. cyberforum. ru/ blogs/ 223907/ 10860. html Знаешь что я подумал? Раз мы все источники пишем в голове ветки, то ничего не мешает добавить в голову такой источник, который сам. . .
Подстановка значения реквизита справочника в табличную часть документа
Maks 10.04.2026
Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: при выборе сотрудника (справочник Сотрудники) в ТЧ документа. . .
Очистка реквизитов документа при копировании
Maks 09.04.2026
Алгоритм из решения ниже применим как для типовых, так и для нетиповых документов на самых различных конфигурациях. Задача: при копировании документа очищать определенные реквизиты и табличную. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Поддержать - Реклама - Условия использования - Обратная связь
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru