How to draw arrow line between shapes?

[Jonvy]

Hello all,

In my program, I need draw several circles(TShape), and link them by arrow lines.
There should have a function to call 2 circles, when call this function, it can draw arraw line to link the them.

Circles can be any position on the form.
When I move the circle, the arrow line can also move and keep the connection between them always.
Like attachment video.

Can someone give me sample code for this?

Best regards,
Jonvy

[dseligo]

Maybe it would be easier if you use some already existing flowchart components.
Component EvsSimpleCharts is in the OPM, TAChart maybe also have something.

Also look here:
https://github.com/t-edson/ogEditGraf/
https://wiki.lazarus.freepascal.org/Eye-Candy_Controls#TECScheme
https://forum.lazarus.freepascal.org/index.php/topic,48351.msg348604.html#msg348604

[paweld]

BGRABitmap:

Code: Pascal  [Select][+][-]

1. uses
2.   BGRABitmap, BGRABitmapTypes;
3.  
4. procedure TForm1.FormCreate(Sender: TObject);
5. begin
6.   //form size
7.   Width := 800;
8.   Height := 400;
9. end;
10.  
11. procedure TForm1.FormPaint(Sender: TObject);
12. var
13.   bmp: TBGRABitmap;
14.   pointsarr: array of TPoint;
15.   i, j, r, t, lw: Integer;
16.   ts: TSize;
17.   b: Boolean;
18. begin
19.   r := 50;
20.   t := 8;
21.   lw := 2;
22.   SetLength(pointsarr, 7);
23.   pointsarr[0] := Point(100, 200);
24.   pointsarr[1] := Point(250, 200);
25.   pointsarr[2] := Point(400, 200);
26.   pointsarr[3] := Point(550, 100);
27.   pointsarr[4] := Point(550, 300);
28.   pointsarr[5] := Point(700, 100);
29.   pointsarr[6] := Point(700, 300);
30.   bmp := TBGRABitmap.Create(ClientWidth, ClientHeight, clWhite);
31.   for i := 0 to High(pointsarr) do
32.   begin
33.     bmp.EllipseAntialias(pointsarr[i].X, pointsarr[i].Y, r, r, clBlack, lw, clWhite);
34.     ts := bmp.TextSize('Step ' + IntToStr(i));
35.     bmp.TextOut(pointsarr[i].X - (ts.Width div 2), pointsarr[i].Y - (ts.Height div 2), 'Step ' + IntToStr(i), clNavy);
36.     if i < High(pointsarr) then
37.     begin
38.       bmp.ArrowEndAsTriangle();
39.       bmp.ArrowEndSize := PointF(t, 2);
40.       bmp.ArrowStartOffset:= 0;
41.       b := False;
42.       for j := i downto 0 do
43.       begin
44.         if (pointsarr[j].Y = pointsarr[i + 1].Y) and (pointsarr[j].X < pointsarr[i + 1].X) then
45.         begin
46.           b := True;
47.           break;
48.         end;
49.       end;
50.       if not b then
51.       begin
52.         for j := i downto 0 do
53.         begin
54.           if pointsarr[j].X < pointsarr[i + 1].X then
55.             break;
56.         end;
57.       end;
58.       bmp.DrawLineAntialias(pointsarr[j].X + r + lw, pointsarr[j].Y,
59.         pointsarr[i + 1].X - r - t - lw, pointsarr[i + 1].Y, clGreen, lw);
60.     end;
61.   end;
62.   bmp.Draw(Canvas, 0, 0);
63.   bmp.Free;
64. end;  

[wp]

Borrowed from TAChart:

Code: Pascal  [Select][+][-]

1. uses
2.   Math;
3.  
4. function RotatePointX(AX, AAngle: Double): TPoint;
5. var
6.   sa, ca: Extended;
7. begin
8.   SinCos(AAngle, sa, ca);
9.   Result.X := Round(ca * AX);
10.   Result.Y := Round(sa * AX);
11. end;
12.  
13. procedure DrawArrowLine(ACanvas: TCanvas; FromPt, ToPt: TPoint; ArrowWidth: Integer = 5;
14.   ArrowLength: Integer = 10; ArrowBaseLength: Integer = 10);
15. var
16.   angle: Double;
17.   dir: Double;
18.   diag: Integer;
19.   pt1, pt2, ptBase: TPoint;
20. begin
21.   // Draw the connection line from FromPt to ToPt
22.   ACanvas.Line(FromPt, ToPt);
23.  
24.   // Draw the arrow at the end point ToPt.
25.   dir := ArcTan2(ToPt.Y - FromPt.Y, ToPt.X - FromPt.X);  // Direction of line
26.   angle := ArcTan2(ArrowWidth, ArrowLength);             // Opening angle of arrow
27.   diag := -Round(sqrt(sqr(ArrowLength) + sqr(ArrowWidth)));
28.   pt1 := ToPt + RotatePointX(diag, dir - angle);
29.   pt2 := ToPt + RotatePointX(diag, dir + angle);
30.   if ArrowBaseLength > 0 then
31.   begin
32.     ptBase := ToPt + RotatePointX(-ArrowBaseLength, dir);
33.     ACanvas.Polygon([pt1, ToPt, pt2, ptBase]);
34.   end else
35.     ACanvas.PolyLine([pt1, ToPt, pt2]);
36. end;
37.  
38. procedure TForm1.PaintBox1Paint(Sender: TObject);
39. begin
40.   Paintbox1.Canvas.Brush.Color := clWhite;
41.   Paintbox1.Canvas.FillRect(0, 0, Paintbox1.Width, Paintbox1.Height);
42.   Paintbox1.Canvas.Pen.Color := clRed;
43.   Paintbox1.Canvas.Brush.Color := clRed;
44.   DrawArrowLine(Paintbox1.Canvas, Point(10, 10), Point(Paintbox1.Width-10, Paintbox1.Height-10));
45.   DrawArrowLine(Paintbox1.Canvas, Point(Paintbox1.Width-20, 20), Point(20, Paintbox1.Height-20), 10, 20, 15);  
46. end;

         

[Jonvy]

BGRABitmap:

Code: Pascal  [Select][+][-]

1. uses
2.   BGRABitmap, BGRABitmapTypes;
3.  
4. procedure TForm1.FormCreate(Sender: TObject);
5. begin
6.   //form size
7.   Width := 800;
8.   Height := 400;
9. end;
10.  
11. procedure TForm1.FormPaint(Sender: TObject);
12. var
13.   bmp: TBGRABitmap;
14.   pointsarr: array of TPoint;
15.   i, j, r, t, lw: Integer;
16.   ts: TSize;
17.   b: Boolean;
18. begin
19.   r := 50;
20.   t := 8;
21.   lw := 2;
22.   SetLength(pointsarr, 7);
23.   pointsarr[0] := Point(100, 200);
24.   pointsarr[1] := Point(250, 200);
25.   pointsarr[2] := Point(400, 200);
26.   pointsarr[3] := Point(550, 100);
27.   pointsarr[4] := Point(550, 300);
28.   pointsarr[5] := Point(700, 100);
29.   pointsarr[6] := Point(700, 300);
30.   bmp := TBGRABitmap.Create(ClientWidth, ClientHeight, clWhite);
31.   for i := 0 to High(pointsarr) do
32.   begin
33.     bmp.EllipseAntialias(pointsarr[i].X, pointsarr[i].Y, r, r, clBlack, lw, clWhite);
34.     ts := bmp.TextSize('Step ' + IntToStr(i));
35.     bmp.TextOut(pointsarr[i].X - (ts.Width div 2), pointsarr[i].Y - (ts.Height div 2), 'Step ' + IntToStr(i), clNavy);
36.     if i < High(pointsarr) then
37.     begin
38.       bmp.ArrowEndAsTriangle();
39.       bmp.ArrowEndSize := PointF(t, 2);
40.       bmp.ArrowStartOffset:= 0;
41.       b := False;
42.       for j := i downto 0 do
43.       begin
44.         if (pointsarr[j].Y = pointsarr[i + 1].Y) and (pointsarr[j].X < pointsarr[i + 1].X) then
45.         begin
46.           b := True;
47.           break;
48.         end;
49.       end;
50.       if not b then
51.       begin
52.         for j := i downto 0 do
53.         begin
54.           if pointsarr[j].X < pointsarr[i + 1].X then
55.             break;
56.         end;
57.       end;
58.       bmp.DrawLineAntialias(pointsarr[j].X + r + lw, pointsarr[j].Y,
59.         pointsarr[i + 1].X - r - t - lw, pointsarr[i + 1].Y, clGreen, lw);
60.     end;
61.   end;
62.   bmp.Draw(Canvas, 0, 0);
63.   bmp.Free;
64. end;  

Thanks paweld, I never use BGRABitmap before, I'll study it first,then try to use it. Your code looks nice!

[Jonvy]

Borrowed from TAChart:

Code: Pascal  [Select][+][-]

1. uses
2.   Math;
3.  
4. function RotatePointX(AX, AAngle: Double): TPoint;
5. var
6.   sa, ca: Extended;
7. begin
8.   SinCos(AAngle, sa, ca);
9.   Result.X := Round(ca * AX);
10.   Result.Y := Round(sa * AX);
11. end;
12.  
13. procedure DrawArrowLine(ACanvas: TCanvas; FromPt, ToPt: TPoint; ArrowWidth: Integer = 5;
14.   ArrowLength: Integer = 10; ArrowBaseLength: Integer = 10);
15. var
16.   angle: Double;
17.   dir: Double;
18.   diag: Integer;
19.   pt1, pt2, ptBase: TPoint;
20. begin
21.   // Draw the connection line from FromPt to ToPt
22.   ACanvas.Line(FromPt, ToPt);
23.  
24.   // Draw the arrow at the end point ToPt.
25.   dir := ArcTan2(ToPt.Y - FromPt.Y, ToPt.X - FromPt.X);  // Direction of line
26.   angle := ArcTan2(ArrowWidth, ArrowLength);             // Opening angle of arrow
27.   diag := -Round(sqrt(sqr(ArrowLength) + sqr(ArrowWidth)));
28.   pt1 := ToPt + RotatePointX(diag, dir - angle);
29.   pt2 := ToPt + RotatePointX(diag, dir + angle);
30.   if ArrowBaseLength > 0 then
31.   begin
32.     ptBase := ToPt + RotatePointX(-ArrowBaseLength, dir);
33.     ACanvas.Polygon([pt1, ToPt, pt2, ptBase]);
34.   end else
35.     ACanvas.PolyLine([pt1, ToPt, pt2]);
36. end;
37.  
38. procedure TForm1.PaintBox1Paint(Sender: TObject);
39. begin
40.   Paintbox1.Canvas.Brush.Color := clWhite;
41.   Paintbox1.Canvas.FillRect(0, 0, Paintbox1.Width, Paintbox1.Height);
42.   Paintbox1.Canvas.Pen.Color := clRed;
43.   Paintbox1.Canvas.Brush.Color := clRed;
44.   DrawArrowLine(Paintbox1.Canvas, Point(10, 10), Point(Paintbox1.Width-10, Paintbox1.Height-10));
45.   DrawArrowLine(Paintbox1.Canvas, Point(Paintbox1.Width-20, 20), Point(20, Paintbox1.Height-20), 10, 20, 15);  
46. end;

         

Thanks wp. I didn't think of way to use math function to do the  rotation, your code give me some clues.