Паскаль, графика. Движущийся шар по спирали по часовой и против часовой стрелки

@MoonVertical · Регистрация: 06.05.2016

Студворк — интернет-сервис помощи студентам

Здравствуйте, простые пользователи просторов интернета и продвинутые магистры паскаля

Огромная просьба, крик о помощи - не могу разобраться с некоторыми тонкостями паскаля, грубо говоря - я чайник, поэтому прошу помочь!
Моё задание:
Создать 1 - меню, 2 - титульный лист, 3 - движение шарика по спирали по часовой стрелки, 4 - движение шарика против часовой стрелки, 5 - выход из программы.
В принципе 1, 2, 3 и 5 пункт готовы.
Нужна помощь:
- Выход из графики (3, 4 пункты) при помощи клавиши Esc и возврат в меню.
- Движение шарика против часовой стрелки (понимаю, что нужно "y" задать через "-", но не могу реализовать. Помогите, пожалуйста!).
- работа всей программы без косяков.

За помощь - огромное человеческое спасибо и +1000 к карме! Буду очень благодарен, ребят!!!

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
Program shar;
uses graphABC;
Const p:array[1..4] of string[25]=('Титульник','По часовой стрелке','Против часовой стрелки','Выход') ;
Var a, i:byte;
b:char;
c:byte;
t:integer;
{-----------------------------------------------------------}
procedure okno;
var x,y:integer;
s:string;
begin 
  x:=windowwidth;
  y:=windowheight;
  str(x,s);
  textout(100,100,s);
  str(y,s);
  textout(100,500,s);
end;
procedure text_menu(a:byte); 
var i:byte; 
begin 
  for i:=1 to 4 do 
    begin 
    if i=a then 
    setfontcolor(clred) 
   else
    setfontcolor(clblack);
    textout(280,170+30*i,p[i]); 
    end; 
end; 
{---------------------------------------------------------------}
Procedure titulniy;
begin
Setfontcolor((clblack));
Textout(100,5,'Министерство образования и науки Российской Федерации');
Textout(10,20,'Федеральное государственное автономное общеобразовательное учереждение высшего');
Textout(10,35,'профессионального образования "Уральский федеральный университет имени первого Президента');
Textout(250,50,'России Б.Н.Ельцина"');
Textout(250,80,'Строительный институт');
Textout(255,95,'Кафедра Гидравлики');
Textout(260,110,'Курсовая работа');     
Textout(262,125,'по информатике');
Textout(220,145,'"Движение шарика по спирали"');
Textout(420,280,'Группа Ст-150003');
Textout(420,295,'Выполнил:  Романенко Р.П.');
Textout(420,310,'Проверила:  Служеникина Н.В.');  
Textout(420,325,'Дата сдачи:15.05.2016');
Textout(250,450,'Екатеринбург, 2016');
end;
{--------------------------------------------}
procedure pochasovoi;
var xc,yc,x,y,n,i,j:integer;
    a,r,f:real;
    m:array[1..2,1..10000]of integer;
begin
setwindowsize(650,650);
centerwindow;
xc:=windowwidth div 2;
yc:=windowheight div 2;
n:=0;
a:=0;
f:=2;
while f<30*pi do
 begin
  r:=2*f;
  n:=n+1;
  m[1,n]:=round(xc+r*cos(f));
  m[2,n]:=round(yc+r*sin(f));
  f:=f+0.01;
 end;
j:=0;
a:=0;
f:=2;
lockdrawing;
while f<30*pi do
 begin
  clearwindow;
  r:=2*f;
  x:=round(xc+r*cos(f));
  y:=round(yc+r*sin(f));
  j:=j+1;
  for i:=1 to j do
  setpixel(m[1,i],m[2,i],clBlue);//рисуем траекторию
  setpencolor(clred);
  setbrushcolor(clred);
  circle(x,y,5);  //рисуем шарик
  sleep(1);
  f:=f+0.01;
  redraw;
 end;
end;
{-------------------------------------------}
procedure knopki(t:integer); 
begin 
case t of 
Vk_enter:
if a=1 then begin clearwindow; titulniy ;  end
else
begin if a=2 then begin clearwindow; pochasovoi;
 
end;
if a=4 then begin closewindow; end;
 
end;
 
 
    
VK_Up:    begin  a:=a-1; if a=0 then a:=4;text_menu(a); end;   
VK_Down:  begin  a:=a+1; if a=5 then a:=1;text_menu(a); end;
    
Vk_Escape:
begin  
if a=1 then begin clearwindow; text_menu(a); end;
if a=2 then begin clearwindow; text_menu(a);  end;
if a=3 then begin clearwindow; text_menu(a);  end;
if a=4 then begin clearwindow; text_menu(a);  end;
end;
end; 
end; 
{--------------------------------}
begin
a:=1;
 
 
text_menu(a); 
onkeydown:=knopki;
 
{pochasovoi;
onkeydown:=knopki;}
end.

@Puporev · 07.05.2016, 16:00

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
Program shar;
uses graphABC;
Const p:array[1..4] of string[25]=('Титульник','По часовой стрелке','Против часовой стрелки','Выход') ;
Var a:byte;
{-----------------------------------------------------------}
procedure okno;//ЗАЧЕМ ЭТО?
var x,y:integer;
begin
  x:=windowwidth;
  y:=windowheight;
  textout(100,100,inttostr(x));
  textout(100,500,inttostr(y));
end;
procedure text_menu(a:byte);
var i:byte;
begin
for i:=1 to 4 do
 begin
  if i=a then setfontcolor(clred)
  else setfontcolor(clblack);
  textout(280,170+30*i,p[i]);
 end;
end;
{---------------------------------------------------------------}
Procedure titulniy;
begin
Setfontcolor((clblack));
Textout(100,5,'Министерство образования и науки Российской Федерации');
Textout(10,20,'Федеральное государственное автономное общеобразовательное учереждение высшего');
Textout(10,35,'профессионального образования "Уральский федеральный университет имени первого Президента');
Textout(250,50,'России Б.Н.Ельцина"');
Textout(250,80,'Строительный институт');
Textout(255,95,'Кафедра Гидравлики');
Textout(260,110,'Курсовая работа');
Textout(262,125,'по информатике');
Textout(220,145,'"Движение шарика по спирали"');
Textout(420,280,'Группа Ст-150003');
Textout(420,295,'Выполнил:  Романенко Р.П.');
Textout(420,310,'Проверила:  Служеникина Н.В.');
Textout(420,325,'Дата сдачи:15.05.2016');
Textout(250,450,'Екатеринбург, 2016');
end;
{--------------------------------------------}
procedure spiral(k:integer);
var xc,yc,x,y,n,i,j:integer;
    r,f:real;
    m:array of Point;//[1..2,1..10000]of integer;
begin
setwindowsize(650,650);
centerwindow;
xc:=windowwidth div 2;
yc:=windowheight div 2;
setbrushcolor(clred);
setbrushstyle(bsSolid);
n:=0;
f:=0;
while f<=20*pi do
 begin
  r:=5*f;
  n:=n+1;
  setlength(m,n);
  m[n-1].x:=round(xc+r*cos(f));
  m[n-1].y:=round(yc+k*r*sin(f));
  f:=f+0.05;
 end;
j:=0;
f:=0;
lockdrawing;
while f<=20*pi do
 begin
  clearwindow;
  r:=5*f;
  x:=round(xc+r*cos(f));
  y:=round(yc+k*r*sin(f));
  j:=j+1;
  moveto(m[0].x,m[0].y);
  setpencolor(clBlue);
  for i:=1 to j-1 do
  lineto(m[i].X,m[i].y);
  setpencolor(clred);
  setbrushcolor(clred);
  setbrushstyle(bsSolid);
  circle(x,y,5);  //рисуем шарик
  sleep(1);
  f:=f+0.05;
  redraw;
 end;
unlockdrawing;
setbrushcolor(clWhite);
end;
{-------------------------------------------}
procedure knopki(t:integer);
begin
case t of
Vk_enter:case a of
         1:begin 
           clearwindow; 
           titulniy ;  
           end;
         2:begin 
           clearwindow; 
           spiral(1);
           end;
         3:begin 
           clearwindow; 
           spiral(-1);
           end;  
         4:closewindow; 
         end;
VK_Up:begin
      a:=a-1; 
      if a=0 then a:=4;
      text_menu(a); 
      end;
VK_Down:begin
        a:=a+1;
        if a=5 then a:=1;
        text_menu(a); 
        end;
Vk_Escape:begin//выход из каждой из 3х процедур
          setwindowsize(640,480); 
          clearwindow;
          a:=1;
          text_menu(a);
          end;
end;
end;
 
{--------------------------------}
begin
a:=1;
centerwindow;
text_menu(a);
onkeydown:=knopki;
end.

@MoonVertical · 09.05.2016, 17:31 **[ТС]**

Огромное спасибо!!! Крайне благодарен за помощь!

Новые блоги и статьи Все статьи Все блоги /
Angular vs Svelte - что лучше? Reangularity 09.07.2025 Сегодня рынок разделился на несколько четких категорий: тяжеловесы корпоративного уровня (Angular), гибкие универсалы (React), прогрессивные решения (Vue) и новая волна компилируемых фреймворков. . .	Code First и Database First в Entity Framework UnmanagedCoder 09.07.2025 Entity Framework дает нам свободу выбора, предлагая как Code First, так и Database First подходы. Но эта свобода порождает вечный вопрос — какой подход выбрать? Entity Framework — это. . .	Как использовать Bluetooth-модуль HC-05 с Arduino Wired 08.07.2025 Bluetooth - это технология, созданная чтобы заменить кабельные соединения. Обычно ее используют для связи небольших устройств: мобильных телефонов, ноутбуков, наушников и т. д. Работает она на частоте. . .	Руководство по структурам данных Python AI_Generated 08.07.2025 Я отчетливо помню свои первые серьезные проекты на Python - я писал код, он работал, заказчики были относительно довольны. Но однажды мой наставник, взглянув на мою реализацию поиска по огромному. . .	Тестирование энергоэффективности и скорости вычислений видеокарт в BOINC проектах Programma_Boinc 08.07.2025 Тестирование энергоэффективности и скорости вычислений видеокарт в BOINC проектах Опубликовано: 07. 07. 2025 Рубрика: Uncategorized Автор: AlexA Статья размещается на сайте с разрешения. . .
Раскрываем внутренние механики Android с помощью контекста и манифеста mobDevWorks 07.07.2025 Каждый Android-разработчик сталкивается с Context и манифестом буквально в первый день работы. Но много ли мы задумываемся о том, что скрывается за этими обыденными элементами? Я, честно говоря,. . .	API на базе FastAPI с Python за пару минут AI_Generated 07.07.2025 FastAPI - это относительно молодой фреймворк для создания веб-API, который за короткое время заработал бешеную популярность в Python-сообществе. И не зря. Я помню, как впервые запустил приложение на. . .	Основы WebGL. Раскрашивание вершин с помощью VBO 8Observer8 05.07.2025 На русском https:/ / vkvideo. ru/ video-231374465_456239020 На английском https:/ / www. youtube. com/ watch?v=oskqtCrWns0 Исходники примера:	Мониторинг микросервисов с OpenTelemetry в Kubernetes Mr. Docker 04.07.2025 Проблема наблюдаемости (observability) в Kubernetes - это не просто вопрос сбора логов или метрик. Это целый комплекс вызовов, которые возникают из-за самой природы контейнеризации и оркестрации. К. . .	Проблемы с Kotlin и Wasm при создании игры GameUnited 03.07.2025 В современном мире разработки игр выбор технологии - это зачастую балансирование между удобством разработки, переносимостью и производительностью. Когда я решил создать свою первую веб-игру, мой. . .

@MoonVertical 0 / 0 / 0 Регистрация: 06.05.2016 Сообщений: 2
	09.05.2016, 17:31 [ТС]
	Огромное спасибо!!! Крайне благодарен за помощь! 0

Опции темы