fpvectorial: Adds support for the arrow entity in both generic fpvectorial and also DXF, and with a rendered directly in fpvectorial. Also fixes the text coordinates in DXF

git-svn-id: trunk@37235 -

components/fpvectorial/dxfvectorialreader.pas

@@ -30,7 +30,8 @@ interface
 
 uses
   Classes, SysUtils, Math,
-  fpvectorial, fpimage, fpvutils,
+  fpcanvas, fpimage,
+  fpvectorial, fpvutils,
   lconvencoding;
 
 type
@@ -103,6 +104,7 @@ type
     procedure ReadENTITIES_VERTEX(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
     procedure ReadENTITIES_SEQEND(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
     procedure ReadENTITIES_MTEXT(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
+    procedure ReadENTITIES_LEADER(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
     procedure ReadENTITIES_POINT(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
     function  GetCoordinateValue(AStr: shortstring): Double;
     function  ConvertDXFStringToUTF8(AStr: string): string;
@@ -741,6 +743,7 @@ begin
     else if CurToken.StrValue = 'SPLINE' then ReadENTITIES_SPLINE(CurToken.Childs, AData, ADoc)
     else if CurToken.StrValue = 'POINT' then ReadENTITIES_POINT(CurToken.Childs, AData, ADoc)
     else if CurToken.StrValue = 'MTEXT' then ReadENTITIES_MTEXT(CurToken.Childs, AData, ADoc)
+    else if CurToken.StrValue = 'LEADER' then ReadENTITIES_LEADER(CurToken.Childs, AData, ADoc)
     // A Polyline can have multiple child objects
     else if CurToken.StrValue = 'POLYLINE' then
     begin
@@ -1201,7 +1204,7 @@ begin
 
   // Position fixing for documents with negative coordinates
   PosX := PosX - DOC_OFFSET.X;
-  PosY := PosY - DOC_OFFSET.Y;
+  PosY := PosY + FontSize - DOC_OFFSET.Y;
 
   // Convert the string if necessary
   Str := ConvertDXFStringToUTF8(Str);
@@ -1429,12 +1432,73 @@ begin
 
   // Position fixing for documents with negative coordinates
   PosX := PosX - DOC_OFFSET.X;
-  PosY := PosY - DOC_OFFSET.Y;
+  PosY := PosY + FontSize - DOC_OFFSET.Y;
 
   //
   AData.AddText(PosX, PosY, 0, '', Round(FontSize), Str);
 end;
 
+procedure TvDXFVectorialReader.ReadENTITIES_LEADER(ATokens: TDXFTokens;
+  AData: TvVectorialPage; ADoc: TvVectorialDocument);
+var
+  CurToken: TDXFToken;
+  i, curPoint: Integer;
+  lValueX, lValueY: Double;
+  lArrow: TvArrow;
+begin
+  lArrow := TvArrow.Create;
+  curPoint := 0;
+
+  for i := 0 to ATokens.Count - 1 do
+  begin
+    // Now read and process the item name
+    CurToken := TDXFToken(ATokens.Items[i]);
+
+    // Avoid an exception by previously checking if the conversion can be made
+    if CurToken.GroupCode in [10, 20, 30, 11, 21, 31] then
+    begin
+      CurToken.FloatValue :=  StrToFloat(Trim(CurToken.StrValue), FPointSeparator);
+    end;
+
+    // Loads the coordinates
+    // With Position fixing for documents with negative coordinates
+    case CurToken.GroupCode of
+      10:
+      begin
+        // Starting a new point
+        Inc(curPoint);
+
+        lValueX := CurToken.FloatValue - DOC_OFFSET.X;
+
+        case curPoint of
+        1: lArrow.X := lValueX;
+        2: lArrow.Base.X := lValueX;
+        3: lArrow.ExtraLineBase.X := lValueX;
+        end;
+      end;
+      20:
+      begin
+        lValueY := CurToken.FloatValue - DOC_OFFSET.Y;
+
+        case curPoint of
+        1: lArrow.Y := lValueY;
+        2: lArrow.Base.Y := lValueY;
+        3: lArrow.ExtraLineBase.Y := lValueY;
+        end;
+      end;
+    end;
+  end;
+
+  // Give a % of the line length to the arrow head
+  lArrow.ArrowLength := 0.2 * sqrt(sqr(lArrow.Base.Y - lArrow.Y) + sqr(lArrow.Base.X - lArrow.X));
+  lArrow.ArrowBaseLength := lArrow.ArrowLength / 2;
+
+  // And now write it
+  lArrow.HasExtraLine := True;
+  lArrow.Brush.Style := bsSolid;
+  AData.AddEntity(lArrow);
+end;
+
 procedure TvDXFVectorialReader.ReadENTITIES_POINT(ATokens: TDXFTokens;
   AData: TvVectorialPage; ADoc: TvVectorialDocument);
 var

components/fpvectorial/fpvectorial.pas

@@ -197,6 +197,7 @@ type
         elements might be able to override this setting. }
     Pen: TvPen;
     constructor Create; override;
+    procedure ApplyPenToCanvas(ADest: TFPCustomCanvas);
   end;
 
   { TvEntityWithPenAndBrush }
@@ -207,6 +208,7 @@ type
         elements might be able to override this setting. }
     Brush: TvBrush;
     constructor Create; override;
+    procedure ApplyBrushToCanvas(ADest: TFPCustomCanvas);
   end;
 
   TvClipMode = (vcmNonzeroWindingRule, vcmEvenOddRule);
@@ -320,6 +322,31 @@ type
   public
   end;
 
+  { TvArrow }
+
+  //
+  // The arrow look like this:
+  //
+  // A<------|B
+  //         |
+  //         |C
+  //
+  // A -> X,Y,Z
+  // B -> Base
+  // C -> ExtraLineBase, which exists if HasExtraLine=True
+
+  TvArrow = class(TvEntityWithPenAndBrush)
+  public
+    Base: T3DPoint;
+    HasExtraLine: Boolean;
+    ExtraLineBase: T3DPoint;
+    ArrowLength: Double;
+    ArrowBaseLength: Double;
+    procedure CalculateBoundingBox(ADest: TFPCustomCanvas; var ALeft, ATop, ARight, ABottom: Double); override;
+    procedure Render(ADest: TFPCustomCanvas; ADestX: Integer = 0;
+      ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
+  end;
+
   {@@
     The elements bellow describe a formula
 
@@ -654,6 +681,13 @@ begin
   Pen.Color := colBlack;
 end;
 
+procedure TvEntityWithPen.ApplyPenToCanvas(ADest: TFPCustomCanvas);
+begin
+  ADest.Pen.FPColor := Pen.Color;
+  ADest.Pen.Width := Pen.Width;
+  ADest.Pen.Style := Pen.Style;
+end;
+
 { TvEntityWithPenAndBrush }
 
 constructor TvEntityWithPenAndBrush.Create;
@@ -663,6 +697,12 @@ begin
   Brush.Color := colBlue;
 end;
 
+procedure TvEntityWithPenAndBrush.ApplyBrushToCanvas(ADest: TFPCustomCanvas);
+begin
+  ADest.Brush.FPColor := Brush.Color;
+  ADest.Brush.Style := Brush.Style;
+end;
+
 { TvRasterImage }
 
 procedure TvRasterImage.InitializeWithConvertionOf3DPointsToHeightMap(APage: TvVectorialPage; AWidth, AHeight: Integer);
@@ -710,6 +750,95 @@ begin
   end;
 end;
 
+{ TvArrow }
+
+procedure TvArrow.CalculateBoundingBox(ADest: TFPCustomCanvas; var ALeft, ATop,
+  ARight, ABottom: Double);
+begin
+
+end;
+
+procedure TvArrow.Render(ADest: TFPCustomCanvas; ADestX: Integer;
+  ADestY: Integer; AMulX: Double; AMulY: Double);
+
+  function CoordToCanvasX(ACoord: Double): Integer;
+  begin
+    Result := Round(ADestX + AmulX * ACoord);
+  end;
+
+  function CoordToCanvasY(ACoord: Double): Integer;
+  begin
+    Result := Round(ADestY + AmulY * ACoord);
+  end;
+
+var
+  lArrow, lBase, lExtraBase: TPoint;
+  lPointD, lPointE, lPointF: T3DPoint;
+  lPoints: array[0..2] of TPoint;
+  AlfaAngle: Double;
+begin
+  ApplyPenToCanvas(ADest);
+  ApplyBrushToCanvas(ADest);
+
+  lArrow.X := CoordToCanvasX(X);
+  lArrow.Y := CoordToCanvasY(Y);
+  lBase.X := CoordToCanvasX(Base.X);
+  lBase.Y := CoordToCanvasY(Base.Y);
+  lExtraBase.X := CoordToCanvasX(ExtraLineBase.X);
+  lExtraBase.Y := CoordToCanvasY(ExtraLineBase.Y);
+
+  // Start with the lines
+
+  ADest.Line(lArrow, lBase);
+
+  if HasExtraLine then
+    ADest.Line(lBase, lExtraBase);
+
+  // Now draw the arrow head
+  lPoints[0].X := CoordToCanvasX(X);
+  lPoints[0].Y := CoordToCanvasY(Y);
+  //
+  // Here a lot of trigonometry comes to play, it is hard to explain in text, but in essence
+  //
+  // A line L is formed by the points A (Arrow head) and B (Base)
+  // Our smaller triangle starts at a point D in this line which has length ArrowLength counting from A
+  // This forms a rectangle triangle with a line paralel to the X axis
+  // Alfa is the angle between A and the line parallel to the X axis
+  //
+  // This brings this equations:
+  // AlfaAngle := arctg((B.Y - A.Y) / (B.X - A.X));
+  // Sin(Alfa) := (D.Y - A.Y) / ArrowLength
+  // Cos(Alfa) := (D.X - A.X) / ArrowLength
+  //
+  // Then at this point D we start a line perpendicular to the line L
+  // And with this line we progress a length of ArrowBaseLength/2
+  // This line, the D point and a line parallel to the Y axis for another
+  // rectangle triangle with the same Alfa angle at the point D
+  // The point at the end of the hipotenuse of this triangle is our point E
+  // So we have more equations:
+  //
+  // Sin(Alfa) := (E.x - D.X) / (ArrowBaseLength/2)
+  // Cos(Alfa) := (E.Y - D.Y) / (ArrowBaseLength/2)
+  //
+  // And the same in the opposite direction for our point F:
+  //
+  // Sin(Alfa) := (D.X - F.X) / (ArrowBaseLength/2)
+  // Cos(Alfa) := (D.Y - F.Y) / (ArrowBaseLength/2)
+  //
+  AlfaAngle := ArcTan((Base.Y - Y) / (Base.X - X));
+  lPointD.Y := Sin(AlfaAngle) * ArrowLength + Y;
+  lPointD.X := Cos(AlfaAngle) * ArrowLength + X;
+  lPointE.X := Sin(AlfaAngle) * (ArrowBaseLength/2) + lPointD.X;
+  lPointE.Y := Cos(AlfaAngle) * (ArrowBaseLength/2) + lPointD.Y;
+  lPointF.X := - Sin(AlfaAngle) * (ArrowBaseLength/2) + lPointD.X;
+  lPointF.Y := - Cos(AlfaAngle) * (ArrowBaseLength/2) + lPointD.Y;
+  lPoints[1].X := CoordToCanvasX(lPointE.X);
+  lPoints[1].Y := CoordToCanvasY(lPointE.Y);
+  lPoints[2].X := CoordToCanvasX(lPointF.X);
+  lPoints[2].Y := CoordToCanvasY(lPointF.Y);
+  ADest.Polygon(lPoints);
+end;
+
 { TvFormulaElement }
 
 function TvFormulaElement.CalculateHeight: Single;