Текущий архив: 2009.10.11;
Скачать: CL | DM;

Вниз

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

← →
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]

??

---

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

CSS   (06.08.09 00:16) [8]

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

---

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

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

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.

---

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

Текущий архив: 2009.10.11;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.03 c