Форум программистов, компьютерный форум, киберфорум
Наши страницы
PascalABC.NET
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.60/5: Рейтинг темы: голосов - 5, средняя оценка - 4.60
minowa
0 / 0 / 0
Регистрация: 13.06.2013
Сообщений: 27
#1

Нарисовать анимированную бабочку

18.06.2013, 13:58. Просмотров 888. Ответов 4
Метки нет (Все метки)

может кто нарисовать бабочку анимированную?
и желательно с узорами и по возможности все операции сделать через функцию или же процедур
0
Лучшие ответы (1)
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
18.06.2013, 13:58
Ответы с готовыми решениями:

Нарисовать анимированную божью коровку
Пожалуйста помогите!Мне нужно нарисовать анимированую божью коровку в...

Изобразите анимированную картинку в графическом режиме
Изобразите анимированную картинку в графическом режиме. Кран, из которого...

Изобразите анимированную картинку в графическом режиме
Изобразите анимированную картинку в графическом режиме. Идущие часы (со...

Нарисовать трапецию, после чего нарисовать ее зеркальную копию (относительно диагонали 1го квадранта) и уменьшить
Собственно сделал так, только пока что без уменьшения, отзеркаленную копию...

Нарисовать бабочку
Помогите решить задачу. Нарисовать разноцветную бабочку,меняющую цвета. ...

4
Striker
18.06.2013, 15:11
  #2

Не по теме:

Ждите, КонецСвета появится онлайн и Вам всё нарисует в лучшем виде.

4
КонецСвета
Почетный модератор
7928 / 3899 / 2464
Регистрация: 30.10.2011
Сообщений: 5,379
18.06.2013, 16:52 #3
ленивый вариант
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
uses graphABC;
 
procedure Babochka(x,y: integer);
begin
setbrushcolor(clmediumblue);
setpencolor(clmediumblue);
circle(x-45,y-30,40);
circle(x+45,y-30,40);
circle(x-35,y+20,30);
circle(x+35,y+20,30);
 
setbrushcolor(claquamarine);
setpencolor(claquamarine);
circle(x-55,y-55,5);
circle(x+55,y-55,5);
circle(x-70,y-45,5);
circle(x+70,y-45,5);
circle(x-75,y-20,5);
circle(x+75,y-20,5);
circle(x-50,y+35,5);
circle(x+50,y+35,5);
 
setbrushcolor(clviolet);
setpencolor(clviolet);
circle(x-45,y-20,20);
circle(x+45,y-20,20);
circle(x-35,y+20,10);
circle(x+35,y+20,10);
 
setbrushcolor(cldarkblue);
setpencolor(cldarkblue);
ellipse(x-6,y-60,x+6,y+40);
setpenwidth(3);
arc(x-15,y-80,15,0,180);
arc(x+15,y-80,15,0,180);
line(x,y-80,x,y-60);
setpenwidth(1);
end;
 
procedure Zvet;
begin
setpencolor(clblack);
setbrushcolor(clmagenta);
for var i:=1 to 36 do
  begin
  Coordinate.Angle:=(i*10);
  ellipse(-5,0,5,45);
  end;
setbrushcolor(clyellow); 
circle(0,0,10);
end;
 
begin
lockdrawing;
Coordinate.SetMathematic;
Coordinate.Origin:=Window.Center;
repeat
for var u:=360 downto 1 do
  begin
  clearwindow;
  Babochka(150,0);
  Zvet;
  sleep(10);
  redraw;
  Coordinate.Angle:=u;
  end;
until false;
end.
2
volvo877
38 / 37 / 23
Регистрация: 01.06.2009
Сообщений: 59
18.06.2013, 17:13 #4
Чистой воды математика (butterfly curve), поэтому без узоров, зато всего одна функция для отрисовки:

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
uses graphabc;
 
const scale = 40; // Сильно не увеличивай,будет ошибка GDI...
 
function bCurve(theta : real) : real;
begin
  result := scale * (exp(cos(theta/scale)) - 2*cos(4*theta/scale) + 
                     Power(sin((2*theta/scale - Pi)/24), 5));
end;
 
var s : array of integer;
begin
  LockDrawing;
  for var steps := 1 to 10 do // Количество взмахов
  begin
    s := new integer[6](0, 1, 2, 3, 2, 1);
    for var i := 0 to 5 do
    begin
      ClearWindow;
      for var theta := 0 to 359 * scale do
      begin
        var r : real := bCurve(theta);
        PutPixel(WindowCenter.X + Trunc((1 - 0.1*s[i]) * r * sin(theta/scale)),
                 WindowCenter.Y - Trunc(r * cos(theta/scale)), clRed);
      end;
      Redraw;
      Sleep(50);
    end;
  end;
end.
2
КонецСвета
Почетный модератор
7928 / 3899 / 2464
Регистрация: 30.10.2011
Сообщений: 5,379
18.06.2013, 17:27 #5
volvo877,
...еще вариант с хлопающими крылышками
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
uses graphABC;
var kk: byte;
 
procedure Babochka(x,y: integer; k:byte);
begin
setbrushcolor(clmediumblue);
setpencolor(clmediumblue);
ellipse(x-10-5*k,y-60,x-5,y+10);
ellipse(x+10+5*k,y-60,x+5,y+10);
ellipse(x-5*k,y+50,x-5,y);
ellipse(x+5*k,y+50,x+5,y);
 
setbrushcolor(cldarkviolet);
setpencolor(cldarkviolet);
ellipse(x-10-4*k,y-50,x-5,y);
ellipse(x+10+4*k,y-50,x+5,y);
ellipse(x-4*k,y+40,x-5,y-10);
ellipse(x+4*k,y+40,x+5,y-10);
 
setbrushcolor(cldarkblue);
setpencolor(cldarkblue);
ellipse(x-6,y-60,x+6,y+40);
setpenwidth(3);
arc(x-15,y-80,15,0,180);
arc(x+15,y-80,15,0,180);
line(x,y-80,x,y-60);
setpenwidth(1);
end;
 
procedure Zvet;
begin
setpencolor(clblack);
setbrushcolor(clmagenta);
for var i:=1 to 36 do
  begin
  Coordinate.Angle:=(i*10);
  ellipse(-5,0,5,45);
  end;
setbrushcolor(clyellow); 
circle(0,0,10);
end;
 
begin
lockdrawing;
Coordinate.SetMathematic;
Coordinate.Origin:=Window.Center;
repeat
for var u:=360 downto 1 do
  begin
  clearwindow;
  if u mod 20<10 then  kk:=u mod 10 
    else  kk:=10-u mod 10;
  Babochka(150,0,kk);
  Zvet;
  sleep(20);
  redraw;
  Coordinate.Angle:=u;
  end;
until false;
end.
2
18.06.2013, 17:27
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
18.06.2013, 17:27

Нарисовать бабочку
Здравствуйте! Нарисуйте пожалуйста такой рисунок

Нарисовать бабочку

Нарисовать бабочку
Я недавно начал заниматься программированием и столкнулся с трудностями


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

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

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