Hülle einer kalligrafischen Beziér-Kurve ermitteln

[negaH]

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;