fpvectorial: Large rework: Removes from compilation the old PDF support and changes everything to a new architecture with multiple page support

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1913 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat 2011-09-07 11:04:33 +00:00
parent bbc5a584ba
commit 628c2fe4ab
13 changed files with 622 additions and 565 deletions

View File

@ -28,7 +28,7 @@ type
private
LastX, LastY, LastZ: Double;
function SeparateString(AString: string; ASeparator: Char): T10Strings;
procedure ReadString(AStr: string; AData: TvVectorialDocument);
procedure ReadString(AStr: string; AData: TvVectorialPage);
function GetCoordinate(AStr: shortstring): Integer;
function GetCoordinateValue(AStr: shortstring): Double;
public
@ -91,7 +91,7 @@ begin
end;
procedure TvAvisoCNCGCodeReader.ReadString(AStr: string;
AData: TvVectorialDocument);
AData: TvVectorialPage);
var
AParams: T10Strings;
DestX, DestY, DestZ: Double;
@ -210,20 +210,22 @@ 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}
AData.StartPath(0, 0);
FirstPage := AData.AddPage();
FirstPage.StartPath(0, 0);
for i := 0 to AStrings.Count - 1 do
ReadString(AStrings.Strings[i], AData);
ReadString(AStrings.Strings[i], FirstPage);
{$ifdef FPVECTORIALDEBUG}
WriteLn('AData.EndPath');
{$endif}
AData.EndPath();
FirstPage.EndPath();
end;
initialization

View File

@ -21,6 +21,8 @@ type
{ TvAvisoCNCGCodeWriter }
TvAvisoCNCGCodeWriter = class(TvCustomVectorialWriter)
private
procedure WritePageToStrings(AStrings: TStrings; AData: TvVectorialPage);
public
{ General reading methods }
procedure WriteToStrings(AStrings: TStrings; AData: TvVectorialDocument); override;
@ -30,8 +32,8 @@ implementation
{ TvGCodeVectorialWriter }
procedure TvAvisoCNCGCodeWriter.WriteToStrings(AStrings: TStrings;
AData: TvVectorialDocument);
procedure TvAvisoCNCGCodeWriter.WritePageToStrings(AStrings: TStrings;
AData: TvVectorialPage);
var
i, j: Integer;
Str: string;
@ -40,6 +42,7 @@ var
Cur3DSegment: T3DSegment;
Cur2DBezierSegment: T2DBezierSegment;
Cur3DBezierSegment: T3DBezierSegment;
lEntity: TvEntity;
begin
AStrings.Clear;
@ -48,9 +51,11 @@ begin
AStrings.Add('G00');
// itera por todos os itens
for i := 0 to AData.GetPathCount - 1 do
for i := 0 to AData.GetEntitiesCount - 1 do
begin
APath := AData.GetPath(i);
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');
@ -97,6 +102,15 @@ begin
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);

View File

@ -23,7 +23,7 @@ interface
uses
Classes, SysUtils,
pdfvrlexico, pdfvrsintatico, pdfvrsemantico, avisozlib,
//avisozlib,
fpvectorial;
type

View File

@ -87,21 +87,21 @@ type
IsReadingPolyline: Boolean;
Polyline: array of TPolylineElement;
//
procedure ReadHEADER(ATokens: TDXFTokens; AData: TvVectorialDocument);
procedure ReadENTITIES(ATokens: TDXFTokens; AData: TvVectorialDocument);
procedure ReadENTITIES_LINE(ATokens: TDXFTokens; AData: TvVectorialDocument);
procedure ReadENTITIES_ARC(ATokens: TDXFTokens; AData: TvVectorialDocument);
procedure ReadENTITIES_CIRCLE(ATokens: TDXFTokens; AData: TvVectorialDocument);
procedure ReadENTITIES_DIMENSION(ATokens: TDXFTokens; AData: TvVectorialDocument);
procedure ReadENTITIES_ELLIPSE(ATokens: TDXFTokens; AData: TvVectorialDocument);
procedure ReadENTITIES_TEXT(ATokens: TDXFTokens; AData: TvVectorialDocument);
procedure ReadENTITIES_LWPOLYLINE(ATokens: TDXFTokens; AData: TvVectorialDocument);
procedure ReadENTITIES_SPLINE(ATokens: TDXFTokens; AData: TvVectorialDocument);
procedure ReadENTITIES_POLYLINE(ATokens: TDXFTokens; AData: TvVectorialDocument);
procedure ReadENTITIES_VERTEX(ATokens: TDXFTokens; AData: TvVectorialDocument);
procedure ReadENTITIES_SEQEND(ATokens: TDXFTokens; AData: TvVectorialDocument);
procedure ReadENTITIES_MTEXT(ATokens: TDXFTokens; AData: TvVectorialDocument);
procedure ReadENTITIES_POINT(ATokens: TDXFTokens; AData: TvVectorialDocument);
procedure ReadHEADER(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadENTITIES(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadENTITIES_LINE(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadENTITIES_ARC(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadENTITIES_CIRCLE(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadENTITIES_DIMENSION(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadENTITIES_ELLIPSE(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadENTITIES_TEXT(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadENTITIES_LWPOLYLINE(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadENTITIES_SPLINE(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadENTITIES_POLYLINE(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadENTITIES_VERTEX(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadENTITIES_SEQEND(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadENTITIES_MTEXT(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadENTITIES_POINT(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
function GetCoordinateValue(AStr: shortstring): Double;
//
function DXFColorIndexToFPColor(AColorIndex: Integer): TFPColor;
@ -344,7 +344,7 @@ end;
{ TvDXFVectorialReader }
procedure TvDXFVectorialReader.ReadHEADER(ATokens: TDXFTokens;
AData: TvVectorialDocument);
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
i, j: Integer;
CurToken: TDXFToken;
@ -432,7 +432,7 @@ begin
end;
end;
procedure TvDXFVectorialReader.ReadENTITIES(ATokens: TDXFTokens; AData: TvVectorialDocument);
procedure TvDXFVectorialReader.ReadENTITIES(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
i: Integer;
CurToken: TDXFToken;
@ -442,26 +442,26 @@ begin
for i := 0 to ATokens.Count - 1 do
begin
CurToken := TDXFToken(ATokens.Items[i]);
if CurToken.StrValue = 'ARC' then ReadENTITIES_ARC(CurToken.Childs, AData)
else if CurToken.StrValue = 'CIRCLE' then ReadENTITIES_CIRCLE(CurToken.Childs, AData)
else if CurToken.StrValue = 'DIMENSION' then ReadENTITIES_DIMENSION(CurToken.Childs, AData)
else if CurToken.StrValue = 'ELLIPSE' then ReadENTITIES_ELLIPSE(CurToken.Childs, AData)
else if CurToken.StrValue = 'LINE' then ReadENTITIES_LINE(CurToken.Childs, AData)
else if CurToken.StrValue = 'TEXT' then ReadENTITIES_TEXT(CurToken.Childs, AData)
else if CurToken.StrValue = 'LWPOLYLINE' then ReadENTITIES_LWPOLYLINE(CurToken.Childs, AData)
else if CurToken.StrValue = 'SPLINE' then ReadENTITIES_SPLINE(CurToken.Childs, AData)
else if CurToken.StrValue = 'POINT' then ReadENTITIES_POINT(CurToken.Childs, AData)
else if CurToken.StrValue = 'MTEXT' then ReadENTITIES_MTEXT(CurToken.Childs, AData)
if CurToken.StrValue = 'ARC' then ReadENTITIES_ARC(CurToken.Childs, AData, ADoc)
else if CurToken.StrValue = 'CIRCLE' then ReadENTITIES_CIRCLE(CurToken.Childs, AData, ADoc)
else if CurToken.StrValue = 'DIMENSION' then ReadENTITIES_DIMENSION(CurToken.Childs, AData, ADoc)
else if CurToken.StrValue = 'ELLIPSE' then ReadENTITIES_ELLIPSE(CurToken.Childs, AData, ADoc)
else if CurToken.StrValue = 'LINE' then ReadENTITIES_LINE(CurToken.Childs, AData, ADoc)
else if CurToken.StrValue = 'TEXT' then ReadENTITIES_TEXT(CurToken.Childs, AData, ADoc)
else if CurToken.StrValue = 'LWPOLYLINE' then ReadENTITIES_LWPOLYLINE(CurToken.Childs, AData, ADoc)
else if CurToken.StrValue = 'SPLINE' then ReadENTITIES_SPLINE(CurToken.Childs, AData, ADoc)
else if CurToken.StrValue = 'POINT' then ReadENTITIES_POINT(CurToken.Childs, AData, ADoc)
else if CurToken.StrValue = 'MTEXT' then ReadENTITIES_MTEXT(CurToken.Childs, AData, ADoc)
// A Polyline can have multiple child objects
else if CurToken.StrValue = 'POLYLINE' then
begin
IsReadingPolyline := True;
ReadENTITIES_POLYLINE(CurToken.Childs, AData);
ReadENTITIES_POLYLINE(CurToken.Childs, AData, ADoc);
end
else if CurToken.StrValue = 'VERTEX' then ReadENTITIES_VERTEX(CurToken.Childs, AData)
else if CurToken.StrValue = 'VERTEX' then ReadENTITIES_VERTEX(CurToken.Childs, AData, ADoc)
else if CurToken.StrValue = 'SEQEND' then
begin
ReadENTITIES_SEQEND(CurToken.Childs, AData);
ReadENTITIES_SEQEND(CurToken.Childs, AData, ADoc);
IsReadingPolyline := False;
end
else
@ -471,7 +471,7 @@ begin
end;
end;
procedure TvDXFVectorialReader.ReadENTITIES_LINE(ATokens: TDXFTokens; AData: TvVectorialDocument);
procedure TvDXFVectorialReader.ReadENTITIES_LINE(ATokens: TDXFTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
CurToken: TDXFToken;
i: Integer;
@ -541,7 +541,7 @@ Arcs are always counter-clockwise in DXF
220, 230 DXF: Y and Z values of extrusion direction (optional)
}
procedure TvDXFVectorialReader.ReadENTITIES_ARC(ATokens: TDXFTokens;
AData: TvVectorialDocument);
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
CurToken: TDXFToken;
i: Integer;
@ -604,7 +604,7 @@ Group codes Description
220, 230 DXF: Y and Z values of extrusion direction (optional)
}
procedure TvDXFVectorialReader.ReadENTITIES_CIRCLE(ATokens: TDXFTokens;
AData: TvVectorialDocument);
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
CurToken: TDXFToken;
i: Integer;
@ -703,7 +703,7 @@ Aligned Dimension Group Codes
X->14,24 X->13,23
}
procedure TvDXFVectorialReader.ReadENTITIES_DIMENSION(ATokens: TDXFTokens;
AData: TvVectorialDocument);
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
CurToken: TDXFToken;
i: Integer;
@ -815,7 +815,7 @@ end;
42 End parameter (this value is 2pi for a full ellipse)
}
procedure TvDXFVectorialReader.ReadENTITIES_ELLIPSE(ATokens: TDXFTokens;
AData: TvVectorialDocument);
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
CurToken: TDXFToken;
i: Integer;
@ -880,7 +880,7 @@ end;
See the Group 72 and 73 integer codes table for clarification.
}
procedure TvDXFVectorialReader.ReadENTITIES_TEXT(ATokens: TDXFTokens;
AData: TvVectorialDocument);
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
CurToken: TDXFToken;
i: Integer;
@ -920,7 +920,7 @@ end;
{.$define FPVECTORIALDEBUG_LWPOLYLINE}
procedure TvDXFVectorialReader.ReadENTITIES_LWPOLYLINE(ATokens: TDXFTokens;
AData: TvVectorialDocument);
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
CurToken: TDXFToken;
i, curPoint: Integer;
@ -978,7 +978,7 @@ end;
{.$define FPVECTORIALDEBUG_SPLINE}
procedure TvDXFVectorialReader.ReadENTITIES_SPLINE(ATokens: TDXFTokens;
AData: TvVectorialDocument);
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
CurToken: TDXFToken;
i, curPoint: Integer;
@ -1035,13 +1035,13 @@ begin
end;
procedure TvDXFVectorialReader.ReadENTITIES_POLYLINE(ATokens: TDXFTokens;
AData: TvVectorialDocument);
AData: TvVectorialPage; ADoc: TvVectorialDocument);
begin
SetLength(Polyline, 0);
end;
procedure TvDXFVectorialReader.ReadENTITIES_VERTEX(ATokens: TDXFTokens;
AData: TvVectorialDocument);
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
CurToken: TDXFToken;
i, curPoint: Integer;
@ -1077,7 +1077,7 @@ end;
{$define FPVECTORIALDEBUG_POLYLINE}
procedure TvDXFVectorialReader.ReadENTITIES_SEQEND(ATokens: TDXFTokens;
AData: TvVectorialDocument);
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
i: Integer;
begin
@ -1105,7 +1105,7 @@ begin
end;
procedure TvDXFVectorialReader.ReadENTITIES_MTEXT(ATokens: TDXFTokens;
AData: TvVectorialDocument);
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
CurToken: TDXFToken;
i: Integer;
@ -1144,7 +1144,7 @@ begin
end;
procedure TvDXFVectorialReader.ReadENTITIES_POINT(ATokens: TDXFTokens;
AData: TvVectorialDocument);
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
CurToken: TDXFToken;
i: Integer;
@ -1229,18 +1229,21 @@ procedure TvDXFVectorialReader.ReadFromStrings(AStrings: TStrings;
var
i: Integer;
CurToken, CurTokenFirstChild: TDXFToken;
lPage: TvVectorialPage;
begin
Tokenizer.ReadFromStrings(AStrings);
lPage := AData.AddPage();
for i := 0 to Tokenizer.Tokens.Count - 1 do
begin
CurToken := TDXFToken(Tokenizer.Tokens.Items[i]);
CurTokenFirstChild := TDXFToken(CurToken.Childs.Items[0]);
if CurTokenFirstChild.StrValue = 'HEADER' then
ReadHEADER(CurToken.Childs, AData)
ReadHEADER(CurToken.Childs, lPage, AData)
else if CurTokenFirstChild.StrValue = 'ENTITIES' then
ReadENTITIES(CurToken.Childs, AData);
ReadENTITIES(CurToken.Childs, lPage, AData);
end;
end;

View File

@ -115,22 +115,22 @@ type
//
procedure DebugStack();
//
procedure RunPostScript(ATokens: TPsTokens; AData: TvVectorialDocument);
procedure RunPostScript(ATokens: TPsTokens; AData: TvVectorialPage; ADoc: TvVectorialDocument);
//
procedure ExecuteProcedureToken(AToken: TProcedureToken; AData: TvVectorialDocument);
procedure ExecuteOperatorToken(AToken: TExpressionToken; AData: TvVectorialDocument);
function ExecuteArithmeticAndMathOperator(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
function ExecutePathConstructionOperator(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
function ExecuteGraphicStateOperatorsDI(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
function ExecuteGraphicStateOperatorsDD(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
function ExecuteDictionaryOperators(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
function ExecuteMiscellaneousOperators(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
function ExecuteStackManipulationOperator(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
function ExecuteControlOperator(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
function ExecutePaintingOperator(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
function ExecuteDeviceSetupAndOutputOperator(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
function ExecuteArrayOperator(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
function ExecuteStringOperator(AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
procedure ExecuteProcedureToken(AToken: TProcedureToken; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ExecuteOperatorToken(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument);
function ExecuteArithmeticAndMathOperator(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
function ExecutePathConstructionOperator(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
function ExecuteGraphicStateOperatorsDI(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
function ExecuteGraphicStateOperatorsDD(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
function ExecuteDictionaryOperators(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
function ExecuteMiscellaneousOperators(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
function ExecuteStackManipulationOperator(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
function ExecuteControlOperator(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
function ExecutePaintingOperator(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
function ExecuteDeviceSetupAndOutputOperator(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
function ExecuteArrayOperator(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
function ExecuteStringOperator(AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
//
procedure PostScriptCoordsToFPVectorialCoords(AParam1, AParam2: TPSToken; var APosX, APosY: Double);
function DictionarySubstituteOperator(ADictionary: TStringList; var ACurToken: TPSToken): Boolean;
@ -461,7 +461,7 @@ begin
end;
procedure TvEPSVectorialReader.RunPostScript(ATokens: TPsTokens;
AData: TvVectorialDocument);
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
i: Integer;
lSubstituted: Boolean;
@ -530,8 +530,8 @@ begin
Continue;
end;
if CurToken is TProcedureToken then ExecuteProcedureToken(TProcedureToken(CurToken), AData)
else ExecuteOperatorToken(TExpressionToken(CurToken), AData);
if CurToken is TProcedureToken then ExecuteProcedureToken(TProcedureToken(CurToken), AData, ADoc)
else ExecuteOperatorToken(TExpressionToken(CurToken), AData, ADoc);
if ExitCalled then Break;
end;
@ -542,7 +542,7 @@ begin
end;
procedure TvEPSVectorialReader.ExecuteProcedureToken(AToken: TProcedureToken;
AData: TvVectorialDocument);
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
ProcTokenizer: TPSTokenizer;
lStream: TMemoryStream;
@ -588,42 +588,42 @@ begin
end;
// Now run the procedure
RunPostScript(AToken.Childs, AData);
RunPostScript(AToken.Childs, AData, ADoc);
{$ifdef FPVECTORIALDEBUG_CODEFLOW}
WriteLn('[TvEPSVectorialReader.ExecuteProcedureToken] END');
{$endif}
end;
procedure TvEPSVectorialReader.ExecuteOperatorToken(AToken: TExpressionToken;
AData: TvVectorialDocument);
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
Param1, Param2: TPSToken;
begin
if AToken.StrValue = '' then raise Exception.Create('[TvEPSVectorialReader.ProcessExpressionToken] Empty operator');
if ExecuteDictionaryOperators(AToken, AData) then Exit;
if ExecuteDictionaryOperators(AToken, AData, ADoc) then Exit;
if ExecuteArithmeticAndMathOperator(AToken, AData) then Exit;
if ExecuteArithmeticAndMathOperator(AToken, AData, ADoc) then Exit;
if ExecutePathConstructionOperator(AToken, AData) then Exit;
if ExecutePathConstructionOperator(AToken, AData, ADoc) then Exit;
if ExecuteGraphicStateOperatorsDI(AToken, AData) then Exit;
if ExecuteGraphicStateOperatorsDI(AToken, AData, ADoc) then Exit;
if ExecuteGraphicStateOperatorsDD(AToken, AData) then Exit;
if ExecuteGraphicStateOperatorsDD(AToken, AData, ADoc) then Exit;
if ExecuteControlOperator(AToken, AData) then Exit;
if ExecuteControlOperator(AToken, AData, ADoc) then Exit;
if ExecuteStackManipulationOperator(AToken, AData) then Exit;
if ExecuteStackManipulationOperator(AToken, AData, ADoc) then Exit;
if ExecuteMiscellaneousOperators(AToken, AData) then Exit;
if ExecuteMiscellaneousOperators(AToken, AData, ADoc) then Exit;
if ExecutePaintingOperator(AToken, AData) then Exit;
if ExecutePaintingOperator(AToken, AData, ADoc) then Exit;
if ExecuteDeviceSetupAndOutputOperator(AToken, AData) then Exit;
if ExecuteDeviceSetupAndOutputOperator(AToken, AData, ADoc) then Exit;
if ExecuteArrayOperator(AToken, AData) then Exit;
if ExecuteArrayOperator(AToken, AData, ADoc) then Exit;
if ExecuteStringOperator(AToken, AData) then Exit;
if ExecuteStringOperator(AToken, AData, ADoc) then Exit;
// If we got here, there the command not yet implemented
raise Exception.Create(Format('[TvEPSVectorialReader.ProcessExpressionToken] Unknown PostScript Command "%s" in Line %d',
@ -762,7 +762,7 @@ end;
Count elements down to mark
}
function TvEPSVectorialReader.ExecuteStackManipulationOperator(
AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
var
Param1, Param2, NewToken: TPSToken;
lIndexN, lIndexJ: Integer;
@ -956,7 +956,7 @@ end;
any string cvs substring Convert to string
}
function TvEPSVectorialReader.ExecuteControlOperator(AToken: TExpressionToken;
AData: TvVectorialDocument): Boolean;
AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
var
Param1, Param2, Param3, Param4, CounterToken: TPSToken;
NewToken: TExpressionToken;
@ -973,7 +973,7 @@ begin
if not (Param1 is TProcedureToken) then
raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteControlOperator] The operator if requires a procedure. Error at line %d', [AToken.Line]));
if Param2.BoolValue then ExecuteProcedureToken(TProcedureToken(Param1), AData);
if Param2.BoolValue then ExecuteProcedureToken(TProcedureToken(Param1), AData, ADoc);
Exit(True);
end;
@ -989,8 +989,8 @@ begin
if not (Param2 is TProcedureToken) then
raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteControlOperator] The operator ifelse requires a procedure. Error at line %d', [AToken.Line]));
if Param3.BoolValue then ExecuteProcedureToken(TProcedureToken(Param2), AData)
else ExecuteProcedureToken(TProcedureToken(Param1), AData);
if Param3.BoolValue then ExecuteProcedureToken(TProcedureToken(Param2), AData, ADoc)
else ExecuteProcedureToken(TProcedureToken(Param1), AData, ADoc);
Exit(True);
end;
@ -1033,7 +1033,7 @@ begin
if not (Param1 is TProcedureToken) then
raise Exception.Create(Format('[TvEPSVectorialReader.ExecuteControlOperator] The operator stopped requires a procedure. Error at line %d', [AToken.Line]));
ExecuteProcedureToken(TProcedureToken(Param1), AData);
ExecuteProcedureToken(TProcedureToken(Param1), AData, ADoc);
NewToken := TExpressionToken.Create;
NewToken.ETType := ettOperand;
@ -1053,7 +1053,7 @@ begin
while True do
begin
ExecuteProcedureToken(TProcedureToken(Param1), AData);
ExecuteProcedureToken(TProcedureToken(Param1), AData, ADoc);
if ExitCalled then
begin
@ -1126,7 +1126,7 @@ begin
CounterToken.FloatValue := FloatCounter;
Stack.Push(CounterToken);
ExecuteProcedureToken(TProcedureToken(Param1), AData);
ExecuteProcedureToken(TProcedureToken(Param1), AData, ADoc);
FloatCounter := FloatCounter + Param3.FloatValue;
@ -1220,7 +1220,7 @@ end;
form execform Paint form
}
function TvEPSVectorialReader.ExecutePaintingOperator(AToken: TExpressionToken;
AData: TvVectorialDocument): Boolean;
AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
var
Param1, Param2: TPSToken;
begin
@ -1333,7 +1333,7 @@ end;
parameters
}
function TvEPSVectorialReader.ExecuteDeviceSetupAndOutputOperator(
AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
var
Param1, Param2: TPSToken;
begin
@ -1379,7 +1379,7 @@ end;
packedarray proc forall Execute proc for each element of packedarray
}
function TvEPSVectorialReader.ExecuteArrayOperator(AToken: TExpressionToken;
AData: TvVectorialDocument): Boolean;
AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
begin
Result := False;
@ -1420,7 +1420,7 @@ end;
int1 shift bitshift int2 Perform bitwise shift of int1 (positive is left)
}
function TvEPSVectorialReader.ExecuteStringOperator(AToken: TExpressionToken;
AData: TvVectorialDocument): Boolean;
AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
var
Param1, Param2: TPSToken;
NewToken: TExpressionToken;
@ -1492,7 +1492,7 @@ end;
rrand int Return random number seed
}
function TvEPSVectorialReader.ExecuteArithmeticAndMathOperator(
AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
var
Param1, Param2: TPSToken;
NewToken: TExpressionToken;
@ -1579,7 +1579,7 @@ end;
ucache Declare that user path is to be cached
}
function TvEPSVectorialReader.ExecutePathConstructionOperator(
AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
var
Param1, Param2, Param3, Param4, Param5, Param6: TPSToken;
PosX, PosY, PosX2, PosY2, PosX3, PosY3, BaseX, BaseY: Double;
@ -1767,7 +1767,7 @@ begin
{$endif}
AData.SetBrushStyle(bsClear);
AData.EndPath();
CurrentGraphicState.ClipPath := AData.GetPath(AData.GetPathCount()-1);
CurrentGraphicState.ClipPath := AData.GetEntity(AData.GetEntitiesCount()-1) as TPath;
CurrentGraphicState.ClipMode := vcmEvenOddRule;
Exit(True);
end
@ -1823,7 +1823,7 @@ end;
yellow, black
}
function TvEPSVectorialReader.ExecuteGraphicStateOperatorsDI(
AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
var
Param1, Param2, Param3: TPSToken;
lRed, lGreen, lBlue: Double;
@ -1977,7 +1977,7 @@ end;
matrix1 matrix2 invertmatrix matrix2 Fill matrix2 with inverse of matrix1
}
function TvEPSVectorialReader.ExecuteGraphicStateOperatorsDD(
AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
var
Param1, Param2: TPSToken;
begin
@ -2097,7 +2097,7 @@ end;
dictionary stack
}
function TvEPSVectorialReader.ExecuteDictionaryOperators(
AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
var
Param1, Param2: TPSToken;
NewToken: TExpressionToken;
@ -2190,7 +2190,7 @@ end;
prompt Executed when ready for interactive input
}
function TvEPSVectorialReader.ExecuteMiscellaneousOperators(
AToken: TExpressionToken; AData: TvVectorialDocument): Boolean;
AToken: TExpressionToken; AData: TvVectorialPage; ADoc: TvVectorialDocument): Boolean;
begin
Result := False;
@ -2273,17 +2273,20 @@ end;
procedure TvEPSVectorialReader.ReadFromStream(AStream: TStream;
AData: TvVectorialDocument);
var
lPage: TvVectorialPage;
begin
Tokenizer.ReadFromStream(AStream);
// Tokenizer.DebugOut();
// Make sure we have at least one path
AData.StartPath();
lPage := AData.AddPage();
lPage.StartPath();
RunPostScript(Tokenizer.Tokens, AData);
RunPostScript(Tokenizer.Tokens, lPage, AData);
// Make sure we have at least one path
AData.EndPath();
lPage.EndPath();
// PostScript has no document size information, so lets calculate it ourselves
AData.GuessDocumentSize();

View File

@ -3,7 +3,7 @@ unit fpvectbuildunit;
interface
Uses
avisocncgcodereader,avisocncgcodewriter,avisozlib,fpvectorial,
fpvtocanvas,pdfvectorialreader,pdfvrlexico,pdfvrsemantico,pdfvrsintatico,
fpvtocanvas,
svgvectorialwriter,cdrvectorialreader,epsvectorialreader;
implementation

View File

@ -265,19 +265,16 @@ type
TvCustomVectorialWriter = class;
TvCustomVectorialReader = class;
TvVectorialPage = class;
{ TvVectorialDocument }
TvVectorialDocument = class
private
FEntities: TFPList;
FTmpPath: TPath;
FTmpText: TvText;
procedure RemoveCallback(data, arg: pointer);
FPages: TFPList;
FCurrentPageIndex: Integer;
function CreateVectorialWriter(AFormat: TvVectorialFormat): TvCustomVectorialWriter;
function CreateVectorialReader(AFormat: TvVectorialFormat): TvCustomVectorialReader;
procedure ClearTmpPath();
procedure AppendSegmentToTmpPath(ASegment: TPathSegment);
public
Width, Height: Double; // in millimeters
Name: string;
@ -302,9 +299,34 @@ type
function GetDetailedFileFormat(): string;
procedure GuessDocumentSize();
procedure GuessGoodZoomLevel(AScreenSize: Integer = 500);
{ Page methods }
function GetPage(AIndex: Integer): TvVectorialPage;
function GetPageCount: Integer;
function GetCurrentPage: TvVectorialPage;
procedure SetCurrentPage(AIndex: Integer);
function AddPage(): TvVectorialPage;
{ Data removing methods }
procedure Clear; virtual;
end;
{ TvVectorialPage }
TvVectorialPage = class
private
FEntities: TFPList;
FTmpPath: TPath;
FTmpText: TvText;
//procedure RemoveCallback(data, arg: pointer);
procedure ClearTmpPath();
procedure AppendSegmentToTmpPath(ASegment: TPathSegment);
public
Width, Height: Double; // in millimeters
Owner: TvVectorialDocument;
{ Base methods }
constructor Create(AOwner: TvVectorialDocument); virtual;
destructor Destroy; override;
procedure Assign(ASource: TvVectorialPage);
{ Data reading methods }
function GetPath(ANum: Cardinal): TPath;
function GetPathCount: Integer;
function GetEntity(ANum: Cardinal): TvEntity;
function GetEntitiesCount: Integer;
function FindAndSelectEntity(Pos: TPoint): TvFindEntityResult;
@ -336,9 +358,6 @@ type
procedure AddEllipse(CenterX, CenterY, MajorHalfAxis, MinorHalfAxis, Angle: Double);
// Dimensions
procedure AddAlignedDimension(BaseLeft, BaseRight, DimLeft, DimRight: T3DPoint);
{ properties }
property PathCount: Integer read GetPathCount;
property Paths[Index: Cardinal]: TPath read GetPath;
end;
{@@ TvVectorialReader class reference type }
@ -490,6 +509,376 @@ begin
Result.Z := 0;
end;
{ TvVectorialPage }
procedure TvVectorialPage.ClearTmpPath;
var
segment, oldsegment: TPathSegment;
begin
FTmpPath.Points := nil;
FTmpPath.PointsEnd := nil;
FTmpPath.Len := 0;
FTmpPath.Brush.Color := colBlue;
FTmpPath.Brush.Style := bsClear;
FTmpPath.Pen.Color := colBlack;
FTmpPath.Pen.Style := psSolid;
FTmpPath.Pen.Width := 1;
end;
procedure TvVectorialPage.AppendSegmentToTmpPath(ASegment: TPathSegment);
begin
FTmpPath.AppendSegment(ASegment);
end;
constructor TvVectorialPage.Create(AOwner: TvVectorialDocument);
begin
inherited Create;
FEntities := TFPList.Create;
FTmpPath := TPath.Create;
Owner := AOwner;
end;
destructor TvVectorialPage.Destroy;
begin
Clear;
FEntities.Free;
inherited Destroy;
end;
procedure TvVectorialPage.Assign(ASource: TvVectorialPage);
var
i: Integer;
begin
Clear;
for i := 0 to ASource.GetEntitiesCount - 1 do
Self.AddEntity(ASource.GetEntity(i));
end;
function TvVectorialPage.GetEntity(ANum: Cardinal): TvEntity;
begin
if ANum >= FEntities.Count then raise Exception.Create('TvVectorialDocument.GetEntity: Entity number out of bounds');
if FEntities.Items[ANum] = nil then raise Exception.Create('TvVectorialDocument.GetEntity: Invalid Entity number');
Result := TvEntity(FEntities.Items[ANum]);
end;
function TvVectorialPage.GetEntitiesCount: Integer;
begin
Result := FEntities.Count;
end;
function TvVectorialPage.FindAndSelectEntity(Pos: TPoint): TvFindEntityResult;
var
lEntity: TvEntity;
i: Integer;
begin
Result := vfrNotFound;
for i := 0 to GetEntitiesCount() - 1 do
begin
lEntity := GetEntity(i);
Result := lEntity.TryToSelect(Pos);
if Result <> vfrNotFound then
begin
Owner.SelectedvElement := lEntity;
Exit;
end;
end;
end;
procedure TvVectorialPage.Clear;
begin
FEntities.Clear();
end;
{@@
Adds an entity to the document and returns it's current index
}
function TvVectorialPage.AddEntity(AEntity: TvEntity): Integer;
begin
Result := FEntities.Count;
FEntities.Add(Pointer(AEntity));
end;
procedure TvVectorialPage.AddPathCopyMem(APath: TPath);
var
lPath: TPath;
Len: Integer;
begin
lPath := TPath.Create;
lPath.Assign(APath);
AddEntity(lPath);
//WriteLn(':>TvVectorialDocument.AddPath 1 Len = ', Len);
end;
{@@
Starts writing a Path in multiple steps.
Should be followed by zero or more calls to AddPointToPath
and by a call to EndPath to effectively add the data.
@see EndPath, AddPointToPath
}
procedure TvVectorialPage.StartPath(AX, AY: Double);
var
segment: T2DSegment;
begin
ClearTmpPath();
FTmpPath.Len := 1;
segment := T2DSegment.Create;
segment.SegmentType := stMoveTo;
segment.X := AX;
segment.Y := AY;
FTmpPath.Points := segment;
FTmpPath.PointsEnd := segment;
end;
procedure TvVectorialPage.StartPath;
begin
ClearTmpPath();
end;
procedure TvVectorialPage.AddMoveToPath(AX, AY: Double);
var
segment: T2DSegment;
begin
segment := T2DSegment.Create;
segment.SegmentType := stMoveTo;
segment.X := AX;
segment.Y := AY;
AppendSegmentToTmpPath(segment);
end;
{@@
Adds one more point to the end of a Path being
writing in multiple steps.
Does nothing if not called between StartPath and EndPath.
Can be called multiple times to add multiple points.
@see StartPath, EndPath
}
procedure TvVectorialPage.AddLineToPath(AX, AY: Double);
var
segment: T2DSegment;
begin
segment := T2DSegment.Create;
segment.SegmentType := st2DLine;
segment.X := AX;
segment.Y := AY;
AppendSegmentToTmpPath(segment);
end;
procedure TvVectorialPage.AddLineToPath(AX, AY: Double; AColor: TFPColor);
var
segment: T2DSegmentWithPen;
begin
segment := T2DSegmentWithPen.Create;
segment.SegmentType := st2DLineWithPen;
segment.X := AX;
segment.Y := AY;
segment.Pen.Color := AColor;
AppendSegmentToTmpPath(segment);
end;
procedure TvVectorialPage.AddLineToPath(AX, AY, AZ: Double);
var
segment: T3DSegment;
begin
segment := T3DSegment.Create;
segment.SegmentType := st3DLine;
segment.X := AX;
segment.Y := AY;
segment.Z := AZ;
AppendSegmentToTmpPath(segment);
end;
{@@
Gets the current Pen Pos in the temporary path
}
procedure TvVectorialPage.GetCurrentPathPenPos(var AX, AY: Double);
begin
// Check if we are the first segment in the tmp path
if FTmpPath.PointsEnd = nil then raise Exception.Create('[TvVectorialDocument.GetCurrentPathPenPos] One cannot obtain the Pen Pos if there are no segments in the temporary path');
AX := T2DSegment(FTmpPath.PointsEnd).X;
AY := T2DSegment(FTmpPath.PointsEnd).Y;
end;
{@@
Adds a bezier element to the path. It starts where the previous element ended
and it goes throw the control points [AX1, AY1] and [AX2, AY2] and ends
in [AX3, AY3].
}
procedure TvVectorialPage.AddBezierToPath(AX1, AY1, AX2, AY2, AX3, AY3: Double);
var
segment: T2DBezierSegment;
begin
segment := T2DBezierSegment.Create;
segment.SegmentType := st2DBezier;
segment.X := AX3;
segment.Y := AY3;
segment.X2 := AX1;
segment.Y2 := AY1;
segment.X3 := AX2;
segment.Y3 := AY2;
AppendSegmentToTmpPath(segment);
end;
procedure TvVectorialPage.AddBezierToPath(AX1, AY1, AZ1, AX2, AY2, AZ2, AX3, AY3, AZ3: Double);
var
segment: T3DBezierSegment;
begin
segment := T3DBezierSegment.Create;
segment.SegmentType := st3DBezier;
segment.X := AX3;
segment.Y := AY3;
segment.Z := AZ3;
segment.X2 := AX1;
segment.Y2 := AY1;
segment.Z2 := AZ1;
segment.X3 := AX2;
segment.Y3 := AY2;
segment.Z3 := AZ2;
AppendSegmentToTmpPath(segment);
end;
procedure TvVectorialPage.SetBrushColor(AColor: TFPColor);
begin
FTmPPath.Brush.Color := AColor;
end;
procedure TvVectorialPage.SetBrushStyle(AStyle: TFPBrushStyle);
begin
FTmPPath.Brush.Style := AStyle;
end;
procedure TvVectorialPage.SetPenColor(AColor: TFPColor);
begin
FTmPPath.Pen.Color := AColor;
end;
procedure TvVectorialPage.SetPenStyle(AStyle: TFPPenStyle);
begin
FTmPPath.Pen.Style := AStyle;
end;
procedure TvVectorialPage.SetPenWidth(AWidth: Integer);
begin
FTmPPath.Pen.Width := AWidth;
end;
procedure TvVectorialPage.SetClipPath(AClipPath: TPath; AClipMode: TvClipMode);
begin
FTmPPath.ClipPath := AClipPath;
FTmPPath.ClipMode := AClipMode;
end;
{@@
Finishes writing a Path, which was created in multiple
steps using StartPath and AddPointToPath,
to the document.
Does nothing if there wasn't a previous correspondent call to
StartPath.
@see StartPath, AddPointToPath
}
procedure TvVectorialPage.EndPath;
begin
if FTmPPath.Len = 0 then Exit;
AddPathCopyMem(FTmPPath);
ClearTmpPath();
end;
procedure TvVectorialPage.AddText(AX, AY: Double; FontName: string;
FontSize: integer; AText: utf8string);
var
lText: TvText;
begin
lText := TvText.Create;
lText.Value.Text := AText;
lText.X := AX;
lText.Y := AY;
lText.Font.Name := FontName;
lText.Font.Size := FontSize;
AddEntity(lText);
end;
procedure TvVectorialPage.AddText(AX, AY: Double; AStr: utf8string);
begin
AddText(AX, AY, '', 10, AStr);
end;
procedure TvVectorialPage.AddCircle(ACenterX, ACenterY, ARadius: Double);
var
lCircle: TvCircle;
begin
lCircle := TvCircle.Create;
lCircle.X := ACenterX;
lCircle.Y := ACenterY;
lCircle.Radius := ARadius;
AddEntity(lCircle);
end;
procedure TvVectorialPage.AddCircularArc(ACenterX, ACenterY, ARadius,
AStartAngle, AEndAngle: Double; AColor: TFPColor);
var
lCircularArc: TvCircularArc;
begin
lCircularArc := TvCircularArc.Create;
lCircularArc.X := ACenterX;
lCircularArc.Y := ACenterY;
lCircularArc.Radius := ARadius;
lCircularArc.StartAngle := AStartAngle;
lCircularArc.EndAngle := AEndAngle;
lCircularArc.Pen.Color := AColor;
AddEntity(lCircularArc);
end;
procedure TvVectorialPage.AddEllipse(CenterX, CenterY, MajorHalfAxis,
MinorHalfAxis, Angle: Double);
var
lEllipse: TvEllipse;
begin
lEllipse := TvEllipse.Create;
lEllipse.X := CenterX;
lEllipse.Y := CenterY;
lEllipse.MajorHalfAxis := MajorHalfAxis;
lEllipse.MinorHalfAxis := MinorHalfAxis;
lEllipse.Angle := Angle;
AddEntity(lEllipse);
end;
procedure TvVectorialPage.AddAlignedDimension(BaseLeft, BaseRight, DimLeft,
DimRight: T3DPoint);
var
lDim: TvAlignedDimension;
begin
lDim := TvAlignedDimension.Create;
lDim.BaseLeft := BaseLeft;
lDim.BaseRight := BaseRight;
lDim.DimensionLeft := DimLeft;
lDim.DimensionRight := DimRight;
AddEntity(lDim);
end;
{ TvText }
constructor TvText.Create;
@ -589,18 +978,6 @@ end;
{ TsWorksheet }
{@@
Helper method for clearing the records in a spreadsheet.
}
procedure TvVectorialDocument.RemoveCallback(data, arg: pointer);
begin
{ if data <> nil then
begin
ldata := PObject(data);
ldata^.Free;
end;}
end;
{@@
Constructor.
}
@ -608,8 +985,7 @@ constructor TvVectorialDocument.Create;
begin
inherited Create;
FEntities := TFPList.Create;
FTmpPath := TPath.Create;
FPages := TFPList.Create;
end;
{@@
@ -619,19 +995,19 @@ destructor TvVectorialDocument.Destroy;
begin
Clear;
FEntities.Free;
FPages.Free;
inherited Destroy;
end;
procedure TvVectorialDocument.Assign(ASource: TvVectorialDocument);
var
i: Integer;
//var
// i: Integer;
begin
Clear;
for i := 0 to ASource.GetEntitiesCount - 1 do
Self.AddEntity(ASource.GetEntity(i));
// Clear;
//
// for i := 0 to ASource.GetEntitiesCount - 1 do
// Self.AddEntity(ASource.GetEntity(i));
end;
procedure TvVectorialDocument.AssignTo(ADest: TvVectorialDocument);
@ -639,288 +1015,6 @@ begin
ADest.Assign(Self);
end;
procedure TvVectorialDocument.AddPathCopyMem(APath: TPath);
var
lPath: TPath;
Len: Integer;
begin
lPath := TPath.Create;
lPath.Assign(APath);
AddEntity(lPath);
//WriteLn(':>TvVectorialDocument.AddPath 1 Len = ', Len);
end;
{@@
Starts writing a Path in multiple steps.
Should be followed by zero or more calls to AddPointToPath
and by a call to EndPath to effectively add the data.
@see EndPath, AddPointToPath
}
procedure TvVectorialDocument.StartPath(AX, AY: Double);
var
segment: T2DSegment;
begin
ClearTmpPath();
FTmpPath.Len := 1;
segment := T2DSegment.Create;
segment.SegmentType := stMoveTo;
segment.X := AX;
segment.Y := AY;
FTmpPath.Points := segment;
FTmpPath.PointsEnd := segment;
end;
procedure TvVectorialDocument.StartPath();
begin
ClearTmpPath();
end;
procedure TvVectorialDocument.AddMoveToPath(AX, AY: Double);
var
segment: T2DSegment;
begin
segment := T2DSegment.Create;
segment.SegmentType := stMoveTo;
segment.X := AX;
segment.Y := AY;
AppendSegmentToTmpPath(segment);
end;
{@@
Adds one more point to the end of a Path being
writing in multiple steps.
Does nothing if not called between StartPath and EndPath.
Can be called multiple times to add multiple points.
@see StartPath, EndPath
}
procedure TvVectorialDocument.AddLineToPath(AX, AY: Double);
var
segment: T2DSegment;
begin
segment := T2DSegment.Create;
segment.SegmentType := st2DLine;
segment.X := AX;
segment.Y := AY;
AppendSegmentToTmpPath(segment);
end;
procedure TvVectorialDocument.AddLineToPath(AX, AY: Double; AColor: TFPColor);
var
segment: T2DSegmentWithPen;
begin
segment := T2DSegmentWithPen.Create;
segment.SegmentType := st2DLineWithPen;
segment.X := AX;
segment.Y := AY;
segment.Pen.Color := AColor;
AppendSegmentToTmpPath(segment);
end;
procedure TvVectorialDocument.AddLineToPath(AX, AY, AZ: Double);
var
segment: T3DSegment;
begin
segment := T3DSegment.Create;
segment.SegmentType := st3DLine;
segment.X := AX;
segment.Y := AY;
segment.Z := AZ;
AppendSegmentToTmpPath(segment);
end;
{@@
Gets the current Pen Pos in the temporary path
}
procedure TvVectorialDocument.GetCurrentPathPenPos(var AX, AY: Double);
begin
// Check if we are the first segment in the tmp path
if FTmpPath.PointsEnd = nil then raise Exception.Create('[TvVectorialDocument.GetCurrentPathPenPos] One cannot obtain the Pen Pos if there are no segments in the temporary path');
AX := T2DSegment(FTmpPath.PointsEnd).X;
AY := T2DSegment(FTmpPath.PointsEnd).Y;
end;
{@@
Adds a bezier element to the path. It starts where the previous element ended
and it goes throw the control points [AX1, AY1] and [AX2, AY2] and ends
in [AX3, AY3].
}
procedure TvVectorialDocument.AddBezierToPath(AX1, AY1, AX2, AY2, AX3,
AY3: Double);
var
segment: T2DBezierSegment;
begin
segment := T2DBezierSegment.Create;
segment.SegmentType := st2DBezier;
segment.X := AX3;
segment.Y := AY3;
segment.X2 := AX1;
segment.Y2 := AY1;
segment.X3 := AX2;
segment.Y3 := AY2;
AppendSegmentToTmpPath(segment);
end;
procedure TvVectorialDocument.AddBezierToPath(AX1, AY1, AZ1, AX2, AY2, AZ2,
AX3, AY3, AZ3: Double);
var
segment: T3DBezierSegment;
begin
segment := T3DBezierSegment.Create;
segment.SegmentType := st3DBezier;
segment.X := AX3;
segment.Y := AY3;
segment.Z := AZ3;
segment.X2 := AX1;
segment.Y2 := AY1;
segment.Z2 := AZ1;
segment.X3 := AX2;
segment.Y3 := AY2;
segment.Z3 := AZ2;
AppendSegmentToTmpPath(segment);
end;
procedure TvVectorialDocument.SetBrushColor(AColor: TFPColor);
begin
FTmPPath.Brush.Color := AColor;
end;
procedure TvVectorialDocument.SetBrushStyle(AStyle: TFPBrushStyle);
begin
FTmPPath.Brush.Style := AStyle;
end;
procedure TvVectorialDocument.SetPenColor(AColor: TFPColor);
begin
FTmPPath.Pen.Color := AColor;
end;
procedure TvVectorialDocument.SetPenStyle(AStyle: TFPPenStyle);
begin
FTmPPath.Pen.Style := AStyle;
end;
procedure TvVectorialDocument.SetPenWidth(AWidth: Integer);
begin
FTmPPath.Pen.Width := AWidth;
end;
procedure TvVectorialDocument.SetClipPath(AClipPath: TPath;
AClipMode: TvClipMode);
begin
FTmPPath.ClipPath := AClipPath;
FTmPPath.ClipMode := AClipMode;
end;
{@@
Finishes writing a Path, which was created in multiple
steps using StartPath and AddPointToPath,
to the document.
Does nothing if there wasn't a previous correspondent call to
StartPath.
@see StartPath, AddPointToPath
}
procedure TvVectorialDocument.EndPath();
begin
if FTmPPath.Len = 0 then Exit;
AddPathCopyMem(FTmPPath);
ClearTmpPath();
end;
procedure TvVectorialDocument.AddText(AX, AY: Double; FontName: string; FontSize: integer; AText: utf8string);
var
lText: TvText;
begin
lText := TvText.Create;
lText.Value.Text := AText;
lText.X := AX;
lText.Y := AY;
lText.Font.Name := FontName;
lText.Font.Size := FontSize;
AddEntity(lText);
end;
procedure TvVectorialDocument.AddText(AX, AY: Double; AStr: utf8string);
begin
AddText(AX, AY, '', 10, AStr);
end;
procedure TvVectorialDocument.AddCircle(ACenterX, ACenterY, ARadius: Double);
var
lCircle: TvCircle;
begin
lCircle := TvCircle.Create;
lCircle.X := ACenterX;
lCircle.Y := ACenterY;
lCircle.Radius := ARadius;
AddEntity(lCircle);
end;
procedure TvVectorialDocument.AddCircularArc(ACenterX, ACenterY,
ARadius, AStartAngle, AEndAngle: Double; AColor: TFPColor);
var
lCircularArc: TvCircularArc;
begin
lCircularArc := TvCircularArc.Create;
lCircularArc.X := ACenterX;
lCircularArc.Y := ACenterY;
lCircularArc.Radius := ARadius;
lCircularArc.StartAngle := AStartAngle;
lCircularArc.EndAngle := AEndAngle;
lCircularArc.Pen.Color := AColor;
AddEntity(lCircularArc);
end;
procedure TvVectorialDocument.AddEllipse(CenterX, CenterY,
MajorHalfAxis, MinorHalfAxis, Angle: Double);
var
lEllipse: TvEllipse;
begin
lEllipse := TvEllipse.Create;
lEllipse.X := CenterX;
lEllipse.Y := CenterY;
lEllipse.MajorHalfAxis := MajorHalfAxis;
lEllipse.MinorHalfAxis := MinorHalfAxis;
lEllipse.Angle := Angle;
AddEntity(lEllipse);
end;
{@@
Adds an entity to the document and returns it's current index
}
function TvVectorialDocument.AddEntity(AEntity: TvEntity): Integer;
begin
Result := FEntities.Count;
FEntities.Add(Pointer(AEntity));
end;
procedure TvVectorialDocument.AddAlignedDimension(BaseLeft, BaseRight,
DimLeft, DimRight: T3DPoint);
var
lDim: TvAlignedDimension;
begin
lDim := TvAlignedDimension.Create;
lDim.BaseLeft := BaseLeft;
lDim.BaseRight := BaseRight;
lDim.DimensionLeft := DimLeft;
lDim.DimensionRight := DimRight;
AddEntity(lDim);
end;
{@@
Convenience method which creates the correct
writer object for a given vector graphics document format.
@ -965,25 +1059,6 @@ begin
if Result = nil then raise Exception.Create('Unsupported vector graphics format.');
end;
procedure TvVectorialDocument.ClearTmpPath();
var
segment, oldsegment: TPathSegment;
begin
FTmpPath.Points := nil;
FTmpPath.PointsEnd := nil;
FTmpPath.Len := 0;
FTmpPath.Brush.Color := colBlue;
FTmpPath.Brush.Style := bsClear;
FTmpPath.Pen.Color := colBlack;
FTmpPath.Pen.Style := psSolid;
FTmpPath.Pen.Width := 1;
end;
procedure TvVectorialDocument.AppendSegmentToTmpPath(ASegment: TPathSegment);
begin
FTmpPath.AppendSegment(ASegment);
end;
{@@
Writes the document to a file.
@ -1130,19 +1205,24 @@ end;
procedure TvVectorialDocument.GuessDocumentSize();
var
i: Integer;
i, j: Integer;
lEntity: TvEntity;
lLeft, lTop, lRight, lBottom: Double;
CurPage: TvVectorialPage;
begin
lLeft := 0;
lTop := 0;
lRight := 0;
lBottom := 0;
for i := 0 to GetEntitiesCount() - 1 do
for j := 0 to GetPageCount()-1 do
begin
lEntity := GetEntity(I);
lEntity.ExpandBoundingBox(lLeft, lTop, lRight, lBottom);
CurPage := GetPage(j);
for i := 0 to CurPage.GetEntitiesCount() - 1 do
begin
lEntity := CurPage.GetEntity(I);
lEntity.ExpandBoundingBox(lLeft, lTop, lRight, lBottom);
end;
end;
Width := lRight - lLeft;
@ -1154,68 +1234,34 @@ begin
ZoomLevel := AScreenSize / Height;
end;
function TvVectorialDocument.GetPath(ANum: Cardinal): TPath;
var
i: Integer;
Index: Integer = - 1;
function TvVectorialDocument.GetPage(AIndex: Integer): TvVectorialPage;
begin
Result := nil;
if ANum >= FEntities.Count then raise Exception.Create('TvVectorialDocument.GetPath: Path number out of bounds');
for i := 0 to FEntities.Count - 1 do
begin
if TvEntity(FEntities.Items[i]) is TPath then
begin
Inc(Index);
if Index = ANum then Result := TPath(FEntities.Items[i]);
end;
end;
Result := TvVectorialPage(FPages.Items[AIndex]);
end;
function TvVectorialDocument.GetPathCount: Integer;
var
i: Integer;
function TvVectorialDocument.GetPageCount: Integer;
begin
Result := 0;
for i := 0 to FEntities.Count - 1 do
if TvEntity(FEntities.Items[i]) is TPath then Inc(Result);
Result := FPages.Count;
end;
function TvVectorialDocument.GetEntity(ANum: Cardinal): TvEntity;
function TvVectorialDocument.GetCurrentPage: TvVectorialPage;
begin
if ANum >= FEntities.Count then raise Exception.Create('TvVectorialDocument.GetEntity: Entity number out of bounds');
if FEntities.Items[ANum] = nil then raise Exception.Create('TvVectorialDocument.GetEntity: Invalid Entity number');
Result := TvEntity(FEntities.Items[ANum]);
if FCurrentPageIndex >= 0 then
Result := GetPage(FCurrentPageIndex)
else
Result := nil;
end;
function TvVectorialDocument.GetEntitiesCount: Integer;
procedure TvVectorialDocument.SetCurrentPage(AIndex: Integer);
begin
Result := FEntities.Count;
FCurrentPageIndex := AIndex;
end;
function TvVectorialDocument.FindAndSelectEntity(Pos: TPoint): TvFindEntityResult;
var
lEntity: TvEntity;
i: Integer;
function TvVectorialDocument.AddPage: TvVectorialPage;
begin
Result := vfrNotFound;
for i := 0 to GetEntitiesCount() - 1 do
begin
lEntity := GetEntity(i);
Result := lEntity.TryToSelect(Pos);
if Result <> vfrNotFound then
begin
SelectedvElement := lEntity;
Exit;
end;
end;
Result := TvVectorialPage.Create(Self);
FPages.Add(Result);
if FCurrentPageIndex < 0 then FCurrentPageIndex := FPages.Count-1;
end;
{@@
@ -1223,7 +1269,6 @@ end;
}
procedure TvVectorialDocument.Clear;
begin
FEntities.Clear();
end;
{ TvCustomVectorialReader }

View File

@ -1,7 +1,8 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="3">
<Package Version="4">
<Name Value="fpvectorialpkg"/>
<AddToProjectUsesSection Value="True"/>
<CompilerOptions>
<Version Value="10"/>
<SearchPaths>
@ -11,71 +12,55 @@
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Files Count="16">
<Files Count="12">
<Item1>
<Filename Value="svgvectorialwriter.pas"/>
<UnitName Value="svgvectorialwriter"/>
</Item1>
<Item2>
<Filename Value="pdfvrsintatico.pas"/>
<UnitName Value="pdfvrsintatico"/>
</Item2>
<Item3>
<Filename Value="pdfvrsemantico.pas"/>
<UnitName Value="pdfvrsemantico"/>
</Item3>
<Item4>
<Filename Value="pdfvrlexico.pas"/>
<UnitName Value="pdfvrlexico"/>
</Item4>
<Item5>
<Filename Value="pdfvectorialreader.pas"/>
<UnitName Value="pdfvectorialreader"/>
</Item5>
<Item6>
<Filename Value="fpvtocanvas.pas"/>
<UnitName Value="fpvtocanvas"/>
</Item6>
<Item7>
</Item2>
<Item3>
<Filename Value="fpvectorial.pas"/>
<UnitName Value="fpvectorial"/>
</Item7>
<Item8>
</Item3>
<Item4>
<Filename Value="fpvectbuildunit.pas"/>
<UnitName Value="fpvectbuildunit"/>
</Item8>
<Item9>
</Item4>
<Item5>
<Filename Value="dxfvectorialreader.pas"/>
<UnitName Value="dxfvectorialreader"/>
</Item9>
<Item10>
</Item5>
<Item6>
<Filename Value="cdrvectorialreader.pas"/>
<UnitName Value="cdrvectorialreader"/>
</Item10>
<Item11>
</Item6>
<Item7>
<Filename Value="avisozlib.pas"/>
<UnitName Value="avisozlib"/>
</Item11>
<Item12>
</Item7>
<Item8>
<Filename Value="avisocncgcodewriter.pas"/>
<UnitName Value="avisocncgcodewriter"/>
</Item12>
<Item13>
</Item8>
<Item9>
<Filename Value="avisocncgcodereader.pas"/>
<UnitName Value="avisocncgcodereader"/>
</Item13>
<Item14>
</Item9>
<Item10>
<Filename Value="svgvectorialreader.pas"/>
<UnitName Value="svgvectorialreader"/>
</Item14>
<Item15>
</Item10>
<Item11>
<Filename Value="epsvectorialreader.pas"/>
<UnitName Value="epsvectorialreader"/>
</Item15>
<Item16>
</Item11>
<Item12>
<Filename Value="fpvutils.pas"/>
<UnitName Value="fpvutils"/>
</Item16>
</Item12>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="2">

View File

@ -7,8 +7,7 @@ unit fpvectorialpkg;
interface
uses
svgvectorialwriter, pdfvrsintatico, pdfvrsemantico, pdfvrlexico,
pdfvectorialreader, fpvtocanvas, fpvectorial, fpvectbuildunit,
svgvectorialwriter, fpvtocanvas, fpvectorial, fpvectbuildunit,
dxfvectorialreader, cdrvectorialreader, avisozlib, avisocncgcodewriter,
avisocncgcodereader, svgvectorialreader, epsvectorialreader, fpvutils,
LazarusPackageIntf;

View File

@ -22,16 +22,16 @@ uses
fpimage,
fpvectorial, fpvutils;
procedure DrawFPVectorialToCanvas(ASource: TvVectorialDocument;
procedure DrawFPVectorialToCanvas(ASource: TvVectorialPage;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
procedure DrawFPVPathToCanvas(ASource: TvVectorialDocument; CurPath: TPath;
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: TvVectorialDocument; CurEntity: TvEntity;
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: TvVectorialDocument; CurText: TvText;
procedure DrawFPVTextToCanvas(ASource: TvVectorialPage; CurText: TvText;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
@ -101,7 +101,7 @@ end;
DrawFPVectorialToCanvas(ASource, ADest, 0, ASource.Height, 1.0, -1.0);
}
procedure DrawFPVectorialToCanvas(ASource: TvVectorialDocument;
procedure DrawFPVectorialToCanvas(ASource: TvVectorialPage;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
var
@ -130,7 +130,7 @@ begin
{$endif}
end;
procedure DrawFPVPathToCanvas(ASource: TvVectorialDocument; CurPath: TPath;
procedure DrawFPVPathToCanvas(ASource: TvVectorialPage; CurPath: TPath;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
@ -337,7 +337,7 @@ begin
{$endif}
end;
procedure DrawFPVEntityToCanvas(ASource: TvVectorialDocument; CurEntity: TvEntity;
procedure DrawFPVEntityToCanvas(ASource: TvVectorialPage; CurEntity: TvEntity;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
@ -543,7 +543,7 @@ begin
end;
end;
procedure DrawFPVTextToCanvas(ASource: TvVectorialDocument; CurText: TvText;
procedure DrawFPVTextToCanvas(ASource: TvVectorialPage; CurText: TvText;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);

View File

@ -45,14 +45,14 @@ type
private
FPointSeparator, FCommaSeparator: TFormatSettings;
FSVGPathTokenizer: TSVGPathTokenizer;
procedure ReadPathFromNode(APath: TDOMNode; AData: TvVectorialDocument);
procedure ReadPathFromString(AStr: string; AData: TvVectorialDocument);
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: TvVectorialDocument;
const AData: TvVectorialPage;
const ASrcX, ASrcY: Float; var ADestX, ADestY: Float);
procedure ConvertSVGDeltaToFPVDelta(
const AData: TvVectorialDocument;
const AData: TvVectorialPage;
const ASrcX, ASrcY: Float; var ADestX, ADestY: Float);
public
{ General reading methods }
@ -194,7 +194,7 @@ end;
{ TvSVGVectorialReader }
procedure TvSVGVectorialReader.ReadPathFromNode(APath: TDOMNode;
AData: TvVectorialDocument);
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
lNodeName, lStyleStr, lDStr: WideString;
i: Integer;
@ -209,12 +209,12 @@ begin
end;
AData.StartPath();
ReadPathFromString(UTF8Encode(lDStr), AData);
ReadPathFromString(UTF8Encode(lDStr), AData, ADoc);
AData.EndPath();
end;
procedure TvSVGVectorialReader.ReadPathFromString(AStr: string;
AData: TvVectorialDocument);
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
i: Integer;
X, Y, X2, Y2, X3, Y3: Float;
@ -296,7 +296,7 @@ begin
end;
procedure TvSVGVectorialReader.ConvertSVGCoordinatesToFPVCoordinates(
const AData: TvVectorialDocument; const ASrcX, ASrcY: Float;
const AData: TvVectorialPage; const ASrcX, ASrcY: Float;
var ADestX,ADestY: Float);
begin
ADestX := ASrcX * FLOAT_MILIMETERS_PER_PIXEL;
@ -304,7 +304,7 @@ begin
end;
procedure TvSVGVectorialReader.ConvertSVGDeltaToFPVDelta(
const AData: TvVectorialDocument; const ASrcX, ASrcY: Float; var ADestX,
const AData: TvVectorialPage; const ASrcX, ASrcY: Float; var ADestX,
ADestY: Float);
begin
ADestX := ASrcX * FLOAT_MILIMETERS_PER_PIXEL;
@ -334,6 +334,7 @@ procedure TvSVGVectorialReader.ReadFromStream(AStream: TStream;
var
Doc: TXMLDocument;
lFirstLayer, lCurNode: TDOMNode;
lPage: TvVectorialPage;
begin
try
// Read in xml file from the stream
@ -346,9 +347,10 @@ begin
// Now process the elements inside the first layer
lFirstLayer := Doc.DocumentElement.FirstChild;
lCurNode := lFirstLayer.FirstChild;
lPage := AData.AddPage();
while Assigned(lCurNode) do
begin
ReadPathFromNode(lCurNode, AData);
ReadPathFromNode(lCurNode, lPage, AData);
lCurNode := lCurNode.NextSibling;
end;
finally

View File

@ -252,11 +252,13 @@ procedure TvSVGVectorialWriter.WriteEntities(AStrings: TStrings;
AData: TvVectorialDocument);
var
lEntity: TvEntity;
i: Integer;
i, j: Integer;
CurPage: TvVectorialPage;
begin
for i := 0 to AData.GetEntitiesCount() - 1 do
CurPage := AData.GetPage(0);
for i := 0 to CurPage.GetEntitiesCount() - 1 do
begin
lEntity := AData.GetEntity(i);
lEntity := CurPage.GetEntity(i);
if lEntity is TPath then WritePath(i, TPath(lEntity), AStrings, AData)
else if lEntity is TvText then WriteText(AStrings, TvText(lEntity), AData);

View File

@ -45,7 +45,7 @@ var
implementation
uses
fpvectorial, cdrvectorialreader, svgvectorialwriter, pdfvectorialreader,
fpvectorial, cdrvectorialreader, svgvectorialwriter,
dxfvectorialreader, epsvectorialreader,
fpvtocanvas,
dxftokentotree;
@ -93,7 +93,7 @@ begin
Drawer.Drawing.Canvas.Brush.Style := bsSolid;
Drawer.Drawing.Canvas.FillRect(0, 0, Drawer.Drawing.Width, Drawer.Drawing.Height);
DrawFPVectorialToCanvas(
Vec,
Vec.GetPage(0),
Drawer.Drawing.Canvas,
FPVVIEWER_SPACE_FOR_NEGATIVE_COORDS,
Drawer.Drawing.Height - FPVVIEWER_SPACE_FOR_NEGATIVE_COORDS,
@ -141,13 +141,15 @@ end;
procedure TfrmFPVViewer.buttonRenderingTestClick(Sender: TObject);
var
Vec: TvVectorialDocument;
VecDoc: TvVectorialDocument;
Vec: TvVectorialPage;
begin
notebook.PageIndex := 0;
Drawer.Clear;
Vec := TvVectorialDocument.Create;
VecDoc := TvVectorialDocument.Create;
Vec := VecDoc.AddPage();
try
Vec.AddAlignedDimension(Make2DPoint(100, 50), Make2DPoint(200, 100), Make2DPoint(100, 150), Make2DPoint(200, 150));
Vec.AddAlignedDimension(Make2DPoint(50, 250), Make2DPoint(100, 200), Make2DPoint(150, 250), Make2DPoint(150, 200));