User Drawing of Lines and Curves

[Mike Warren 2]

I need to allow the users of my program to draw lines and curves.

 

Is TPath the best way to do this? I haven't been able to find much in the way of documentation so far, and because this sort of thing is totally new to me I'd love an example to allow me to understand what needs to be done.

 

Probably the way I imagine the user would interact would be to click a start point and then an end point to draw a line, and then click along the line and drag to create nodes to change the line into a curve.

 

I'm expecting a steep learning curve, unless there is already a Firemonkey component I can purchase to do this.

 

Can anyone offer any suggestions?

 

 

[KodeZwerg 54]

unit Unit12;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TForm12 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    procedure DrawLine(Color : TColor);
  public
    FStartX, FStartY,
    FEndX, FEndY : integer;
    FLineDrawn : boolean;
  end;

var
  Form12: TForm12;

implementation

{$R *.dfm}

{ TForm12 }

procedure TForm12.FormCreate(Sender: TObject);
begin
  FLineDrawn := False;
end;

procedure TForm12.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FLineDrawn := True;
  FStartX := X;
  FStartY := Y;
end;

procedure TForm12.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  FEndX := X;
  FEndY := Y;
  if FLineDrawn then
    DrawLine(clRed);
end;

procedure TForm12.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FLineDrawn := False;
  DrawLine(clGreen);
end;

procedure TForm12.DrawLine(Color : TColor);
begin
  Self.Refresh;
  Canvas.Pen.Color := Color;
  Canvas.MoveTo(FStartX, FStartY);
  Canvas.LineTo(FEndX, FEndY);
end;

end.

A very basic example that might lead you into the direction you want.
Steps to reproduce:
1. Create a new Vcl Application.
2. Add handlers as shown in above example.
3. run app and press mouse button, keep it pressed while moving, release button for a final drawing.

[angusj 126]

https://stackoverflow.com/questions/24789766/drawing-a-bezier-curve-using-firemonkey

[Rollo62 502]

Yes, I use TPath too, a lot.

Works nice and reliable and is probably the most simple way to do that in FMX.

 

Nevertheless, if you need more advanced drawing, I would look into SVG and/or into TImage32 from Angus, or even into SkiaForDelphi from Vinicious and friends.

 

 

[XylemFlow 6]

Here's a basic demo using TPath and TSelectionPoint (Tested for Windows 32-bit). Click and drag to draw the line. Then you can drag the control points to create a curve. Of course you can then add the path to a list of paths if you want to keep multiple drawn paths.

 

PathDemo.zip

Edited August 5, 2023 by XylemFlow
typo

[Mike Warren 2]

Thank you all for your replies.

 

@XylemFlow: That is exactly what I was looking for! I learn so much better by example and your example is very close to what I want to do.

[Mike Warren 2]

I've just started to look at this and have a problem already.

 

I need to be able to edit these paths later which means I have to be able to click on them. The path is clickable, but it doesn't exactly follow the line. It's an area (shown in blue on the attached image. Ideally, I'd like to detect a click near the line (maybe 4 pixels either side and not the area the TPath exposes. At this point the only thing I can think of is going to require a lot of code to calculate where the line is, which will run way too slow to be practical in a mouse move event, especially when there may be 20 to 50 (or more) paths on the form.

 

Does anyone have an idea on how I can achieve this?

 

 

[Anders Melander 1639]

8 hours ago, Mike Warren said:

Does anyone have an idea on how I can achieve this?

1. Convert the bezier to a polyline with a fixed limited number of points (whatever drawing routine you end up using already does this internally, you just need a lot fewer points for hit testing than for drawing a smooth line).
2. Iterate the segments of the polyline and find the minimum distance from your point to the segments.

Even with thousands of beziers, you should be able to do this in no time at all (I'm guessing low milliseconds).

[Cristian Peța 94]

17 hours ago, Anders Melander said:

Convert the bezier to a polyline with a fixed limited number of points (whatever drawing routine you end up using already does this internally, you just need a lot fewer points for hit testing than for drawing a smooth line).

Path1.Data.FlattenToPolygon will return an array of points.

17 hours ago, Anders Melander said:

Iterate the segments of the polyline and find the minimum distance from your point to the segments. 

Use DistanceFromPointToLine

procedure LineEcuation(var a, b, c: Double; x1, y1, x2, y2: Double);
begin
  if Abs(x1*y2 - x2*y1) < 1E-20 then begin
    if (Abs(x1) > 1E-20) or (Abs(x2) > 1E-20) then begin//Ecuation  a*x + y = 0
      if (Abs(x1) > 1E-20) then
        a := -y1 / x1
      else
        a := -y2 / x2;
      b := 1;
      c := 0;
    end
    else begin//Ecuation  x = 0
      a := 1;
      b := 0;
      c := 0;
    end;
  end
  else begin//Ecuation  a*x + b*y + 1 = 0
    b := (x2 - x1) / (x1*y2 - x2*y1);
    a := (y1 - y2) / (x1*y2 - x2*y1);
    c := 1;
  end;
end;


//X0, Y0 point
//Xd1, Yd1, Xd2, Yd2 - points of the line
function DistanceFromPointToLine(X0, Y0, Xd1, Yd1, Xd2, Yd2: Double): Double;
var
  a, b, c: Double;
begin
  LineEcuation(a, b, c, Xd1, Yd1, Xd2, Yd2);
  Result := Abs(a * X0 + b * Y0 + c) / Hypot(a, b);
end;

 

17 hours ago, Anders Melander said:

Even with thousands of beziers, you should be able to do this in no time at all (I'm guessing low milliseconds). 

I also think so.

[Anders Melander 1639]

2 hours ago, Cristian Peța said:

Use DistanceFromPointToLine

One needs to take into account that we're not dealing with lines but line segments. Lines have infinite length, while line segments have finite length.

We don't want to detect a hit beyond the end of the line segment:

I think the following one does the trick. I use it in a bitmap editor for scanline conversion of lines (the above image was made with it).

(*

  Distance from point to line segment.

  Let A=(xa,ya), B=(xb,yb), X=(x,y)

  Now, the line between A and B is given parametrically by

        V(k) = (1-k)A + kB = A + k(B - A)

  and adding the constraint 0 <= k <= 1 makes V(k) the line segment from A to B.

  Now, the line through X perpendicular to V(k) intersects V(k) when k equals

            (B - A) . (X - A)
       k = -------------------
               | B - A |^2

  So if k <= 0, X is closest to A, if k >= 1, X is closest to B, and
  if 0 < k < kp, X is closest to V(k).

*)
function DistanceToLine(X,Y, XA,YA, XB,YB: integer; var RunLength: Single): Single;

  function VectorLength(X1,Y1, X2,Y2: Single): Single; inline;
  begin
    Result := Hypot(X1-X2, Y1-Y2); // = Sqrt(Sqr(X1-X2) + Sqr(Y1-Y2))
  end;

var
  k: Single;
  dx, dy: integer;
begin
  dx := XB-XA;
  dy := YB-YA;

  if (dx <> 0) or (dy <> 0) then
  begin
    k := (dx*(X-XA) + dy*(Y-YA)) / (Sqr(dx)+Sqr(dy));

    if (k <= 0) then
      // Point before or at start of line segment
      Result := VectorLength(XA,YA, X,Y)
    else
    if (k >= 1) then
      // Point after or at end of line segment
      Result := VectorLength(XB,YB, X,Y)
    else
      // Point within line segment
      Result := VectorLength(X,Y, XA+k*dx, YA+k*dy); // = VectorLength(X,Y, (1-kp)*XA+kp*XB, (1-kp)*YA+kp*YB);

    RunLength := k;
  end else
  // Degenerate line
  begin
    RunLength := 0;
    Result := VectorLength(XA,YA,X,Y);
  end;
end;

The result is the distance, the RunLength parameter can be used to determine where the projection of the point onto the line lies: before, on, or after the line segment.

 

A small optimization can be done since we're doing hit-testing and don't really need the actual, precise distance value. The VectorLength function uses Hypot (i.e. Pythagoras) to calculate the distance. Hypot internally does a Sqrt, which is an expensive operation. The Sqrt can be eliminated so we return the squared distance instead and then we just need to compare that value against the squared hit limit instead. I.e. if your hit limit was 4 then compare the squared distance against 4*4 = 16 instead.

Edited August 17, 2023 by Anders Melander
something ate my bitmap

[Mike Warren 2]

Thank you both. I really appreciate your help. Sorry for the delay getting back to this thread. I've been sick and haven't had a chance to delve into this yet.

[dirace 0]

Hello
I have tried the app from @XylemFlow  .
It is working great if Stroke.Thickness is 1.
If Stroke.Thickness is 20 the selectionpoints are not at the expected position.
Their position change relatively to the angle of the line.
Any Idea how can this be solved?

 

Thank you

[Anders Melander 1639]

41 minutes ago, dirace said:

It is working great if Stroke.Thickness is 1.
If Stroke.Thickness is 20 the selectionpoints are not at the expected position.

It's a bug in FMX. Probably related to this one: https://quality.embarcadero.com/browse/RSP-39520

 

It's visible for Stroke.Thickness>1

[dirace 0]

A screenshot showing the problem.
Is this a bug or do I miss something?

[Anders Melander 1639]

1 hour ago, dirace said:

Is this a bug

 

1 hour ago, Anders Melander said:

It's a bug

 

[Gustav Schubert 25]

We only need to deal with the flattened points, distance to line segment computation is not needed.

 

I know this only because I have just tested out the FlattenToPolygon approach starting from the PathDemo.zip test program from above. To find the distance between two points is easy when working with TPointF. It is more difficult to update the properties of a supposedly easy to use TLine test component. One would have expected a TLine component to have TPointF properties for start and end points, but nope. The snippets below may be of help, when building the interactive test program.
 

procedure TFormMain.InitProps;
begin
  { Since we are using design time test components in the test program ... }

  { the TPath under test }
  Path.HitTest := False;

  { a TCircle }
  Circle.Width := 50;
  Circle.Height := 50;
  Circle.HitTest := False;
  Circle.Opacity := 0.5;
  Circle.Stroke.Color := claBlue;

  { a TLine }
  Line.LineType := TLineType.Top;
  Line.RotationCenter.Point := TPointF.Zero;
  Line.Height := 0;
  Line.HitTest := False;
  Line.Stroke.Color := claRed;
end;

procedure TFormMain.PanelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  if FDragging then
  begin
    FDragging := False;
    ControlPoint1.Visible := True;
    ControlPoint2.Visible := True;
  end
  else if ssCtrl in Shift then
  begin
    ShowClosestPoint(TPointF.Create(X, Y)); // <-- new: Ctrl-Click to test!
  end
end;

procedure TFormMain.ShowClosestPoint(P: TPointF);
var
  T: TPointF;
  PT: TPointF;
begin
  { T is closest point on Path, measured from test point P }
  T := FindClosestPoint(Path, P);

  { center the translucent circle at the closest point }
  Circle.Position.Point := T - TPointF.Create(Circle.Width, Circle.Height) / 2;

  { update the test line properties, so that Line is drawn from P to T }
  PT := T - P;
  Line.Position.Point := P;
  Line.Width := PT.Length;
  Line.RotationAngle := 180 + RadToDeg(TPointF.Zero.Angle(PT));
end;

function TFormMain.FindClosestPoint(APath: TPath; APoint: TPointF): TPointF;
var
  Poly: TPolygon;
  l: Integer;

  i: Integer;
  d: single;

  iMin: Integer;
  dMin: single;
begin
  APath.Data.FlattenToPolygon(Poly, 2);

  l := Length(Poly);
  if l < 1 then
    Exit;

  dMin := APoint.Distance(Poly[0]);
  iMin := 0;
  for i := 1 to l - 1 do
  begin
    d := APoint.Distance(Poly[i]);
    if d < dMin then
    begin
      dMin := d;
      iMin := i;
    end;
  end;

  result := Poly[iMin];
end;

 

[jerik 0]

Great discussion! 

[XylemFlow 6]

On 9/5/2023 at 5:01 PM, Anders Melander said:

It's a bug in FMX. Probably related to this one: https://quality.embarcadero.com/browse/RSP-39520

 

It's visible for Stroke.Thickness>1

Funny. That bug was reported by me, but I hadn't considered that it would cause problems in my demo.

Edited September 18, 2023 by XylemFlow

[Mike Warren 2]

On 9/19/2023 at 5:07 AM, XylemFlow said:

Funny. That bug was reported by me, but I hadn't considered that it would cause problems in my demo.

Looks like this bug has been fixed in D12 according to the QC. I haven't installed D12 yet to check.

 

[Dave Nottage 493]

52 minutes ago, Mike Warren said:

Looks like this bug has been fixed in D12 according to the QC. I haven't installed D12 yet to check.

A very brief check (at design-time) shows it appears to have been fixed.

[Mike Warren 2]

It doesn't appear to be fixed to me.