Формы причудливых форм Delphi

[DeaD_MoroZ]

Давайте тут выкладывать регионы для рисования интересных форм???

вот например, бабочка


procedure TForm1.FormCreate(Sender: TObject);
var
R1, R2 : HRgn;
P : array [0..2] of TPoint;
X : Word;
begin
// левое верхнее крыло
R1 :=CreateEllipticRgn(Round(-Width*0.4),
0,Round(Width*0.49),Round(Height*1.1));
// правое верхнее крыло
R2 :=CreateEllipticRgn(Round(Width*0.51),
0,Round(Width*1.4),Round(Height*1.1));
CombineRgn(R2,R1,R2,RGN_OR);
// отсекаем лишнее от верхних крыльев,
// остаются линзы на пересечении эллипсов

R1 :=CreateEllipticRgn(0,Round(-Height*0.3),
Width,Round(Height*0.71));
CombineRgn(R1,R1,R2,RGN_AND);

//эллипс - основа нижних крыльев
R2 :=CreateEllipticRgn(Round(Width*0.1),
Round(Height*0.65), Round(Width*0.9), Height);
CombineRgn(R1,R1,R2,RGN_OR);
// вырезаем эллипс - разрез между нижних крыльев
R2 :=CreateEllipticRgn(Round(Width*0.3),
Round(Height*0.7), Round(Width*0.7), Round(Height*1.5));
CombineRgn(R1,R1,R2,RGN_DIFF);

// вертикальный эллипс - туловище бабочки
R2 :=CreateEllipticRgn(Round(Width*0.46),
Round(Height*0.3), Round(Width*0.54),
Round(Height*0.8));
CombineRgn(R1,R1,R2,RGN_OR);

// голова - круг; за основу берем меньшую
// из двух величин - высоты и ширины окна
X := Width;
if Height < X then X := Height;
X := Round(X/18);
R2 :=CreateEllipticRgn(Round(Width*0.5)-X,
Round(Height*0.3)-X, Round(Width*0.5)+X,
Round(Height*0.3)+X);

CombineRgn(R1,R1,R2,RGN_OR);

// левый усик
P[0] := Point(Round(Width*0.5), Round(Height*0.3));
P[1] := Point(Round(Width*0.35), Round(Height*0.01));
P[2] := Point(Round(Width*0.355)+1, 0);
R2 := CreatePolygonRgn(P, 3, WINDING);
CombineRgn(R1,R1,R2,RGN_OR);

// правый усик
P[0] := Point(Round(Width*0.5), Round(Height*0.3));
P[1] := Point(Round(Width*0.655+1), Round(Height*0.01));
P[2] := Point(Round(Width*0.65), 0);
R2 := CreatePolygonRgn(P, 3, WINDING);

CombineRgn(R1,R1,R2,RGN_OR);

// острие на крыле слева снизу
P[0] := Point(Round(Width*0.15), Height);
P[1] := Point(Round(Width*0.2), Round(Height*0.8));
P[2] := Point(Round(Width*0.3), Round(Height*0.9));
R2 := CreatePolygonRgn(P, 3, WINDING);
CombineRgn(R1,R1,R2,RGN_OR);

// острие на крыле справа снизу
P[0] := Point(Round(Width*0.85), Height);
P[1] := Point(Round(Width*0.8), Round(Height*0.8));
P[2] := Point(Round(Width*0.7), Round(Height*0.9));

R2 := CreatePolygonRgn(P, 3, WINDING);
CombineRgn(R1,R1,R2,RGN_OR);

// Назначаем полученный регион форме
SetWindowRgn(Handle, R1, True);
end;


кто может нарисовать бутылку???

[mr.The]

А не проще далеть форму=форме какой-либо картинки(гугл ит)? Зачем такие извращения?

[POS_troi]

2mr.The

Дык. Имтереснее из Мозга фрэш делать =)

Мне вот раскажите как в NET с регионами работать =(

[DeaD_MoroZ]

А не проще далеть форму=форме какой-либо картинки(гугл ит)? Зачем такие извращения?
ну вот так любой дурак может...


function BitmapToRegion(Bitmap: TBitmap; TransColor: TColor): HRGN;
var
X, Y: Integer;
XStart: Integer;
begin
Result := 0;
with Bitmap do
for Y := 0 to Height - 1 do
begin
X := 0;
while X < Width do
begin
while (X < Width) and (Canvas.Pixels[X, Y] = TransColor) do
Inc(X);
if X >= Width then
Break;
XStart := X;
while (X < Width) and (Canvas.Pixels[X, Y] <> TransColor) do
Inc(X);
if Result = 0 then
Result := CreateRectRgn(XStart, Y, X, Y + 1)
else
CombineRgn(Result, Result,
CreateRectRgn(XStart, Y, X, Y + 1), RGN_OR);
end;
end;
end;

[mr.The]

Ну дык зачем ещё что-то? Давайте ещё фракталы в формах строить, чего уж там.