Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Потрепаться";
Текущий архив: 2002.05.13;
Скачать: [xml.tar.bz2];

Вниз

Конкурс для начинающих   Найти похожие ветки 

 
MBo   (2002-04-03 12:02) [0]

Задача: нарисовать на Canvas формы пасхальное яйцо.
Идея не моя, но занятно ;)


 
VictorT   (2002-04-03 13:52) [1]

А какие критерии для оценки?


 
MBo   (2002-04-03 15:10) [2]

чтобы выглядело, как пасхальное яйцо ;)


 
SPeller   (2002-04-03 15:15) [3]

А чем пасхальное яйцо отличается отпростого кроме окраса ?


 
MBo   (2002-04-03 15:20) [4]

ничем ;)


 
SPeller   (2002-04-03 15:31) [5]

Ну написал бы просто "яйцо", почему именно пасхальное ?


 
vuk   (2002-04-03 15:38) [6]

to MBo:
Вы имели в виду т.н. Easter Eggs? ;o)


 
MBo   (2002-04-03 15:48) [7]

>Vuk
нет :)

Просто задача не совсем тривиальная


 
deleon   (2002-04-03 15:49) [8]

Может оно должно вращаться ? :)))


 
SPeller   (2002-04-03 15:51) [9]

Вращаться, переливаться и хаотически по экрани двигаться :))


 
MBo   (2002-04-03 15:52) [10]

не надо усматривать подвоха. его нет.


 
Alx2   (2002-04-03 16:25) [11]

Вот мой вариант:
Кидаем на форму PaintBox1 и, типа, Пасха (зелено-голубая какая-то, правда) :))

Procedure TForm1.Button4Click(Sender: TObject);
Var X, Y, sx, sy, tmp1, tmp2: real;
Begin
With PaintBox1 Do
Begin
sx := 1 / 100;
sy := 1 / 100;
X := -2;
While X < 2 Do
Begin
Y := -2;
While Y < 2 Do
Begin
tmp1 := sqr(sqr(X) + sqr(Y));
tmp2 := sqr(X) + sqr(Y) + 2 * Y + 1;
If tmp1 < tmp2
Then Canvas.Pixels[round((2 + X) / 8 * Width), round((2 - Y) / 4 * Height)] := round(1000 * (tmp2 - tmp1)) Shl 12;
Y := Y + sy;
End;
X := X + sx;
End;
End;
End;




 
Alx2   (2002-04-03 16:27) [12]

Чуть не забыл!
Чтобы пропорции были более-менее, надо PaintBox1.Width=PaintBox1.Height


 
MBo   (2002-04-03 16:37) [13]

Фаберже :)
форма слегка подкачала снизу.


 
vopros   (2002-04-03 16:41) [14]

Красиво толко снизу больше на сидяшую женскую попу похоже.


 
Alx2   (2002-04-03 16:42) [15]

Оно без скорлупы и протухло :))


 
Alx2   (2002-04-03 16:46) [16]

>vopros © (03.04.02 16:41)
Собственно, такой кривой (x^2 + y^2)^2 = x^2 + y^2 + 2*y + 1 (но не попой) описывается так называемое "мировое яйцо"


 
vopros   (2002-04-03 16:52) [17]

Вот у Настьки попа была...И тут я все изгадил....:))Такая же красивая как Мировое яйцо снизу.


 
Alx2   (2002-04-03 16:55) [18]

>vopros © (03.04.02 16:52)
А ты ей такой комплимент выдай 8)


 
McSimm   (2002-04-03 16:56) [19]


> MBo ©

Если следовать заданным критериям, лучше (проще и красивее) всего эта задача решается так:
...
Bmp.LoadFromFile(Path+"BeautyEasterEgg.bmp");
Canvas.Draw(xx, yy, Bmp);
...



 
Alx2   (2002-04-03 16:59) [20]

>MBo
>форма слегка подкачала снизу.
Исправился. Теперь форма - ok. (на квадратном PaintBox1)

Procedure TForm1.Button4Click(Sender: TObject);
Var X, Y, sx, sy, tmp1, tmp2: real;
Begin
With PaintBox1 Do
Begin
sx := 1 / 200;
sy := 1 / 200;
X := -2;
While X < 2 Do
Begin
Y := -2;
While Y < 2 Do
Begin
tmp1 := sqr(sqr(X) + sqr(Y));
tmp2 := sqr(X) + sqr(Y) + 2 * Y + 1.3;
If tmp1 < tmp2
Then Canvas.Pixels[round((2 + X) / 6.5 * Width), round((2 - Y) / 4 * Height)] := round(1000 * (tmp2 - tmp1)) Shl 12;
Y := Y + sy;
End;
X := X + sx;
End;
End;
End;




 
MBo   (2002-04-03 17:04) [21]

вполне яичная форма ;)

Я так и подозревал, Алексей, что ты заинтересуешься,
хотя и вопрос позиционировался как задачка для малоопытных ;)

Решение может быть и "более другим", способов, наверно, много.
Если кто еще попробует свои силы, милости просим.


 
vopros   (2002-04-03 17:08) [22]

Ну знаете ли первое мне нравилось больше...Тако Мировое Яйцо. Извините что треплюсь думать алгоритмы щас неохото.


 
Alx2   (2002-04-03 17:37) [23]

>MBo © (03.04.02 17:04)
>Я так и подозревал, Алексей, что ты заинтересуешься...
:))
Было дело...


 
Alx2   (2002-04-03 17:43) [24]

>MBo
А твой вариант?


 
MBo   (2002-04-03 18:50) [25]

завтра. может, еще кто-нибудь заинтересуется


 
Alx2   (2002-04-04 09:36) [26]

Помешался я на этом яйце:))
Вот, собственно, "конкурсный" вариант (рисовать на квадратном PaintBox1):

Procedure TForm1.Button4Click(Sender: TObject);
Var X, Y, sx, sy, tmp1, tmp2: real;
cx, cy, tmp: Integer;
Begin
With PaintBox1 Do
Begin
sx := 1 / 200;
sy := 1 / 200;
X := -2;
While X < 2 Do
Begin
Y := -2;
While Y < 2 Do
Begin
tmp1 := sqr(sqr(X) + sqr(Y));
tmp2 := sqr(X) + sqr(Y) + 2 * Y + 1.5;
cx := round((2 + X) / 6.5 * Width);
cy := round((2 - Y) / 4 * Height);
If tmp1 < tmp2
Then
Begin
tmp := round((20 * (tmp2 - tmp1))) + 150;
If (abs(X) > 1 / 1E40) And
(abs(frac(sqrt(sqr(sin(10 * X) * X + Y) +
sqr(sin(10 * Y) * Y + X)) -
Pi * arctan(Y / X)) / (Pi)) < 0.03)
Then
Canvas.Pixels[cx, cy] := tmp Shl 12
Else
Canvas.Pixels[cx, cy] := tmp
End;
Y := Y + sy;
End;
X := X + sx;
End;
End;
End;




 
MBo   (2002-04-04 09:52) [27]

>Alx2

Куры квохчут и плачут от восторга! ;)

пара вариантов

прикольный

procedure TForm1.Button1Click(Sender: TObject);
var
r : trect;
begin
r.Left := 5;
r.top := 5;
r.Right := 135;
r.Bottom := 105;
form1.canvas.FrameRect(r);
form1.canvas.Ellipse(10,10,130,100);
form1.Canvas.Brush.Color := clYellow;
form1.canvas.Ellipse(45,30,95,80);
end;

не совсем овоид

procedure TForm1.Button2Click(Sender: TObject);

procedure eggTop(l,t,r,b: integer);
var half: integer;
begin
half := t+(b-t) div 2;
form1.Canvas.Arc(l,t,r,b,l,half,r,half);
end;

procedure eggBottom(l,t,r,b: integer);
var half: integer;
begin
half := t+(b-t) div 2;
form1.Canvas.Arc(l,t,r,b,r,half,l,half);
end;

procedure egg(l,t,r,b: integer; egginess: integer);
var stretch: integer;
begin
stretch := (egginess*(b-t)) div 100;
EggTop(l,t+stretch,r,b);
EggBottom(l,t,r,b+stretch);
form1.Canvas.Brush.Color := clBlue;
form1.Canvas.FloodFill((r-l) div 2,(b-t) div 2,form1.Canvas.Pen.Color,fsBorder);
end;

begin
// Left, top, width, height, egginess
egg(50,50,300,400,20);
end;

--------------------------------------------
мой вариант

procedure TForm1.Button2Click(Sender: TObject);
var
rgn:hRgn;
pts:array[0..6] of TPoint;
x1,y,x2,deltax,deltay:integer;
begin
x1:=100; x2:=400; y:=200; deltax:=5; deltay:=100;
Canvas.brush.Color:=clRed;
//Canvas.Pen.Color:=clRed; //если Canvas.Floodfill использовать
pts[0].x:=x1; pts[0].y:=y;
pts[1].x:=x1+deltax; pts[1].y:=y-deltay;
pts[2].x:=x2-deltax; pts[2].y:=y-2*deltay;
pts[3].x:=x2; pts[3].y:=y;
pts[4].x:=x2-deltax; pts[4].y:=y+2*deltay;
pts[5].x:=x1+deltax; pts[5].y:=y+deltay;
pts[6].x:=x1; pts[6].y:=y;

//просто, но тормозно
//Canvas.PolyBezier(pts);
//Canvas.FloodFill(x1+100,y,clRed,fsBorder);

//шустро
BeginPath(canvas.Handle);
PolyBezier(canvas.Handle,pts,7);
EndPath(canvas.Handle);
rgn:=PathToRegion(Canvas.Handle);
FillRgn(Canvas.handle,Rgn,Canvas.Brush.Handle);
DeleteObject(rgn);

end;


 
Alx2   (2002-04-04 10:09) [28]

>MBo
Пасха forever :)
С кем еще яйцами померяемся?



Страницы: 1 вся ветка

Форум: "Потрепаться";
Текущий архив: 2002.05.13;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.51 MB
Время: 0.005 c
1-39769
PVN
2002-04-28 18:06
2002.05.13
2 вопроса...


3-39651
Tanyusha
2002-04-16 12:37
2002.05.13
обработка соединения таблиц


4-39897
Эдуард
2002-03-11 14:32
2002.05.13
Как получить некоторые значения из чужой программы


4-39895
skywalker
2002-03-06 17:48
2002.05.13
И снова потоки...


1-39797
ProfiUgl
2002-04-29 09:10
2002.05.13
Боращение к компоненту расположенному на другой форме





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский