Registriert seit: 25. Jun 2003
Ort: Thüringen
2.950 Beiträge
|
Re: Hülle einer kalligrafischen Beziér-Kurve ermitteln
21. Jul 2006, 14:58
Hi Volker,
auf einem TForm machst du zwei TImage -> TImage1 und TImage2 (256*256 Pixel) und eine TButton. In dessen OnClick nachfolgende Methode TForm1.Button1Click().
Wir können deine Spline selber als Region erstellen OHNE Umwege über den Path des GDIs.
DrawCubicCurve() ist hier aus dem Forum abgekupfert und wurde von mir erweiteret. Nun zeichnen wir entlang einer Spline mit einem eigenen Pen der aus einer selbstgewählten Region besteht.
Im Grunde kannst du den Parameter Canvas rausnehmen da dieser nur zur Visualisierung dient. Als Ergebnis steht in Data.Region eine komplexe Hüllkurve als Region die mit der Region Data.Pen entlang einer Spline gezeichnet wurde.
Wie immer alles quick&dirty und schönmachen musst du schon selber.
Wir geben dann in zwei TImage's das aus was wir a) stück für stück gezeichnet haben und b) die erzeugte Region. Damit wir sehen das diese erzeugte Region wirklich nur aus einer Hüllkurve besteht zeichne ich diese unausgefüllt in Rot.
CreateSplineRgn() wäre nun ein Vorschlag meinerseits für eine fertige Funktion.
Für den Source der Kubischen Spline bin ich nicht verantwortlich, den habe ich wie gesagt hier aus der DP, und stellt mitnichten das dar was ich sonst als guten Source bezeichnen würde, sorry also.
Ich meine auch das es bessere Spline Routinen gibt die die Schrittweite beim Zeichnen einer Spline exakt an die Pixelauflösung anpassen können. Aber egal, fürs erste reichte der Source aus.
Gruß Hagen
Delphi-Quellcode:
function DrawCubicCurve(Canvas: TCanvas; const Points: array of TPoint; Steps: Cardinal = 1): hRgn;
type
PData = ^TData;
TData = packed record
Canvas: TCanvas;
Region: hRgn;
Pen: hRgn;
end;
function Interpolate( const p1, p2, p3, p4: TPoint; t: single): TPoint;
function cubic(v1, v2, v3, v4, t: single): single;
begin
result:=v2+t*((-v1+v3)+t*((2*v1-2*v2+v3-v4)+t*(-v1+v2 - v3 + v4)));
end;
begin
Result.x:=round(cubic(p1.x, p2.x, p3.x, p4.x, t));
Result.y:=round(cubic(p1.y, p2.y, p3.y, p4.y, t));
end;
procedure MyDrawing(X,Y: Integer; Data: PData); stdcall;
begin
with Data^ do
begin
OffsetRgn(Pen, X, Y);
FillRgn(Canvas.Handle, Pen, Canvas.Brush.Handle);
CombineRgn(Region, Region, Pen, RGN_OR);
OffsetRgn(Pen, -X, -Y);
end;
end;
var
i, s: integer;
p, p1, p2, p3, p4, e: TPoint;
Data: TData;
begin
Assert(Steps > 0);
Result := 0;
if Length(Points) < 2 then Exit;
Data.Canvas := Canvas;
Data.Region := CreateRectRgn(0,0,0,0);
// Data.Pen := CreateRectRgn(-5, -10, +5, +10);
Data.Pen := CreateEllipticRgn(-5, -20, +5, +20);
e := Points[0];
p2 := Points[0];
p3 := Points[0];
p4 := Points[1];
for I := 0 to High(Points)-1 do
begin
p1 := p2;
p2 := p3;
p3 := p4;
if i+2 < Length(Points) then
p4 := Points[i+2];
for s := 1 to Steps do
begin
P := Interpolate(p1, p2, p3, p4, s / Steps);
LineDDA(E.X, E.Y, P.X, P.Y, @MyDrawing, Integer(@Data));
E := P;
end;
end;
DeleteObject(Data.Pen);
Result := Data.Region;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Bitmap: TBitmap;
Region: hRgn;
begin
Region := 0;
Bitmap := TBitmap.Create;
try
Bitmap.Width := 256;
Bitmap.Height := 256;
Bitmap.Monochrome := True;
with Bitmap.Canvas do
begin
Brush.Color := clBlack;
Brush.Style := bsSolid;
Pen.Style := psSolid;
Pen.Width := 3;
Region := DrawCubicCurve(Bitmap.Canvas, [Point(10, 50), Point(40, 50), Point(40, 90), Point(80, 50), Point(80, 50), Point(100, 150)], 100);
end;
Image1.Picture.Assign(Bitmap);
with Image2, Canvas do
begin
Brush.Color := clWhite;
FillRect(ClientRect);
Brush.Color := clRed;
FrameRgn( Handle, Region, Canvas.Brush.Handle, 1, 1);
end;
finally
Bitmap.Free;
DeleteObject(Region);
end;
end;
Delphi-Quellcode:
function CreateSplineRgn(Pen: hRgn; const Points: array of TPoint; Steps: Cardinal = 1): hRgn;
type
PData = ^TData;
TData = packed record
Region: hRgn;
Pen: hRgn;
end;
function Interpolate(const p1, p2, p3, p4: TPoint; t: single): TPoint;
function cubic(v1, v2, v3, v4, t: single): single;
begin
result:=v2+t*((-v1+v3)+t*((2*v1-2*v2+v3-v4)+t*(-v1+v2 - v3 + v4)));
end;
begin
Result.x:=round(cubic(p1.x, p2.x, p3.x, p4.x, t));
Result.y:=round(cubic(p1.y, p2.y, p3.y, p4.y, t));
end;
procedure MyDrawing(X,Y: Integer; Data: PData); stdcall;
begin
with Data^ do
begin
OffsetRgn(Pen, X, Y);
CombineRgn(Region, Region, Pen, RGN_OR);
OffsetRgn(Pen, -X, -Y);
end;
end;
var
i, s: integer;
p, p1, p2, p3, p4, e: TPoint;
Data: TData;
begin
Assert(Steps > 0);
Assert(Pen <> 0);
Result := 0;
if (Length(Points) < 2) or (Pen = 0) or (Steps = 0) then Exit;
Data.Region := CreateRectRgn(0,0,0,0);
Data.Pen := Pen;
e := Points[0];
p2 := Points[0];
p3 := Points[0];
p4 := Points[1];
for I := 0 to High(Points)-1 do
begin
p1 := p2;
p2 := p3;
p3 := p4;
if i+2 < Length(Points) then
p4 := Points[i+2];
for s := 1 to Steps do
begin
P := Interpolate(p1, p2, p3, p4, s / Steps);
LineDDA(E.X, E.Y, P.X, P.Y, @MyDrawing, Integer(@Data));
E := P;
end;
end;
Result := Data.Region;
end;
|