paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-03 11:37:21 +01:00
Code Issues Packages Projects Releases Wiki Activity

fpvectorial: Starts adding support for layers, reorders the units in the package, adds svg circle read support and improves a lot the svg reader

Browse Source 
git-svn-id: trunk@39664 -
This commit is contained in:
sekelsenmat 2012-12-27 20:59:58 +00:00
parent d56bbd667d
commit f810a228b7
4 changed files with 297 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
components/fpvectorial/fpvectorial.pas
View File

@ -240,6 +240,8 @@ type
Pen: TvPen;
constructor Create; override;
procedure ApplyPenToCanvas(ADest: TFPCustomCanvas);
procedure Render(ADest: TFPCustomCanvas; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
end;
{ TvEntityWithPenAndBrush }
@ -251,6 +253,8 @@ type
Brush: TvBrush;
constructor Create; override;
procedure ApplyBrushToCanvas(ADest: TFPCustomCanvas);
procedure Render(ADest: TFPCustomCanvas; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
end;
TvClipMode = (vcmNonzeroWindingRule, vcmEvenOddRule);
@ -515,14 +519,7 @@ type
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
end;
{@@
A block is a group of other elements. It is not rendered directly into the drawing,
but instead is rendered via another item, called TvInsert
}
{ TvBlock }
TvBlock = class(TvEntity)
TvEntityWithSubEntities = class(TvEntity)
private
FCurIndex: Integer;
procedure CallbackDeleteElement(data,arg:pointer);
@ -540,6 +537,16 @@ type
// Never add a Render() procedure to TvBlock, because blocks are invisible!
end;
{@@
A block is a group of other elements. It is not rendered directly into the drawing,
but instead is rendered via another item, called TvInsert
}
{ TvBlock }
TvBlock = class(TvEntityWithSubEntities)
end;
{@@
A "Insert" inserts a block into the drawing in the specified position
}
@ -553,6 +560,20 @@ type
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
end;
{@@
Layers are groups of elements.
Layers are similar to blocks and the diference is that the layer draws
its contents, while the block doesnt, and it cannot be pasted with an TvInsert.
}
{ TvLayer }
TvLayer = class(TvEntityWithSubEntities)
public
procedure Render(ADest: TFPCustomCanvas; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
end;
{ TvVectorialDocument }
TvVectorialDocument = class
@ -609,6 +630,7 @@ type
FEntities: TFPList; // of TvEntity
FTmpPath: TPath;
FTmpText: TvText;
FCurrentLayer: TvLayer;
//procedure RemoveCallback(data, arg: pointer);
procedure ClearTmpPath();
procedure AppendSegmentToTmpPath(ASegment: TPathSegment);
@ -660,6 +682,8 @@ type
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;
// Layers
function AddLayerAndSetAsCurrent(AName: string): TvLayer;
// Dimensions
function AddAlignedDimension(BaseLeft, BaseRight, DimLeft, DimRight: T3DPoint; AOnlyCreate: Boolean = False): TvAlignedDimension;
function AddRadialDimension(AIsDiameter: Boolean; ACenter, ADimLeft, ADimRight: T3DPoint; AOnlyCreate: Boolean = False): TvRadialDimension;
@ -960,6 +984,13 @@ begin
ADest.Pen.Style := Pen.Style;
end;
procedure TvEntityWithPen.Render(ADest: TFPCustomCanvas; ADestX: Integer;
ADestY: Integer; AMulX: Double; AMulY: Double);
begin
inherited Render(ADest, ADestX, ADestY, AMulX, AMulY);
ApplyPenToCanvas(ADest);
end;
{ TvEntityWithPenAndBrush }
constructor TvEntityWithPenAndBrush.Create;
@ -975,6 +1006,13 @@ begin
ADest.Brush.Style := Brush.Style;
end;
procedure TvEntityWithPenAndBrush.Render(ADest: TFPCustomCanvas;
ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double);
begin
inherited Render(ADest, ADestX, ADestY, AMulX, AMulY);
ApplyBrushToCanvas(ADest);
end;
{ TPath }
constructor TPath.Create;
@ -1490,6 +1528,7 @@ procedure TvCircle.Render(ADest: TFPCustomCanvas; ADestX: Integer;
end;
begin
inherited Render(ADest, ADestX, ADestY, AMulX, AMulY);
ADest.Ellipse(
CoordToCanvasX(X - Radius),
CoordToCanvasY(Y - Radius),
@ -2483,45 +2522,45 @@ begin
end;
end;
{ TvBlock }
{ TvEntityWithSubEntities }
procedure TvBlock.CallbackDeleteElement(data, arg: pointer);
procedure TvEntityWithSubEntities.CallbackDeleteElement(data, arg: pointer);
begin
TvEntity(data).Free;
end;
constructor TvBlock.Create;
constructor TvEntityWithSubEntities.Create;
begin
inherited Create;
FElements := TFPList.Create;
end;
destructor TvBlock.Destroy;
destructor TvEntityWithSubEntities.Destroy;
begin
FElements.Free;
inherited Destroy;
end;
function TvBlock.GetFirstEntity: TvEntity;
function TvEntityWithSubEntities.GetFirstEntity: TvEntity;
begin
if FElements.Count = 0 then Exit(nil);
Result := FElements.Items[0];
FCurIndex := 1;
end;
function TvBlock.GetNextEntity: TvEntity;
function TvEntityWithSubEntities.GetNextEntity: TvEntity;
begin
if FElements.Count <= FCurIndex then Exit(nil);
Result := FElements.Items[FCurIndex];
Inc(FCurIndex);
end;
procedure TvBlock.AddEntity(AEntity: TvEntity);
procedure TvEntityWithSubEntities.AddEntity(AEntity: TvEntity);
begin
FElements.Add(AEntity);
end;
procedure TvBlock.Clear;
procedure TvEntityWithSubEntities.Clear;
begin
inherited Clear;
FElements.ForEachCall(CallbackDeleteElement, nil);
@ -2556,6 +2595,29 @@ begin
end;
end;
{ TvLayer }
procedure TvLayer.Render(ADest: TFPCustomCanvas; ADestX: Integer;
ADestY: Integer; AMulX: Double; AMulY: Double);
var
lEntity: TvEntity;
begin
inherited Render(ADest, ADestX, ADestY, AMulX, AMulY);
lEntity := GetFirstEntity();
while lEntity <> nil do
begin
{$IFDEF FPVECTORIAL_DEBUG_BLOCKS}
//WriteLn(Format('[TvInsert.Render] Name=%s Block=%s Entity=%s EntityXY=%f | %f BlockXY=%f | %f InsertXY=%f | %f',
// [Name, Block.Name, lEntity.ClassName, lEntity.X, lEntity.Y, Block.X, Block.Y, X, Y]));
{$ENDIF}
// Render
lEntity.Render(ADest, ADestX, ADestY, AMulX, AMuly);
lEntity := GetNextEntity();
end;
end;
{ TvVectorialPage }
procedure TvVectorialPage.ClearTmpPath;
@ -3011,6 +3073,11 @@ begin
Result := lInsert;
end;
function TvVectorialPage.AddLayerAndSetAsCurrent(AName: string): TvLayer;
begin
Result := nil;//TvLayer.Create;
end;
function TvVectorialPage.AddAlignedDimension(BaseLeft, BaseRight, DimLeft,
DimRight: T3DPoint; AOnlyCreate: Boolean = False): TvAlignedDimension;

84
components/fpvectorial/fpvectorialpkg.lpk
View File

@ -14,68 +14,68 @@
</CompilerOptions>
<Files Count="16">
<Item1>
<Filename Value="svgvectorialwriter.pas"/>
<UnitName Value="svgvectorialwriter"/>
<Filename Value="fpvectorial.pas"/>
<UnitName Value="fpvectorial"/>
</Item1>
<Item2>
<Filename Value="fpvtocanvas.pas"/>
<UnitName Value="fpvtocanvas"/>
</Item2>
<Item3>
<Filename Value="fpvectorial.pas"/>
<UnitName Value="fpvectorial"/>
</Item3>
<Item4>
<Filename Value="fpvectbuildunit.pas"/>
<UnitName Value="fpvectbuildunit"/>
</Item4>
<Item5>
<Filename Value="dxfvectorialreader.pas"/>
<UnitName Value="dxfvectorialreader"/>
</Item5>
<Item6>
<Filename Value="cdrvectorialreader.pas"/>
<UnitName Value="cdrvectorialreader"/>
</Item6>
<Item7>
<Filename Value="avisozlib.pas"/>
<UnitName Value="avisozlib"/>
</Item7>
<Item8>
<Filename Value="avisocncgcodewriter.pas"/>
<UnitName Value="avisocncgcodewriter"/>
</Item8>
<Item9>
<Filename Value="avisocncgcodereader.pas"/>
<UnitName Value="avisocncgcodereader"/>
</Item9>
<Item10>
<Filename Value="svgvectorialreader.pas"/>
<UnitName Value="svgvectorialreader"/>
</Item10>
<Item11>
<Filename Value="epsvectorialreader.pas"/>
<UnitName Value="epsvectorialreader"/>
</Item11>
<Item12>
</Item3>
<Item4>
<Filename Value="fpvutils.pas"/>
<UnitName Value="fpvutils"/>
</Item12>
<Item13>
</Item4>
<Item5>
<Filename Value="avisozlib.pas"/>
<UnitName Value="avisozlib"/>
</Item5>
<Item6>
<Filename Value="avisocncgcodewriter.pas"/>
<UnitName Value="avisocncgcodewriter"/>
</Item6>
<Item7>
<Filename Value="avisocncgcodereader.pas"/>
<UnitName Value="avisocncgcodereader"/>
</Item7>
<Item8>
<Filename Value="cdrvectorialreader.pas"/>
<UnitName Value="cdrvectorialreader"/>
</Item8>
<Item9>
<Filename Value="dxfvectorialreader.pas"/>
<UnitName Value="dxfvectorialreader"/>
</Item9>
<Item10>
<Filename Value="epsvectorialreader.pas"/>
<UnitName Value="epsvectorialreader"/>
</Item10>
<Item11>
<Filename Value="lasvectorialreader.pas"/>
<UnitName Value="lasvectorialreader"/>
</Item11>
<Item12>
<Filename Value="lazvectorialreader.pas"/>
<UnitName Value="lazvectorialreader"/>
</Item12>
<Item13>
<Filename Value="mathmlvectorialreader.pas"/>
<UnitName Value="mathmlvectorialreader"/>
</Item13>
<Item14>
<Filename Value="rawvectorialreadwrite.pas"/>
<UnitName Value="rawvectorialreadwrite"/>
</Item14>
<Item15>
<Filename Value="mathmlvectorialreader.pas"/>
<UnitName Value="mathmlvectorialreader"/>
<Filename Value="svgvectorialreader.pas"/>
<UnitName Value="svgvectorialreader"/>
</Item15>
<Item16>
<Filename Value="lazvectorialreader.pas"/>
<UnitName Value="lasvectorialreader"/>
<Filename Value="svgvectorialwriter.pas"/>
<UnitName Value="svgvectorialwriter"/>
</Item16>
</Files>
<Type Value="RunAndDesignTime"/>

10
components/fpvectorial/fpvectorialpkg.pas
View File

@ -7,11 +7,11 @@ unit fpvectorialpkg;
interface
uses
svgvectorialwriter, fpvtocanvas, fpvectorial, fpvectbuildunit,
dxfvectorialreader, cdrvectorialreader, avisozlib, avisocncgcodewriter,
avisocncgcodereader, svgvectorialreader, epsvectorialreader, fpvutils,
lasvectorialreader, rawvectorialreadwrite, mathmlvectorialreader,
lazvectorialreader, LazarusPackageIntf;
fpvectorial, fpvtocanvas, fpvectbuildunit, fpvutils, avisozlib,
avisocncgcodewriter, avisocncgcodereader, cdrvectorialreader,
dxfvectorialreader, epsvectorialreader, lasvectorialreader,
lazvectorialreader, mathmlvectorialreader, rawvectorialreadwrite,
svgvectorialreader, svgvectorialwriter, LazarusPackageIntf;
implementation

189
components/fpvectorial/svgvectorialreader.pas
View File

@ -14,7 +14,7 @@ interface
uses
Classes, SysUtils, math,
xmlread, dom, fgl,
fpimage, fpcanvas, xmlread, dom, fgl,
fpvectorial, fpvutils;
type
@ -45,15 +45,22 @@ type
private
FPointSeparator, FCommaSeparator: TFormatSettings;
FSVGPathTokenizer: TSVGPathTokenizer;
procedure ReadPathFromNode(APath: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
function ReadSVGColor(AValue: string): TFPColor;
procedure ReadSVGStyle(AValue: string; ADestEntity: TvEntityWithPenAndBrush);
procedure ReadSVGStyleWithKeyAndValue(AKey, AValue: string; ADestEntity: TvEntityWithPenAndBrush);
function IsAttributeFromStyle(AStr: string): Boolean;
//
procedure ReadEntityFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadCircleFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadPathFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadPathFromString(AStr: string; AData: TvVectorialPage; ADoc: TvVectorialDocument);
function StringWithUnitToFloat(AStr: string): Single;
function StringWithUnitToFloat(AStr: string): Double;
procedure ConvertSVGCoordinatesToFPVCoordinates(
const AData: TvVectorialPage;
const ASrcX, ASrcY: Float; var ADestX, ADestY: Float);
const ASrcX, ASrcY: Double; var ADestX, ADestY: Double);
procedure ConvertSVGDeltaToFPVDelta(
const AData: TvVectorialPage;
const ASrcX, ASrcY: Float; var ADestX, ADestY: Float);
const ASrcX, ASrcY: Double; var ADestX, ADestY: Double);
public
{ General reading methods }
constructor Create; override;
@ -193,19 +200,152 @@ end;
{ TvSVGVectorialReader }
procedure TvSVGVectorialReader.ReadPathFromNode(APath: TDOMNode;
function TvSVGVectorialReader.ReadSVGColor(AValue: string): TFPColor;
begin
case AValue of
'black': Result := colBlack;
'white': Result := colWhite;
'red': Result := colRed;
'blue': Result := colBlue;
'green': Result := colGreen;
'yellow': Result := colYellow;
end;
end;
// style="fill:none;stroke:black;stroke-width:3"
procedure TvSVGVectorialReader.ReadSVGStyle(AValue: string;
ADestEntity: TvEntityWithPenAndBrush);
var
lStr, lStyleKeyStr, lStyleValueStr: String;
lStrings: TStringList;
i, lPosEqual: Integer;
begin
if AValue = '' then Exit;
// Now split using ";" separator
lStrings := TStringList.Create;
try
lStrings.Delimiter := ';';
lStrings.DelimitedText := AValue;
for i := 0 to lStrings.Count-1 do
begin
lStr := lStrings.Strings[i];
lPosEqual := Pos('=', lStr);
lStyleKeyStr := Copy(lStr, 0, lPosEqual);
lStyleValueStr := Copy(lStr, lPosEqual+1, Length(lStr));
ReadSVGStyleWithKeyAndValue(lStyleKeyStr, lStyleValueStr, ADestEntity);
end;
finally
lStrings.Free;
end;
end;
procedure TvSVGVectorialReader.ReadSVGStyleWithKeyAndValue(AKey,
AValue: string; ADestEntity: TvEntityWithPenAndBrush);
begin
if AKey = 'stroke' then
begin
if ADestEntity.Brush.Style = bsClear then ADestEntity.Brush.Style := bsSolid;
if AValue = 'none' then ADestEntity.Pen.Style := fpcanvas.psClear
else ADestEntity.Pen.Color := ReadSVGColor(AValue)
end
else if AKey = 'stroke-width' then
ADestEntity.Pen.Width := StrToInt(AValue)
else if AKey = 'fill' then
begin
if AValue = 'none' then ADestEntity.Brush.Style := fpcanvas.bsClear
else ADestEntity.Brush.Color := ReadSVGColor(AValue)
end;
end;
function TvSVGVectorialReader.IsAttributeFromStyle(AStr: string): Boolean;
begin
Result := (AStr = 'stroke') or (AStr = 'stroke-width') or
(AStr = 'fill');
end;
procedure TvSVGVectorialReader.ReadEntityFromNode(ANode: TDOMNode;
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
lEntityName, lLayerName: DOMString;
lCurNode, lLayerNameNode: TDOMNode;
lLayer: TvLayer;
begin
lEntityName := ANode.NodeName;
case lEntityName of
'circle': ReadCircleFromNode(ANode, AData, ADoc);
'path': ReadPathFromNode(ANode, AData, ADoc);
// Layers
'g':
begin
// if we are already inside a layer, something may be wrong...
//if ALayer <> nil then raise Exception.Create('[TvSVGVectorialReader.ReadEntityFromNode] A layer inside a layer was found!');
lLayerNameNode := ANode.Attributes.GetNamedItem('id');
lLayerName := '';
if lLayerNameNode <> nil then lLayerName := lLayerNameNode.NodeValue;
lLayer := AData.AddLayerAndSetAsCurrent(lLayerName);
lCurNode := ANode.FirstChild;
while Assigned(lCurNode) do
begin
ReadEntityFromNode(lCurNode, AData, ADoc);
lCurNode := lCurNode.NextSibling;
end;
end;
end;
end;
procedure TvSVGVectorialReader.ReadCircleFromNode(ANode: TDOMNode;
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
cx, cy, cr, dtmp: double;
lCircle: TvCircle;
i: Integer;
lNodeName: DOMString;
begin
cx := 0.0;
cy := 0.0;
cr := 0.0;
lCircle := TvCircle.Create;
// read the attributes
for i := 0 to ANode.Attributes.Length - 1 do
begin
lNodeName := ANode.Attributes.Item[i].NodeName;
if lNodeName = 'cx' then
cx := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue)
else if lNodeName = 'cy' then
cy := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue)
else if lNodeName = 'r' then
cr := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue)
else if IsAttributeFromStyle(lNodeName) then
ReadSVGStyleWithKeyAndValue(lNodeName, ANode.Attributes.Item[i].NodeValue, lCircle);
end;
ConvertSVGCoordinatesToFPVCoordinates(
AData, cx, cy, lCircle.X, lCircle.Y);
ConvertSVGCoordinatesToFPVCoordinates(
AData, cr, 0, lCircle.Radius, dtmp);
AData.AddEntity(lCircle);
end;
procedure TvSVGVectorialReader.ReadPathFromNode(ANode: TDOMNode;
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
lNodeName, lStyleStr, lDStr: WideString;
i: Integer;
begin
for i := 0 to APath.Attributes.Length - 1 do
for i := 0 to ANode.Attributes.Length - 1 do
begin
lNodeName := APath.Attributes.Item[i].NodeName;
lNodeName := ANode.Attributes.Item[i].NodeName;
if lNodeName = 'style' then
lStyleStr := APath.Attributes.Item[i].NodeValue
lStyleStr := ANode.Attributes.Item[i].NodeValue
else if lNodeName = 'd' then
lDStr := APath.Attributes.Item[i].NodeValue
lDStr := ANode.Attributes.Item[i].NodeValue
end;
AData.StartPath();
@ -217,8 +357,8 @@ procedure TvSVGVectorialReader.ReadPathFromString(AStr: string;
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
i: Integer;
X, Y, X2, Y2, X3, Y3: Float;
CurX, CurY: Float;
X, Y, X2, Y2, X3, Y3: Double;
CurX, CurY: Double;
begin
FSVGPathTokenizer.Tokens.Clear;
FSVGPathTokenizer.TokenizePathString(AStr);
@ -280,11 +420,13 @@ begin
end;
end;
function TvSVGVectorialReader.StringWithUnitToFloat(AStr: string): Single;
function TvSVGVectorialReader.StringWithUnitToFloat(AStr: string): Double;
var
UnitStr, ValueStr: string;
Len: Integer;
begin
if AStr = '' then Exit(0.0);
// Check the unit
Len := Length(AStr);
UnitStr := Copy(AStr, Len-1, 2);
@ -292,20 +434,24 @@ begin
begin
ValueStr := Copy(AStr, 1, Len-2);
Result := StrToInt(ValueStr);
end
else // If there is no unit, just use StrToFloat
begin
Result := StrToFloat(AStr);
end;
end;
procedure TvSVGVectorialReader.ConvertSVGCoordinatesToFPVCoordinates(
const AData: TvVectorialPage; const ASrcX, ASrcY: Float;
var ADestX,ADestY: Float);
const AData: TvVectorialPage; const ASrcX, ASrcY: Double;
var ADestX,ADestY: Double);
begin
ADestX := ASrcX * FLOAT_MILIMETERS_PER_PIXEL;
ADestY := AData.Height - ASrcY * FLOAT_MILIMETERS_PER_PIXEL;
end;
procedure TvSVGVectorialReader.ConvertSVGDeltaToFPVDelta(
const AData: TvVectorialPage; const ASrcX, ASrcY: Float; var ADestX,
ADestY: Float);
const AData: TvVectorialPage; const ASrcX, ASrcY: Double; var ADestX,
ADestY: Double);
begin
ADestX := ASrcX * FLOAT_MILIMETERS_PER_PIXEL;
ADestY := - ASrcY * FLOAT_MILIMETERS_PER_PIXEL;
@ -333,7 +479,7 @@ procedure TvSVGVectorialReader.ReadFromStream(AStream: TStream;
AData: TvVectorialDocument);
var
Doc: TXMLDocument;
lFirstLayer, lCurNode: TDOMNode;
lCurNode: TDOMNode;
lPage: TvVectorialPage;
begin
try
@ -344,15 +490,14 @@ begin
AData.Width := StringWithUnitToFloat(Doc.DocumentElement.GetAttribute('width'));
AData.Height := StringWithUnitToFloat(Doc.DocumentElement.GetAttribute('height'));
// Now process the elements inside the first layer
lFirstLayer := Doc.DocumentElement.FirstChild;
lCurNode := lFirstLayer.FirstChild;
// Now process the elements
lCurNode := Doc.DocumentElement.FirstChild;
lPage := AData.AddPage();
lPage.Width := AData.Width;
lPage.Height := AData.Height;
while Assigned(lCurNode) do
begin
ReadPathFromNode(lCurNode, lPage, AData);
ReadEntityFromNode(lCurNode, lPage, AData);
lCurNode := lCurNode.NextSibling;
end;
finally