Форум программистов, компьютерный форум, киберфорум
PascalABC.NET
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.67/3: Рейтинг темы: голосов - 3, средняя оценка - 4.67
170 / 31 / 17
Регистрация: 13.03.2017
Сообщений: 170
1

Макет анимации: полеты, реверс, взрывы

25.03.2017, 05:00. Просмотров 546. Ответов 6
Метки нет (Все метки)

Шуточная макетная программа для изучения анимации.
Если понравилось, не забудь сказать спасибо!
{Учебная программа анимации, автор: Сергей Игнатьев.
{Полет птицы и облака разработал Конец света.
Благодарность за помощь модераторам Volvo и Puporev}

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
146
147
148
149
150
151
152
153
154
Program EGYPT;
uses graphabC;
const Nm=10;
type mass=array[1..Nm] of integer;
var  dx,dy,dxp,dyp:mass;
var x,y,ky,kx: integer;
var b: boolean;
 
procedure BrushUp(x0,y0,n:integer;dx,dy:mass);
begin
  var L := new List<Point>;
  for var i := 1 to n do 
  L.Add(new Point(x0 + dx[i], y0 - dy[i])); 
  Polygon(L.ToArray);
end;
 
procedure Piramid(np,x0,y0:integer;k:real);
begin
  var s,s2,h,d,m: real;
  h:=146;d:=230; //Реальные размеры пирамиды Хеопса  
   m:=1.5;
   h:=m*h; d:=m*d;
   //m-масштаб, к-изменение размеров пирамид, np- номер пирамиды
   if np>1 then 
    begin
    h:=k*h; d:=k*d;        
    end;
   s2:=sqrt(2*d*d); s:=s2/2; 
   dxp[1]:=0; dyp[1]:=0;   
   dxp[2]:=round(s); dyp[2]:=round(h);
   dxp[3]:=round(s2); dyp[3]:=0;
   setpencolor(clGray);
   setbrushcolor(clSandyBrown);  
   BrushUp(x0,y0,3,dxp,dyp);     
   dxp[1]:=round(s*1.2); dyp[1]:=0;   
   dxp[2]:=round(s); dyp[2]:=round(h);
   dxp[3]:=round(s2); dyp[3]:=0;  
   setbrushcolor(clGray);
   BrushUp(x0,y0,3,dxp,dyp);       
end;
 
procedure ExplosionPro(r0:integer);
//Подготовка к взрыву
begin
  var p: real;
   var a:array[1..10] of real;
   var r:array[1..10] of real;
   p:=3.14159/180;
   a[1]:=0; a[2]:=30; a[3]:=45; a[4]:=60; a[5]:=80;
   a[6]:=110; a[7]:=125; a[8]:=135; a[9]:=180; a[10]:=270;   
   r[1]:=r0; r[2]:=2*r0; r[3]:=r0; r[4]:=3*r0; r[5]:=r0;
   r[6]:=2*r0; r[7]:=r0; r[8]:=4*r0; r[9]:=r0; r[10]:=r0/5;  
   for var i:=1 to 10 do 
    begin
     dx[i]:=round(r[i]*cos(p*a[i]));
     dy[i]:=round(r[i]*sin(p*a[i]));
    end;
end;
 
procedure Oblako(x,y: integer);
//процедура рисования облака
begin
  setpencolor(clwhite);
  setbrushcolor(clwhite);
  rectangle(x,y-20,x+100,y);
  circle(x,y-10,10);
  circle(x+100,y-10,10);
  circle(x+20,y-20,20);
  circle(x+80,y-20,20);
  circle(x+50,y-30,20);
end;
 
procedure Ptiza (xx,yy: integer);
//процедура рисования птицы
begin
var r,fy:integer;
//яйцо
setbrushcolor(clwhite);
fy:=300+yy*4;
r:=8;
if ky<0 then
r:=0;
circle(xx-10*kx,fy,r);
if fy>499 then
begin    
    Brush.Color := Color.White;
    ExplosionPro(15);
    BrushUp(xx-10*kx,fy,10,dx,dy);
    setbrushcolor(clYellow);
    ExplosionPro(10);
    BrushUp(xx-5*kx,fy,10,dx,dy);
end; 
//Птица
  setbrushcolor(clsilver);
  rectangle(xx+35*kx,115,xx+60*kx,125);
  rectangle(xx-80*kx,115,xx-30*kx,125);
  rectangle(xx-70*kx,105,xx-20*kx,115);
  rectangle(xx-70*kx,125,xx-20*kx,135);
  ellipse(xx-40*kx,100,xx+40*kx,140);
  setpencolor(clred);
  //клюв
  Pen.Color := Color.Red;
  line(xx+85*kx,115,xx+100*kx,120);
  line(xx+85*kx,125,xx+100*kx,120);
  Pen.Width := 2;
  line(xx+85*kx,120,xx+98*kx,120);
  line(xx+85*kx,123,xx+94*kx,120);
  line(xx+85*kx,117,xx+94*kx,120);
  setpencolor(clwhite);  
  Pen.Width := 1;
  circle(xx+70*kx,120,15);  
  //крылья
  setbrushcolor(clgray);
  rectangle(xx-20*kx,120,xx+20*kx,120+yy);
  setbrushcolor(clblack);
  circle(xx+75*kx,120,5);
end; 
begin
  setwindowsize  (1000,600);
  Window.Title:='Птица с яйцами сканирует пирамиды в Египте';
  //запрет рисования в гр.окне
  lockdrawing;
  y:=0;ky:=-2;kx:=-1;  
  //бесконечный цикл
  repeat
  //Смена направления полета
   kx:=-kx;
   b:=true;   
   while b  do   
   begin   
   if kx>0 then       
   if x<=1100 then b:=true else b:=False   
   else  
   if x>=-100 then b:=true else b:=False;   
    //очистить экран
    clearwindow(clskyblue);
    setbrushcolor(clBisque);
    rectangle(0,500,1000,600); 
    Piramid(1,-30,500,1);
    Piramid(2,300,500,1.2);
    Piramid(3,700,500,0.7);
    Oblako(150,70);
    Oblako(450,100);
    Oblako(750,60);    
    Ptiza (x,y);
    //вычисление следующих координат
    y:=y+ky;
    //при необходимости - смена направления взмаха крыла
    if (y>50) or (y<-50) then ky:=ky*(-1);
    redraw;
    inc(x,3*kx);
   end;      
until false;
end.
3
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
25.03.2017, 05:00
Ответы с готовыми решениями:

Новые взрывы в Москве. Ваше мнение?
Цитата Газета.Ру &quot;В московском метро произошли мощные взрывы. Погибли больше трех десятков...

Макет отчета. Не получается Вывод данных о сумме в макет
Не могу разобраться с применением метода Присоединить к ТабДоку. В частности с выводом данных...

Алгоритмы.Анимации. Написать прогу для изображения анимации
нужно чтобы она двигалась во все стороны. вот эта фигура

Реверс строки
Добрый день! Простите за скорее всего глупый и неуместный вопрос, но в чем приципиальная разница в...

6
Alexandr212
25.03.2017, 09:57
  #2

Не по теме:

Это шедевр!:bravo::rofl:

0
38 / 36 / 25
Регистрация: 25.01.2017
Сообщений: 152
Записей в блоге: 2
24.04.2017, 17:31 3
Я бы сказал "СПАСИБО", но кнопку так и не нашел. Наверное несколько постов написать надо.
0
170 / 31 / 17
Регистрация: 13.03.2017
Сообщений: 170
25.04.2017, 04:19  [ТС] 4
keltor, Я рад, что Вам понравилось. Программирование это такой вид творчества, который доставляет удовольствие в основном автору. редко кто может оценить вложенный труд. Спасибо!
1
38 / 36 / 25
Регистрация: 25.01.2017
Сообщений: 152
Записей в блоге: 2
25.04.2017, 10:45 5
И Вам спасибо - у меня теперь есть кнопка "спасибо" и я могу её нажимать. А то печатать лень.
0
1731 / 1326 / 1405
Регистрация: 28.10.2016
Сообщений: 4,265
25.04.2017, 11:12 6
Выглядит недурно
1
170 / 31 / 17
Регистрация: 13.03.2017
Сообщений: 170
25.04.2017, 15:07  [ТС] 7
Hitoku, Спасибо, в основном варианте птица летит на фоне фото с пирамидами. Жаль, что не могу это повторить на это форуме. Может быть Вам какой-нибудь конкурс программ затеять? Было-бы всем интересно показать свои идеи и картинки. Я на форуме новичок и не знаю как это сделать
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
25.04.2017, 15:07

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

реверс строки
короче, у меня есть строка.. ее надо перевести наоборот. типа было ЛОХ стало ХОЛ вот как я...

Реверс списка
Есть односвязный список. Требуется создать реверс списка, после чего продлить основной список этим...

добавить реверс
вот программа domains i=integer l=i* predicates parse(l,l) del(l,l) append(l,l,l)

Реверс строки
#include &lt;stdio.h&gt; #define MAXLINE 1000 int getline(char line, int lim); void reverse(char from,...

Реверс строки
Не могу написать программу которая перестанавливает символы в строке(abc-&gt;cba)

Реверс списка
Язык Scheme R5RS Определить процедуру revers, которая по заданному списку строит новый список,...


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

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

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.