Форум: "Потрепаться";
Текущий архив: 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.004 c