paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 06:38:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

Adding fpvectorial to the Lazarus repository

Browse Source 
git-svn-id: trunk@33179 -
This commit is contained in:
sekelsenmat 2011-10-30 16:41:36 +00:00
parent d52f647d9a
commit fb8a2a5c4b
33 changed files with 9709 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
.gitattributes vendored
View File

@ -937,6 +937,38 @@ components/fppkg/svn/test/proplist.txt svneol=native#text/plain
components/fppkg/svn/test/status.xml svneol=native#text/plain
components/fppkg/svn/test/testsvnclasses.pas svneol=native#text/plain
components/fppkg/svn/test/testsvncommand.pas svneol=native#text/plain
components/fpvectorial/avisocncgcodereader.pas svneol=native#text/plain
components/fpvectorial/avisocncgcodewriter.pas svneol=native#text/plain
components/fpvectorial/avisozlib.pas svneol=native#text/plain
components/fpvectorial/cdrvectorialreader.pas svneol=native#text/plain
components/fpvectorial/dxfvectorialreader.pas svneol=native#text/plain
components/fpvectorial/epsvectorialreader.pas svneol=native#text/plain
components/fpvectorial/examples/fpce_mainform.lfm svneol=native#text/plain
components/fpvectorial/examples/fpce_mainform.pas svneol=native#text/plain
components/fpvectorial/examples/fpcorelexplorer.ico -text
components/fpvectorial/examples/fpcorelexplorer.lpi svneol=native#text/plain
components/fpvectorial/examples/fpcorelexplorer.lpr svneol=native#text/plain
components/fpvectorial/examples/fpvc_mainform.lfm svneol=native#text/plain
components/fpvectorial/examples/fpvc_mainform.pas svneol=native#text/plain
components/fpvectorial/examples/fpvectorialconverter.ico -text
components/fpvectorial/examples/fpvectorialconverter.lpi svneol=native#text/plain
components/fpvectorial/examples/fpvectorialconverter.lpr svneol=native#text/plain
components/fpvectorial/examples/fpvmodifytest.lpi svneol=native#text/plain
components/fpvectorial/examples/fpvmodifytest.pas svneol=native#text/plain
components/fpvectorial/examples/fpvwritetest.lpi svneol=native#text/plain
components/fpvectorial/examples/fpvwritetest.pas svneol=native#text/plain
components/fpvectorial/fpvectbuildunit.pas svneol=native#text/plain
components/fpvectorial/fpvectorial.pas svneol=native#text/plain
components/fpvectorial/fpvectorialpkg.lpk svneol=native#text/plain
components/fpvectorial/fpvectorialpkg.pas svneol=native#text/plain
components/fpvectorial/fpvtocanvas.pas svneol=native#text/plain
components/fpvectorial/fpvutils.pas svneol=native#text/plain
components/fpvectorial/pdfvectorialreader.pas svneol=native#text/plain
components/fpvectorial/pdfvrlexico.pas svneol=native#text/plain
components/fpvectorial/pdfvrsemantico.pas svneol=native#text/plain
components/fpvectorial/pdfvrsintatico.pas svneol=native#text/plain
components/fpvectorial/svgvectorialreader.pas svneol=native#text/plain
components/fpvectorial/svgvectorialwriter.pas svneol=native#text/plain
components/fpweb/README.txt svneol=native#text/plain
components/fpweb/demo/README.txt svneol=native#text/plain
components/fpweb/fpideexteditorinsertfilenameunit.lfm svneol=native#text/plain

236
components/fpvectorial/avisocncgcodereader.pas Normal file
View File

@ -0,0 +1,236 @@
{
Reads AvisoCNC G-Code
License: The same modified LGPL as the Free Pascal RTL
See the file COPYING.modifiedLGPL for more details
AUTHORS: Felipe Monteiro de Carvalho
Pedro Sol Pegorini L de Lima
}
unit avisocncgcodereader;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
fpvectorial;
type
{ Used by tcutils.SeparateString }
T10Strings = array[0..9] of shortstring;
{ TvAvisoCNCGCodeReader }
TvAvisoCNCGCodeReader = class(TvCustomVectorialReader)
private
LastX, LastY, LastZ: Double;
function SeparateString(AString: string; ASeparator: Char): T10Strings;
procedure ReadString(AStr: string; AData: TvVectorialPage);
function GetCoordinate(AStr: shortstring): Integer;
function GetCoordinateValue(AStr: shortstring): Double;
public
{ General reading methods }
procedure ReadFromStrings(AStrings: TStrings; AData: TvVectorialDocument); override;
end;
implementation
const
{ Coordinate constants }
INT_COORDINATE_NONE = 0;
INT_COORDINATE_X = 1;
INT_COORDINATE_Y = 2;
INT_COORDINATE_Z = 3;
{ GCode constants }
STR_GCODE_LINEAR_MOVE = 'G01';
STR_GCODE_STEPPER_MOVE = 'S01';
STR_GCODE_2DBEZIER_MOVE = 'B02';
STR_GCODE_3DBEZIER_MOVE = 'B03';
STR_GCODE_DRILL_UP = 'P01';
STR_GCODE_DRILL_DOWN = 'P02';
{ TvAvisoCNCGCodeReader }
{@@
Reads a string and separates it in substring
using ASeparator to delimite them.
Limits:
Number of substrings: 10 (indexed 0 to 9)
Length of each substring: 255 (they are shortstrings)
}
function TvAvisoCNCGCodeReader.SeparateString(AString: string; ASeparator: Char): T10Strings;
var
i, CurrentPart: Integer;
begin
CurrentPart := 0;
{ Clears the result }
for i := 0 to 9 do Result[i] := '';
{ Iterates througth the string, filling strings }
for i := 1 to Length(AString) do
begin
if Copy(AString, i, 1) = ASeparator then
begin
Inc(CurrentPart);
{ Verifies if the string capacity wasn't exceeded }
if CurrentPart > 9 then Exit;
end
else
Result[CurrentPart] := Result[CurrentPart] + Copy(AString, i, 1);
end;
end;
procedure TvAvisoCNCGCodeReader.ReadString(AStr: string;
AData: TvVectorialPage);
var
AParams: T10Strings;
DestX, DestY, DestZ: Double;
i: Integer;
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn('TvAvisoCNCGCodeReader.ReadString ', AStr);
{$endif}
AParams := SeparateString(AStr, ' ');
{
Format may be:
G01 X3
G01 X3 Y4
G01 X3 Y4 Z2
}
if AParams[0] = STR_GCODE_DRILL_UP then
begin
AData.AddLineToPath(LastX, LastY, 0);
LastZ := 0;
end
else if AParams[0] = STR_GCODE_DRILL_DOWN then
begin
AData.AddLineToPath(LastX, LastY, 50);
LastZ := 50;
end
else if AParams[0] = STR_GCODE_LINEAR_MOVE then
begin
DestX := LastX;
DestY := LastY;
DestZ := LastZ;
for i := 1 to 3 do
begin
case GetCoordinate(AParams[i]) of
INT_COORDINATE_X: DestX := GetCoordinateValue(AParams[i]);
INT_COORDINATE_Y: DestY := GetCoordinateValue(AParams[i]);
INT_COORDINATE_Z: DestZ := GetCoordinateValue(AParams[i]);
else
// error
end;
end;
AData.AddLineToPath(DestX, DestY, DestZ);
LastX := DestX;
LastY := DestY;
LastZ := DestZ;
end
else if AParams[0] = STR_GCODE_2DBEZIER_MOVE then
begin
AData.AddBezierToPath(
GetCoordinateValue(AParams[1]),
GetCoordinateValue(AParams[2]),
GetCoordinateValue(AParams[3]),
GetCoordinateValue(AParams[4]),
GetCoordinateValue(AParams[5]),
GetCoordinateValue(AParams[6])
);
LastX := GetCoordinateValue(AParams[5]);
LastY := GetCoordinateValue(AParams[6]);
end
else if AParams[0] = STR_GCODE_3DBEZIER_MOVE then
begin
AData.AddBezierToPath(
GetCoordinateValue(AParams[1]),
GetCoordinateValue(AParams[2]),
GetCoordinateValue(AParams[3]),
GetCoordinateValue(AParams[4]),
GetCoordinateValue(AParams[5]),
GetCoordinateValue(AParams[6]),
GetCoordinateValue(AParams[7]),
GetCoordinateValue(AParams[8]),
GetCoordinateValue(AParams[9])
);
LastX := GetCoordinateValue(AParams[7]);
LastY := GetCoordinateValue(AParams[8]);
LastZ := GetCoordinateValue(AParams[9]);
end;
{else
begin
Ignore any of these codes:
STR_GCODE_STEPPER_MOVE
and anything else
end;}
end;
function TvAvisoCNCGCodeReader.GetCoordinate(AStr: shortstring): Integer;
begin
Result := INT_COORDINATE_NONE;
if AStr = '' then Exit
else if AStr[1] = 'X' then Result := INT_COORDINATE_X
else if AStr[1] = 'Y' then Result := INT_COORDINATE_Y
else if AStr[1] = 'Z' then Result := INT_COORDINATE_Z;
end;
function TvAvisoCNCGCodeReader.GetCoordinateValue(AStr: shortstring): Double;
begin
Result := 0.0;
if Length(AStr) <= 1 then Exit;
Result := StrToFloat(Copy(AStr, 2, Length(AStr) - 1));
end;
{@@
The information of each separate path is lost in G-Code files
Only one path uniting all of them is created when reading G-Code
}
procedure TvAvisoCNCGCodeReader.ReadFromStrings(AStrings: TStrings;
AData: TvVectorialDocument);
var
i: Integer;
FirstPage: TvVectorialPage;
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn('TvAvisoCNCGCodeReader.ReadFromStrings AStrings = ', PtrInt(AStrings), ' AData = ', PtrInt(AData));
{$endif}
FirstPage := AData.AddPage();
FirstPage.StartPath(0, 0);
for i := 0 to AStrings.Count - 1 do
ReadString(AStrings.Strings[i], FirstPage);
{$ifdef FPVECTORIALDEBUG}
WriteLn('AData.EndPath');
{$endif}
FirstPage.EndPath();
end;
initialization
RegisterVectorialReader(TvAvisoCNCGCodeReader, vfGCodeAvisoCNCPrototipoV5);
end.

119
components/fpvectorial/avisocncgcodewriter.pas Normal file
View File

@ -0,0 +1,119 @@
{
Writes AvisoCNC G-Code
License: The same modified LGPL as the Free Pascal RTL
See the file COPYING.modifiedLGPL for more details
AUTHORS: Felipe Monteiro de Carvalho
Pedro Sol Pegorini L de Lima
}
unit avisocncgcodewriter;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
fpvectorial;
type
{ TvAvisoCNCGCodeWriter }
TvAvisoCNCGCodeWriter = class(TvCustomVectorialWriter)
private
procedure WritePageToStrings(AStrings: TStrings; AData: TvVectorialPage);
public
{ General reading methods }
procedure WriteToStrings(AStrings: TStrings; AData: TvVectorialDocument); override;
end;
implementation
{ TvGCodeVectorialWriter }
procedure TvAvisoCNCGCodeWriter.WritePageToStrings(AStrings: TStrings;
AData: TvVectorialPage);
var
i, j: Integer;
Str: string;
APath: TPath;
CurSegment: T2DSegment;
Cur3DSegment: T3DSegment;
Cur2DBezierSegment: T2DBezierSegment;
Cur3DBezierSegment: T3DBezierSegment;
lEntity: TvEntity;
begin
AStrings.Clear;
AStrings.Add('M216 // Ligar monitor de carga');
AStrings.Add('G28 // Ir rapidamente para posição inicial');
AStrings.Add('G00');
// itera por todos os itens
for i := 0 to AData.GetEntitiesCount - 1 do
begin
lEntity := AData.GetEntity(i);
if not (lEntity is TPath) then Continue;
APath := lEntity as TPath;
// levanta a broca
AStrings.Add('P01 // Sobe a cabeça de gravação');
// vai para o ponto inicial
CurSegment := T2DSegment(APath.Points);
AStrings.Add(Format('G01 X%f Y%f',
[CurSegment.X, CurSegment.Y]));
AStrings.Add('P02 // Abaixa a cabeça de gravação');
for j := 1 to APath.Len - 1 do
begin
CurSegment := T2DSegment(CurSegment.Next);
case CurSegment.SegmentType of
st2DLine: AStrings.Add(Format('G01 X%f Y%f',
[CurSegment.X, CurSegment.Y]));
st3DLine:
begin
Cur3DSegment := T3DSegment(CurSegment);
AStrings.Add(Format('G01 X%f Y%f Z%f',
[Cur3DSegment.X, Cur3DSegment.Y, Cur3DSegment.Z]));
end;
st2DBezier:
begin
Cur2DBezierSegment := T2DBezierSegment(CurSegment);
AStrings.Add(Format('B02 X%f Y%f X%f Y%f X%f Y%f',
[Cur2DBezierSegment.X2, Cur2DBezierSegment.Y2,
Cur2DBezierSegment.X3, Cur2DBezierSegment.Y3,
Cur2DBezierSegment.X, Cur2DBezierSegment.Y]));
end;
st3DBezier:
begin
Cur3DBezierSegment := T3DBezierSegment(CurSegment);
AStrings.Add(Format('B03 X%f Y%f Z%f X%f Y%f Z%f X%f Y%f Z%f',
[Cur3DBezierSegment.X2, Cur3DBezierSegment.Y2, Cur3DBezierSegment.Z2,
Cur3DBezierSegment.X3, Cur3DBezierSegment.Y3, Cur3DBezierSegment.Z3,
Cur3DBezierSegment.X, Cur3DBezierSegment.Y, Cur3DBezierSegment.Z]));
end;
end;
end;
end;
AStrings.Add('P01 // Sobe a cabeça de gravação');
AStrings.Add('M30 // Parar o programa e retornar para posição inicial');
AStrings.Add('M215 // Desligar monitor de carga');
end;
procedure TvAvisoCNCGCodeWriter.WriteToStrings(AStrings: TStrings;
AData: TvVectorialDocument);
var
lPage: TvVectorialPage;
begin
lPage := AData.GetPage(0);
WritePageToStrings(AStrings, lPage);
end;
initialization
RegisterVectorialWriter(TvAvisoCNCGCodeWriter, vfGCodeAvisoCNCPrototipoV5);
end.

74
components/fpvectorial/avisozlib.pas Normal file
View File

@ -0,0 +1,74 @@
unit avisozlib;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, paszlib;
type
Decode = class
public
procedure CHECK_ERR(err: Integer; msg: String);
procedure EXIT_ERR(const msg: String);
function test_inflate(compr: Pointer; comprLen : LongInt;
uncompr: Pointer; uncomprLen : LongInt): PChar;
constructor Create();
end;
implementation
procedure Decode.CHECK_ERR(err: Integer; msg: String);
begin
if err <> Z_OK then
begin
raise Exception.Create('ERROR: ' + msg);
Halt(1);
end;
end;
procedure Decode.EXIT_ERR(const msg: String);
begin
raise Exception.Create('ERROR: ' + msg);
Halt(1);
end;
function Decode.test_inflate(compr: Pointer; comprLen : LongInt;
uncompr: Pointer; uncomprLen : LongInt): PChar;
var err: Integer;
d_stream: TZStream; // decompression stream
begin
StrCopy(PChar(uncompr), 'garbage');
d_stream.next_in := compr;
d_stream.avail_in := 0;
d_stream.next_out := uncompr;
err := inflateInit(d_stream);
CHECK_ERR(err, 'inflateInit');
while (d_stream.total_out < uncomprLen) and
(d_stream.total_in < comprLen) do
begin
d_stream.avail_out := 1; // force small buffers
d_stream.avail_in := 1;
err := inflate(d_stream, Z_NO_FLUSH);
if err = Z_STREAM_END then
break;
CHECK_ERR(err, 'inflate');
end;
err := inflateEnd(d_stream);
CHECK_ERR(err, 'inflateEnd');
Result:=PChar(uncompr);
end;
constructor Decode.Create();
begin
inherited Create;
end;
end.

180
components/fpvectorial/cdrvectorialreader.pas Normal file
View File

@ -0,0 +1,180 @@
{
cdrvectorialreader.pas
Reads a Corel Draw vectorial file
CDR file format specification obtained from:
ADOBE SYSTEMS INCORPORATED. PDF Reference: Adobe®
Portable Document Format. San Jose, 2006. (Sixth edition).
AUTHORS: Felipe Monteiro de Carvalho
License: The same modified LGPL as the Free Pascal RTL
See the file COPYING.modifiedLGPL for more details
}
unit cdrvectorialreader;
{$ifdef fpc}
{$mode delphi}
{$endif}
interface
uses
Classes, SysUtils,
//avisozlib,
fpvectorial;
type
TCDRChunk = class
Name: array[0..3] of Char;
Size: Cardinal;
ChildChunks: TFPList;
end;
TCDRChunkClass = class of TCDRChunk;
TvCDRInternalData = TCDRChunk;
TCDRChunkVRSN = class(TCDRChunk)
VersionStr: string;
VersionNum: Integer;
end;
{ TvCDRVectorialReader }
TvCDRVectorialReader = class(TvCustomVectorialReader)
private
procedure ReadVersionChunk(AStream: TStream; var AData: TCDRChunk);
function AddNewChunk(var AData: TCDRChunk; AClass: TCDRChunkClass): TCDRChunk;
public
{ General reading methods }
procedure ReadFromStream(AStream: TStream; AData: TvVectorialDocument); override;
{ File format exploring methods }
procedure ExploreFromFile(AFilename: string; out AData: TvCDRInternalData);
procedure ExploreFromStream(AStream: TStream; out AData: TvCDRInternalData);
end;
implementation
{ TvPDFVectorialReader }
procedure TvCDRVectorialReader.ReadVersionChunk(AStream: TStream;
var AData: TCDRChunk);
var
lDWord: DWord;
lChunk: TCDRChunkVRSN absolute AData;
lVerBytes: array[0..1] of Byte;
begin
// Read the Chunk name
lDWord := AStream.ReadDWord();
// Read the Chunk size
lDWord := AStream.ReadDWord();
// Read the version
AStream.Read(lVerBytes, 2);
if (lVerBytes[0] = $BC) and (lVerBytes[1] = $02) then
begin
lChunk.VersionNum := 7;
lChunk.VersionStr := 'CorelDraw 7';
end
else if (lVerBytes[0] = $20) and (lVerBytes[1] = $03) then
begin
lChunk.VersionNum := 8;
lChunk.VersionStr := 'CorelDraw 8';
end
else if (lVerBytes[0] = $21) and (lVerBytes[1] = $03) then
begin
lChunk.VersionNum := 8;
lChunk.VersionStr := 'CorelDraw 8bidi';
end
else if (lVerBytes[0] = $84) and (lVerBytes[1] = $03) then
begin
lChunk.VersionNum := 9;
lChunk.VersionStr := 'CorelDraw 9';
end
else if (lVerBytes[0] = $E8) and (lVerBytes[1] = $03) then
begin
lChunk.VersionNum := 10;
lChunk.VersionStr := 'CorelDraw 10';
end
else if (lVerBytes[0] = $4C) and (lVerBytes[1] = $04) then
begin
lChunk.VersionNum := 11;
lChunk.VersionStr := 'CorelDraw 11';
end
else if (lVerBytes[0] = $B0) and (lVerBytes[1] = $04) then
begin
lChunk.VersionNum := 12;
lChunk.VersionStr := 'CorelDraw 12';
end
else if (lVerBytes[0] = $14) and (lVerBytes[1] = $05) then
begin
lChunk.VersionNum := 13;
lChunk.VersionStr := 'CorelDraw X3';
end;
end;
function TvCDRVectorialReader.AddNewChunk(var AData: TCDRChunk; AClass: TCDRChunkClass): TCDRChunk;
begin
if AData.ChildChunks = nil then AData.ChildChunks := TFPList.Create;
Result := AClass.Create;
AData.ChildChunks.Add(Result);
end;
procedure TvCDRVectorialReader.ReadFromStream(AStream: TStream;
AData: TvVectorialDocument);
begin
end;
procedure TvCDRVectorialReader.ExploreFromFile(AFilename: string;
out AData: TvCDRInternalData);
var
FileStream: TFileStream;
begin
FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
try
ExploreFromStream(FileStream, AData);
finally
FileStream.Free;
end;
end;
procedure TvCDRVectorialReader.ExploreFromStream(AStream: TStream;
out AData: TvCDRInternalData);
var
lRIFF: array[0..3] of Char;
lDocSize, lDWord: Cardinal;
lChild: TCDRChunk;
begin
// Create the data object
AData := TCDRChunk.Create;
// All CorelDraw files starts with "RIFF"
AStream.Read(lRIFF, 4);
if lRIFF <> 'RIFF' then
raise Exception.Create('[TvCDRVectorialReader.ExploreFromStream] The Corel Draw RIFF file marker wasn''t found.');
// And then 4 bytes for the document size
lDocSize := AStream.ReadDWord();
// And mroe 4 bytes of other stuff
lDWord := AStream.ReadDWord();
// Now comes the version
lChild := AddNewChunk(AData, TCDRChunkVRSN);
ReadVersionChunk(AStream, lChild);
end;
initialization
RegisterVectorialReader(TvCDRVectorialReader, vfCorelDrawCDR);
end.

1255
components/fpvectorial/dxfvectorialreader.pas Normal file
View File

File diff suppressed because it is too large Load Diff

2301
components/fpvectorial/epsvectorialreader.pas Normal file
View File

File diff suppressed because it is too large Load Diff

62
components/fpvectorial/examples/fpce_mainform.lfm Normal file
View File

@ -0,0 +1,62 @@
object formCorelExplorer: TformCorelExplorer
Left = 216
Height = 345
Top = 192
Width = 466
Caption = 'FP Corel Explorer'
ClientHeight = 345
ClientWidth = 466
LCLVersion = '0.9.29'
object Label1: TLabel
Left = 8
Height = 14
Top = 40
Width = 123
Caption = 'Location of the Input file:'
ParentColor = False
end
object Label2: TLabel
Left = 8
Height = 32
Top = 8
Width = 224
AutoSize = False
Caption = 'This application helps us explore the internal structure of Corel Draw files (*.cdr).'
ParentColor = False
WordWrap = True
end
object shellInput: TShellTreeView
Left = 8
Height = 272
Top = 64
Width = 224
FileSortType = fstFoldersFirst
TabOrder = 0
OnSelectionChanged = shellInputSelectionChanged
ObjectTypes = [otFolders, otNonFolders]
end
object labelFilename: TLabel
Left = 256
Height = 14
Top = 65
Width = 47
Caption = 'Filename:'
ParentColor = False
end
object labelVersion: TLabel
Left = 256
Height = 14
Top = 88
Width = 40
Caption = 'Version:'
ParentColor = False
end
object labelSize: TLabel
Left = 256
Height = 14
Top = 112
Width = 24
Caption = 'Size:'
ParentColor = False
end
end

91
components/fpvectorial/examples/fpce_mainform.pas Normal file
View File

@ -0,0 +1,91 @@
unit fpce_mainform;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
EditBtn, ExtCtrls, ComCtrls, ShellCtrls;
type
{ TformCorelExplorer }
TformCorelExplorer = class(TForm)
Label1: TLabel;
Label2: TLabel;
labelSize: TLabel;
labelVersion: TLabel;
labelFilename: TLabel;
shellInput: TShellTreeView;
procedure buttonQuitClick(Sender: TObject);
procedure shellInputSelectionChanged(Sender: TObject);
private
{ private declarations }
function CheckInput(): Boolean;
public
{ public declarations }
end;
var
formCorelExplorer: TformCorelExplorer;
implementation
uses
fpvectorial, cdrvectorialreader, svgvectorialwriter, pdfvectorialreader,
fpvtocanvas;
{$R *.lfm}
{ TformCorelExplorer }
procedure TformCorelExplorer.buttonQuitClick(Sender: TObject);
begin
Close;
end;
procedure TformCorelExplorer.shellInputSelectionChanged(Sender: TObject);
var
Vec: TvVectorialDocument;
Reader: TvCDRVectorialReader;
lFormat: TvVectorialFormat;
lChunk, lCurChunk: TCDRChunk;
Str: string;
begin
// First check the in input
if not CheckInput() then Exit;
// Now read the data from the input file
Reader := TvCDRVectorialReader.Create;
try
Reader.ExploreFromFile(shellInput.GetSelectedNodePath(), lChunk);
labelFilename.Caption := 'Filename: ' + shellInput.GetSelectedNodePath();
if (lChunk.ChildChunks <> nil) and (lChunk.ChildChunks.First <> nil) then
begin
// Version Chunk
lCurChunk := TCDRChunk(lChunk.ChildChunks.First);
Str := TCDRChunkVRSN(lCurChunk).VersionStr;
labelVersion.Caption := 'Version: ' + Str;
// Main data
lCurChunk := TCDRChunk(lChunk.ChildChunks.Items[1]);
labelSize.Caption := 'Size: ' + ;
end;
finally
Reader.Free;
end;
end;
function TformCorelExplorer.CheckInput(): Boolean;
var
lPath: String;
begin
lPath := shellInput.GetSelectedNodePath();
Result := (ExtractFileExt(lPath) = STR_CORELDRAW_EXTENSION);
end;
end.

BIN
components/fpvectorial/examples/fpcorelexplorer.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

91
components/fpvectorial/examples/fpcorelexplorer.lpi Normal file
View File

@ -0,0 +1,91 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="fpcorelexplorer"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="fpcorelexplorer.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpcorelexplorer"/>
</Unit0>
<Unit1>
<Filename Value="fpce_mainform.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="formCorelExplorer"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fpce_mainform"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="fpcorelexplorer"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)\"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="4">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
<Item4>
<Name Value="EConvertError"/>
</Item4>
</Exceptions>
</Debugging>
</CONFIG>

20
components/fpvectorial/examples/fpcorelexplorer.lpr Normal file
View File

@ -0,0 +1,20 @@
program fpcorelexplorer;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, fpce_mainform
{ you can add units after this };
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TformCorelExplorer, formCorelExplorer);
Application.Run;
end.

98
components/fpvectorial/examples/fpvc_mainform.lfm Normal file
View File

@ -0,0 +1,98 @@
object formVectorialConverter: TformVectorialConverter
Left = 216
Height = 439
Top = 192
Width = 240
BorderStyle = bsSingle
Caption = 'FP Vectorial Converter'
ClientHeight = 439
ClientWidth = 240
LCLVersion = '0.9.31'
object Label1: TLabel
Left = 8
Height = 18
Top = 112
Width = 172
Caption = 'Location of the Input file:'
ParentColor = False
end
object Label2: TLabel
Left = 11
Height = 104
Top = 8
Width = 229
AutoSize = False
Caption = 'This converter application use the fpvectorial library to convert between various different vectorial graphics formats. The type is detected from the extension and the supported types are: PDF (*.pdf), SVG (*.svg) and Corel Draw file (*.cdr).'
Font.Height = -12
ParentColor = False
ParentFont = False
WordWrap = True
end
object editInput: TFileNameEdit
Left = 8
Height = 25
Top = 128
Width = 192
DialogOptions = []
FilterIndex = 0
HideDirectories = False
ButtonWidth = 23
NumGlyphs = 0
MaxLength = 0
TabOrder = 0
end
object Label3: TLabel
Left = 8
Height = 18
Top = 152
Width = 184
Caption = 'Full path of the Output file:'
ParentColor = False
end
object editOutput: TFileNameEdit
Left = 8
Height = 25
Top = 168
Width = 192
DialogOptions = []
FilterIndex = 0
HideDirectories = False
ButtonWidth = 23
NumGlyphs = 0
MaxLength = 0
TabOrder = 1
end
object buttonConvert: TButton
Left = 87
Height = 25
Top = 192
Width = 67
Caption = 'Convert'
OnClick = buttonConvertClick
TabOrder = 2
end
object buttonQuit: TButton
Left = 176
Height = 25
Top = 192
Width = 59
Caption = 'Quit'
OnClick = buttonQuitClick
TabOrder = 3
end
object imagePreview: TImage
Left = 8
Height = 210
Top = 224
Width = 224
end
object buttonVisualize: TButton
Left = 8
Height = 25
Top = 192
Width = 59
Caption = 'Visualize'
OnClick = buttonVisualizeClick
TabOrder = 4
end
end

97
components/fpvectorial/examples/fpvc_mainform.pas Normal file
View File

@ -0,0 +1,97 @@
unit fpvc_mainform;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
EditBtn, ExtCtrls;
type
{ TformVectorialConverter }
TformVectorialConverter = class(TForm)
buttonVisualize: TButton;
buttonConvert: TButton;
buttonQuit: TButton;
editInput: TFileNameEdit;
editOutput: TFileNameEdit;
imagePreview: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure buttonConvertClick(Sender: TObject);
procedure buttonQuitClick(Sender: TObject);
procedure buttonVisualizeClick(Sender: TObject);
private
{ private declarations }
function CheckInput(): Boolean;
public
{ public declarations }
end;
var
formVectorialConverter: TformVectorialConverter;
implementation
uses
fpvectorial, cdrvectorialreader, svgvectorialwriter, pdfvectorialreader,
fpvtocanvas;
{$R *.lfm}
{ TformVectorialConverter }
procedure TformVectorialConverter.buttonQuitClick(Sender: TObject);
begin
Close;
end;
procedure TformVectorialConverter.buttonVisualizeClick(Sender: TObject);
var
Vec: TvVectorialDocument;
begin
// First check the in input
if not CheckInput() then Exit;
Vec := TvVectorialDocument.Create;
try
Vec.ReadFromFile(editInput.FileName, vfPDF);
imagePreview.Canvas.Brush.Color := clWhite;
imagePreview.Canvas.FillRect(0, 0, imagePreview.Width, imagePreview.Height);
DrawFPVectorialToCanvas(Vec, imagePreview.Canvas);
finally
Vec.Free;
end;
end;
function TformVectorialConverter.CheckInput(): Boolean;
begin
// todo...
end;
procedure TformVectorialConverter.buttonConvertClick(Sender: TObject);
var
Vec: TvVectorialDocument;
lFormat: TvVectorialFormat;
begin
// First check the in input
if not CheckInput() then Exit;
// Now convert
Vec := TvVectorialDocument.Create;
try
lFormat := TvVectorialDocument.GetFormatFromExtension(editInput.FileName);
Vec.ReadFromFile(editInput.FileName, lFormat);
lFormat := TvVectorialDocument.GetFormatFromExtension(editOutPut.FileName);
Vec.WriteToFile(editOutPut.FileName, lFormat);
finally
Vec.Free;
end;
end;
end.

BIN
components/fpvectorial/examples/fpvectorialconverter.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

95
components/fpvectorial/examples/fpvectorialconverter.lpi Normal file
View File

@ -0,0 +1,95 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="fpvectorialconverter"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="fpvectorialconverter.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpvectorialconverter"/>
</Unit0>
<Unit1>
<Filename Value="fpvc_mainform.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="formVectorialConverter"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fpvc_mainform"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="fpvectorialconverter"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="4">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
<Item4>
<Name Value="EConvertError"/>
</Item4>
</Exceptions>
</Debugging>
</CONFIG>

16
components/fpvectorial/examples/fpvectorialconverter.lpr Normal file
View File

@ -0,0 +1,16 @@
program fpvectorialconverter;
{$mode objfpc}{$H+}
uses
Interfaces, // this includes the LCL widgetset
Forms, fpvc_mainform;
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TformVectorialConverter, formVectorialConverter);
Application.Run;
end.

239
components/fpvectorial/examples/fpvmodifytest.lpi Normal file
View File

@ -0,0 +1,239 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<MainUnit Value="0"/>
<Title Value="fpvmodifytest"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<ActiveWindowIndexAtStart Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1" Active="Default">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<Units Count="5">
<Unit0>
<Filename Value="fpvmodifytest.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpvmodifytest"/>
<EditorIndex Value="0"/>
<WindowIndex Value="0"/>
<TopLine Value="19"/>
<CursorPos X="1" Y="44"/>
<UsageCount Value="23"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="fpvectorial.pas"/>
<UnitName Value="fpvectorial"/>
<EditorIndex Value="4"/>
<WindowIndex Value="0"/>
<TopLine Value="1267"/>
<CursorPos X="16" Y="1275"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="svgvectorialwriter.pas"/>
<UnitName Value="svgvectorialwriter"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="3"/>
<WindowIndex Value="0"/>
<TopLine Value="228"/>
<CursorPos X="19" Y="245"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="svgvectorialreader.pas"/>
<UnitName Value="svgvectorialreader"/>
<EditorIndex Value="2"/>
<WindowIndex Value="0"/>
<TopLine Value="319"/>
<CursorPos X="17" Y="352"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="fpvutils.pas"/>
<UnitName Value="fpvutils"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<TopLine Value="2"/>
<CursorPos X="3" Y="14"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit4>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="fpvmodifytest.pas"/>
<Caret Line="40" Column="1" TopLine="19"/>
</Position1>
<Position2>
<Filename Value="fpvmodifytest.pas"/>
<Caret Line="42" Column="1" TopLine="19"/>
</Position2>
<Position3>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="217" Column="9" TopLine="188"/>
</Position3>
<Position4>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="260" Column="3" TopLine="226"/>
</Position4>
<Position5>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="258" Column="1" TopLine="226"/>
</Position5>
<Position6>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="261" Column="1" TopLine="226"/>
</Position6>
<Position7>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="263" Column="1" TopLine="226"/>
</Position7>
<Position8>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="93" Column="1" TopLine="69"/>
</Position8>
<Position9>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="94" Column="1" TopLine="69"/>
</Position9>
<Position10>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="95" Column="1" TopLine="69"/>
</Position10>
<Position11>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="96" Column="1" TopLine="69"/>
</Position11>
<Position12>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="98" Column="1" TopLine="69"/>
</Position12>
<Position13>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="100" Column="1" TopLine="69"/>
</Position13>
<Position14>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="102" Column="1" TopLine="69"/>
</Position14>
<Position15>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="104" Column="1" TopLine="69"/>
</Position15>
<Position16>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="105" Column="1" TopLine="69"/>
</Position16>
<Position17>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="111" Column="1" TopLine="71"/>
</Position17>
<Position18>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="112" Column="1" TopLine="72"/>
</Position18>
<Position19>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="113" Column="1" TopLine="73"/>
</Position19>
<Position20>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="115" Column="1" TopLine="75"/>
</Position20>
<Position21>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="119" Column="1" TopLine="79"/>
</Position21>
<Position22>
<Filename Value="fpvectorial.pas"/>
<Caret Line="1224" Column="24" TopLine="1206"/>
</Position22>
<Position23>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="183" Column="31" TopLine="180"/>
</Position23>
<Position24>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="55" Column="3" TopLine="131"/>
</Position24>
<Position25>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="26" Column="74" TopLine="2"/>
</Position25>
<Position26>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="27" Column="15" TopLine="2"/>
</Position26>
<Position27>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="259" Column="3" TopLine="227"/>
</Position27>
<Position28>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="28" Column="98" TopLine="27"/>
</Position28>
<Position29>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="217" Column="38" TopLine="193"/>
</Position29>
<Position30>
<Filename Value="svgvectorialwriter.pas"/>
<Caret Line="220" Column="39" TopLine="188"/>
</Position30>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="10"/>
<Target>
<Filename Value="fpvmodifytest"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

67
components/fpvectorial/examples/fpvmodifytest.pas Normal file
View File

@ -0,0 +1,67 @@
{
Author: Felipe Monteiro de Carvalho
License: Public Domain
}
program fpvmodifytest;
{$mode objfpc}{$H+}
uses
fpvectorial, svgvectorialwriter, svgvectorialreader, fpvutils;
const
cFormat = vfSVG;
cExtension = '.svg';
var
VecDoc: TvVectorialDocument;
Vec: TvVectorialPage;
Path: TPath;
i: Integer;
Segment: TPathSegment;
_2DSegment: T2DSegment;
BezSegment: T2DBezierSegment;
lEntity: TvEntity;
begin
VecDoc := TvVectorialDocument.Create;
try
// Read the file
VecDoc.ReadFromFile('bezier_1.svg');
Vec := VecDoc.GetPage(0);
// Now add 10 to the Y coordinate of all elements
for i := 0 to Vec.GetEntitiesCount() - 1 do
begin
lEntity := Vec.GetEntity(i);
if not (lEntity is TPath) then Continue;
Path := lEntity as TPath;
Path.PrepareForSequentialReading();
Path.Next();
while Path.CurPoint <> nil do
begin
Segment := Path.CurPoint;
if Segment is T2DBezierSegment then
begin
BezSegment := Segment as T2DBezierSegment;
BezSegment.Y := BezSegment.Y + 10;
BezSegment.Y2 := BezSegment.Y2 + 10;
BezSegment.Y3 := BezSegment.Y3 + 10;
end
else if Segment is T2DSegment then
begin
_2DSegment := Segment as T2DSegment;
_2DSegment.Y := _2DSegment.Y + 10;
end;
Path.Next();
end;
end;
// Write the changed file to disk
VecDoc.WriteToFile('bezier_1_mod' + cExtension, cFormat);
finally
VecDoc.Free;
end;
end.

75
components/fpvectorial/examples/fpvwritetest.lpi Normal file
View File

@ -0,0 +1,75 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="fpvwritetest"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<Units Count="1">
<Unit0>
<Filename Value="fpvwritetest.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpvwritetest"/>
</Unit0>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="10"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="fpvwritetest"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerMessages>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

186
components/fpvectorial/examples/fpvwritetest.pas Normal file
View File

@ -0,0 +1,186 @@
{
FPVectorial example application for writing vectorial images
generated in code to disk. This program will generate the following
vectorial images:
single_line_1 One line from (0, 20) to (30, 30)
single_line_2 One line from (20, 30) to (30, 20)
polyline_1 One line from (0, 0) to (10, 10) to (20, 30) to (30, 20)
polyline_2 One line from (10, 10) to (20, 30) to (30, 20) to (40, 40)
bezier_1 One path starting in (0, 0) lining to (10, 10) then bezier to (20, 10) and then line to (30, 0)
bezier_2 One curve from (10, 10) to (20, 20)
text_ascii One text written at (10, 10)
text_europen One text testing european languages at (20, 20)
text_asian One text testing asian languages at (30, 30)
Author: Felipe Monteiro de Carvalho
License: Public Domain
}
program fpvwritetest;
{$mode objfpc}{$H+}
uses
fpvectorial, svgvectorialwriter, fpvutils;
const
cFormat = vfSVG;
cExtension = '.svg';
var
Vec: TvVectorialDocument;
{$R *.res}
begin
Vec := TvVectorialDocument.Create;
try
// All documents are 10cm x 10cm
Vec.Width := 100;
Vec.Height := 100;
// single_line_1 One line from (0, 20) to (30, 30)
Vec.StartPath(0, 20);
Vec.AddLineToPath(30, 30);
Vec.EndPath();
Vec.WriteToFile('single_line_1' + cExtension, cFormat);
// single_line_2 One line from (20, 30) to (30, 20)
Vec.Clear;
Vec.StartPath(20, 30);
Vec.AddLineToPath(30, 20);
Vec.EndPath();
Vec.WriteToFile('single_line_2' + cExtension, cFormat);
// single_line_3 One line from (0, 20) to (30, 30) + frame
Vec.Clear;
Vec.StartPath(0, 20);
Vec.AddLineToPath(30, 30);
Vec.EndPath();
Vec.StartPath(0, 0);
Vec.AddLineToPath(100, 0);
Vec.AddLineToPath(100, 100);
Vec.AddLineToPath(0, 100);
Vec.AddLineToPath(0, 0);
Vec.EndPath();
Vec.WriteToFile('single_line_3' + cExtension, cFormat);
// polyline_1 One line from (0, 0) to (10, 10) to (20, 30) to (30, 20)
Vec.Clear;
Vec.StartPath(0, 0);
Vec.AddLineToPath(10, 10);
Vec.AddLineToPath(20, 30);
Vec.AddLineToPath(30, 20);
Vec.EndPath();
Vec.WriteToFile('polyline_1' + cExtension, cFormat);
// polyline_2 One line from (10, 10) to (20, 30) to (30, 20) to (40, 40)
Vec.Clear;
Vec.StartPath(10, 10);
Vec.AddLineToPath(20, 30);
Vec.AddLineToPath(30, 20);
Vec.AddLineToPath(40, 40);
Vec.EndPath();
Vec.WriteToFile('polyline_2' + cExtension, cFormat);
// bezier_1 One path starting in (0, 0) lining to (10, 10) then bezier to (20, 10) and then line to (30, 0)
Vec.Clear;
Vec.StartPath(0, 0);
Vec.AddLineToPath(10, 10);
Vec.AddBezierToPath(10, 20, 20, 20, 20, 10);
Vec.AddLineToPath(30, 0);
Vec.EndPath();
Vec.WriteToFile('bezier_1' + cExtension, cFormat);
// bezier_2 One curve from (10, 10) to (20, 20)
Vec.Clear;
Vec.StartPath(10, 10);
Vec.AddBezierToPath(10, 15, 15, 20, 20, 10);
Vec.EndPath();
Vec.WriteToFile('bezier_2' + cExtension, cFormat);
// text_ascii One text written at (10, 10)
Vec.Clear;
Vec.AddText(10, 10, 0, '10,10 Some text in english.');
Vec.WriteToFile('text_ascii' + cExtension, cFormat);
// text_europen One text testing european languages at (20, 20)
Vec.Clear;
Vec.AddText(20, 20, 0, '20, 20 Mówić, cześć, Włosku, Parabéns, Assunção, Correções.');
Vec.WriteToFile('text_europen' + cExtension, cFormat);
// text_asian One text testing asian languages at (30, 30)
Vec.Clear;
Vec.AddText(30, 30, 0, '30, 30 森林，是一个高密度树木的区域');
Vec.WriteToFile('text_asian' + cExtension, cFormat);
// multi_test_1 Combines various elements
Vec.Clear;
Vec.StartPath(0, 20);
Vec.AddLineToPath(30, 30);
Vec.EndPath();
Vec.StartPath(0, 0);
Vec.AddLineToPath(100, 0);
Vec.AddLineToPath(100, 100);
Vec.AddLineToPath(0, 100);
Vec.AddLineToPath(0, 0);
Vec.EndPath();
Vec.StartPath(0, 0);
Vec.AddLineToPath(10, 10);
Vec.AddBezierToPath(10, 20, 20, 20, 20, 10);
Vec.AddLineToPath(30, 0);
Vec.EndPath();
Vec.AddText(10, 10, 0, '10,10 Some text in english.');
Vec.AddText(20, 20, 0, '20, 20 Mówić, cześć, Włosku, Parabéns.');
Vec.AddText(30, 30, 0, '30, 30 森林，是一个高密');
Vec.WriteToFile('multi_test_1' + cExtension, cFormat);
// pen_test_1 Tests the properties of the Pen
Vec.Clear;
Vec.StartPath(0, 20);
Vec.AddLineToPath(30, 30);
Vec.SetPenWidth(10);
Vec.EndPath();
Vec.StartPath(0, 0);
Vec.AddLineToPath(100, 0);
Vec.AddLineToPath(100, 100);
Vec.AddLineToPath(0, 100);
Vec.AddLineToPath(0, 0);
Vec.SetPenWidth(10);
Vec.EndPath();
Vec.StartPath(0, 0);
Vec.AddLineToPath(10, 10);
Vec.AddBezierToPath(10, 20, 20, 20, 20, 10);
Vec.AddLineToPath(30, 0);
Vec.SetPenWidth(10);
Vec.EndPath();
Vec.WriteToFile('pen_test_1' + cExtension, cFormat);
// pen_test_2 Tests the properties of the Pen
Vec.Clear;
Vec.StartPath(0, 20);
Vec.AddLineToPath(30, 30);
Vec.SetPenWidth(10);
Vec.SetPenColor(RGBToVColor(255, 0, 0));
Vec.EndPath();
Vec.StartPath(0, 0);
Vec.AddLineToPath(100, 0);
Vec.AddLineToPath(100, 100);
Vec.AddLineToPath(0, 100);
Vec.AddLineToPath(0, 0);
Vec.SetPenWidth(10);
Vec.SetPenColor(RGBToVColor(0, 255, 0));
Vec.EndPath();
Vec.StartPath(0, 0);
Vec.AddLineToPath(10, 10);
Vec.AddBezierToPath(10, 20, 20, 20, 20, 10);
Vec.AddLineToPath(30, 0);
Vec.SetPenWidth(10);
Vec.SetPenColor(RGBToVColor(0, 0, 255));
Vec.EndPath();
Vec.WriteToFile('pen_test_2' + cExtension, cFormat);
finally
Vec.Free;
end;
end.

10
components/fpvectorial/fpvectbuildunit.pas Normal file
View File

@ -0,0 +1,10 @@
unit fpvectbuildunit;
interface
Uses
avisocncgcodereader,avisocncgcodewriter,avisozlib,fpvectorial,
fpvtocanvas,
svgvectorialwriter,cdrvectorialreader,epsvectorialreader;
implementation
end.

1480
components/fpvectorial/fpvectorial.pas Normal file
View File

File diff suppressed because it is too large Load Diff

82
components/fpvectorial/fpvectorialpkg.lpk Normal file
View File

@ -0,0 +1,82 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="4">
<Name Value="fpvectorialpkg"/>
<AddToProjectUsesSection Value="True"/>
<CompilerOptions>
<Version Value="10"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Files Count="12">
<Item1>
<Filename Value="svgvectorialwriter.pas"/>
<UnitName Value="svgvectorialwriter"/>
</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>
<Filename Value="fpvutils.pas"/>
<UnitName Value="fpvutils"/>
</Item12>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="LCL"/>
</Item1>
<Item2>
<PackageName Value="FCL"/>
<MinVersion Major="1" Release="1" Valid="True"/>
</Item2>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
</Package>
</CONFIG>

23
components/fpvectorial/fpvectorialpkg.pas Normal file
View File

@ -0,0 +1,23 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit fpvectorialpkg;
interface
uses
svgvectorialwriter, fpvtocanvas, fpvectorial, fpvectbuildunit,
dxfvectorialreader, cdrvectorialreader, avisozlib, avisocncgcodewriter,
avisocncgcodereader, svgvectorialreader, epsvectorialreader, fpvutils,
LazarusPackageIntf;
implementation
procedure Register;
begin
end;
initialization
RegisterPackage('fpvectorialpkg', @Register);
end.

591
components/fpvectorial/fpvtocanvas.pas Normal file
View File

@ -0,0 +1,591 @@
unit fpvtocanvas;
{$mode objfpc}{$H+}
interface
{$define USE_LCL_CANVAS}
{$ifdef USE_LCL_CANVAS}
{$define USE_CANVAS_CLIP_REGION}
{.$define DEBUG_CANVAS_CLIP_REGION}
{$endif}
{$ifndef Windows}
{.$define FPVECTORIAL_TOCANVAS_DEBUG}
{$endif}
uses
Classes, SysUtils, Math,
{$ifdef USE_LCL_CANVAS}
Graphics, LCLIntf, LCLType,
{$endif}
fpcanvas,
fpimage,
fpvectorial, fpvutils;
procedure DrawFPVectorialToCanvas(ASource: TvVectorialPage;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
procedure DrawFPVPathToCanvas(ASource: TvVectorialPage; CurPath: TPath;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
procedure DrawFPVEntityToCanvas(ASource: TvVectorialPage; CurEntity: TvEntity;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
procedure DrawFPVTextToCanvas(ASource: TvVectorialPage; CurText: TvText;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
implementation
function Rotate2DPoint(P,Fix :TPoint; alpha:double): TPoint;
var
sinus, cosinus : Extended;
begin
SinCos(alpha, sinus, cosinus);
P.x := P.x - Fix.x;
P.y := P.y - Fix.y;
result.x := Round(p.x*cosinus + p.y*sinus) + fix.x ;
result.y := Round(-p.x*sinus + p.y*cosinus) + Fix.y;
end;
procedure DrawRotatedEllipse(
ADest: TFPCustomCanvas;
CurEllipse: TvEllipse;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
var
PointList: array[0..6] of TPoint;
f: TPoint;
dk, x1, x2, y1, y2: Integer;
{$ifdef USE_LCL_CANVAS}
ALCLDest: TCanvas absolute ADest;
{$endif}
begin
{$ifdef USE_LCL_CANVAS}
CurEllipse.CalculateBoundingRectangle();
x1 := CurEllipse.BoundingRect.Left;
x2 := CurEllipse.BoundingRect.Right;
y1 := CurEllipse.BoundingRect.Top;
y2 := CurEllipse.BoundingRect.Bottom;
dk := Round(0.654 * Abs(y2-y1));
f.x := Round(CurEllipse.X);
f.y := Round(CurEllipse.Y - 1);
PointList[0] := Rotate2DPoint(Point(x1, f.y), f, CurEllipse.Angle) ; // Startpoint
PointList[1] := Rotate2DPoint(Point(x1, f.y - dk), f, CurEllipse.Angle);
//Controlpoint of Startpoint first part
PointList[2] := Rotate2DPoint(Point(x2- 1, f.y - dk), f, CurEllipse.Angle);
//Controlpoint of secondpoint first part
PointList[3] := Rotate2DPoint(Point(x2 -1 , f.y), f, CurEllipse.Angle);
// Firstpoint of secondpart
PointList[4] := Rotate2DPoint(Point(x2-1 , f.y + dk), f, CurEllipse.Angle);
// Controllpoint of secondpart firstpoint
PointList[5] := Rotate2DPoint(Point(x1, f.y + dk), f, CurEllipse.Angle);
// Conrollpoint of secondpart endpoint
PointList[6] := PointList[0]; // Endpoint of
// Back to the startpoint
ALCLDest.PolyBezier(Pointlist[0]);
{$endif}
end;
{@@
This function draws a FPVectorial vectorial image to a TFPCustomCanvas
descendent, such as TCanvas from the LCL.
Be careful that by default this routine does not execute coordinate transformations,
and that FPVectorial works with a start point in the bottom-left corner, with
the X growing to the right and the Y growing to the top. This will result in
an image in TFPCustomCanvas mirrored in the Y axis in relation with the document
as seen in a PDF viewer, for example. This can be easily changed with the
provided parameters. To have the standard view of an image viewer one could
use this function like this:
DrawFPVectorialToCanvas(ASource, ADest, 0, ASource.Height, 1.0, -1.0);
}
procedure DrawFPVectorialToCanvas(ASource: TvVectorialPage;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
var
i: Integer;
CurEntity: TvEntity;
begin
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
WriteLn(':>DrawFPVectorialToCanvas');
{$endif}
for i := 0 to ASource.GetEntitiesCount - 1 do
begin
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
Write(Format('[Path] ID=%d', [i]));
{$endif}
CurEntity := ASource.GetEntity(i);
if CurEntity is TPath then DrawFPVPathToCanvas(ASource, TPath(CurEntity), ADest, ADestX, ADestY, AMulX, AMulY)
else if CurEntity is TvText then DrawFPVTextToCanvas(ASource, TvText(CurEntity), ADest, ADestX, ADestY, AMulX, AMulY)
else DrawFPVEntityToCanvas(ASource, CurEntity, ADest, ADestX, ADestY, AMulX, AMulY);
end;
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
WriteLn(':<DrawFPVectorialToCanvas');
{$endif}
end;
procedure DrawFPVPathToCanvas(ASource: TvVectorialPage; CurPath: TPath;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
function CoordToCanvasX(ACoord: Double): Integer;
begin
Result := Round(ADestX + AmulX * ACoord);
end;
function CoordToCanvasY(ACoord: Double): Integer;
begin
Result := Round(ADestY + AmulY * ACoord);
end;
var
j, k: Integer;
PosX, PosY: Double; // Not modified by ADestX, etc
CoordX, CoordY: Integer;
CurSegment: TPathSegment;
Cur2DSegment: T2DSegment absolute CurSegment;
Cur2DBSegment: T2DBezierSegment absolute CurSegment;
// For bezier
CurX, CurY: Integer; // Not modified by ADestX, etc
CoordX2, CoordY2, CoordX3, CoordY3, CoordX4, CoordY4: Integer;
CurveLength: Integer;
t: Double;
// For polygons
Points: array of TPoint;
// Clipping Region
{$ifdef USE_LCL_CANVAS}
ClipRegion, OldClipRegion: HRGN;
ACanvas: TCanvas absolute ADest;
{$endif}
begin
PosX := 0;
PosY := 0;
ADest.Brush.Style := bsClear;
ADest.MoveTo(ADestX, ADestY);
// Set the path Pen and Brush options
ADest.Pen.Style := CurPath.Pen.Style;
ADest.Pen.Width := Round(CurPath.Pen.Width * AMulX);
if ADest.Pen.Width < 1 then ADest.Pen.Width := 1;
ADest.Pen.FPColor := CurPath.Pen.Color;
ADest.Brush.FPColor := CurPath.Brush.Color;
// Prepare the Clipping Region, if any
{$ifdef USE_CANVAS_CLIP_REGION}
if CurPath.ClipPath <> nil then
begin
OldClipRegion := LCLIntf.CreateEmptyRegion();
GetClipRgn(ACanvas.Handle, OldClipRegion);
ClipRegion := ConvertPathToRegion(CurPath.ClipPath, ADestX, ADestY, AMulX, AMulY);
SelectClipRgn(ACanvas.Handle, ClipRegion);
DeleteObject(ClipRegion);
// debug info
{$ifdef DEBUG_CANVAS_CLIP_REGION}
ConvertPathToPoints(CurPath.ClipPath, ADestX, ADestY, AMulX, AMulY, Points);
ACanvas.Polygon(Points);
{$endif}
end;
{$endif}
//
// For solid paths, draw a polygon for the main internal area
//
if CurPath.Brush.Style <> bsClear then
begin
CurPath.PrepareForSequentialReading;
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
Write(' Solid Path Internal Area');
{$endif}
ADest.Brush.Style := CurPath.Brush.Style;
SetLength(Points, CurPath.Len);
for j := 0 to CurPath.Len - 1 do
begin
//WriteLn('j = ', j);
CurSegment := TPathSegment(CurPath.Next());
CoordX := CoordToCanvasX(Cur2DSegment.X);
CoordY := CoordToCanvasY(Cur2DSegment.Y);
Points[j].X := CoordX;
Points[j].Y := CoordY;
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
Write(Format(' P%d,%d', [CoordY, CoordY]));
{$endif}
end;
ADest.Polygon(Points);
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
Write(' Now the details ');
{$endif}
end;
//
// For other paths, draw more carefully
//
CurPath.PrepareForSequentialReading;
for j := 0 to CurPath.Len - 1 do
begin
//WriteLn('j = ', j);
CurSegment := TPathSegment(CurPath.Next());
case CurSegment.SegmentType of
stMoveTo:
begin
CoordX := CoordToCanvasX(Cur2DSegment.X);
CoordY := CoordToCanvasY(Cur2DSegment.Y);
ADest.MoveTo(CoordX, CoordY);
PosX := Cur2DSegment.X;
PosY := Cur2DSegment.Y;
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
Write(Format(' M%d,%d', [CoordY, CoordY]));
{$endif}
end;
// This element can override temporarely the Pen
st2DLineWithPen:
begin
ADest.Pen.FPColor := T2DSegmentWithPen(Cur2DSegment).Pen.Color;
CoordX := CoordToCanvasX(PosX);
CoordY := CoordToCanvasY(PosY);
CoordX2 := CoordToCanvasX(Cur2DSegment.X);
CoordY2 := CoordToCanvasY(Cur2DSegment.Y);
ADest.Line(CoordX, CoordY, CoordX2, CoordY2);
PosX := Cur2DSegment.X;
PosY := Cur2DSegment.Y;
ADest.Pen.FPColor := CurPath.Pen.Color;
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
Write(Format(' L%d,%d', [CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y)]));
{$endif}
end;
st2DLine, st3DLine:
begin
CoordX := CoordToCanvasX(PosX);
CoordY := CoordToCanvasY(PosY);
CoordX2 := CoordToCanvasX(Cur2DSegment.X);
CoordY2 := CoordToCanvasY(Cur2DSegment.Y);
ADest.Line(CoordX, CoordY, CoordX2, CoordY2);
PosX := Cur2DSegment.X;
PosY := Cur2DSegment.Y;
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
Write(Format(' L%d,%d', [CoordX, CoordY]));
{$endif}
end;
{ To draw a bezier we need to divide the interval in parts and make
lines between this parts }
st2DBezier, st3DBezier:
begin
CoordX := CoordToCanvasX(PosX);
CoordY := CoordToCanvasY(PosY);
CoordX2 := CoordToCanvasX(Cur2DBSegment.X2);
CoordY2 := CoordToCanvasY(Cur2DBSegment.Y2);
CoordX3 := CoordToCanvasX(Cur2DBSegment.X3);
CoordY3 := CoordToCanvasY(Cur2DBSegment.Y3);
CoordX4 := CoordToCanvasX(Cur2DBSegment.X);
CoordY4 := CoordToCanvasY(Cur2DBSegment.Y);
SetLength(Points, 0);
AddBezierToPoints(
Make2DPoint(CoordX, CoordY),
Make2DPoint(CoordX2, CoordY2),
Make2DPoint(CoordX3, CoordY3),
Make2DPoint(CoordX4, CoordY4),
Points
);
ADest.Brush.Style := CurPath.Brush.Style;
if Length(Points) >= 3 then
ADest.Polygon(Points);
PosX := Cur2DSegment.X;
PosY := Cur2DSegment.Y;
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
Write(Format(' ***C%d,%d %d,%d %d,%d %d,%d',
[CoordToCanvasX(PosX), CoordToCanvasY(PosY),
CoordToCanvasX(Cur2DBSegment.X2), CoordToCanvasY(Cur2DBSegment.Y2),
CoordToCanvasX(Cur2DBSegment.X3), CoordToCanvasY(Cur2DBSegment.Y3),
CoordToCanvasX(Cur2DBSegment.X), CoordToCanvasY(Cur2DBSegment.Y)]));
{$endif}
end;
end;
end;
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
WriteLn('');
{$endif}
// Restores the previous Clip Region
{$ifdef USE_CANVAS_CLIP_REGION}
if CurPath.ClipPath <> nil then
begin
SelectClipRgn(ACanvas.Handle, OldClipRegion); //Using OldClipRegion crashes in Qt
end;
{$endif}
end;
procedure DrawFPVEntityToCanvas(ASource: TvVectorialPage; CurEntity: TvEntity;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
function CoordToCanvasX(ACoord: Double): Integer;
begin
Result := Round(ADestX + AmulX * ACoord);
end;
function CoordToCanvasY(ACoord: Double): Integer;
begin
Result := Round(ADestY + AmulY * ACoord);
end;
var
i: Integer;
{$ifdef USE_LCL_CANVAS}
ALCLDest: TCanvas;
{$endif}
// For entities
CurCircle: TvCircle;
CurEllipse: TvEllipse;
//
CurArc: TvCircularArc;
FinalStartAngle, FinalEndAngle: double;
BoundsLeft, BoundsTop, BoundsRight, BoundsBottom,
IntStartAngle, IntAngleLength, IntTmp: Integer;
//
CurDim: TvAlignedDimension;
Points: array of TPoint;
UpperDim, LowerDim: T3DPoint;
begin
{$ifdef USE_LCL_CANVAS}
ALCLDest := TCanvas(ADest);
{$endif}
ADest.Brush.Style := CurEntity.Brush.Style;
ADest.Pen.Style := CurEntity.Pen.Style;
ADest.Pen.FPColor := CurEntity.Pen.Color;
ADest.Brush.FPColor := CurEntity.Brush.Color;
if CurEntity is TvCircle then
begin
CurCircle := CurEntity as TvCircle;
ADest.Ellipse(
CoordToCanvasX(CurCircle.X - CurCircle.Radius),
CoordToCanvasY(CurCircle.Y - CurCircle.Radius),
CoordToCanvasX(CurCircle.X + CurCircle.Radius),
CoordToCanvasY(CurCircle.Y + CurCircle.Radius)
);
end
else if CurEntity is TvEllipse then
begin
CurEllipse := CurEntity as TvEllipse;
DrawRotatedEllipse(ADest, CurEllipse);
end
else if CurEntity is TvCircularArc then
begin
CurArc := CurEntity as TvCircularArc;
{$ifdef USE_LCL_CANVAS}
// ToDo: Consider a X axis inversion
// If the Y axis is inverted, then we need to mirror our angles as well
BoundsLeft := CoordToCanvasX(CurArc.X - CurArc.Radius);
BoundsTop := CoordToCanvasY(CurArc.Y - CurArc.Radius);
BoundsRight := CoordToCanvasX(CurArc.X + CurArc.Radius);
BoundsBottom := CoordToCanvasY(CurArc.Y + CurArc.Radius);
{if AMulY > 0 then
begin}
FinalStartAngle := CurArc.StartAngle;
FinalEndAngle := CurArc.EndAngle;
{end
else // AMulY is negative
begin
// Inverting the angles generates the correct result for Y axis inversion
if CurArc.EndAngle = 0 then FinalStartAngle := 0
else FinalStartAngle := 360 - 1* CurArc.EndAngle;
if CurArc.StartAngle = 0 then FinalEndAngle := 0
else FinalEndAngle := 360 - 1* CurArc.StartAngle;
end;}
IntStartAngle := Round(16*FinalStartAngle);
IntAngleLength := Round(16*(FinalEndAngle - FinalStartAngle));
// On Gtk2 and Carbon, the Left really needs to be to the Left of the Right position
// The same for the Top and Bottom
// On Windows it works fine either way
// On Gtk2 if the positions are inverted then the arcs are screwed up
// In Carbon if the positions are inverted, then the arc is inverted
if BoundsLeft > BoundsRight then
begin
IntTmp := BoundsLeft;
BoundsLeft := BoundsRight;
BoundsRight := IntTmp;
end;
if BoundsTop > BoundsBottom then
begin
IntTmp := BoundsTop;
BoundsTop := BoundsBottom;
BoundsBottom := IntTmp;
end;
// Arc(ALeft, ATop, ARight, ABottom, Angle16Deg, Angle16DegLength: Integer);
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
// WriteLn(Format('Drawing Arc Center=%f,%f Radius=%f StartAngle=%f AngleLength=%f',
// [CurArc.CenterX, CurArc.CenterY, CurArc.Radius, IntStartAngle/16, IntAngleLength/16]));
{$endif}
ADest.Pen.FPColor := CurArc.Pen.Color;
ALCLDest.Arc(
BoundsLeft, BoundsTop, BoundsRight, BoundsBottom,
IntStartAngle, IntAngleLength
);
ADest.Pen.FPColor := colBlack;
// Debug info
// {$define FPVECTORIALDEBUG}
// {$ifdef FPVECTORIALDEBUG}
// WriteLn(Format('Drawing Arc x1y1=%d,%d x2y2=%d,%d start=%d end=%d',
// [BoundsLeft, BoundsTop, BoundsRight, BoundsBottom, IntStartAngle, IntAngleLength]));
// {$endif}
{ ADest.TextOut(CoordToCanvasX(CurArc.CenterX), CoordToCanvasY(CurArc.CenterY),
Format('R=%d S=%d L=%d', [Round(CurArc.Radius*AMulX), Round(FinalStartAngle),
Abs(Round((FinalEndAngle - FinalStartAngle)))]));
ADest.Pen.Color := TColor($DDDDDD);
ADest.Rectangle(
BoundsLeft, BoundsTop, BoundsRight, BoundsBottom);
ADest.Pen.Color := clBlack;}
{$endif}
end
else if CurEntity is TvAlignedDimension then
begin
CurDim := CurEntity as TvAlignedDimension;
//
// Draws this shape:
// vertical horizontal
// ___
// | | or ---| X cm
// | --|
// Which marks the dimension
ADest.MoveTo(CoordToCanvasX(CurDim.BaseRight.X), CoordToCanvasY(CurDim.BaseRight.Y));
ADest.LineTo(CoordToCanvasX(CurDim.DimensionRight.X), CoordToCanvasY(CurDim.DimensionRight.Y));
ADest.LineTo(CoordToCanvasX(CurDim.DimensionLeft.X), CoordToCanvasY(CurDim.DimensionLeft.Y));
ADest.LineTo(CoordToCanvasX(CurDim.BaseLeft.X), CoordToCanvasY(CurDim.BaseLeft.Y));
// Now the arrows
// horizontal
SetLength(Points, 3);
if CurDim.DimensionRight.Y = CurDim.DimensionLeft.Y then
begin
ADest.Brush.FPColor := colBlack;
ADest.Brush.Style := bsSolid;
// Left arrow
Points[0] := Point(CoordToCanvasX(CurDim.DimensionLeft.X), CoordToCanvasY(CurDim.DimensionLeft.Y));
Points[1] := Point(Points[0].X + 7, Points[0].Y - 3);
Points[2] := Point(Points[0].X + 7, Points[0].Y + 3);
ADest.Polygon(Points);
// Right arrow
Points[0] := Point(CoordToCanvasX(CurDim.DimensionRight.X), CoordToCanvasY(CurDim.DimensionRight.Y));
Points[1] := Point(Points[0].X - 7, Points[0].Y - 3);
Points[2] := Point(Points[0].X - 7, Points[0].Y + 3);
ADest.Polygon(Points);
ADest.Brush.Style := bsClear;
// Dimension text
Points[0].X := CoordToCanvasX((CurDim.DimensionLeft.X+CurDim.DimensionRight.X)/2);
Points[0].Y := CoordToCanvasY(CurDim.DimensionLeft.Y);
LowerDim.X := CurDim.DimensionRight.X-CurDim.DimensionLeft.X;
ADest.Font.Size := 10;
ADest.TextOut(Points[0].X, Points[0].Y, Format('%.1f', [LowerDim.X]));
end
else
begin
ADest.Brush.FPColor := colBlack;
ADest.Brush.Style := bsSolid;
// There is no upper/lower preference for DimensionLeft/Right, so we need to check
if CurDim.DimensionLeft.Y > CurDim.DimensionRight.Y then
begin
UpperDim := CurDim.DimensionLeft;
LowerDim := CurDim.DimensionRight;
end
else
begin
UpperDim := CurDim.DimensionRight;
LowerDim := CurDim.DimensionLeft;
end;
// Upper arrow
Points[0] := Point(CoordToCanvasX(UpperDim.X), CoordToCanvasY(UpperDim.Y));
Points[1] := Point(Points[0].X + Round(AMulX), Points[0].Y - Round(AMulY*3));
Points[2] := Point(Points[0].X - Round(AMulX), Points[0].Y - Round(AMulY*3));
ADest.Polygon(Points);
// Lower arrow
Points[0] := Point(CoordToCanvasX(LowerDim.X), CoordToCanvasY(LowerDim.Y));
Points[1] := Point(Points[0].X + Round(AMulX), Points[0].Y + Round(AMulY*3));
Points[2] := Point(Points[0].X - Round(AMulX), Points[0].Y + Round(AMulY*3));
ADest.Polygon(Points);
ADest.Brush.Style := bsClear;
// Dimension text
Points[0].X := CoordToCanvasX(CurDim.DimensionLeft.X);
Points[0].Y := CoordToCanvasY((CurDim.DimensionLeft.Y+CurDim.DimensionRight.Y)/2);
LowerDim.Y := CurDim.DimensionRight.Y-CurDim.DimensionLeft.Y;
if LowerDim.Y < 0 then LowerDim.Y := -1 * LowerDim.Y;
ADest.Font.Size := 10;
ADest.TextOut(Points[0].X, Points[0].Y, Format('%.1f', [LowerDim.Y]));
end;
SetLength(Points, 0);
{ // Debug info
ADest.TextOut(CoordToCanvasX(CurDim.BaseRight.X), CoordToCanvasY(CurDim.BaseRight.Y), 'BR');
ADest.TextOut(CoordToCanvasX(CurDim.DimensionRight.X), CoordToCanvasY(CurDim.DimensionRight.Y), 'DR');
ADest.TextOut(CoordToCanvasX(CurDim.DimensionLeft.X), CoordToCanvasY(CurDim.DimensionLeft.Y), 'DL');
ADest.TextOut(CoordToCanvasX(CurDim.BaseLeft.X), CoordToCanvasY(CurDim.BaseLeft.Y), 'BL');}
end;
end;
procedure DrawFPVTextToCanvas(ASource: TvVectorialPage; CurText: TvText;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
function CoordToCanvasX(ACoord: Double): Integer;
begin
Result := Round(ADestX + AmulX * ACoord);
end;
function CoordToCanvasY(ACoord: Double): Integer;
begin
Result := Round(ADestY + AmulY * ACoord);
end;
var
i: Integer;
{$ifdef USE_LCL_CANVAS}
ALCLDest: TCanvas;
{$endif}
//
LowerDim: T3DPoint;
begin
{$ifdef USE_LCL_CANVAS}
ALCLDest := TCanvas(ADest);
{$endif}
ADest.Font.Size := Round(AmulX * CurText.Font.Size);
ADest.Pen.Style := psSolid;
ADest.Pen.FPColor := colBlack;
ADest.Brush.Style := bsClear;
{$ifdef USE_LCL_CANVAS}
ALCLDest.Font.Orientation := Round(CurText.Font.Orientation * 16);
{$endif}
// TvText supports multiple lines
for i := 0 to CurText.Value.Count - 1 do
begin
if CurText.Font.Size = 0 then LowerDim.Y := CurText.Y - 12 * (i + 1)
else LowerDim.Y := CurText.Y - CurText.Font.Size * (i + 1);
ADest.TextOut(CoordToCanvasX(CurText.X), CoordToCanvasY(LowerDim.Y), CurText.Value.Strings[i]);
end;
end;
end.

295
components/fpvectorial/fpvutils.pas Normal file
View File

@ -0,0 +1,295 @@
{
fpvutils.pas
Vector graphics document
License: The same modified LGPL as the Free Pascal RTL
See the file COPYING.modifiedLGPL for more details
AUTHORS: Felipe Monteiro de Carvalho
Pedro Sol Pegorini L de Lima
}
unit fpvutils;
{.$define USE_LCL_CANVAS}
{.$define FPVECTORIAL_BEZIERTOPOINTS_DEBUG}
{$ifdef fpc}
{$mode delphi}
{$endif}
interface
uses
Classes, SysUtils, Math,
{$ifdef USE_LCL_CANVAS}
Graphics, LCLIntf, LCLType,
{$endif}
fpvectorial, fpimage;
type
T10Strings = array[0..9] of shortstring;
TPointsArray = array of TPoint;
// Color Conversion routines
function FPColorToRGBHexString(AColor: TFPColor): string;
function RGBToFPColor(AR, AG, AB: byte): TFPColor; inline;
// Coordinate Conversion routines
function CanvasCoordsToFPVectorial(AY: Integer; AHeight: Integer): Integer; inline;
function CanvasTextPosToFPVectorial(AY: Integer; ACanvasHeight, ATextHeight: Integer): Integer;
function CoordToCanvasX(ACoord: Double; ADestX: Integer; AMulX: Double): Integer; inline;
function CoordToCanvasY(ACoord: Double; ADestY: Integer; AMulY: Double): Integer; inline;
// Other routines
function SeparateString(AString: string; ASeparator: char): T10Strings;
// Mathematical routines
procedure EllipticalArcToBezier(Xc, Yc, Rx, Ry, startAngle, endAngle: Double; var P1, P2, P3, P4: T3DPoint);
procedure CircularArcToBezier(Xc, Yc, R, startAngle, endAngle: Double; var P1, P2, P3, P4: T3DPoint);
procedure AddBezierToPoints(P1, P2, P3, P4: T3DPoint; var Points: TPointsArray);
procedure ConvertPathToPoints(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray);
// LCL-related routines
{$ifdef USE_LCL_CANVAS}
function ConvertPathToRegion(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double): HRGN;
{$endif}
implementation
{@@ This function is utilized by the SVG writer and some other places, so
it shouldn't be changed.
}
function FPColorToRGBHexString(AColor: TFPColor): string;
begin
Result := Format('%.2x%.2x%.2x', [AColor.Red shr 8, AColor.Green shr 8, AColor.Blue shr 8]);
end;
function RGBToFPColor(AR, AG, AB: byte): TFPColor; inline;
begin
Result.Red := (AR shl 8) + AR;
Result.Green := (AG shl 8) + AG;
Result.Blue := (AB shl 8) + AB;
Result.Alpha := $FFFF;
end;
{@@ Converts the coordinate system from a TCanvas to FPVectorial
The basic difference is that the Y axis is positioned differently and
points upwards in FPVectorial and downwards in TCanvas.
The X axis doesn't change. The fix is trivial and requires only the Height of
the Canvas as extra info.
@param AHeight Should receive TCanvas.Height
}
function CanvasCoordsToFPVectorial(AY: Integer; AHeight: Integer): Integer; inline;
begin
Result := AHeight - AY;
end;
{@@
LCL Text is positioned based on the top-left corner of the text.
Besides that, one also needs to take the general coordinate change into account too.
@param ACanvasHeight Should receive TCanvas.Height
@param ATextHeight Should receive TFont.Size
}
function CanvasTextPosToFPVectorial(AY: Integer; ACanvasHeight, ATextHeight: Integer): Integer;
begin
Result := CanvasCoordsToFPVectorial(AY, ACanvasHeight) - ATextHeight;
end;
function CoordToCanvasX(ACoord: Double; ADestX: Integer; AMulX: Double): Integer;
begin
Result := Round(ADestX + AmulX * ACoord);
end;
function CoordToCanvasY(ACoord: Double; ADestY: Integer; AMulY: Double): Integer;
begin
Result := Round(ADestY + AmulY * ACoord);
end;
{@@
Reads a string and separates it in substring
using ASeparator to delimite them.
Limits:
Number of substrings: 10 (indexed 0 to 9)
Length of each substring: 255 (they are shortstrings)
}
function SeparateString(AString: string; ASeparator: char): T10Strings;
var
i, CurrentPart: integer;
begin
CurrentPart := 0;
{ Clears the result }
for i := 0 to 9 do
Result[i] := '';
{ Iterates througth the string, filling strings }
for i := 1 to Length(AString) do
begin
if Copy(AString, i, 1) = ASeparator then
begin
Inc(CurrentPart);
{ Verifies if the string capacity wasn't exceeded }
if CurrentPart > 9 then
Exit;
end
else
Result[CurrentPart] := Result[CurrentPart] + Copy(AString, i, 1);
end;
end;
{ Considering a counter-clockwise arc, elliptical and alligned to the axises
An elliptical Arc can be converted to
the following Cubic Bezier control points:
P1 = E(startAngle) <- start point
P2 = P1+alfa * dE(startAngle) <- control point
P3 = P4−alfa * dE(endAngle) <- control point
P4 = E(endAngle) <- end point
source: http://www.spaceroots.org/documents/ellipse/elliptical-arc.pdf
The equation of an elliptical arc is:
X(t) = Xc + Rx * cos(t)
Y(t) = Yc + Ry * sin(t)
dX(t)/dt = - Rx * sin(t)
dY(t)/dt = + Ry * cos(t)
}
procedure EllipticalArcToBezier(Xc, Yc, Rx, Ry, startAngle, endAngle: Double;
var P1, P2, P3, P4: T3DPoint);
var
halfLength, arcLength, alfa: Double;
begin
arcLength := endAngle - startAngle;
halfLength := (endAngle - startAngle) / 2;
alfa := sin(arcLength) * (Sqrt(4 + 3*sqr(tan(halfLength))) - 1) / 3;
// Start point
P1.X := Xc + Rx * cos(startAngle);
P1.Y := Yc + Ry * sin(startAngle);
// End point
P4.X := Xc + Rx * cos(endAngle);
P4.Y := Yc + Ry * sin(endAngle);
// Control points
P2.X := P1.X + alfa * -1 * Rx * sin(startAngle);
P2.Y := P1.Y + alfa * Ry * cos(startAngle);
P3.X := P4.X - alfa * -1 * Rx * sin(endAngle);
P3.Y := P4.Y - alfa * Ry * cos(endAngle);
end;
procedure CircularArcToBezier(Xc, Yc, R, startAngle, endAngle: Double; var P1,
P2, P3, P4: T3DPoint);
begin
EllipticalArcToBezier(Xc, Yc, R, R, startAngle, endAngle, P1, P2, P3, P4);
end;
{ This routine converts a Bezier to a Polygon and adds the points of this poligon
to the end of the provided Points output variables }
procedure AddBezierToPoints(P1, P2, P3, P4: T3DPoint; var Points: TPointsArray);
var
CurveLength, k, CurX, CurY, LastPoint: Integer;
t: Double;
begin
{$ifdef FPVECTORIAL_BEZIERTOPOINTS_DEBUG}
Write(Format('[AddBezierToPoints] P1=%f,%f P2=%f,%f P3=%f,%f P4=%f,%f =>', [P1.X, P1.Y, P2.X, P2.Y, P3.X, P3.Y, P4.X, P4.Y]));
{$endif}
CurveLength :=
Round(sqrt(sqr(P2.X - P1.X) + sqr(P2.Y - P1.Y))) +
Round(sqrt(sqr(P3.X - P2.X) + sqr(P3.Y - P2.Y))) +
Round(sqrt(sqr(P4.X - P4.X) + sqr(P4.Y - P3.Y)));
LastPoint := Length(Points)-1;
SetLength(Points, Length(Points)+CurveLength);
for k := 1 to CurveLength do
begin
t := k / CurveLength;
CurX := Round(sqr(1 - t) * (1 - t) * P1.X + 3 * t * sqr(1 - t) * P2.X + 3 * t * t * (1 - t) * P3.X + t * t * t * P4.X);
CurY := Round(sqr(1 - t) * (1 - t) * P1.Y + 3 * t * sqr(1 - t) * P2.Y + 3 * t * t * (1 - t) * P3.Y + t * t * t * P4.Y);
Points[LastPoint+k].X := CurX;
Points[LastPoint+k].Y := CurY;
{$ifdef FPVECTORIAL_BEZIERTOPOINTS_DEBUG}
Write(Format(' P=%d,%d', [CurX, CurY]));
{$endif}
end;
{$ifdef FPVECTORIAL_BEZIERTOPOINTS_DEBUG}
WriteLn(Format(' CurveLength=%d', [CurveLength]));
{$endif}
end;
procedure ConvertPathToPoints(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray);
var
i, LastPoint: Integer;
CoordX, CoordY: Integer;
CoordX2, CoordY2, CoordX3, CoordY3, CoordX4, CoordY4: Integer;
// Segments
CurSegment: TPathSegment;
Cur2DSegment: T2DSegment absolute CurSegment;
Cur2DBSegment: T2DBezierSegment absolute CurSegment;
begin
APath.PrepareForSequentialReading;
SetLength(Points, 0);
for i := 0 to APath.Len - 1 do
begin
CurSegment := TPathSegment(APath.Next());
CoordX := CoordToCanvasX(Cur2DSegment.X, ADestX, AMulX);
CoordY := CoordToCanvasY(Cur2DSegment.Y, ADestY, AMulY);
case CurSegment.SegmentType of
st2DBezier, st3DBezier:
begin
LastPoint := Length(Points)-1;
CoordX4 := CoordX;
CoordY4 := CoordY;
CoordX := Points[LastPoint].X;
CoordY := Points[LastPoint].Y;
CoordX2 := CoordToCanvasX(Cur2DBSegment.X2, ADestX, AMulX);
CoordY2 := CoordToCanvasY(Cur2DBSegment.Y2, ADestY, AMulY);
CoordX3 := CoordToCanvasX(Cur2DBSegment.X3, ADestX, AMulX);
CoordY3 := CoordToCanvasY(Cur2DBSegment.Y3, ADestY, AMulY);
AddBezierToPoints(
Make2DPoint(CoordX, CoordY),
Make2DPoint(CoordX2, CoordY2),
Make2DPoint(CoordX3, CoordY3),
Make2DPoint(CoordX4, CoordY4),
Points);
end;
else
LastPoint := Length(Points);
SetLength(Points, Length(Points)+1);
Points[LastPoint].X := CoordX;
Points[LastPoint].Y := CoordY;
end;
end;
end;
{$ifdef USE_LCL_CANVAS}
function ConvertPathToRegion(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double): HRGN;
var
WindingMode: Integer;
Points: array of TPoint;
begin
APath.PrepareForSequentialReading;
SetLength(Points, 0);
ConvertPathToPoints(APath, ADestX, ADestY, AMulX, AMulY, Points);
if APath.ClipMode = vcmEvenOddRule then WindingMode := LCLType.ALTERNATE
else WindingMode := LCLType.WINDING;
Result := LCLIntf.CreatePolygonRgn(@Points[0], Length(Points), WindingMode);
end;
{$endif}
end.

265
components/fpvectorial/pdfvectorialreader.pas Normal file
View File

@ -0,0 +1,265 @@
{
pdfvectorialreader.pas
Reads the vectorial information form a PDF file
PDF file format specification obtained from:
ADOBE SYSTEMS INCORPORATED. PDF Reference: Adobe®
Portable Document Format. San Jose, 2006. (Sixth edition).
AUTHORS: Felipe Monteiro de Carvalho
Pedro Sol Pegorini L de Lima
}
unit pdfvectorialreader;
{$ifdef fpc}
{$mode delphi}
{$endif}
interface
uses
Classes, SysUtils,
pdfvrlexico, pdfvrsintatico, pdfvrsemantico, avisozlib,
fpvectorial;
type
{ TvPDFVectorialReader }
TvPDFVectorialReader = class(TvCustomVectorialReader)
private
procedure WriteStringToStream(AStream: TStream; AString: string);
public
{ public to allow uncompressing PDFs independently }
function getFirstPage(AInput: TStream; AOutput: TStream):PageHeader;
procedure unzipPage(AInput: TStream; AOutput: TStream);
procedure translatePage(AInput: TStream; AData: TvVectorialDocument;
APageHeader: PageHeader);
{ General reading methods }
procedure ReadFromStream(AStream: TStream; AData: TvVectorialDocument); override;
end;
implementation
{ TvPDFVectorialReader }
procedure TvPDFVectorialReader.WriteStringToStream(AStream: TStream;
AString: string);
begin
AStream.WriteBuffer(AString[1], Length(AString));
end;
function TvPDFVectorialReader.getFirstPage(AInput: TStream; AOutput: TStream): PageHeader;
var
mytoken: Token;
myAnLexicoPage: AnLexico;
myAnLexicoContents: AnLexico;
myAnSintaticoPage: AnSintaticoPage;
myAnSintaticoContents: AnSintaticoPageContents;
AInput2: TStream;
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> TvPDFVectorialReader.getFirstPage');
{$endif}
AInput2 := TMemoryStream.Create;
AInput2.Size := AInput.Size;
AInput2.CopyFrom(AInput, AInput.Size);
AInput.Seek(0, soFromBeginning);
AInput2.Seek(0, soFromBeginning);
myAnLexicoPage := AnLexico.Create;
myAnLexicoPage.Doc := AInput;
myAnLexicoPage.bytesRemaining:= myAnLexicoPage.Doc.Size;
myAnSintaticoPage := AnSintaticoPage.Create;
// find first page
while ((myAnSintaticoPage.pageFound <> true) and
(myAnLexicoPage.bytesRemaining > 0)) do
begin
mytoken := myAnLexicoPage.getToken();
myAnSintaticoPage.automata(mytoken);
end;
if (myAnSintaticoPage.pageFound = false) then
begin
raise Exception.Create('ERROR: Arquivo corrompido.');
Halt(1);
end;
AInput.Seek(0, soFromBeginning);
myAnLexicoContents := AnLexico.Create;
myAnLexicoContents.Doc := AInput;
myAnLexicoContents.bytesRemaining:= myAnLexicoContents.Doc.Size;
myAnSintaticoContents := AnSintaticoPageContents.Create;
// gathering information of the first page
myAnSintaticoContents.obj1:=myAnSintaticoPage.obj1;
myAnSintaticoContents.obj2:=myAnSintaticoPage.obj2;
//find first page contents
while ((myAnSintaticoContents.contentsFound <> true) and
(myAnLexicoContents.bytesRemaining > 0)) do
begin
mytoken := myAnLexicoContents.getToken();
myAnSintaticoContents.automata(mytoken, AInput2);
end;
if (myAnSintaticoContents.contentsFound = false) then
begin
raise Exception.Create('ERROR: Arquivo corrompido.');
Halt(1);
end;
// gathering information of the first page
myAnLexicoContents.bytesRemaining:=myAnSintaticoContents.h.page_length;
// write file with content just from the first page
while (myAnLexicoContents.bytesRemaining > 0) do
begin
mytoken := myAnLexicoContents.getPageToken();
WriteStringToStream(AOutput, mytoken.token_string);
end;
Result:=myAnSintaticoContents.h;
{$ifdef FPVECTORIALDEBUG}
WriteLn(':< TvPDFVectorialReader.getFirstPage');
{$endif}
// AInput2.Free;
end;
procedure TvPDFVectorialReader.unzipPage(AInput: TStream; AOutput: TStream);
var
compr, uncompr: Pbyte;
comprLen, uncomprLen: LongInt;
myDecode: decode;
BufStr: string;
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> TvPDFVectorialReader.unzipPage');
{$endif}
myDecode := Decode.Create;
comprLen := 10000 * SizeOf(Integer); // don't overflow
uncomprLen := comprLen;
GetMem(compr, comprLen);
GetMem(uncompr, uncomprLen);
if (compr = NIL) or (uncompr = NIL) then
myDecode.EXIT_ERR('Out of memory');
(* compr and uncompr are cleared to avoid reading uninitialized
* data and to ensure that uncompr compresses well.
*)
FillChar(compr^, comprLen, 0);
FillChar(uncompr^, uncomprLen, 0);
AInput.Read(compr^, comprLen);
BufStr := string(myDecode.test_inflate(compr, comprLen, uncompr, uncomprLen));
WriteStringToStream(AOutput, BufStr);
FreeMem(compr, comprLen);
FreeMem(uncompr, uncomprLen);
{$ifdef FPVECTORIALDEBUG}
WriteLn(':< TvPDFVectorialReader.unzipPage');
{$endif}
end;
procedure TvPDFVectorialReader.translatePage(AInput: TStream;
AData: TvVectorialDocument; APageHeader: PageHeader);
var
myAnLexico: AnLexico;
myAnSintaticoCommand: AnSintaticoCommand;
myAnSemantico: AnSemantico;
mytoken: Token;
c: Command;
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> TvPDFVectorialReader.translatePage');
{$endif}
// initialize data main
myAnLexico := AnLexico.Create;
myAnLexico.Doc := AInput;
myAnLexico.bytesRemaining:= myAnLexico.Doc.Size;
myAnSintaticoCommand := AnSintaticoCommand.Create;
myAnSemantico := AnSemantico.Create;
// initialize machine
myAnSemantico.startMachine();
while (myAnLexico.bytesRemaining > 0) do
begin
mytoken := myAnLexico.getToken();
c:=myAnSintaticoCommand.automata(mytoken);
if (myAnSintaticoCommand.Codigo = true) then
myAnSemantico.generate(c, AData);
end;
// end machine
myAnSemantico.endMachine();
end;
procedure TvPDFVectorialReader.ReadFromStream(AStream: TStream;
AData: TvVectorialDocument);
var
APageHeader: PageHeader;
APageStream, AUnzipStream: TStream;
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> TvPDFVectorialReader.ReadFromStream');
{$endif}
APageStream := TMemoryStream.Create;
AUnzipStream := TMemoryStream.Create;
// get first page
APageHeader := getFirstPage(AStream, APageStream);
// unzip page
if (APageHeader.flate_decode = true) then
begin
APageStream.Seek(0, soFromBeginning);
unzipPage(APageStream, AUnzipStream);
// translate page to doc data
AUnzipStream.Seek(0, soFromBeginning);
translatePage(AUnzipStream, AData, APageHeader);
end
else
begin
// translate page to doc data
APageStream.Seek(0, soFromBeginning);
translatePage(APageStream, AData, APageHeader);
end;
APageStream.Free;
AUnzipStream.Free;
//ShowMessage('Sucesso!');
{$ifdef FPVECTORIALDEBUG}
WriteLn(':< TvPDFVectorialReader.ReadFromStream');
WriteLn('Sucesso!');
{$endif}
end;
{*******************************************************************
* Initialization section
*
* Registers this reader / writer on fpVectorial
*
*******************************************************************}
initialization
RegisterVectorialReader(TvPDFVectorialReader, vfPDF);
end.

113
components/fpvectorial/pdfvrlexico.pas Normal file
View File

@ -0,0 +1,113 @@
unit pdfvrlexico;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
Token = record
tipo: Int64;
token_string: String;
end;
TPDFCommandCode = (cc_NONE, cc_m_START_PATH, cc_l_ADD_LINE_TO_PATH,
cc_H_CLOSE_PATH, cc_S_END_PATH, cc_hS_CLOSE_AND_END_PATH,
cc_c_BEZIER_TO_X_Y_USING_X2_Y2_AND_X3_Y3,
cc_v_BEZIER_TO_X_Y_USING_CURRENT_POS_AND_X2_Y2,
cc_y_BEZIER_TO_X_Y_USING_X_Y_AND_X2_Y2,
cc_CONCATENATE_MATRIX,cc_RESTORE_MATRIX);
Command = record
cord_x3: String;
cord_y3: String;
cord_x2: String;
cord_y2: String;
cord_x: String;
cord_y: String;
my_operator: String;
code: TPDFCommandCode;
end;
PageHeader = record
page_length: Int64;
flate_decode: Boolean;
end;
AnLexico = class
public
Doc: TStream;
bytesRemaining: Int64;
constructor Create();
function getToken(): Token;
function getPageToken(): Token;
end;
implementation
function AnLexico.getToken(): Token;
var
t: Byte;
mytoken: Token;
begin
mytoken.tipo := 0;
while( bytesRemaining > 0 ) do
begin
t := Doc.ReadByte();
bytesRemaining := bytesRemaining - 1;
// numbers or points or minus
if((((t >= 48) and (t <= 57)) or (t = 46 ) or (t = 45)) and
((mytoken.tipo = 1) or (mytoken.tipo = 0))) then
begin
mytoken.token_string := mytoken.token_string + char(t);
mytoken.tipo:=1;
end
else if(((t >= 65) and (t <= 90)) or ((t >= 97) and (t <= 122)) // letters
or (t = 42) // *
and ((mytoken.tipo = 2) or (mytoken.tipo = 0))) then
begin
mytoken.token_string := mytoken.token_string + char(t);
mytoken.tipo:=2;
end
else // everything else
begin
if (mytoken.tipo <> 0) then
begin
// solve CorelDraw problem after "stream"
if ((t=13) and (bytesRemaining>0)) then
begin
t := Doc.ReadByte();
bytesRemaining:=bytesRemaining-1;
end;
Result := mytoken;
Exit;
end;
end;
end;
Result := mytoken;
end;
function AnLexico.getPageToken(): Token;
var
t: Byte;
mytoken: Token;
begin
mytoken.tipo := 0;
if (bytesRemaining > 0) then
begin
t := Doc.ReadByte;
mytoken.token_string:=char(t);
bytesRemaining := bytesRemaining - 1;
end;
Result := mytoken;
end;
constructor AnLexico.Create();
begin
inherited Create;
end;
end.

244
components/fpvectorial/pdfvrsemantico.pas Normal file
View File

@ -0,0 +1,244 @@
unit pdfvrsemantico;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, pdfvrlexico, fpvectorial;
type
{ AnSemantico }
AnSemantico = class
public
FPointSeparator, FCommaSeparator: TFormatSettings;
close_path_x: String;
close_path_y: String;
cm_a, cm_b, cm_c, cm_d, cm_e, cm_f: Real; // coordinate spaces constants
function StringToFloat(AStr: string): Double;
function generate(c: Command; AData: TvVectorialDocument): String;
function convert(x: String; y: String; Axis: Char): String;
function startMachine(): String;
function endMachine(): String;
constructor Create;
end;
implementation
{ PDF doesn't seam very consistent when it comes to using commas or
points as decimal separator, so we just try both }
function AnSemantico.StringToFloat(AStr: string): Double;
begin
if Pos('.', AStr) > 0 then Result := StrToFloat(AStr, FPointSeparator)
else Result := StrToFloat(AStr, FCommaSeparator);
end;
function AnSemantico.generate(c: Command; AData: TvVectorialDocument): String;
var
enter_line : String;
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSemantico.generate');
{$endif}
enter_line:= LineEnding; //chr(13) + chr(10); // CR and LF
if ((c.code = cc_H_CLOSE_PATH) or (c.code = cc_hS_CLOSE_AND_END_PATH)) then // command h or s
begin
c.cord_x:=close_path_x;
c.cord_y:=close_path_y;
end;
if ((c.code <> cc_H_CLOSE_PATH) and (c.code <> cc_hS_CLOSE_AND_END_PATH)) then // close path already converted
begin
if ((c.code = cc_m_START_PATH) or (c.code = cc_l_ADD_LINE_TO_PATH)) then
begin
//WriteLn(':: anSemantico.generate convert code ', Integer(c.code));
c.cord_x := convert(c.cord_x,c.cord_y,'x');
c.cord_y := convert(c.cord_x,c.cord_y,'y');
end;
if ((c.code = cc_c_BEZIER_TO_X_Y_USING_X2_Y2_AND_X3_Y3)) then
begin
//WriteLn(':: anSemantico.generate convert code ', Integer(c.code));
c.cord_x := convert(c.cord_x,c.cord_y,'x');
c.cord_y := convert(c.cord_x,c.cord_y,'y');
c.cord_x2 := convert(c.cord_x2,c.cord_y2,'x');
c.cord_y2 := convert(c.cord_x2,c.cord_y2,'y');
c.cord_x3 := convert(c.cord_x3,c.cord_y3,'x');
c.cord_y3 := convert(c.cord_x3,c.cord_y3,'y');
end;
end;
case c.code of
cc_m_START_PATH: // command m
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSemantico.generate Estado 1 EndPath StartPath');
{$endif}
// Result:='G01' + ' ' + 'X' + c.cord_x + ' ' + 'Y' + c.cord_y + enter_line +
// 'G01 Z50 // Abaixa a cabeça de gravação';
// Correcao para programas de desenho que geram um novo inicio no
// fim do desenho, terminamos qualquer desenho inacabado
AData.EndPath();
AData.StartPath(StringToFloat(c.cord_x), StringToFloat(c.cord_y));
close_path_x:=c.cord_x;
close_path_y:=c.cord_y;
end;
cc_l_ADD_LINE_TO_PATH: // command l
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSemantico.generate Estado 2 AddPointToPath');
{$endif}
// Result:='G01' + ' ' + 'X' + c.cord_x + ' ' + 'Y' + c.cord_y;
AData.AddLineToPath(StringToFloat(c.cord_x), StringToFloat(c.cord_y));
end;
cc_h_CLOSE_PATH: // command h
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSemantico.generate Estado 3 AddPointToPath');
{$endif}
//Result:='G01' + ' ' + 'X' + c.cord_x + ' ' + 'Y' + c.cord_y;
AData.AddLineToPath(StringToFloat(c.cord_x), StringToFloat(c.cord_y));
end;
cc_S_END_PATH: // command S
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSemantico.generate Estado 4 EndPath');
{$endif}
// Result:='G01 Z0 // Sobe a cabeça de gravação' + enter_line;
AData.EndPath();
end;
cc_hS_CLOSE_AND_END_PATH: // command s
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSemantico.generate Estado 5 AddPoint EndPath');
{$endif}
//Result:='G01' + ' ' + 'X' + c.cord_x + ' ' + 'Y' + c.cord_y + enter_line
// +'G01 Z0 // Sobe a cabeça de gravação' + enter_line;
AData.AddLineToPath(StringToFloat(c.cord_x), StringToFloat(c.cord_y));
AData.EndPath();
end;
cc_c_BEZIER_TO_X_Y_USING_X2_Y2_AND_X3_Y3: // command c
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSemantico.generate Estado 6 Bezier');
{$endif}
//Result:='G01' + ' ' + 'X' + c.cord_x + ' ' + 'Y' + c.cord_y + enter_line
// +'G01 Z0 // Sobe a cabeça de gravação' + enter_line;
AData.AddBezierToPath(
StringToFloat(c.cord_x3), StringToFloat(c.cord_y3),
StringToFloat(c.cord_x2), StringToFloat(c.cord_y2),
StringToFloat(c.cord_x), StringToFloat(c.cord_y)
);
end;
cc_CONCATENATE_MATRIX: // command cm
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSemantico.cc_CONCATENATE_MATRIX');
{$endif}
cm_a := StringToFloat(c.cord_x3);
cm_b := StringToFloat(c.cord_y3);
cm_c := StringToFloat(c.cord_x2);
cm_d := StringToFloat(c.cord_y2);
cm_e := StringToFloat(c.cord_x);
cm_f := StringToFloat(c.cord_y);
end;
cc_RESTORE_MATRIX: // command Q
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSemantico.cc_RESTORE_MATRIX');
{$endif}
cm_a:=1;
cm_b:=0;
cm_c:=0;
cm_d:=1;
cm_e:=0;
cm_f:=0;
end;
else
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSemantico.generate Estado ELSE');
{$endif}
Result:=c.my_operator;
end;
end;
function AnSemantico.convert(x: String; y: String; Axis: Char): String;
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSemantico.convert');
{$endif}
// convert from 1/72 inch to milimeters and change axis if necessary
if (Axis = 'y') then
begin
// y' = b * x + d * y + f
Result:=FloatToStr((cm_b*StringToFloat(x)+cm_d*StringToFloat(y)+cm_f)*(25.40/72));
end
else
// Axis = 'x'
begin
// x' = a * x + c * y + e
Result:=FloatToStr((cm_a*StringToFloat(x)+cm_c*StringToFloat(y)+cm_e)*(25.40/72));
end;
end;
function AnSemantico.startMachine(): String;
var
enter_line : String;
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSemantico.startMachine');
{$endif}
enter_line:=chr(13) + chr(10); // CR and LF
Result:='M216 // Ligar monitor de carga' + enter_line +
'G28 // Ir rapidamente para posição inicial' + enter_line +
'G00' + enter_line;
end;
function AnSemantico.endMachine(): String;
var
enter_line : String;
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSemantico.endMachine');
{$endif}
enter_line:=chr(13) + chr(10); // CR and LF
Result:='M30 // Parar o programa e retornar para posição inicial' + enter_line +
'M215 // Desligar monitor de carga' + enter_line;
end;
constructor AnSemantico.Create;
begin
inherited Create;
cm_a:=1;
cm_b:=0;
cm_c:=0;
cm_d:=1;
cm_e:=0;
cm_f:=0;
// Format seetings to convert a string to a float
FPointSeparator := DefaultFormatSettings;
FPointSeparator.DecimalSeparator := '.';
FPointSeparator.ThousandSeparator := '#';// disable the thousand separator
FCommaSeparator := DefaultFormatSettings;
FCommaSeparator.DecimalSeparator := ',';
FCommaSeparator.ThousandSeparator := '#';// disable the thousand separator
end;
end.

628
components/fpvectorial/pdfvrsintatico.pas Normal file
View File

@ -0,0 +1,628 @@
unit pdfvrsintatico;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, pdfvrlexico;
type
AnSintaticoPage = class
public
Estado: Int64;
obj1,obj2 : String;
pageFound: Boolean;
constructor Create;
procedure automata(t: Token);
end;
AnSintaticoPageContents = class
public
Estado: Int64;
obj1,obj2 : String;
len_obj1,len_obj2: String;
contentsFound: Boolean;
h: PageHeader;
constructor Create;
procedure automata(t: Token; Input: TStream);
end;
AnSintaticoCommand = class
public
Estado: Int64;
Codigo: Boolean;
c: Command;
constructor Create;
function automata(t: Token):Command;
end;
AnSintaticoLength = class
public
Estado: Int64;
len_obj1,len_obj2: String;
page_length : Int64;
lenghtFound: Boolean;
constructor Create;
procedure automata(t: Token);
end;
implementation
procedure AnSintaticoPage.automata(t: Token);
begin
case Estado of
1:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoPage.automata Estado 1');
{$endif}
if(t.token_string = 'Type') then
begin
Estado := 2;
end
else
begin
Estado := 1;
end;
end;
2:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoPage.automata Estado 2');
{$endif}
if(t.token_string = 'Page') then
begin
Estado := 3;
end
else
begin
Estado := 1;
end;
end;
3:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoPage.automata Estado 3');
{$endif}
if(t.token_string = 'Contents') then
begin
Estado := 4;
end
else
begin
Estado := 3;
end;
end;
4:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoPage.automata Estado 4');
{$endif}
if(t.tipo = 1) then // numbers 1
begin
obj1:=t.token_string;
Estado := 5;
end
else
begin
raise Exception.Create('ERROR: Arquivo corrompido.');
Halt(1);
end;
end;
5:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoPage.automata Estado 5');
{$endif}
if(t.tipo = 1) then // numbers 2
begin
obj2:=t.token_string;
Estado := 6; // symbolic state
pageFound := true;
end
else
begin
raise Exception.Create('ERROR: Arquivo corrompido.');
Halt(1);
end;
end;
else
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoPage.automata Estado ELSE');
{$endif}
Estado := 1;
end;
end;
procedure AnSintaticoPageContents.automata(t: Token; Input: TStream);
var
myAnLexicoLength: AnLexico;
myAnSintaticoLength: AnSintaticoLength;
mytokenLength: Token;
begin
case Estado of
1:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoPageContents.automata Estado 1');
{$endif}
if(t.token_string = obj1) then
begin
Estado := 2;
end
else
begin
Estado := 1;
end;
end;
2:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoPageContents.automata Estado 2');
{$endif}
if(t.token_string = obj2) then
begin
Estado := 3;
end
else
begin
Estado := 1;
end;
end;
3:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoPageContents.automata Estado 3');
{$endif}
if(t.token_string = 'obj') then
begin
Estado := 4;
end
else
begin
Estado := 1;
end;
end;
4:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoPageContents.automata Estado 4');
{$endif}
if(t.token_string = 'Length') then
begin
Estado := 5;
end
else if (t.token_string = 'Filter') then
begin
Estado := 7;
end
else
begin
Estado := 4;
end;
end;
5:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoPageContents.automata Estado 5');
{$endif}
if(t.tipo = 1) then
begin
h.page_length := StrToInt(t.token_string);
len_obj1:=t.token_string;
Estado := 6;
end
else
begin
raise Exception.Create('ERROR: Arquivo corrompido.');
Halt(1);
end;
end;
6:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoPageContents.automata Estado 6');
{$endif}
if(t.token_string = 'Filter') then
begin
Estado := 7;
end
else if (t.token_string = 'stream') then
begin
contentsFound := true;
Estado := 9; // symbolic state
end
else if (t.tipo = 1) then
begin
len_obj2:=t.token_string;
myAnLexicoLength := AnLexico.Create;
myAnLexicoLength.Doc := Input;
myAnLexicoLength.bytesRemaining:= myAnLexicoLength.Doc.Size;
myAnSintaticoLength := AnSintaticoLength.Create;
myAnSintaticoLength.len_obj1:=len_obj1;
myAnSintaticoLength.len_obj2:=len_obj2;
while ((myAnSintaticoLength.lenghtFound <> true) and
(myAnLexicoLength.bytesRemaining > 0)) do
begin
mytokenLength := myAnLexicoLength.getToken();
myAnSintaticoLength.automata(mytokenLength);
end;
if (myAnSintaticoLength.lenghtFound = false) then
begin
raise Exception.Create('ERROR: Arquivo corrompido.');
Halt(1);
end;
h.page_length:=myAnSintaticoLength.page_length;
myAnLexicoLength.Doc.Destroy;
Estado := 6;
end
else
begin
Estado := 6;
end;
end;
7:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoPageContents.automata Estado 7');
{$endif}
if(t.token_string = 'FlateDecode') then
begin
h.flate_decode := true;
Estado := 8;
end
else
begin
raise Exception.Create('ERROR: Encodificacao nao suportada.');
Halt(1);
end;
end;
8:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoPageContents.automata Estado 8');
{$endif}
if(t.token_string = 'stream') then
begin
contentsFound := true;
Estado := 9; // symbolic state
end
else if (t.token_string = 'Length') then
begin
Estado := 5;
end
else
begin
Estado := 8;
end;
end;
else
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoPageContents.automata Estado ELSE');
{$endif}
Estado := 1;
end;
end;
procedure AnSintaticoLength.automata(t: Token);
begin
case Estado of
1:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoLength.automata Estado 1');
{$endif}
if(t.token_string = len_obj1) then
begin
Estado := 2;
end
else
begin
Estado := 1;
end;
end;
2:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoLength.automata Estado 2');
{$endif}
if(t.token_string = len_obj2) then
begin
Estado := 3;
end
else
begin
Estado := 1;
end;
end;
3:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoLength.automata Estado 3');
{$endif}
if(t.token_string = 'obj') then
begin
Estado := 4;
end
else
begin
Estado := 1;
end;
end;
4:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoLength.automata Estado 4 Length: ', StrToInt(t.token_string));
{$endif}
if(t.tipo = 1) then
begin
page_length:=StrToInt(t.token_string);
lenghtFound:=true;
Estado := 5; // symbolic state
end
else
begin
raise Exception.Create('ERROR: Arquivo corrompido.');
Halt(1);
end;
end;
else
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoLength.automata Estado ELSE');
{$endif}
Estado := 1;
end;
end;
function AnSintaticoCommand.automata(t: Token):Command;
begin
c.cord_x3 := c.cord_y3;
c.cord_y3 := c.cord_x2;
c.cord_x2 := c.cord_y2;
c.cord_y2 := c.cord_x;
c.cord_x := c.cord_y;
c.cord_y := c.my_operator;
c.my_operator := t.token_string;
c.code := cc_NONE;
Codigo := false;
case Estado of
1:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoCommand.automata Estado 1');
{$endif}
if(t.tipo = 1) then // numbers 1
begin
Estado := 2;
end
else if( t.token_string = 'h' ) then // command h
begin
Estado := 9; // symbolic state
Estado := 1;
Codigo := true;
c.code:=cc_H_CLOSE_PATH;
Result:=c;
end
else if( t.token_string = 's' ) then // command s
begin
Estado := 10; // symbolic state
Estado := 1;
Codigo := true;
c.code:=cc_hS_CLOSE_AND_END_PATH;
Result:=c;
end
else if( t.token_string = 'S' ) then // command S
begin
Estado := 11; // symbolic state
Estado := 1;
Codigo := true;
c.code:=cc_S_END_PATH;
Result:=c;
end
else if( t.token_string = 'Q' ) then // command Q
begin
Estado := 21; // symbolic state
Estado := 1;
Codigo := true;
c.code:=cc_RESTORE_MATRIX;
Result:=c;
end
else if ((t.token_string = 'f') or (t.token_string = 'F')
or (t.token_string = 'f*') or (t.token_string = 'B')
or (t.token_string = 'B*') or (t.token_string = 'b')
or (t.token_string = 'b*') or (t.token_string = 'n')) then
begin
Estado := 12; // symbolic state
Estado := 1;
Codigo := true;
c.code:=cc_hS_CLOSE_AND_END_PATH; // ignore painting..
Result:=c;
//raise Exception.Create('ERROR: Prenchimento nao eh suportado.');
//Halt(1);
end
else if ((t.token_string = 'W') or (t.token_string = 'W*')) then
begin
Estado := 13; // symbolic state
raise Exception.Create('ERROR: Clipping nao eh suportado.');
Halt(1);
end
else
begin
Estado := 1;
end;
end;
2:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoCommand.automata Estado 2');
{$endif}
if(t.tipo = 1) then // numbers 2
begin
Estado := 3;
end
else
begin
Estado := 1;
end;
end;
3:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoCommand.automata Estado 3');
{$endif}
if(t.tipo = 1) then // numbers 3
begin
Estado := 5;
end
else if(t.token_string = 'l') then // command l
begin
Estado := 14; // symbolic state
Estado := 1;
c.code:=cc_l_ADD_LINE_TO_PATH;
Codigo := true;
Result:=c;
end
else if(t.token_string = 'm') then // command m
begin
Estado := 15; // symbolic state
Estado := 1;
c.code:=cc_m_START_PATH;
Codigo := true;
Result:=c;
end
else
begin
Estado := 1;
end;
end;
5:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoCommand.automata Estado 5');
{$endif}
if(t.tipo = 1) then // numbers 4
begin
Estado := 6;
end
else
begin
Estado := 1;
end;
end;
6:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoCommand.automata Estado 6');
{$endif}
if(t.tipo = 1) then // numbers 5
begin
Estado := 7;
end
else if( t.token_string = 'v' ) then // command v
begin
Estado := 16; // symbolic state
raise Exception.Create('ERROR: Curva de bezier nao eh suportada.');
Halt(1);
end
else if( t.token_string = 'y' ) then // command y
begin
Estado := 17; // symbolic state
raise Exception.Create('ERROR: Curva de bezier nao eh suportada.');
Halt(1);
end
else if( t.token_string = 're' ) then // command re
begin
Estado := 18; // symbolic state
raise Exception.Create('ERROR: Comando nao suportado.');
Halt(1);
end
else
begin
Estado := 1;
end;
end;
7:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoCommand.automata Estado 7');
{$endif}
if(t.tipo = 1) then // numbers 6
begin
Estado := 8;
end
else
begin
Estado := 1;
end;
end;
8:
begin
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoCommand.automata Estado 8');
{$endif}
if(t.token_string = 'c') then // commmand c
begin
Estado := 19; // symbolic state
Estado := 1;
c.code:=cc_c_BEZIER_TO_X_Y_USING_X2_Y2_AND_X3_Y3;
Codigo := true;
Result:=c;
end
else if( t.token_string = 'cm' ) then // command cm
begin
Estado := 20; // symbolic state
Estado := 1;
c.code:=cc_CONCATENATE_MATRIX;
Codigo := true;
Result:=c;
end
else
begin
Estado := 1;
end;
end;
else
{$ifdef FPVECTORIALDEBUG}
WriteLn(':> AnSintaticoCommand.automata Estado ELSE');
{$endif}
Estado := 1;
end;
end;
constructor AnSintaticoCommand.Create;
begin
inherited Create;
Estado := 1;
end;
constructor AnSintaticoPage.Create;
begin
inherited Create;
Estado := 1;
pageFound := false;
end;
constructor AnSintaticoPageContents.Create;
begin
inherited Create;
Estado := 1;
contentsFound := false;
h.flate_decode := false;
end;
constructor AnSintaticoLength.Create;
begin
inherited Create;
Estado := 1;
lenghtFound := false;
end;
end.

369
components/fpvectorial/svgvectorialreader.pas Normal file
View File

@ -0,0 +1,369 @@
{
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: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadPathFromString(AStr: string; AData: TvVectorialPage; ADoc: TvVectorialDocument);
function StringWithUnitToFloat(AStr: string): Single;
procedure ConvertSVGCoordinatesToFPVCoordinates(
const AData: TvVectorialPage;
const ASrcX, ASrcY: Float; var ADestX, ADestY: Float);
procedure ConvertSVGDeltaToFPVDelta(
const AData: TvVectorialPage;
const ASrcX, ASrcY: Float; var ADestX, ADestY: Float);
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);
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: TvVectorialPage; ADoc: 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, ADoc);
AData.EndPath();
end;
procedure TvSVGVectorialReader.ReadPathFromString(AStr: string;
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
i: Integer;
X, Y, X2, Y2, X3, Y3: Float;
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;
ConvertSVGCoordinatesToFPVCoordinates(AData, CurX, CurY, CurX, CurY);
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;
ConvertSVGDeltaToFPVDelta(AData, X, Y, X, Y);
// LineTo uses relative coordenates in SVG
CurX := CurX + X;
CurY := CurY + Y;
AData.AddLineToPath(CurX, CurY);
Inc(i, 3);
end
else if FSVGPathTokenizer.Tokens.Items[i].TokenType = sttBezierTo then
begin
X2 := FSVGPathTokenizer.Tokens.Items[i+1].Value;
Y2 := FSVGPathTokenizer.Tokens.Items[i+2].Value;
X3 := FSVGPathTokenizer.Tokens.Items[i+3].Value;
Y3 := FSVGPathTokenizer.Tokens.Items[i+4].Value;
X := FSVGPathTokenizer.Tokens.Items[i+5].Value;
Y := FSVGPathTokenizer.Tokens.Items[i+6].Value;
ConvertSVGDeltaToFPVDelta(AData, X2, Y2, X2, Y2);
ConvertSVGDeltaToFPVDelta(AData, X3, Y3, X3, Y3);
ConvertSVGDeltaToFPVDelta(AData, X, Y, X, Y);
AData.AddBezierToPath(X2 + CurX, Y2 + CurY, X3 + CurX, Y3 + CurY, X + CurX, Y + CurY);
// BezierTo uses relative coordenates in SVG
CurX := CurX + X;
CurY := CurY + Y;
Inc(i, 7);
end
else
begin
Inc(i);
end;
end;
end;
function TvSVGVectorialReader.StringWithUnitToFloat(AStr: string): Single;
var
UnitStr, ValueStr: string;
Len: Integer;
begin
// Check the unit
Len := Length(AStr);
UnitStr := Copy(AStr, Len-1, 2);
if UnitStr = 'mm' then
begin
ValueStr := Copy(AStr, 1, Len-2);
Result := StrToInt(ValueStr);
end;
end;
procedure TvSVGVectorialReader.ConvertSVGCoordinatesToFPVCoordinates(
const AData: TvVectorialPage; const ASrcX, ASrcY: Float;
var ADestX,ADestY: Float);
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);
begin
ADestX := ASrcX * FLOAT_MILIMETERS_PER_PIXEL;
ADestY := - ASrcY * FLOAT_MILIMETERS_PER_PIXEL;
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;
lPage: TvVectorialPage;
begin
try
// Read in xml file from the stream
ReadXMLFile(Doc, AStream);
// Read the properties of the <svg> tag
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;
lPage := AData.AddPage();
lPage.Width := AData.Width;
lPage.Height := AData.Height;
while Assigned(lCurNode) do
begin
ReadPathFromNode(lCurNode, lPage, AData);
lCurNode := lCurNode.NextSibling;
end;
finally
// finally, free the document
Doc.Free;
end;
end;
initialization
RegisterVectorialReader(TvSVGVectorialReader, vfSVG);
end.

275
components/fpvectorial/svgvectorialwriter.pas Normal file
View File

@ -0,0 +1,275 @@
{
Writes 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 svgvectorialwriter;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, math, fpvectorial, fpvutils, fpcanvas;
type
{ TvSVGVectorialWriter }
TvSVGVectorialWriter = class(TvCustomVectorialWriter)
private
FPointSeparator, FCommaSeparator: TFormatSettings;
procedure WriteDocumentSize(AStrings: TStrings; AData: TvVectorialDocument);
procedure WriteDocumentName(AStrings: TStrings; AData: TvVectorialDocument);
procedure WritePath(AIndex: Integer; APath: TPath; AStrings: TStrings; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure WriteText(AStrings: TStrings; lText: TvText; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure WriteEntities(AStrings: TStrings; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ConvertFPVCoordinatesToSVGCoordinates(
const AData: TvVectorialPage;
const ASrcX, ASrcY: Double; var ADestX, ADestY: double);
public
{ General reading methods }
procedure WriteToStrings(AStrings: TStrings; 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
{ TvSVGVectorialWriter }
procedure TvSVGVectorialWriter.WriteDocumentSize(AStrings: TStrings; AData: TvVectorialDocument);
begin
AStrings.Add(' width="' + FloatToStr(AData.Width, FPointSeparator) + 'mm"');
AStrings.Add(' height="' + FloatToStr(AData.Height, FPointSeparator) + 'mm"');
end;
procedure TvSVGVectorialWriter.WriteDocumentName(AStrings: TStrings; AData: TvVectorialDocument);
begin
AStrings.Add(' sodipodi:docname="New document 1">');
end;
{@@
SVG Coordinate system measures things only in pixels, so that we have to
hardcode a DPI value for the screen, which is usually 72.
FPVectorial uses only milimeters (mm).
The initial point in FPVectorial is in the bottom-left corner of the document
and it grows to the top and to the right. In SVG, on the other hand, the
initial point is in the top-left corner, growing to the bottom and right.
Besides that, coordinates in SVG are also lengths in comparison to the
previous point and not absolute coordinates.
SVG uses commas "," to separate the X,Y coordinates, so it always uses points
"." as decimal separators and uses no thousand separators
}
procedure TvSVGVectorialWriter.WritePath(AIndex: Integer; APath: TPath; AStrings: TStrings;
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
j: Integer;
PathStr: string;
PtX, PtY, OldPtX, OldPtY: double;
BezierCP1X, BezierCP1Y, BezierCP2X, BezierCP2Y: double;
segment: TPathSegment;
l2DSegment: T2DSegment absolute segment;
l2DBSegment: T2DBezierSegment absolute segment;
// Pen properties
lPenWidth: Integer;
lPenColor: string;
// Brush properties
lFillColor: string;
begin
OldPtX := 0;
OldPtY := 0;
PathStr := '';
APath.PrepareForSequentialReading();
for j := 0 to APath.Len - 1 do
begin
segment := TPathSegment(APath.Next());
if (segment.SegmentType <> st2DLine)
and (segment.SegmentType <> stMoveTo)
and (segment.SegmentType <> st2DBezier)
then Break; // unsupported line type
// Coordinate conversion from fpvectorial to SVG
ConvertFPVCoordinatesToSVGCoordinates(
AData, l2DSegment.X, l2DSegment.Y, PtX, PtY);
PtX := PtX - OldPtX;
PtY := PtY - OldPtY;
if (segment.SegmentType = stMoveTo) then
begin
PathStr := PathStr + 'm '
+ FloatToStr(PtX, FPointSeparator) + ','
+ FloatToStr(PtY, FPointSeparator) + ' ';
end
else if (segment.SegmentType = st2DLine) then
begin
PathStr := PathStr + 'l '
+ FloatToStr(PtX, FPointSeparator) + ','
+ FloatToStr(PtY, FPointSeparator) + ' ';
end
else if (segment.SegmentType = st2DBezier) then
begin
// Converts all coordinates to absolute values
ConvertFPVCoordinatesToSVGCoordinates(
AData, l2DBSegment.X2, l2DBSegment.Y2, BezierCP1X, BezierCP1Y);
ConvertFPVCoordinatesToSVGCoordinates(
AData, l2DBSegment.X3, l2DBSegment.Y3, BezierCP2X, BezierCP2Y);
// Transforms them into values relative to the initial point
BezierCP1X := BezierCP1X - OldPtX;
BezierCP1Y := BezierCP1Y - OldPtY;
BezierCP2X := BezierCP2X - OldPtX;
BezierCP2Y := BezierCP2Y - OldPtY;
// PtX and PtY already contains the destination point
// Now render our 2D cubic bezier
PathStr := PathStr + 'c '
+ FloatToStr(BezierCP1X, FPointSeparator) + ','
+ FloatToStr(BezierCP1Y, FPointSeparator) + ' '
+ FloatToStr(BezierCP2X, FPointSeparator) + ','
+ FloatToStr(BezierCP2Y, FPointSeparator) + ' '
+ FloatToStr(PtX, FPointSeparator) + ','
+ FloatToStr(PtY, FPointSeparator) + ' '
;
end;
// Store the current position for future points
OldPtX := OldPtX + PtX;
OldPtY := OldPtY + PtY;
end;
// Get the Pen Width
if APath.Pen.Width >= 1 then lPenWidth := APath.Pen.Width
else lPenWidth := 1;
// Get the Pen Color and Style
if APath.Pen.Style = psClear then lPenColor := 'none'
else lPenColor := '#' + FPColorToRGBHexString(APath.Pen.Color);
// Get the Brush color and style
if APath.Brush.Style = bsClear then lFillColor := 'none'
else lFillColor := '#' + FPColorToRGBHexString(APath.Brush.Color);
// Now effectively write the path
AStrings.Add(' <path');
AStrings.Add(Format(' style="fill:%s;stroke:%s;stroke-width:%dpx;'
+ 'stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"',
[lFillColor, lPenColor, lPenWidth]));
AStrings.Add(' d="' + PathStr + '"');
AStrings.Add(' id="path' + IntToStr(AIndex) + '" />');
end;
procedure TvSVGVectorialWriter.ConvertFPVCoordinatesToSVGCoordinates(
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 TvSVGVectorialWriter.WriteToStrings(AStrings: TStrings;
AData: TvVectorialDocument);
var
lPage: TvVectorialPage;
begin
// Format seetings to convert a string to a float
FPointSeparator := DefaultFormatSettings;
FPointSeparator.DecimalSeparator := '.';
FPointSeparator.ThousandSeparator := '#';// disable the thousand separator
FCommaSeparator := DefaultFormatSettings;
FCommaSeparator.DecimalSeparator := ',';
FCommaSeparator.ThousandSeparator := '#';// disable the thousand separator
// Headers
AStrings.Add('<?xml version="1.0" encoding="UTF-8" standalone="no"?>');
AStrings.Add('<!-- Created with fpVectorial (http://wiki.lazarus.freepascal.org/fpvectorial) -->');
AStrings.Add('');
AStrings.Add('<svg');
AStrings.Add(' xmlns:dc="http://purl.org/dc/elements/1.1/"');
AStrings.Add(' xmlns:cc="http://creativecommons.org/ns#"');
AStrings.Add(' xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"');
AStrings.Add(' xmlns:svg="http://www.w3.org/2000/svg"');
AStrings.Add(' xmlns="http://www.w3.org/2000/svg"');
AStrings.Add(' xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"');
WriteDocumentSize(AStrings, AData);
AStrings.Add(' id="svg2"');
AStrings.Add(' version="1.1"');
WriteDocumentName(AStrings, AData);
// Now data
AStrings.Add(' <g id="layer1">');
lPage := AData.GetPage(0);
WriteEntities(AStrings, lPage, AData);
AStrings.Add(' </g>');
// finalization
AStrings.Add('</svg>');
end;
procedure TvSVGVectorialWriter.WriteText(AStrings: TStrings; lText: TvText;
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
i, j, FontSize: Integer;
TextStr, FontName, SVGFontFamily: string;
PtX, PtY: double;
begin
TextStr := '';
ConvertFPVCoordinatesToSVGCoordinates(
AData, lText.X, lText.Y, PtX, PtY);
TextStr := lText.Value.Text;
FontSize:= ceil(lText.Font.Size / FLOAT_MILIMETERS_PER_PIXEL);
SVGFontFamily := 'Arial, sans-serif';//lText.FontName;
AStrings.Add(' <text ');
AStrings.Add(' x="' + FloatToStr(PtX, FPointSeparator) + '"');
AStrings.Add(' y="' + FloatToStr(PtY, FPointSeparator) + '"');
// AStrings.Add(' font-size="' + IntToStr(FontSize) + '"'); Doesn't seam to work, we need to use the tspan
AStrings.Add(' font-family="' + SVGFontFamily + '">');
AStrings.Add(' <tspan ');
AStrings.Add(' style="font-size:' + IntToStr(FontSize) + '" ');
// AStrings.Add(' id="tspan2828" ');
AStrings.Add(' >');
AStrings.Add(TextStr + '</tspan></text>');
end;
procedure TvSVGVectorialWriter.WriteEntities(AStrings: TStrings;
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
lEntity: TvEntity;
i, j: Integer;
begin
for i := 0 to AData.GetEntitiesCount() - 1 do
begin
lEntity := AData.GetEntity(i);
if lEntity is TPath then WritePath(i, TPath(lEntity), AStrings, AData, ADoc)
else if lEntity is TvText then WriteText(AStrings, TvText(lEntity), AData, ADoc);
end;
end;
initialization
RegisterVectorialWriter(TvSVGVectorialWriter, vfSVG);
end.