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

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

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

Code:

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;

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

 

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

 

2mr.The

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

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

 

ну вот так любой дурак может...

Code:

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;

 

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