From ba73becf3e63d1fc40cd4f0c9355a876850c0592 Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Wed, 2 Jan 2013 09:59:56 +0000 Subject: [PATCH] fpvectorial: Greatly improves the FPV tokens debug information and fixes the svg style reading for paths git-svn-id: trunk@39726 - --- components/fpvectorial/fpvectorial.pas | 134 ++++++++++++++++-- components/fpvectorial/svgvectorialreader.pas | 38 +++-- 2 files changed, 150 insertions(+), 22 deletions(-) diff --git a/components/fpvectorial/fpvectorial.pas b/components/fpvectorial/fpvectorial.pas index 763c8fc337..4219f43dfe 100644 --- a/components/fpvectorial/fpvectorial.pas +++ b/components/fpvectorial/fpvectorial.pas @@ -138,6 +138,7 @@ type Previous: TPathSegment; Next: TPathSegment; procedure Move(ADeltaX, ADeltaY: Double); virtual; + function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; virtual; end; {@@ @@ -154,6 +155,7 @@ type public X, Y: Double; procedure Move(ADeltaX, ADeltaY: Double); override; + function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override; end; T2DSegmentWithPen = class(T2DSegment) @@ -228,11 +230,13 @@ type procedure Move(ADeltaX, ADeltaY: Double); virtual; procedure MoveSubpart(ADeltaX, ADeltaY: Double; ASubpart: Cardinal); virtual; function GetSubpartCount: Integer; virtual; + procedure PositionSubparts(ADest: TFPCustomCanvas; ABaseX, ABaseY: Double); virtual; procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); virtual; function AdjustColorToBackground(AColor: TFPColor; ARenderInfo: TvRenderInfo): TFPColor; function GetNormalizedPos(APage: TvVectorialPage; ANewMin, ANewMax: Double): T3DPoint; function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; virtual; + function GenerateDebugStrForFPColor(AColor: TFPColor): string; end; TvEntityClass = class of TvEntity; @@ -242,6 +246,7 @@ type TvNamedEntity = class(TvEntity) public Name: string; + function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override; end; { TvEntityWithPen } @@ -301,6 +306,7 @@ type function GetSubpartCount: Integer; override; procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override; + function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override; end; {@@ @@ -322,6 +328,7 @@ type function TryToSelect(APos: TPoint; var ASubpart: Cardinal): TvFindEntityResult; override; procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override; + function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override; end; {@@ @@ -542,7 +549,7 @@ type // function CalculateHeight(ADest: TFPCustomCanvas): Double; // in milimeters function CalculateWidth(ADest: TFPCustomCanvas): Double; // in milimeters - procedure PositionElements(ADest: TFPCustomCanvas; ABaseX, ABaseY: Double); + procedure PositionSubparts(ADest: TFPCustomCanvas; ABaseX, ABaseY: Double); override; 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; @@ -567,6 +574,7 @@ type procedure Clear; override; procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override; + function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override; end; {@@ @@ -730,6 +738,7 @@ type // function AddPoint(AX, AY, AZ: Double): TvPoint; { Drawing methods } + procedure PositionEntitySubparts(ADest: TFPCustomCanvas; ABaseX, ABaseY: Double); procedure DrawBackground(ADest: TFPCustomCanvas); procedure Render(ADest: TFPCustomCanvas; ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); @@ -897,6 +906,15 @@ begin end; +function TPathSegment.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; + APageItem: Pointer): Pointer; +var + lStr: string; +begin + lStr := Format('[%s]', [Self.ClassName]); + Result := ADestRoutine(lStr, APageItem); +end; + { T2DSegment } procedure T2DSegment.Move(ADeltaX, ADeltaY: Double); @@ -905,6 +923,15 @@ begin Y := Y + ADeltaY; end; +function T2DSegment.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; + APageItem: Pointer): Pointer; +var + lStr: string; +begin + lStr := Format('[%s] X=%f Y=%f', [Self.ClassName, X, Y]); + Result := ADestRoutine(lStr, APageItem); +end; + { T2DBezierSegment } procedure T2DBezierSegment.Move(ADeltaX, ADeltaY: Double); @@ -988,6 +1015,12 @@ begin Result := 0; end; +procedure TvEntity.PositionSubparts(ADest: TFPCustomCanvas; ABaseX, + ABaseY: Double); +begin + +end; + procedure TvEntity.Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double); begin @@ -1024,7 +1057,23 @@ function TvEntity.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; var lStr: string; begin - lStr := Format('[%s]', [Self.ClassName]); + lStr := Format('[%s] X=%f Y=%f', [Self.ClassName, X, Y]); + Result := ADestRoutine(lStr, APageItem); +end; + +function TvEntity.GenerateDebugStrForFPColor(AColor: TFPColor): string; +begin + Result := IntToHex(AColor.Red div $100, 2) + IntToHex(AColor.Green div $100, 2) + IntToHex(AColor.Blue div $100, 2) + IntToHex(AColor.Alpha div $100, 2); +end; + +{ TvNamedEntity } + +function TvNamedEntity.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; + APageItem: Pointer): Pointer; +var + lStr: string; +begin + lStr := Format('[%s] Name=%s X=%f Y=%f', [Self.ClassName, Name, X, Y]); Result := ADestRoutine(lStr, APageItem); end; @@ -1505,6 +1554,30 @@ begin {$endif} end; +function TPath.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; + APageItem: Pointer): Pointer; +var + lStr: string; + lCurPathSeg: TPathSegment; +begin + lStr := Format('[%s] Name=%s Pen.Color=%s Pen.Style=%s Brush.Color=%s Brush.Style=%s', + [Self.ClassName, Self.Name, + GenerateDebugStrForFPColor(Pen.Color), + GetEnumName(TypeInfo(TFPPenStyle), integer(Pen.Style)), + GenerateDebugStrForFPColor(Brush.Color), + GetEnumName(TypeInfo(TFPBrushStyle), integer(Brush.Style)) + ]); + Result := ADestRoutine(lStr, APageItem); + // Add sub-entities + PrepareForSequentialReading(); + lCurPathSeg := Next(); + while lCurPathSeg <> nil do + begin + lCurPathSeg.GenerateDebugTree(ADestRoutine, Result); + lCurPathSeg := Next(); + end; +end; + { TvText } constructor TvText.Create; @@ -1577,6 +1650,15 @@ begin end; end; +function TvText.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; + APageItem: Pointer): Pointer; +var + lStr: string; +begin + lStr := Format('[%s] Name=%s X=%f Y=%f Text=%s', [Self.ClassName, Name, X, Y, Value.Text]); + Result := ADestRoutine(lStr, APageItem); +end; + { TvCircle } procedure TvCircle.Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer; @@ -2498,7 +2580,7 @@ begin Width := Result; end; -procedure TvFormula.PositionElements(ADest: TFPCustomCanvas; ABaseX, ABaseY: Double); +procedure TvFormula.PositionSubparts(ADest: TFPCustomCanvas; ABaseX, ABaseY: Double); var lElement: TvFormulaElement; lPosX: Double = 0; @@ -2539,30 +2621,30 @@ begin lCentralizeFactorAdj := 0; end; - lElement.Formula.PositionElements(ADest, lElement.Left + lCentralizeFactor, lElement.Top); - lElement.AdjacentFormula.PositionElements(ADest, lElement.Left + lCentralizeFactorAdj, lElement.Top - lElement.Formula.Height - 3); + lElement.Formula.PositionSubparts(ADest, lElement.Left + lCentralizeFactor, lElement.Top); + lElement.AdjacentFormula.PositionSubparts(ADest, lElement.Left + lCentralizeFactorAdj, lElement.Top - lElement.Formula.Height - 3); end; fekRoot: begin // Give a factor for the root drawing - lElement.Formula.PositionElements(ADest, lElement.Left + 10, lElement.Top); + lElement.Formula.PositionSubparts(ADest, lElement.Left + 10, lElement.Top); end; fekPower: begin - lElement.Formula.PositionElements(ADest, lElement.Left, lElement.Top); - lElement.AdjacentFormula.PositionElements(ADest, lElement.Left + lElement.Formula.Width, lElement.Top); + lElement.Formula.PositionSubparts(ADest, lElement.Left, lElement.Top); + lElement.AdjacentFormula.PositionSubparts(ADest, lElement.Left + lElement.Formula.Width, lElement.Top); end; fekSubscript: begin - lElement.Formula.PositionElements(ADest, lElement.Left, lElement.Top); - lElement.AdjacentFormula.PositionElements(ADest, lElement.Left + lElement.Formula.Width, lElement.Top - lElement.Formula.Height / 2); + lElement.Formula.PositionSubparts(ADest, lElement.Left, lElement.Top); + lElement.AdjacentFormula.PositionSubparts(ADest, lElement.Left + lElement.Formula.Width, lElement.Top - lElement.Formula.Height / 2); end; fekSummation: begin // main/bottom formula - lElement.Formula.PositionElements(ADest, lElement.Left, lElement.Top - 30); + lElement.Formula.PositionSubparts(ADest, lElement.Left, lElement.Top - 30); // top formula - lElement.AdjacentFormula.PositionElements(ADest, lElement.Left, lElement.Top); + lElement.AdjacentFormula.PositionSubparts(ADest, lElement.Left, lElement.Top); end; end; @@ -2603,7 +2685,7 @@ var lElement: TvFormulaElement; begin // First position all elements - PositionElements(ADest, Left, Top); + PositionSubparts(ADest, Left, Top); // Now draw them all lElement := GetFirstElement(); @@ -2701,6 +2783,23 @@ begin end; end; +function TvEntityWithSubEntities.GenerateDebugTree( + ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; +var + lStr: string; + lCurEntity: TvEntity; +begin + lStr := Format('[%s] Name=%s', [Self.ClassName, Self.Name]); + Result := ADestRoutine(lStr, APageItem); + // Add sub-entities + lCurEntity := GetFirstEntity(); + while lCurEntity <> nil do + begin + lCurEntity.GenerateDebugTree(ADestRoutine, Result); + lCurEntity := GetNextEntity(); + end; +end; + { TvInsert } procedure TvInsert.Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer; @@ -3277,6 +3376,15 @@ begin Result := lPoint; end; +procedure TvVectorialPage.PositionEntitySubparts(ADest: TFPCustomCanvas; ABaseX, + ABaseY: Double); +var + i: Integer; +begin + for i := 0 to GetEntitiesCount()-1 do + GetEntity(0).PositionSubparts(ADest, ABaseX, ABaseY); +end; + procedure TvVectorialPage.DrawBackground(ADest: TFPCustomCanvas); begin ADest.Pen.Style := psClear; diff --git a/components/fpvectorial/svgvectorialreader.pas b/components/fpvectorial/svgvectorialreader.pas index 6150919701..26fe8e22e0 100644 --- a/components/fpvectorial/svgvectorialreader.pas +++ b/components/fpvectorial/svgvectorialreader.pas @@ -15,7 +15,7 @@ interface uses Classes, SysUtils, math, fpimage, fpcanvas, xmlread, dom, fgl, - fpvectorial, fpvutils; + fpvectorial, fpvutils, lazutf8; type TSVGTokenType = ( @@ -785,6 +785,8 @@ begin cy := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue) else if lNodeName = 'r' then cr := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue) + else if lNodeName = 'id' then + lCircle.Name := UTF16ToUTF8(ANode.Attributes.Item[i].NodeValue) else if lNodeName = 'style' then ReadSVGStyle(ANode.Attributes.Item[i].NodeValue, lCircle) else if IsAttributeFromStyle(lNodeName) then @@ -833,6 +835,8 @@ begin crx := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue) else if lNodeName = 'ry' then cry := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue) + else if lNodeName = 'id' then + lEllipse.Name := UTF16ToUTF8(ANode.Attributes.Item[i].NodeValue) else if lNodeName = 'style' then ReadSVGStyle(ANode.Attributes.Item[i].NodeValue, lEllipse) else if IsAttributeFromStyle(lNodeName) then @@ -903,17 +907,15 @@ end; procedure TvSVGVectorialReader.ReadPathFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument); var - lNodeName, lStyleStr, lDStr: WideString; + lNodeName, lDStr: WideString; i: Integer; lPath: TPath; begin for i := 0 to ANode.Attributes.Length - 1 do begin lNodeName := ANode.Attributes.Item[i].NodeName; - if lNodeName = 'style' then - lStyleStr := ANode.Attributes.Item[i].NodeValue - else if lNodeName = 'd' then - lDStr := ANode.Attributes.Item[i].NodeValue + if lNodeName = 'd' then + lDStr := ANode.Attributes.Item[i].NodeValue; end; AData.StartPath(); @@ -923,8 +925,20 @@ begin lPath.Pen.Style := psClear; lPath.Brush.Color := colBlack; lPath.Brush.Style := bsSolid; - // Add the pen/brush - ReadSVGStyle(lStyleStr, lPath); + // Add the pen/brush/name + for i := 0 to ANode.Attributes.Length - 1 do + begin + lNodeName := ANode.Attributes.Item[i].NodeName; + if lNodeName = 'id' then + lPath.Name := UTF16ToUTF8(ANode.Attributes.Item[i].NodeValue) + else if lNodeName = 'style' then + ReadSVGStyle(ANode.Attributes.Item[i].NodeValue, lPath) + else if IsAttributeFromStyle(lNodeName) then + begin + ReadSVGPenStyleWithKeyAndValue(lNodeName, ANode.Attributes.Item[i].NodeValue, lPath); + ReadSVGBrushStyleWithKeyAndValue(lNodeName, ANode.Attributes.Item[i].NodeValue, lPath); + end; + end; end; // Documentation: http://www.w3.org/TR/SVG/paths.html @@ -1183,7 +1197,9 @@ begin for i := 0 to ANode.Attributes.Length - 1 do begin lNodeName := ANode.Attributes.Item[i].NodeName; - if lNodeName = 'style' then + if lNodeName = 'id' then + lPath.Name := UTF16ToUTF8(ANode.Attributes.Item[i].NodeValue) + else if lNodeName = 'style' then ReadSVGStyle(ANode.Attributes.Item[i].NodeValue, lPath) else if IsAttributeFromStyle(lNodeName) then begin @@ -1225,6 +1241,8 @@ begin cx := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue) else if lNodeName = 'height' then cy := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue) + else if lNodeName = 'id' then + lRect.Name := UTF16ToUTF8(ANode.Attributes.Item[i].NodeValue) else if lNodeName = 'style' then ReadSVGStyle(ANode.Attributes.Item[i].NodeValue, lRect) else if IsAttributeFromStyle(lNodeName) then @@ -1265,6 +1283,8 @@ begin lx := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue) else if lNodeName = 'y' then ly := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue) + else if lNodeName = 'id' then + lText.Name := UTF16ToUTF8(ANode.Attributes.Item[i].NodeValue) else if lNodeName = 'style' then ReadSVGStyle(ANode.Attributes.Item[i].NodeValue, lText, True) else if IsAttributeFromStyle(lNodeName) then