0 / 0 / 0
Регистрация: 06.05.2016
Сообщений: 2

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

06.05.2016, 20:26. Показов 1202. Ответов 2
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Здравствуйте, простые пользователи просторов интернета и продвинутые магистры паскаля
Огромная просьба, крик о помощи - не могу разобраться с некоторыми тонкостями паскаля, грубо говоря - я чайник, поэтому прошу помочь!
Моё задание:
Создать 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.
0
Programming
Эксперт
39485 / 9562 / 3019
Регистрация: 12.04.2006
Сообщений: 41,671
Блог
06.05.2016, 20:26
Ответы с готовыми решениями:

Матрица по спирали против часовой стрелки
Здравствуйте. Имеется программа заполнения матрицы по спирали начиная с верхнего левого угла по часовой стрелке: #include...

Заполнить матрицу по спирали против часовой стрелки
помогите поменять циклы в коде и сделать такую спираль: 1 32 31 30 29 28 27 26 25 2 33 56 55 54 53 52 51 24 3 34 57 72 71 70 69 50 23...

Заполнить матрицу по спирали против часовой стрелки
Ребят,помогите пожалуйста. Нужно заполнить матрицу числами по спирали против часовой стрелки. Заранее спасибо.

2
Почетный модератор
 Аватар для Puporev
64312 / 47609 / 32742
Регистрация: 18.05.2008
Сообщений: 115,181
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.
1
0 / 0 / 0
Регистрация: 06.05.2016
Сообщений: 2
09.05.2016, 17:31  [ТС]
Огромное спасибо!!! Крайне благодарен за помощь!
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
inter-admin
Эксперт
29715 / 6470 / 2152
Регистрация: 06.03.2009
Сообщений: 28,500
Блог
09.05.2016, 17:31
Помогаю со студенческими работами здесь

Массив A[2*n+1][2*n+1] заполнить по спирали против часовой стрелки, начиная из центра
Можете пожалуйста помочь, я должен решить задачки и вот одна из них: Дано число n. Создайте массив A и заполните его по спирали,...

Записать текст матрицы от ее центра по спирали против часовой стрелки
Задача записать текст квадратной матрицы размера n(n-нечетное) от центра матрицы по спирали против часовой стрелки. Например матрица n i...

Заполнить двумерный массив цифрами по спирали, против часовой стрелки
Доброго времени суток. Вот задание : Заполнить двумерный массив цифрами по спирали, против часовой стрелки. Вот решение: ...

Вывести содержимое файла в матрицу по спирали против часовой стрелки
необходимо считывать из файла символ и заносить его в матрицу по спирали против часовой стрелки, не совсем понятен алгоритм заполнения как...

Заполнение матрицы по спирали, начиная с центральной клетки, против часовой стрелки
Никак не могу разобраться с чего начать. Помогите, пожалуйста. Дано число n. Создайте массив A и заполните его по спирали, начиная с...


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

Или воспользуйтесь поиском по форуму:
3
Ответ Создать тему
Опции темы

Новые блоги и статьи
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
В современном мире разработки игр выбор технологии - это зачастую балансирование между удобством разработки, переносимостью и производительностью. Когда я решил создать свою первую веб-игру, мой. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2025, CyberForum.ru