2010. szeptember 11., szombat

Check if a point is on a Bezier curve


Problem/Question/Abstract:

How to check if a point is on a Bezier curve

Answer:

Try this simple approach:

{ ... }
p: array[0..3] of TPoint;
{ ... }

procedure TForm1.Button1Click(Sender: TObject);
begin
  p[0] := Point(10, 100);
  {p[1] := Point(1000, 400);}
  {p[2] := Point(- 400, 400);}
  p[1] := Point(200, -100);
  p[2] := Point(400, 400);
  p[3] := Point(600, 100);
  Canvas.Pen.Width := 5;
  Canvas.Pen.Color := clRed;
  Canvas.PolyBezier(p);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  t, t0, t1, t2, t3, tt: double;
  xx, yy: integer;
  p1, p2: array[0..3] of TPoint;
begin
  t := 0;
  repeat
    tt := 1 - t;
    t0 := tt * tt * tt;
    t1 := 3 * tt * tt * t;
    t2 := 3 * tt * t * t;
    t3 := t * t * t;
    xx := Round(p[0].x * t0 + p[1].x * t1 + p[2].x * t2 + p[3].x * t3);
    yy := Round(p[0].y * t0 + p[1].y * t1 + p[2].y * t2 + p[3].y * t3);
    if (abs(xx - x) + abs(yy - y) <= 2) then {rough checking for easy clicking}
      break;
    t := t + 1 / 512;
  until t > 1;
  if t <= 1 then
  begin
    Canvas.Pen.Width := 5;
    Canvas.Pen.Color := clRed;
    Canvas.PolyBezier(p);
    Canvas.Pen.Width := 2;
    Caption := FormatFloat('0.000', t);
    p1[0].x := p[0].x;
    p1[0].y := p[0].y;
    p1[3].x := xx;
    p1[3].y := yy;
    p1[1].x := Round((p[0].x * tt + p[1].x * t));
    p1[1].y := Round((p[0].y * tt + p[1].y * t));
    xx := Round((p[1].x * tt + p[2].x * t));
    yy := Round((p[1].y * tt + p[2].y * t));
    p1[2].x := Round(p1[1].x * tt + xx * t);
    p1[2].y := Round(p1[1].y * tt + yy * t);
    Canvas.Pen.Color := clYellow;
    Canvas.PolyBezier(p1);
    p2[0].x := p1[3].x;
    p2[0].y := p1[3].y;
    p2[3].x := p[3].x;
    p2[3].y := p[3].y;
    p2[2].x := Round((p[2].x * tt + p[3].x * t));
    p2[2].y := Round((p[2].y * tt + p[3].y * t));
    p2[1].x := Round(p2[2].x * t + xx * tt);
    p2[1].y := Round(p2[2].y * t + yy * tt);
    Canvas.Pen.Color := clAqua;
    Canvas.PolyBezier(p2);
  end;
end;

Nincsenek megjegyzések:

Megjegyzés küldése