You've already forked lazarus-ccr
Adds a SVG reader
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1603 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
@ -38,6 +38,7 @@ const
|
||||
STR_SVG_EXTENSION = '.svg';
|
||||
STR_CORELDRAW_EXTENSION = '.cdr';
|
||||
STR_WINMETAFILE_EXTENSION = '.wmf';
|
||||
STR_AUTOCAD_EXCHANGE_EXTENSION = '.dxf';
|
||||
|
||||
type
|
||||
{@@ We need our own format because TFPColor is too big for our needs and TColor has no Alpha }
|
||||
@ -144,7 +145,6 @@ type
|
||||
Brush: TvBrush;
|
||||
constructor Create();
|
||||
procedure Assign(APath: TPath);
|
||||
function Count(): TPathSegment;
|
||||
procedure PrepareForSequentialReading;
|
||||
function Next(): TPathSegment;
|
||||
end;
|
||||
@ -243,7 +243,8 @@ type
|
||||
procedure WriteToFile(AFileName: string; AFormat: TvVectorialFormat);
|
||||
procedure WriteToStream(AStream: TStream; AFormat: TvVectorialFormat);
|
||||
procedure WriteToStrings(AStrings: TStrings; AFormat: TvVectorialFormat);
|
||||
procedure ReadFromFile(AFileName: string; AFormat: TvVectorialFormat);
|
||||
procedure ReadFromFile(AFileName: string; AFormat: TvVectorialFormat); overload;
|
||||
procedure ReadFromFile(AFileName: string); overload;
|
||||
procedure ReadFromStream(AStream: TStream; AFormat: TvVectorialFormat);
|
||||
procedure ReadFromStrings(AStrings: TStrings; AFormat: TvVectorialFormat);
|
||||
class function GetFormatFromExtension(AFileName: string): TvVectorialFormat;
|
||||
@ -261,7 +262,9 @@ type
|
||||
procedure RemoveAllTexts;
|
||||
{ Data writing methods }
|
||||
procedure AddPath(APath: TPath);
|
||||
procedure StartPath(AX, AY: Double);
|
||||
procedure StartPath(AX, AY: Double); overload;
|
||||
procedure StartPath(); overload;
|
||||
procedure AddMoveToPath(AX, AY: Double);
|
||||
procedure AddLineToPath(AX, AY: Double); overload;
|
||||
procedure AddLineToPath(AX, AY: Double; AColor: TvColor); overload;
|
||||
procedure AddLineToPath(AX, AY, AZ: Double); overload;
|
||||
@ -551,6 +554,23 @@ begin
|
||||
FTmpPath.PointsEnd := segment;
|
||||
end;
|
||||
|
||||
procedure TvVectorialDocument.StartPath();
|
||||
begin
|
||||
ClearTmpPath();
|
||||
end;
|
||||
|
||||
procedure TvVectorialDocument.AddMoveToPath(AX, AY: Double);
|
||||
var
|
||||
segment: T2DSegment;
|
||||
begin
|
||||
segment := T2DSegment.Create;
|
||||
segment.SegmentType := stMoveTo;
|
||||
segment.X := AX;
|
||||
segment.Y := AY;
|
||||
|
||||
AppendSegmentToTmpPath(segment);
|
||||
end;
|
||||
|
||||
{@@
|
||||
Adds one more point to the end of a Path being
|
||||
writing in multiple steps.
|
||||
@ -824,8 +844,17 @@ procedure TvVectorialDocument.AppendSegmentToTmpPath(ASegment: TPathSegment);
|
||||
var
|
||||
L: Integer;
|
||||
begin
|
||||
// Check if we are the first segment in the tmp path
|
||||
if FTmpPath.PointsEnd = nil then
|
||||
Exception.Create('[TvVectorialDocument.AppendSegmentToTmpPath]' + Str_Error_Nil_Path);
|
||||
begin
|
||||
if FTmpPath.Len <> 0 then
|
||||
Exception.Create('[TvVectorialDocument.AppendSegmentToTmpPath]' + Str_Error_Nil_Path);
|
||||
|
||||
FTmpPath.Points := ASegment;
|
||||
FTmpPath.PointsEnd := ASegment;
|
||||
FTmpPath.Len := 1;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
L := FTmpPath.Len;
|
||||
Inc(FTmpPath.Len);
|
||||
@ -904,6 +933,22 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{@@
|
||||
Reads the document from a file. A variant that auto-detects the format from the extension.
|
||||
}
|
||||
procedure TvVectorialDocument.ReadFromFile(AFileName: string);
|
||||
var
|
||||
lExt: string;
|
||||
begin
|
||||
lExt := ExtractFileExt(AFileName);
|
||||
if lExt = STR_PDF_EXTENSION then ReadFromFile(AFileName, vfPDF)
|
||||
else if lExt = STR_POSTSCRIPT_EXTENSION then ReadFromFile(AFileName, vfPostScript)
|
||||
else if lExt = STR_SVG_EXTENSION then ReadFromFile(AFileName, vfSVG)
|
||||
else if lExt = STR_CORELDRAW_EXTENSION then ReadFromFile(AFileName, vfCorelDrawCDR)
|
||||
else if lExt = STR_WINMETAFILE_EXTENSION then ReadFromFile(AFileName, vfWindowsMetafileWMF)
|
||||
else if lExt = STR_AUTOCAD_EXCHANGE_EXTENSION then ReadFromFile(AFileName, vfDXF);
|
||||
end;
|
||||
|
||||
{@@
|
||||
Reads the document from a stream.
|
||||
|
||||
@ -1134,11 +1179,6 @@ begin
|
||||
Brush := APath.Brush;
|
||||
end;
|
||||
|
||||
function TPath.Count(): TPathSegment;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TPath.PrepareForSequentialReading;
|
||||
begin
|
||||
CurPoint := nil;
|
||||
|
||||
@ -5,13 +5,13 @@
|
||||
<CompilerOptions>
|
||||
<Version Value="10"/>
|
||||
<SearchPaths>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Files Count="13">
|
||||
<Files Count="14">
|
||||
<Item1>
|
||||
<Filename Value="svgvectorialwriter.pas"/>
|
||||
<UnitName Value="svgvectorialwriter"/>
|
||||
@ -64,6 +64,10 @@
|
||||
<Filename Value="avisocncgcodereader.pas"/>
|
||||
<UnitName Value="avisocncgcodereader"/>
|
||||
</Item13>
|
||||
<Item14>
|
||||
<Filename Value="svgvectorialreader.pas"/>
|
||||
<UnitName Value="svgvectorialwriter"/>
|
||||
</Item14>
|
||||
</Files>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<RequiredPkgs Count="2">
|
||||
|
||||
@ -10,7 +10,7 @@ uses
|
||||
svgvectorialwriter, pdfvrsintatico, pdfvrsemantico, pdfvrlexico,
|
||||
pdfvectorialreader, fpvtocanvas, fpvectorial, fpvectbuildunit,
|
||||
dxfvectorialreader, cdrvectorialreader, avisozlib, avisocncgcodewriter,
|
||||
avisocncgcodereader, LazarusPackageIntf;
|
||||
avisocncgcodereader, svgvectorialreader, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
300
applications/fpvviewer/fpvectorialsrc/svgvectorialreader.pas
Normal file
300
applications/fpvviewer/fpvectorialsrc/svgvectorialreader.pas
Normal file
@ -0,0 +1,300 @@
|
||||
{
|
||||
Reads an SVG Document
|
||||
|
||||
License: The same modified LGPL as the Free Pascal RTL
|
||||
See the file COPYING.modifiedLGPL for more details
|
||||
|
||||
AUTHORS: Felipe Monteiro de Carvalho
|
||||
}
|
||||
unit svgvectorialreader;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, math,
|
||||
xmlread, dom, fgl,
|
||||
fpvectorial, fpvutils;
|
||||
|
||||
type
|
||||
TSVGTokenType = (sttMoveTo, sttLineTo, sttBezierTo, sttFloatValue);
|
||||
|
||||
TSVGToken = class
|
||||
TokenType: TSVGTokenType;
|
||||
Value: Float;
|
||||
end;
|
||||
|
||||
TSVGTokenList = specialize TFPGList<TSVGToken>;
|
||||
|
||||
{ TSVGPathTokenizer }
|
||||
|
||||
TSVGPathTokenizer = class
|
||||
public
|
||||
FPointSeparator, FCommaSeparator: TFormatSettings;
|
||||
Tokens: TSVGTokenList;
|
||||
constructor Create;
|
||||
Destructor Destroy; override;
|
||||
procedure AddToken(AStr: string);
|
||||
procedure TokenizePathString(AStr: string);
|
||||
end;
|
||||
|
||||
{ TvSVGVectorialReader }
|
||||
|
||||
TvSVGVectorialReader = class(TvCustomVectorialReader)
|
||||
private
|
||||
FPointSeparator, FCommaSeparator: TFormatSettings;
|
||||
FSVGPathTokenizer: TSVGPathTokenizer;
|
||||
procedure ReadPathFromNode(APath: TDOMNode; AData: TvVectorialDocument);
|
||||
procedure ReadPathFromString(AStr: string; AData: TvVectorialDocument);
|
||||
public
|
||||
{ General reading methods }
|
||||
constructor Create; override;
|
||||
Destructor Destroy; override;
|
||||
procedure ReadFromStream(AStream: TStream; AData: TvVectorialDocument); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
// SVG requires hardcoding a DPI value
|
||||
|
||||
// The Opera Browser and Inkscape use 90 DPI, so we follow that
|
||||
|
||||
// 1 Inch = 25.4 milimiters
|
||||
// 90 inches per pixel = (1 / 90) * 25.4 = 0.2822
|
||||
// FLOAT_MILIMETERS_PER_PIXEL = 0.3528; // DPI 72 = 1 / 72 inches per pixel
|
||||
|
||||
FLOAT_MILIMETERS_PER_PIXEL = 0.2822; // DPI 90 = 1 / 90 inches per pixel
|
||||
FLOAT_PIXELS_PER_MILIMETER = 3.5433; // DPI 90 = 1 / 90 inches per pixel
|
||||
|
||||
{ TSVGPathTokenizer }
|
||||
|
||||
constructor TSVGPathTokenizer.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
FPointSeparator := DefaultFormatSettings;
|
||||
FPointSeparator.DecimalSeparator := '.';
|
||||
FPointSeparator.ThousandSeparator := '#';// disable the thousand separator
|
||||
|
||||
Tokens := TSVGTokenList.Create;
|
||||
end;
|
||||
|
||||
destructor TSVGPathTokenizer.Destroy;
|
||||
begin
|
||||
Tokens.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TSVGPathTokenizer.AddToken(AStr: string);
|
||||
var
|
||||
lToken: TSVGToken;
|
||||
begin
|
||||
lToken := TSVGToken.Create;
|
||||
|
||||
if AStr = 'm' then lToken.TokenType := sttMoveTo
|
||||
else if AStr = 'l' then lToken.TokenType := sttLineTo
|
||||
else if AStr = 'c' then lToken.TokenType := sttBezierTo
|
||||
else
|
||||
begin
|
||||
lToken.TokenType := sttFloatValue;
|
||||
lToken.Value := StrToFloat(AStr, FPointSeparator);
|
||||
lToken.Value := lToken.Value * FLOAT_MILIMETERS_PER_PIXEL;
|
||||
end;
|
||||
|
||||
Tokens.Add(lToken);
|
||||
end;
|
||||
|
||||
procedure TSVGPathTokenizer.TokenizePathString(AStr: string);
|
||||
const
|
||||
Str_Space: Char = ' ';
|
||||
Str_Comma: Char = ',';
|
||||
var
|
||||
i: Integer;
|
||||
lTmpStr: string;
|
||||
lState: Integer;
|
||||
lCurChar: Char;
|
||||
begin
|
||||
lState := 0;
|
||||
|
||||
i := 1;
|
||||
while i <= Length(AStr) do
|
||||
begin
|
||||
case lState of
|
||||
0: // Adding to the tmp string
|
||||
begin
|
||||
lCurChar := AStr[i];
|
||||
if lCurChar = Str_Space then
|
||||
begin
|
||||
lState := 1;
|
||||
AddToken(lTmpStr);
|
||||
lTmpStr := '';
|
||||
end
|
||||
else if lCurChar = Str_Comma then
|
||||
begin
|
||||
AddToken(lTmpStr);
|
||||
lTmpStr := '';
|
||||
end
|
||||
else
|
||||
lTmpStr := lTmpStr + lCurChar;
|
||||
|
||||
Inc(i);
|
||||
end;
|
||||
1: // Removing spaces
|
||||
begin
|
||||
if AStr[i] <> Str_Space then lState := 0
|
||||
else Inc(i);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Example of a supported SVG image:
|
||||
|
||||
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
|
||||
<!-- Created with fpVectorial (http://wiki.lazarus.freepascal.org/fpvectorial) -->
|
||||
|
||||
<svg
|
||||
xmlns:dc="http://purl.org/dc/elements/1.1/"
|
||||
xmlns:cc="http://creativecommons.org/ns#"
|
||||
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
|
||||
xmlns:svg="http://www.w3.org/2000/svg"
|
||||
xmlns="http://www.w3.org/2000/svg"
|
||||
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
|
||||
width="100mm"
|
||||
height="100mm"
|
||||
id="svg2"
|
||||
version="1.1"
|
||||
sodipodi:docname="New document 1">
|
||||
<g id="layer1">
|
||||
<path
|
||||
style="fill:none;stroke:#000000;stroke-width:10px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
|
||||
d="m 0,283.486888731396 l 106.307583274274,-35.4358610914245 "
|
||||
id="path0" />
|
||||
<path
|
||||
style="fill:none;stroke:#000000;stroke-width:10px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
|
||||
d="m 0,354.358610914245 l 354.358610914245,0 l 0,-354.358610914245 l -354.358610914245,0 l 0,354.358610914245 "
|
||||
id="path1" />
|
||||
<path
|
||||
style="fill:none;stroke:#000000;stroke-width:10px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
|
||||
d="m 0,354.358610914245 l 35.4358610914245,-35.4358610914245 c 0,-35.4358610914246 35.4358610914245,-35.4358610914246 35.4358610914245,0 l 35.4358610914245,35.4358610914245 "
|
||||
id="path2" />
|
||||
</g>
|
||||
</svg>
|
||||
}
|
||||
|
||||
{ TvSVGVectorialReader }
|
||||
|
||||
procedure TvSVGVectorialReader.ReadPathFromNode(APath: TDOMNode;
|
||||
AData: TvVectorialDocument);
|
||||
var
|
||||
lNodeName, lStyleStr, lDStr: WideString;
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to APath.Attributes.Length - 1 do
|
||||
begin
|
||||
lNodeName := APath.Attributes.Item[i].NodeName;
|
||||
if lNodeName = 'style' then
|
||||
lStyleStr := APath.Attributes.Item[i].NodeValue
|
||||
else if lNodeName = 'd' then
|
||||
lDStr := APath.Attributes.Item[i].NodeValue
|
||||
end;
|
||||
|
||||
AData.StartPath();
|
||||
ReadPathFromString(UTF8Encode(lDStr), AData);
|
||||
AData.EndPath();
|
||||
end;
|
||||
|
||||
procedure TvSVGVectorialReader.ReadPathFromString(AStr: string;
|
||||
AData: TvVectorialDocument);
|
||||
var
|
||||
i: Integer;
|
||||
X, Y, CurX, CurY: Float;
|
||||
begin
|
||||
FSVGPathTokenizer.Tokens.Clear;
|
||||
FSVGPathTokenizer.TokenizePathString(AStr);
|
||||
CurX := 0;
|
||||
CurY := 0;
|
||||
|
||||
i := 0;
|
||||
while i < FSVGPathTokenizer.Tokens.Count do
|
||||
begin
|
||||
if FSVGPathTokenizer.Tokens.Items[i].TokenType = sttMoveTo then
|
||||
begin
|
||||
CurX := FSVGPathTokenizer.Tokens.Items[i+1].Value;
|
||||
CurY := FSVGPathTokenizer.Tokens.Items[i+2].Value;
|
||||
|
||||
AData.AddMoveToPath(CurX, CurY);
|
||||
|
||||
Inc(i, 3);
|
||||
end
|
||||
else if FSVGPathTokenizer.Tokens.Items[i].TokenType = sttLineTo then
|
||||
begin
|
||||
X := FSVGPathTokenizer.Tokens.Items[i+1].Value;
|
||||
Y := FSVGPathTokenizer.Tokens.Items[i+2].Value;
|
||||
|
||||
// LineTo uses relative coordenates in SVG
|
||||
CurX := CurX + X;
|
||||
CurY := CurY + Y;
|
||||
|
||||
AData.AddLineToPath(CurX, CurY);
|
||||
|
||||
Inc(i, 3);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Inc(i);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TvSVGVectorialReader.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
FPointSeparator := DefaultFormatSettings;
|
||||
FPointSeparator.DecimalSeparator := '.';
|
||||
FPointSeparator.ThousandSeparator := '#';// disable the thousand separator
|
||||
|
||||
FSVGPathTokenizer := TSVGPathTokenizer.Create;
|
||||
end;
|
||||
|
||||
destructor TvSVGVectorialReader.Destroy;
|
||||
begin
|
||||
FSVGPathTokenizer.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TvSVGVectorialReader.ReadFromStream(AStream: TStream;
|
||||
AData: TvVectorialDocument);
|
||||
var
|
||||
Doc: TXMLDocument;
|
||||
lFirstLayer, lCurNode: TDOMNode;
|
||||
begin
|
||||
try
|
||||
// Read in xml file from the stream
|
||||
ReadXMLFile(Doc, AStream);
|
||||
|
||||
// Now process the elements inside the first layer
|
||||
lFirstLayer := Doc.DocumentElement.FirstChild;
|
||||
lCurNode := lFirstLayer.FirstChild;
|
||||
while Assigned(lCurNode) do
|
||||
begin
|
||||
ReadPathFromNode(lCurNode, AData);
|
||||
lCurNode := lCurNode.NextSibling;
|
||||
end;
|
||||
finally
|
||||
// finally, free the document
|
||||
Doc.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
RegisterVectorialReader(TvSVGVectorialReader, vfSVG);
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user