mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-15 09:23:33 +02:00
fpvectorial: Greatly improves the FPV tokens debug information and fixes the svg style reading for paths
git-svn-id: trunk@39726 -
This commit is contained in:
sekelsenmat
parent
84b0c8d37e
commit
ba73becf3e
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user