Создать анимацию трансформации (увеличения) и движения (перемещения) графических обьектов одновременно

@constant_bel · Регистрация: 15.11.2015

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

Приветствую Вас господа!
В соответствии с задачей нужно реализовать анимацию с трансформацией (увеличением) и движением (перемещением) некоторых графических объектов одновременно в соответствии с сценарием: гриб - растёт, облака - плывут, солнце - движется по горизонту (окружности).
Код вроде бы как составил. Работает, но не до конца как надо. Выполнение процедур Солнце и Гриб выполняется по очереди, а надо чтоб была одновременная визуализация процедур! Помогите решить, кто может. Заранее благодарю.

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
uses GraphABC;
var
  x, y: integer;
procedure Grib(k: byte);
begin
  //SetBrushColor(clSkyBlue);             // небеса цвет
  //Rectangle(0, 0, 360 , 360);           // небеса
  
  SetBrushColor(clLimeGreen);             // зелёная трава
  Rectangle(0, 360, 500, 500);            // земля
  
  SetBrushColor(clBisque);                // ножка - цвет (Бежевый)
  Rectangle(250 - (k div 5), 370, 250 + (k div 5), 370 - (k));
  
  Arc(250, (370 - k), k, 0, 180);           // шляпка гриба
  Line(250 - k, 370 - k, 250 + k, 370 - k); // основание шляпки
  FloodFill(251, 349 - k, clSaddleBrown);   // шляпка - цвет (Коричневый)
end;
 
procedure Oblako(x, y: integer);// с относительной позицией
begin
  SetPenColor(clWhite);
  setBrushColor(clWhite);
  Rectangle(x, y - 20, x + 100, y);
  Circle(x - 3, y - 10, 15);                // левый
  Circle(x + 100, y - 5, 20);               // правый
  Circle(x + 20, y - 20, 15);
  Circle(x + 30, y, 25);
  Circle(x + 70, y - 10, 25);
  Circle(x + 55, y + 15, 10);
end;
procedure Oblako2(x, y: integer);           // не подвижное
begin
  setpencolor(clwhite);
  setbrushcolor(clwhite);
  circle(x, y, 40);
  circle(x + 30, y, 30);
  circle(x - 40, y, 30);
end;
 
procedure Solnce(x0, y0, r0, r, n: integer; u: real);
var
  r1, i, x, y, x1, y1: integer;
  t: real;
begin
  setpencolor(clyellow);
  setbrushcolor(clyellow);
  {лучи}
  SetPenWidth(2);                        //толщина луча
  x := x0 + round(r0 * cos(u));
  y := y0 - round(r0 * sin(u));
  for i := 1 to n do
  begin
    t := 2 * pi * i / n;                  //угол поворота луча
    if odd(i) then r1 := r                // лучи с нечетным номером:
    else r1 := 2 * r;
    x1 := round(R1 * cos(t));             //абсцисса луча на окружности
    y1 := round(R1 * sin(t));             //ордината луча на окружности
    Line(x, y, x + x1, y - y1);           //рисуем луч
  end;
  {солнце}
  Circle(x, y, r);                        //рисуем солнце
end;
 
var
  x0, y0, r0, xk: integer;
  u: real;
begin
  SetWindowSize(500, 500);                  // устанавливаем размер окна в пикселях
  LockDrawing;                              //блокируем рисование в гр.окне
  x0 := WindowWidth div 2;
  y0 := WindowHeight - 100;
  r0 := x0;
  xk := 0;
  u := pi - ArcTan(WindowHeight / 2 / x0);
  repeat
    ClearWindow;                              // очичаем окно после каждого выполнения цыкла
    Solnce(x0, y0, r0, 30, 20, u);            // инициализируем процедуру Солнце
    Oblako2(100, 90);                         // размножаем облака через процедуру
    Oblako2(400, 120);
    Oblako2(450, 80);
    Sleep(10);
    xk := xk + 1;
    u := u - 0.005;
    redraw; 
  until xk > 600;
    
    y := 70;                               // начальная позиция облака
    x := 5;                                // начальная позиция облака
    for var i := 1 to 120 do
    begin
       LockDrawing; 
       ClearWindow(clCornflowerBlue);         // очищаем окно голубым цветом
       Oblako(x + 3 * i, y);                  // инициализируем процедуру Облако
       Grib(i);                               // инициализируем процедуру Гриб
       Sleep(25);                             // скорость выполнения проц-ры Гриб (задержка)
       redraw;                               // перерисовываем графику в ходе выполнения цикла                              
    end;   
end.

Добавлено через 21 час 47 минут
Вот ещё не много доработал, но до идеала далеко ещё:

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
uses GraphABC;
var
  x, y: integer;
procedure Grib(k: byte);
begin
  //SetBrushColor(clSkyBlue);             // небеса цвет
  //Rectangle(0, 0, 360 , 360);           // небеса
  
  SetBrushColor(clLimeGreen);             // зелёная трава
  Rectangle(0, 360, 500, 500);            // земля
  
  SetBrushColor(clBisque);                // ножка - цвет (Бежевый)
  Rectangle(250 - (k div 5), 370, 250 + (k div 5), 370 - (k));
  
  Arc(250, (370 - k), k, 0, 180);           // шляпка гриба
  Line(250 - k, 370 - k, 250 + k, 370 - k); // основание шляпки
  FloodFill(251, 349 - k, clSaddleBrown);   // шляпка - цвет (Коричневый)
end;
 
procedure Oblako(x, y: integer);// с относительной позицией
begin
  SetPenColor(clWhite);
  setBrushColor(clWhite);
  Rectangle(x, y - 20, x + 100, y);
  Circle(x - 3, y - 10, 15);                // левый
  Circle(x + 100, y - 5, 20);               // правый
  Circle(x + 20, y - 20, 15);
  Circle(x + 30, y, 25);
  Circle(x + 70, y - 10, 25);
  Circle(x + 55, y + 15, 10);
end;
procedure Oblako2(x, y: integer);           // не подвижное
begin
  setpencolor(clwhite);
  setbrushcolor(clwhite);
  circle(x, y, 40);
  circle(x + 30, y, 30);
  circle(x - 40, y, 30);
end;
 
procedure Solnce(x0, y0, r0, r, n: integer; u: real);
var
  r1, i, x, y, x1, y1: integer;
  t: real;
begin
  setpencolor(clyellow);
  setbrushcolor(clyellow);
  {лучи}
  SetPenWidth(2);                        //толщина луча
  x := x0 + round(r0 * cos(u));
  y := y0 - round(r0 * sin(u));
  for i := 1 to n do
  begin
    t := 2 * pi * i / n;                  //угол поворота луча
    if odd(i) then r1 := r                // лучи с нечетным номером:
    else r1 := 2 * r;
    x1 := round(R1 * cos(t));             //абсцисса луча на окружности
    y1 := round(R1 * sin(t));             //ордината луча на окружности
    Line(x, y, x + x1, y - y1);           //рисуем луч
  end;
  {солнце}
  Circle(x, y, r);                        //рисуем солнце
end;
 
var
  x0, y0, r0, xk: integer;
  u: real;
begin
  SetWindowSize(500, 500);                  // устанавливаем размер окна в пикселях
  LockDrawing;                              //блокируем рисование в гр.окне
  
  x0 := WindowWidth div 2;
  y0 := WindowHeight - 100;
  r0 := x0;
  xk := 0;
  u := pi - ArcTan(WindowHeight / 2 / x0);
    y := 70;                               // начальная позиция облака
    x := 5;                                // начальная позиция облака
  
      for var i := 1 to 120 do     
    begin
 
       repeat
     
       LockDrawing;
       ClearWindow(clCornflowerBlue);         // очищаем окно голубым цветом
       Oblako(x + 3 * i, y);                  // инициализируем процедуру Облако
       Oblako2(100, 90);                         // размножаем облака через процедуру
       Oblako2(400, 120);
       Oblako2(450, 80);
       Grib(i);                               // инициализируем процедуру Гриб
       Sleep(25);                             // скорость выполнения проц-ры Гриб (задержка)
       //redraw;  // перерисовываем графику в ходе выполнения цикла                              
   
       //ClearWindow;                             // очичаем окно после каждого выполнения цыкла
       Solnce(x0, y0, r0, 30, 20, u);            // инициализируем процедуру Солнце
       Sleep(1);
       xk := xk + 1;
       u := u - 0.005;
       redraw; 
     until xk > 600;
    end;
   
end.

@Cyber_Monster_ · 06.04.2016, 19:47

Зачем изобретать велосипед? Настоятельно советую использовать модуль ABCObjects.

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .	Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .	Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .
И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»	SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .

@Cyber_Monster_ 148 / 129 / 155 Регистрация: 22.03.2016 Сообщений: 502
	06.04.2016, 19:47
	Зачем изобретать велосипед? Настоятельно советую использовать модуль ABCObjects. 1