fpvectorial: Starts preparing support for inserting any kind of entity, fixes setting the pen info for dimension drawings and implements rounded corners in TvRectangle

git-svn-id: trunk@39731 -

components/fpvectorial/dxfvectorialreader.pas

@@ -1487,7 +1487,7 @@ begin
   Result.X := PosX;
   Result.Y := PosY;
   Result.Z := PosZ;
-  Result.Block := lBlock;
+  Result.InsertEntity := lBlock;
   if not AOnlyCreate then AData.AddEntity(Result);
 end;
 

components/fpvectorial/fpvectorial.pas

@@ -209,6 +209,7 @@ type
     BackgroundColor: TFPColor;
     AdjustPenColorToBackground: Boolean;
     Selected: Boolean;
+    ForceRenderBlock: Boolean; // Blocks are usually invisible, but when rendering an insert, their drawing can be forced
   end;
 
   { Now all elements }
@@ -394,6 +395,8 @@ type
   public
     // Mandatory fields
     CX, CY, CZ: Double;
+    // Corner rounding, zero indicates no rounding
+    RX, RY: Double;
     procedure CalculateBoundingBox(ADest: TFPCustomCanvas; var ALeft, ATop, ARight, ABottom: Double); override;
     procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
@@ -605,14 +608,15 @@ type
   end;
 
   {@@
-    A "Insert" inserts a block into the drawing in the specified position
+    A "Insert" inserts a copy of any other element in the specified position.
+    Usually TvBlock entities are inserted, but any entity can be inserted.
   }
 
   { TvInsert }
 
   TvInsert = class(TvNamedEntity)
   public
-    Block: TvBlock; // The block to be inserted
+    InsertEntity: TvEntity; // The entity to be inserted
     procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
   end;
@@ -741,7 +745,7 @@ type
     function AddCircularArc(ACenterX, ACenterY, ARadius, AStartAngle, AEndAngle: Double; AColor: TFPColor; AOnlyCreate: Boolean = False): TvCircularArc;
     function AddEllipse(CenterX, CenterY, HorzHalfAxis, VertHalfAxis, Angle: Double; AOnlyCreate: Boolean = False): TvEllipse;
     function AddBlock(AName: string; AX, AY, AZ: Double): TvBlock;
-    function AddInsert(AX, AY, AZ: Double; ABlock: TvBlock): TvInsert;
+    function AddInsert(AX, AY, AZ: Double; AInsertEntity: TvEntity): TvInsert;
     // Layers
     function AddLayer(AName: string): TvLayer;
     function AddLayerAndSetAsCurrent(AName: string): TvLayer;
@@ -1950,7 +1954,14 @@ begin
   y1 := CoordToCanvasY(fy1);
   y2 := CoordToCanvasY(fy2);
 
-  ADest.Rectangle(x1, y1, x2, y2);
+  {$ifdef USE_LCL_CANVAS}
+  if (RX = 0) and (RY = 0) then
+    ADest.Rectangle(x1, y1, x2, y2)
+  else
+    LCLIntf.RoundRect(TCanvas(ADest).Handle, x1, y1, x2, y2, Round(rx), Round(ry));
+  {$else}
+  ADest.Rectangle(x1, y1, x2, y2)
+  {$endif}
 end;
 
 { TvAlignedDimension }
@@ -1976,6 +1987,8 @@ var
   {$endif}
 begin
   ADest.Pen.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
+  ADest.Pen.Width := 1;
+  ADest.Pen.Style := psSolid;
   //
   // Draws this shape:
   // horizontal     vertical
@@ -2088,6 +2101,8 @@ var
   {$endif}
 begin
   ADest.Pen.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
+  ADest.Pen.Width := 1;
+  ADest.Pen.Style := psSolid;
 
   // The size of the radius of the circle
   lRadius := sqrt(sqr(Center.X - DimensionLeft.X) + sqr(Center.Y - DimensionLeft.Y));
@@ -2852,10 +2867,34 @@ procedure TvInsert.Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADe
   ADestY: Integer; AMulX: Double; AMulY: Double);
 var
   lEntity: TvEntity;
+  OldForceRenderBlock: Boolean;
 begin
   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY);
-  if Block = nil then Exit;
+  if InsertEntity = nil then Exit;
-  lEntity := Block.GetFirstEntity();
+  // If we are inserting a block, make sure it will render its contents
+  OldForceRenderBlock := ARenderInfo.ForceRenderBlock;
+  ARenderInfo.ForceRenderBlock := True;
+  // Alter the position of the elements to consider the positioning of the BLOCK and of the INSERT
+  InsertEntity.Move(X, Y);
+  // Render
+  InsertEntity.Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMuly);
+  // Change them back
+  InsertEntity.Move(-X, -Y);
+  ARenderInfo.ForceRenderBlock := OldForceRenderBlock;
+end;
+
+{ TvBlock }
+
+procedure TvBlock.Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer;
+  ADestY: Integer; AMulX: Double; AMulY: Double);
+var
+  lEntity: TvEntity;
+begin
+  // blocks are invisible by themselves
+  //inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY);
+  if not ARenderInfo.ForceRenderBlock then Exit;
+
+  lEntity := GetFirstEntity();
   while lEntity <> nil do
   begin
     {$IFDEF FPVECTORIAL_DEBUG_BLOCKS}
@@ -2864,24 +2903,16 @@ begin
     {$ENDIF}
 
     // Alter the position of the elements to consider the positioning of the BLOCK and of the INSERT
-    lEntity.Move(Block.X + X, Block.Y + Y);
+    lEntity.Move(X, Y);
     // Render
     lEntity.Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMuly);
     // Change them back
-    lEntity.Move(- Block.X - X, - Block.Y - Y);
+    lEntity.Move(-X, -Y);
 
-    lEntity := Block.GetNextEntity();
+    lEntity := GetNextEntity();
   end;
 end;
 
-{ TvBlock }
-
-procedure TvBlock.Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer;
-  ADestY: Integer; AMulX: Double; AMulY: Double);
-begin
-  // TvBlock.Render must be empty! Because blocks are invisible by themselves
-end;
-
 { TvVectorialPage }
 
 procedure TvVectorialPage.ClearTmpPath;
@@ -3352,14 +3383,14 @@ begin
   Result := lBlock;
 end;
 
-function TvVectorialPage.AddInsert(AX, AY, AZ: Double; ABlock: TvBlock): TvInsert;
+function TvVectorialPage.AddInsert(AX, AY, AZ: Double; AInsertEntity: TvEntity): TvInsert;
 var
   lInsert: TvInsert;
 begin
   lInsert := TvInsert.Create;
   lInsert.X := AX;
   lInsert.Y := AY;
-  lInsert.Block := ABlock;
+  lInsert.InsertEntity := AInsertEntity;
   AddEntity(lInsert);
   Result := lInsert;
 end;

components/fpvectorial/svgvectorialreader.pas

@@ -80,6 +80,7 @@ type
     procedure ReadPolyFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
     procedure ReadRectFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
     procedure ReadTextFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
+    procedure ReadUseFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
     function  StringWithUnitToFloat(AStr: string): Double;
     procedure ConvertSVGCoordinatesToFPVCoordinates(
       const AData: TvVectorialPage;
@@ -309,14 +310,17 @@ begin
 
   // Support for RGB hex
   // ex: #0000ff
+  // Another wierd valid variant: #000
   if (Length(lValue) > 1) and (lValue[1] = '#') then
   begin
     lStr := Copy(lValue, 2, 2);
     Result.Red := StrToInt('$'+lStr)*$101;
     lStr := Copy(lValue, 4, 2);
-    Result.Green := StrToInt('$'+lStr)*$101;
+    if lStr = '' then Result.Green := 0
+    else Result.Green := StrToInt('$'+lStr)*$101;
     lStr := Copy(lValue, 6, 2);
-    Result.Blue := StrToInt('$'+lStr)*$101;
+    if lStr = '' then Result.Blue := 0
+    else Result.Blue := StrToInt('$'+lStr)*$101;
     Exit;
   end;
 
@@ -682,27 +686,53 @@ end;
 
 procedure TvSVGVectorialReader.ReadSVGPenStyleWithKeyAndValue(AKey,
   AValue: string; ADestEntity: TvEntityWithPen);
+var
+  OldAlpha: Word;
 begin
   if AKey = 'stroke' then
   begin
+    // We store and restore the old alpha to support the "-opacity" element
+    OldAlpha := ADestEntity.Pen.Color.Alpha;
     if ADestEntity.Pen.Style = psClear then ADestEntity.Pen.Style := psSolid;
 
     if AValue = 'none'  then ADestEntity.Pen.Style := fpcanvas.psClear
-    else ADestEntity.Pen.Color := ReadSVGColor(AValue)
+    else
+    begin
+      ADestEntity.Pen.Color := ReadSVGColor(AValue);
+      ADestEntity.Pen.Color.Alpha := OldAlpha;
+    end;
   end
   else if AKey = 'stroke-width' then
-    ADestEntity.Pen.Width := Round(StringWithUnitToFloat(AValue));
+    ADestEntity.Pen.Width := Round(StringWithUnitToFloat(AValue))
+  else if AKey = 'stroke-opacity' then
+    ADestEntity.Pen.Color.Alpha := StrToInt(AValue)*$101
+  else if AKey = 'stroke-linecap' then
+  begin
+    {case LowerCase(AValue) of
+    'butt':
+    'round':
+    'square': ADestEntity.Pen;
+    end;}
+  end;
 end;
 
 procedure TvSVGVectorialReader.ReadSVGBrushStyleWithKeyAndValue(AKey,
   AValue: string; ADestEntity: TvEntityWithPenAndBrush);
+var
+  OldAlpha: Word;
 begin
   if AKey = 'fill' then
   begin
+    // We store and restore the old alpha to support the "-opacity" element
+    OldAlpha := ADestEntity.Brush.Color.Alpha;
     if ADestEntity.Brush.Style = bsClear then ADestEntity.Brush.Style := bsSolid;
 
     if AValue = 'none'  then ADestEntity.Brush.Style := fpcanvas.bsClear
-    else ADestEntity.Brush.Color := ReadSVGColor(AValue)
+    else
+    begin
+      ADestEntity.Brush.Color := ReadSVGColor(AValue);
+      ADestEntity.Brush.Color.Alpha := OldAlpha;
+    end;
   end
   else if AKey = 'fill-opacity' then
     ADestEntity.Brush.Color.Alpha := StrToInt(AValue)*$101;
@@ -732,7 +762,11 @@ end;
 function TvSVGVectorialReader.IsAttributeFromStyle(AStr: string): Boolean;
 begin
   Result := (AStr = 'stroke') or (AStr = 'stroke-width') or
+    (AStr = 'stroke-dasharray') or (AStr = 'stroke-opacity') or
+    (AStr = 'stroke-linecap') or
+    // brush
     (AStr = 'fill') or (AStr = 'fill-opacity') or
+    // font
     (AStr = 'font-size') or (AStr = 'fill-family') or
     (AStr = 'font-weight');
 end;
@@ -767,12 +801,13 @@ begin
   case lEntityName of
     'circle': ReadCircleFromNode(ANode, AData, ADoc);
     'ellipse': ReadEllipseFromNode(ANode, AData, ADoc);
+    'g': ReadLayerFromNode(ANode, AData, ADoc);
     'line': ReadLineFromNode(ANode, AData, ADoc);
     'path': ReadPathFromNode(ANode, AData, ADoc);
     'polygon', 'polyline': ReadPolyFromNode(ANode, AData, ADoc);
     'rect': ReadRectFromNode(ANode, AData, ADoc);
     'text': ReadTextFromNode(ANode, AData, ADoc);
-    'g': ReadLayerFromNode(ANode, AData, ADoc);
+    'use': ReadUseFromNode(ANode, AData, ADoc);
   end;
 end;
 
@@ -1278,7 +1313,7 @@ end;
 procedure TvSVGVectorialReader.ReadRectFromNode(ANode: TDOMNode;
   AData: TvVectorialPage; ADoc: TvVectorialDocument);
 var
-  lx, ly, cx, cy: double;
+  lx, ly, cx, cy, lrx, lry: double;
   lRect: TvRectangle;
   i: Integer;
   lNodeName: DOMString;
@@ -1287,6 +1322,8 @@ begin
   ly := 0.0;
   cx := 0.0;
   cy := 0.0;
+  lrx := 0.0;
+  lry := 0.0;
 
   lRect := TvRectangle.Create;
   // SVG entities start without any pen drawing, but with a black brush
@@ -1302,6 +1339,10 @@ begin
       lx := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue)
     else if lNodeName = 'y' then
       ly := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue)
+    else if lNodeName = 'rx' then
+      lrx := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue)
+    else if lNodeName = 'ry' then
+      lry := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue)
     else if lNodeName = 'width' then
       cx := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue)
     else if lNodeName = 'height' then
@@ -1321,6 +1362,10 @@ begin
         AData, lx, ly, lRect.X, lRect.Y);
   ConvertSVGDeltaToFPVDelta(
         AData, cx, cy, lRect.CX, lRect.CY);
+  ConvertSVGDeltaToFPVDelta(
+        AData, lrx, lry, lRect.RX, lRect.RY);
+  lRect.RX := Abs(lRect.RX) * 2;
+  lRect.RY := Abs(lRect.RY) * 2;
 
   AData.AddEntity(lRect);
 end;
@@ -1388,6 +1433,12 @@ begin
   AData.AddEntity(lText);
 end;
 
+procedure TvSVGVectorialReader.ReadUseFromNode(ANode: TDOMNode;
+  AData: TvVectorialPage; ADoc: TvVectorialDocument);
+begin
+
+end;
+
 function TvSVGVectorialReader.StringWithUnitToFloat(AStr: string): Double;
 var
   UnitStr, ValueStr: string;