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

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

06.05.2016, 20:26. Показов 900. Ответов 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
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
06.05.2016, 20:26
Ответы с готовыми решениями:

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

Заполнить матрицу по спирали против часовой стрелки
помогите поменять циклы в коде и сделать такую спираль: 1 32 31 30 29 28 27 26 25 2 33 56 55 54...

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

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

2
Почетный модератор
64275 / 47574 / 32739
Регистрация: 18.05.2008
Сообщений: 115,182
07.05.2016, 16:00 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
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  [ТС] 3
Огромное спасибо!!! Крайне благодарен за помощь!
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
09.05.2016, 17:31
Помогаю со студенческими работами здесь

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

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

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

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


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

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

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2023, CyberForum.ru