фигурная форма.

← →
belmol (2009-07-29 15:16) [0]

Доброго времени суток. столкнулся с проблемкой создания формыы в виде сердца, часть сделал а дальше как закруглить верхушки не могу сообразить, может кто подскажет?
rocedure TForm1.FormCreate(Sender: TObject);
var
R1, R2 : HRgn;
P : array [0..2] of TPoint;
X : Word;
begin
r1:=CreateEllipticRgn(-640,-640,600,700);
r2:=CreateEllipticRgn(0,-640,640+600,700);
CombineRgn(R1,R1,R2,RGN_and);

r2:=CreateEllipticRgn(0,600,600,20);
CombineRgn(R1,R1,R2,RGN_and);

P[0] := Point(20, 0);
P[1] := Point(580, 0);
P[2] := Point(300, 200);
R2 := CreatePolygonRgn(P, 3, Winding);
CombineRgn(R1,R1,R2,RGN_DIFF);
SetWindowRgn(Handle, R1, True);

end;

← →
Anatoly Podgoretsky © (2009-07-29 16:06) [1]

Маловат массив

← →
TIF © (2009-07-29 16:40) [2]

Обычно регионы сложной формы вырезают по bitmap-маске

← →
MBo © (2009-07-29 17:43) [3]

Для того, чтобы нарисовать сердце, можно использовать две симметричные относительно оси кривые Безье (одну PolyBezier c 7-ю контрольными точками).

← →
CSS (2009-08-02 04:31) [4]

belmol, да что там делать-то? =)
Всего-то надо два элипса и полигон... =)))

Вот если нужно чтоб форма ещё и масштабировалась, то будет посложнее...
Может завтра попробую и такое реализовать... =))

> Для того, чтобы нарисовать сердце, можно использовать две
> симметричные относительно оси кривые Безье (одну PolyBezier
> c 7-ю контрольными точками).

Ого... Я даже представить-то себе такого не могу... =))
Примерчика не будет? ;)

← →
MBo © (2009-08-02 07:59) [5]

>Ого... Я даже представить-то себе такого не могу... =))

стоит попробовать - завести массив из семи TPoint (или из четырех для начала), заполнить его, выводить на экран PolyBezier, и поиграть с координатами, чтобы понять, как чего влияет на форму

← →
CSS (2009-08-05 23:35) [6]

Вот в и-нете нашёл:

Procedure TForm1.FormCreate(Sender: TObject); Var d, h, a, b, vx, vy: Integer; z: Real; R1, R2: HRgn; P: Array [0..3] Of TPoint; Begin d:=width div 2; h:=height; a:=d div 2; b:=h-a; R1:=CreateEllipticRgn(0, 0, d, d); R2:=CreateEllipticRgn(d, d, d*2, 0); CombineRgn(R1, R1, R2, RGN_OR); z:=2*a*b/(a*a+b*b); vx:=Trunc(z*b+0.5); vy:=Trunc(z*a+0.5); P[0]:=Point(d, a); P[1]:=Point(d+vx-2, a+vy); P[2]:=Point(d, h); P[3]:=Point(d-vx, a+vy); R2:=CreatePolygonRgn(P, 4, Winding); CombineRgn(R1, R1, R2, RGN_OR); SetWindowRgn(Handle, R1, True); End;

← →
Игорь Шевченко © (2009-08-06 00:15) [7]

> Вот в и-нете нашёл:

Это порнография

← →
CSS (2009-08-06 00:16) [8]

CSS (06.08.09 00:16) [8]

Ну вот она и есть, если откомпилировать и запустить :)

Насчет кривых Безье - это примерно так (правда точки я подбирал на скорую руку, так что тоже порнография получилась, но если подобрать поаккуратней, то получится нужная форма)

unit main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class(TForm) procedure FormPaint(Sender: TObject); procedure FormCreate(Sender: TObject); private procedure WMNcHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; end; var Form1: TForm1; implementation uses GraphUtil, Types; {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); var pts: array[0..7] of TPoint; W2, H2: Integer; Rgn: HRGN; begin W2 := ClientRect.Right div 2; H2 := ClientRect.Bottom div 2; pts[0] := Point(W2, (H2*2) div 3); pts[1] := Point(W2 div 4, H2 div 5); pts[2] := Point(W2-(W2 div 3)*2, H2); pts[3] := Point(W2, (H2 div 5)*9); pts[4] := Point(W2+(W2 div 3)*2, H2); pts[5] := Point(W2*2 - (W2 div 4), H2 div 5); pts[6] := Point(W2, (H2*2) div 3); BeginPath(Canvas.Handle); PolyBezier(Canvas.Handle, pts, 7); EndPath(Canvas.Handle); Rgn := PathToRegion(Canvas.Handle); SetWindowRgn(Handle, Rgn, true); Color := ColorAdjustLuma(ColorToRGB(clRed), 80, true); end; procedure TForm1.FormPaint(Sender: TObject); var FrameBrush: HBRUSH; DC: HDC; Rgn: HRGN; begin FrameBrush := CreateSolidBrush(clRed); DC := GetWindowDC(Handle); Rgn := CreateRectRgnIndirect (BoundsRect); GetWindowRgn(Handle, Rgn); try FrameRgn (DC, Rgn, FrameBrush, 2, 2); finally ReleaseDC(Handle, DC); DeleteObject(FrameBrush); DeleteObject(Rgn); end; end; procedure TForm1.WMNcHitTest(var Message: TWMNCHitTest); begin inherited; if Message.Result = HTCLIENT then Message.Result := HTCAPTION; end; end.

фигурная форма. Найти похожие ветки