pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpvectorial: Major rework to have a single list of entities, allowing to use that as a Z-Order

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1686 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2011-06-17 09:34:54 +00:00
parent 91483bb56d
commit 20bce90e6b
5 changed files with 417 additions and 439 deletions
Download Patch File Download Diff File Expand all files Collapse all files

32
applications/fpvviewer/fpvectorialsrc/dxfvectorialreader.pas
View File

@ -148,22 +148,22 @@ const
// Valid for DXF up to AutoCad 2004, after that RGB is available
AUTOCAD_COLOR_PALETTE: array[0..15] of TFPColor =
(
(Red: $0000; Green: $0000; Blue: $0000; Alpha: FPValphaOpaque), // 0 - Black
(Red: $0000; Green: $0000; Blue: $8080; Alpha: FPValphaOpaque), // 1 - Dark blue
(Red: $0000; Green: $8080; Blue: $0000; Alpha: FPValphaOpaque), // 2 - Dark green
(Red: $0000; Green: $8080; Blue: $8080; Alpha: FPValphaOpaque), // 3 - Dark cyan
(Red: $8080; Green: $0000; Blue: $0000; Alpha: FPValphaOpaque), // 4 - Dark red
(Red: $8080; Green: $0000; Blue: $8080; Alpha: FPValphaOpaque), // 5 - Dark Magenta
(Red: $8080; Green: $8080; Blue: $0000; Alpha: FPValphaOpaque), // 6 - Dark
(Red: $c0c0; Green: $c0c0; Blue: $c0c0; Alpha: FPValphaOpaque), // 7 - Light Gray
(Red: $8080; Green: $8080; Blue: $8080; Alpha: FPValphaOpaque), // 8 - Medium Gray
(Red: $0000; Green: $0000; Blue: $ffff; Alpha: FPValphaOpaque), // 9 - Light blue
(Red: $0000; Green: $ffff; Blue: $0000; Alpha: FPValphaOpaque), // 10 - Light green
(Red: $0000; Green: $ffff; Blue: $ffff; Alpha: FPValphaOpaque), // 11 - Light cyan
(Red: $ffff; Green: $0000; Blue: $0000; Alpha: FPValphaOpaque), // 12 - Light red
(Red: $ffff; Green: $0000; Blue: $ffff; Alpha: FPValphaOpaque), // 13 - Light Magenta
(Red: $ffff; Green: $ffff; Blue: $0000; Alpha: FPValphaOpaque), // 14 - Light Yellow
(Red: $ffff; Green: $ffff; Blue: $ffff; Alpha: FPValphaOpaque) // 15 - White
(Red: $0000; Green: $0000; Blue: $0000; Alpha: alphaOpaque), // 0 - Black
(Red: $0000; Green: $0000; Blue: $8080; Alpha: alphaOpaque), // 1 - Dark blue
(Red: $0000; Green: $8080; Blue: $0000; Alpha: alphaOpaque), // 2 - Dark green
(Red: $0000; Green: $8080; Blue: $8080; Alpha: alphaOpaque), // 3 - Dark cyan
(Red: $8080; Green: $0000; Blue: $0000; Alpha: alphaOpaque), // 4 - Dark red
(Red: $8080; Green: $0000; Blue: $8080; Alpha: alphaOpaque), // 5 - Dark Magenta
(Red: $8080; Green: $8080; Blue: $0000; Alpha: alphaOpaque), // 6 - Dark
(Red: $c0c0; Green: $c0c0; Blue: $c0c0; Alpha: alphaOpaque), // 7 - Light Gray
(Red: $8080; Green: $8080; Blue: $8080; Alpha: alphaOpaque), // 8 - Medium Gray
(Red: $0000; Green: $0000; Blue: $ffff; Alpha: alphaOpaque), // 9 - Light blue
(Red: $0000; Green: $ffff; Blue: $0000; Alpha: alphaOpaque), // 10 - Light green
(Red: $0000; Green: $ffff; Blue: $ffff; Alpha: alphaOpaque), // 11 - Light cyan
(Red: $ffff; Green: $0000; Blue: $0000; Alpha: alphaOpaque), // 12 - Light red
(Red: $ffff; Green: $0000; Blue: $ffff; Alpha: alphaOpaque), // 13 - Light Magenta
(Red: $ffff; Green: $ffff; Blue: $0000; Alpha: alphaOpaque), // 14 - Light Yellow
(Red: $ffff; Green: $ffff; Blue: $ffff; Alpha: alphaOpaque) // 15 - White
);
{ TDXFToken }

201
applications/fpvviewer/fpvectorialsrc/fpvectorial.pas
View File

@ -44,6 +44,8 @@ const
STR_ENCAPSULATEDPOSTSCRIPT_EXTENSION = '.eps';
type
{ Pen, Brush and Font }
TvPen = record
Color: TFPColor;
Style: TFPPenStyle;
@ -55,11 +57,20 @@ type
Style: TFPBrushStyle;
end;
const
FPValphaTransparent = $00;
FPValphaOpaque = $FF;
TvFont = record
Color: TFPColor;
Size: integer;
Name: utf8string;
{@@
Font orientation is measured in degrees and uses the
same direction as the LCL TFont.orientation, which is counter-clockwise.
Zero is the normal, horizontal, orientation.
}
Orientation: Double;
end;
{ Coordinates and polyline segments }
type
T3DPoint = record
X, Y, Z: Double;
end;
@ -128,60 +139,47 @@ type
X3, Y3, Z3: Double;
end;
TPath = class
{ Now all elements }
{@@
All elements should derive from TvEntity, regardless of whatever properties
they might contain.
}
TvEntity = class
public
{@@ The global Pen for the entire entity. In the case of paths, individual
elements might be able to override this setting. }
Pen: TvPen;
{@@ The global Brush for the entire entity. In the case of paths, individual
elements might be able to override this setting. }
Brush: TvBrush;
constructor Create; virtual;
end;
TPath = class(TvEntity)
Len: Integer;
Points: TPathSegment; // Beginning of the double-linked list
PointsEnd: TPathSegment; // End of the double-linked list
CurPoint: TPathSegment; // Used in PrepareForSequentialReading and Next
{@@ The global Pen for the entire path. This Pen might be overriden by
individual elements of the polyline. }
Pen: TvPen;
{@@ Sets a Brush to paint the inner area inside the path.
There is no inner area if Brush.Style = bsClear, which is the default. }
Brush: TvBrush;
constructor Create();
procedure Assign(APath: TPath);
procedure Assign(ASource: TPath);
procedure PrepareForSequentialReading;
function Next(): TPathSegment;
end;
TvFont = record
Color: TFPColor;
Size: integer;
Name: utf8string;
{@@
Font orientation is measured in degrees and uses the
same direction as the LCL TFont.orientation, which is counter-clockwise.
Zero is the normal, horizontal, orientation.
}
Orientation: Double;
end;
{@@
TvText represents a text in memory.
At the moment fonts are unsupported, only simple texts
up to 255 chars are supported.
}
TvText = class
TvText = class(TvEntity)
public
X, Y, Z: Double; // Z is ignored in 2D formats
Value: utf8string;
Font: TvFont;
end;
{@@
}
{ TvEntity }
TvEntity = class
public
Pen: TvPen;
Brush: TvBrush;
constructor Create; virtual;
end;
{@@
}
TvCircle = class(TvEntity)
@ -200,9 +198,6 @@ type
{@@
}
{ TvEllipse }
TvEllipse = class(TvEntity)
public
// Mandatory fields
@ -215,6 +210,8 @@ type
end;
{@@
The brush has no effect in this class
DimensionLeft ---text--- DimensionRight
| |
| | BaseRight
@ -239,8 +236,6 @@ type
TvVectorialDocument = class
private
FPaths: TFPList;
FTexts: TFPList;
FEntities: TFPList;
FTmpPath: TPath;
FTmpText: TvText;
@ -255,6 +250,8 @@ type
{ Base methods }
constructor Create;
destructor Destroy; override;
procedure Assign(ASource: TvVectorialDocument);
procedure AssignTo(ADest: TvVectorialDocument);
procedure WriteToFile(AFileName: string; AFormat: TvVectorialFormat); overload;
procedure WriteToFile(AFileName: string); overload;
procedure WriteToStream(AStream: TStream; AFormat: TvVectorialFormat);
@ -268,16 +265,13 @@ type
{ Data reading methods }
function GetPath(ANum: Cardinal): TPath;
function GetPathCount: Integer;
function GetText(ANum: Cardinal): TvText;
function GetTextCount: Integer;
function GetEntity(ANum: Cardinal): TvEntity;
function GetEntityCount: Integer;
function GetEntitiesCount: Integer;
{ Data removing methods }
procedure Clear;
procedure RemoveAllPaths;
procedure RemoveAllTexts;
{ Data writing methods }
procedure AddPath(APath: TPath);
procedure AddEntity(AEntity: TvEntity);
procedure AddPathCopyMem(APath: TPath);
procedure StartPath(AX, AY: Double); overload;
procedure StartPath(); overload;
procedure AddMoveToPath(AX, AY: Double);
@ -517,8 +511,6 @@ constructor TvVectorialDocument.Create;
begin
inherited Create;
FPaths := TFPList.Create;
FTexts := TFPList.Create;
FEntities := TFPList.Create;
FTmpPath := TPath.Create;
end;
@ -530,40 +522,35 @@ destructor TvVectorialDocument.Destroy;
begin
Clear;
FPaths.Free;
FTexts.Free;
FEntities.Free;
inherited Destroy;
end;
{@@
Clears the list of Vectors and releases their memory.
}
procedure TvVectorialDocument.RemoveAllPaths;
procedure TvVectorialDocument.Assign(ASource: TvVectorialDocument);
var
i: Integer;
begin
// FPaths.ForEachCall(RemoveCallback, nil);
FPaths.Clear;
Clear;
for i := 0 to ASource.GetEntitiesCount - 1 do
Self.AddEntity(ASource.GetEntity(i));
end;
procedure TvVectorialDocument.RemoveAllTexts;
procedure TvVectorialDocument.AssignTo(ADest: TvVectorialDocument);
begin
// FTexts.ForEachCall(RemoveCallback, nil);
FTexts.Clear;
ADest.Assign(Self);
end;
procedure TvVectorialDocument.AddPath(APath: TPath);
procedure TvVectorialDocument.AddPathCopyMem(APath: TPath);
var
lPath: TPath;
Len: Integer;
begin
lPath := TPath.Create;
lPath.Assign(APath);
FPaths.Add(Pointer(lPath));
AddEntity(lPath);
//WriteLn(':>TvVectorialDocument.AddPath 1 Len = ', Len);
//WriteLn(':>TvVectorialDocument.AddPath 2');
//WriteLn(':>TvVectorialDocument.AddPath 3');
//WriteLn(':>TvVectorialDocument.AddPath 4');
end;
{@@
@ -746,7 +733,7 @@ end;
procedure TvVectorialDocument.EndPath();
begin
if FTmPPath.Len = 0 then Exit;
AddPath(FTmPPath);
AddPathCopyMem(FTmPPath);
ClearTmpPath();
end;
@ -761,7 +748,7 @@ begin
lText.Z := AZ;
lText.Font.Name := FontName;
lText.Font.Size := FontSize;
FTexts.Add(lText);
AddEntity(lText);
end;
procedure TvVectorialDocument.AddText(AX, AY, AZ: Double; AStr: utf8string);
@ -778,7 +765,7 @@ begin
lCircle.CenterY := ACenterY;
lCircle.CenterZ := ACenterZ;
lCircle.Radius := ARadius;
FEntities.Add(lCircle);
AddEntity(lCircle);
end;
procedure TvVectorialDocument.AddCircularArc(ACenterX, ACenterY, ACenterZ,
@ -794,7 +781,7 @@ begin
lCircularArc.StartAngle := AStartAngle;
lCircularArc.EndAngle := AEndAngle;
lCircularArc.Pen.Color := AColor;
FEntities.Add(lCircularArc);
AddEntity(lCircularArc);
end;
procedure TvVectorialDocument.AddEllipse(CenterX, CenterY, CenterZ,
@ -809,7 +796,15 @@ begin
lEllipse.MajorHalfAxis := MajorHalfAxis;
lEllipse.MinorHalfAxis := MinorHalfAxis;
lEllipse.Angle := Angle;
FEntities.Add(lEllipse);
AddEntity(lEllipse);
end;
{@@
Don't free the passed TvText because it will be added directly to the list
}
procedure TvVectorialDocument.AddEntity(AEntity: TvEntity);
begin
FEntities.Add(Pointer(AEntity));
end;
procedure TvVectorialDocument.AddAlignedDimension(BaseLeft, BaseRight,
@ -822,7 +817,7 @@ begin
lDim.BaseRight := BaseRight;
lDim.DimensionLeft := DimLeft;
lDim.DimensionRight := DimRight;
FEntities.Add(lDim);
AddEntity(lDim);
end;
{@@
@ -1062,31 +1057,32 @@ begin
end;
function TvVectorialDocument.GetPath(ANum: Cardinal): TPath;
var
i: Integer;
Index: Integer = - 1;
begin
if ANum >= FPaths.Count then raise Exception.Create('TvVectorialDocument.GetPath: Path number out of bounds');
Result := nil;
if FPaths.Items[ANum] = nil then raise Exception.Create('TvVectorialDocument.GetPath: Invalid Path number');
if ANum >= FEntities.Count then raise Exception.Create('TvVectorialDocument.GetPath: Path number out of bounds');
Result := TPath(FPaths.Items[ANum]);
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;
end;
function TvVectorialDocument.GetPathCount: Integer;
var
i: Integer;
begin
Result := FPaths.Count;
end;
Result := 0;
function TvVectorialDocument.GetText(ANum: Cardinal): TvText;
begin
if ANum >= FTexts.Count then raise Exception.Create('TvVectorialDocument.GetText: Text number out of bounds');
if FTexts.Items[ANum] = nil then raise Exception.Create('TvVectorialDocument.GetText: Invalid Text number');
Result := TvText(FTexts.Items[ANum]);
end;
function TvVectorialDocument.GetTextCount: Integer;
begin
Result := FTexts.Count;
for i := 0 to FEntities.Count - 1 do
if TvEntity(FEntities.Items[i]) is TPath then Inc(Result);
end;
function TvVectorialDocument.GetEntity(ANum: Cardinal): TvEntity;
@ -1098,7 +1094,7 @@ begin
Result := TvEntity(FEntities.Items[ANum]);
end;
function TvVectorialDocument.GetEntityCount: Integer;
function TvVectorialDocument.GetEntitiesCount: Integer;
begin
Result := FEntities.Count;
end;
@ -1108,8 +1104,7 @@ end;
}
procedure TvVectorialDocument.Clear;
begin
RemoveAllPaths();
RemoveAllTexts();
FEntities.Clear();
end;
{ TvCustomVectorialReader }
@ -1220,20 +1215,14 @@ end;
{ TPath }
constructor TPath.Create();
procedure TPath.Assign(ASource: TPath);
begin
Brush.Style := bsClear;
inherited Create();
end;
procedure TPath.Assign(APath: TPath);
begin
Len := APath.Len;
Points := APath.Points;
PointsEnd := APath.PointsEnd;
CurPoint := APath.CurPoint;
Pen := APath.Pen;
Brush := APath.Brush;
Len := ASource.Len;
Points := ASource.Points;
PointsEnd := ASource.PointsEnd;
CurPoint := ASource.CurPoint;
Pen := ASource.Pen;
Brush := ASource.Brush;
end;
procedure TPath.PrepareForSequentialReading;

102
applications/fpvviewer/fpvectorialsrc/fpvtocanvas.pas
View File

@ -10,23 +10,22 @@ uses
Classes, SysUtils, Math,
{$ifdef USE_LCL_CANVAS}
Graphics, LCLIntf,
{$else}
fpcanvas,
{$endif}
fpcanvas,
fpimage,
fpvectorial;
procedure DrawFPVectorialToCanvas(ASource: TvVectorialDocument;
{$ifdef USE_LCL_CANVAS}ADest: TCanvas;{$else}ADest: TFPCustomCanvas;{$endif}
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
procedure DrawFPVPathsToCanvas(ASource: TvVectorialDocument;
{$ifdef USE_LCL_CANVAS}ADest: TCanvas;{$else}ADest: TFPCustomCanvas;{$endif}
procedure DrawFPVPathToCanvas(ASource: TvVectorialDocument; CurPath: TPath;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
procedure DrawFPVEntitiesToCanvas(ASource: TvVectorialDocument;
{$ifdef USE_LCL_CANVAS}ADest: TCanvas;{$else}ADest: TFPCustomCanvas;{$endif}
procedure DrawFPVEntityToCanvas(ASource: TvVectorialDocument; CurEntity: TvEntity;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
procedure DrawFPVTextToCanvas(ASource: TvVectorialDocument;
{$ifdef USE_LCL_CANVAS}ADest: TCanvas;{$else}ADest: TFPCustomCanvas;{$endif}
procedure DrawFPVTextToCanvas(ASource: TvVectorialDocument; CurText: TvText;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
implementation
@ -47,17 +46,16 @@ begin
end;
procedure DrawRotatedEllipse(
{$ifdef USE_LCL_CANVAS}
ADest: TCanvas;
{$else}
ADest: TFPCustomCanvas;
{$endif}
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();
@ -82,7 +80,7 @@ begin
// Conrollpoint of secondpart endpoint
PointList[6] := PointList[0]; // Endpoint of
// Back to the startpoint
ADest.PolyBezier(Pointlist[0]);
ALCLDest.PolyBezier(Pointlist[0]);
{$endif}
end;
@ -102,24 +100,32 @@ end;
}
{.$define FPVECTORIAL_TOCANVAS_DEBUG}
procedure DrawFPVectorialToCanvas(ASource: TvVectorialDocument;
{$ifdef USE_LCL_CANVAS}ADest: TCanvas;{$else}ADest: TFPCustomCanvas;{$endif}
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}
DrawFPVPathsToCanvas(ASource, ADest, ADestX, ADestY, AMulX, AMulY);
DrawFPVEntitiesToCanvas(ASource, ADest, ADestX, ADestY, AMulX, AMulY);
DrawFPVTextToCanvas(ASource, ADest, ADestX, ADestY, AMulX, AMulY);
for i := 0 to ASource.GetEntitiesCount - 1 do
begin
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 FPVECTORIALDEBUG}
WriteLn(':<DrawFPVectorialToCanvas');
{$endif}
end;
procedure DrawFPVPathsToCanvas(ASource: TvVectorialDocument;
{$ifdef USE_LCL_CANVAS}ADest: TCanvas;{$else}ADest: TFPCustomCanvas;{$endif}
procedure DrawFPVPathToCanvas(ASource: TvVectorialDocument; CurPath: TPath;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
function CoordToCanvasX(ACoord: Double): Integer;
@ -133,9 +139,8 @@ procedure DrawFPVPathsToCanvas(ASource: TvVectorialDocument;
end;
var
i, j, k: Integer;
j, k: Integer;
PosX, PosY: Integer; // Not modified by ADestX, etc
CurPath: TPath;
CurSegment: TPathSegment;
Cur2DSegment: T2DSegment absolute CurSegment;
Cur2DBSegment: T2DBezierSegment absolute CurSegment;
@ -150,11 +155,6 @@ begin
ADest.MoveTo(ADestX, ADestY);
// Draws all paths
for i := 0 to ASource.PathCount - 1 do
begin
//WriteLn('i = ', i);
CurPath := ASource.Paths[i];
CurPath.PrepareForSequentialReading;
// Set the path Pen and Brush options
@ -225,11 +225,10 @@ begin
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
WriteLn('');
{$endif}
end;
end;
procedure DrawFPVEntitiesToCanvas(ASource: TvVectorialDocument;
{$ifdef USE_LCL_CANVAS}ADest: TCanvas;{$else}ADest: TFPCustomCanvas;{$endif}
procedure DrawFPVEntityToCanvas(ASource: TvVectorialDocument; CurEntity: TvEntity;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
function CoordToCanvasX(ACoord: Double): Integer;
@ -244,8 +243,10 @@ procedure DrawFPVEntitiesToCanvas(ASource: TvVectorialDocument;
var
i: Integer;
{$ifdef USE_LCL_CANVAS}
ALCLDest: TCanvas absolute ADest;
{$endif}
// For entities
CurEntity: TvEntity;
CurCircle: TvCircle;
CurEllipse: TvEllipse;
//
@ -258,11 +259,6 @@ var
Points: array of TPoint;
UpperDim, LowerDim: T3DPoint;
begin
// Draws all entities
for i := 0 to ASource.GetEntityCount - 1 do
begin
CurEntity := ASource.GetEntity(i);
ADest.Brush.Style := CurEntity.Brush.Style;
ADest.Pen.Style := CurEntity.Pen.Style;
ADest.Pen.FPColor := CurEntity.Pen.Color;
@ -331,11 +327,11 @@ begin
[CurArc.CenterX, CurArc.CenterY, CurArc.Radius, IntStartAngle/16, IntAngleLength/16]));
{$endif}
ADest.Pen.FPColor := CurArc.Pen.Color;
ADest.Arc(
ALCLDest.Arc(
BoundsLeft, BoundsTop, BoundsRight, BoundsBottom,
IntStartAngle, IntAngleLength
);
ADest.Pen.Color := clBlack;
ADest.Pen.FPColor := colBlack;
// Debug info
// {$define FPVECTORIALDEBUG}
// {$ifdef FPVECTORIALDEBUG}
@ -370,11 +366,7 @@ begin
SetLength(Points, 3);
if CurDim.DimensionRight.Y = CurDim.DimensionLeft.Y then
begin
{$ifdef USE_LCL_CANVAS}
ADest.Brush.Color := clBlack;
{$else}
ADest.Brush.FPColor := colBlack;
{$endif}
ADest.Brush.Style := bsSolid;
// Left arrow
Points[0] := Point(CoordToCanvasX(CurDim.DimensionLeft.X), CoordToCanvasY(CurDim.DimensionLeft.Y));
@ -396,11 +388,7 @@ begin
end
else
begin
{$ifdef USE_LCL_CANVAS}
ADest.Brush.Color := clBlack;
{$else}
ADest.Brush.FPColor := colBlack;
{$endif}
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
@ -439,11 +427,10 @@ begin
ADest.TextOut(CoordToCanvasX(CurDim.DimensionLeft.X), CoordToCanvasY(CurDim.DimensionLeft.Y), 'DL');
ADest.TextOut(CoordToCanvasX(CurDim.BaseLeft.X), CoordToCanvasY(CurDim.BaseLeft.Y), 'BL');}
end;
end;
end;
procedure DrawFPVTextToCanvas(ASource: TvVectorialDocument;
{$ifdef USE_LCL_CANVAS}ADest: TCanvas;{$else}ADest: TFPCustomCanvas;{$endif}
procedure DrawFPVTextToCanvas(ASource: TvVectorialDocument; CurText: TvText;
ADest: TFPCustomCanvas;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
function CoordToCanvasX(ACoord: Double): Integer;
@ -458,29 +445,20 @@ procedure DrawFPVTextToCanvas(ASource: TvVectorialDocument;
var
i: Integer;
// For text
CurText: TvText;
{$ifdef USE_LCL_CANVAS}
ALCLDest: TCanvas absolute ADest;
{$endif}
//
LowerDim: T3DPoint;
begin
// Draws all text
for i := 0 to ASource.GetTextCount - 1 do
begin
CurText := ASource.GetText(i);
ADest.Font.Size := Round(AmulX * CurText.Font.Size);
ADest.Pen.Style := psSolid;
{$ifdef USE_LCL_CANVAS}
ADest.Pen.Color := clBlack;
{$else}
ADest.Pen.FPColor := colBlack;
{$endif}
ADest.Brush.Style := bsClear;
ADest.Font.Orientation := Round(CurText.Font.Orientation * 16);
ALCLDest.Font.Orientation := Round(CurText.Font.Orientation * 16);
LowerDim.Y := CurText.Y + CurText.Font.Size;
ADest.TextOut(CoordToCanvasX(CurText.X), CoordToCanvasY(LowerDim.Y), CurText.Value);
end;
end;
end.

15
applications/fpvviewer/fpvectorialsrc/fpvutils.pas
View File

@ -29,6 +29,7 @@ function FPColorToRGBHexString(AColor: TFPColor): string;
function RGBToFPColor(AR, AG, AB: byte): TFPColor; inline;
// Other routine
function CanvasCoordsToFPVectorial(AY: Integer; AHeight: Integer): Integer; inline;
function CanvasTextPosToFPVectorial(AY: Integer; ACanvasHeight, ATextHeight: Integer): Integer;
function SeparateString(AString: string; ASeparator: char): T10Strings;
implementation
@ -54,12 +55,26 @@ end;
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;
{@@
Reads a string and separates it in substring
using ASeparator to delimite them.

40
applications/fpvviewer/fpvectorialsrc/svgvectorialwriter.pas
View File

@ -23,9 +23,9 @@ type
FPointSeparator, FCommaSeparator: TFormatSettings;
procedure WriteDocumentSize(AStrings: TStrings; AData: TvVectorialDocument);
procedure WriteDocumentName(AStrings: TStrings; AData: TvVectorialDocument);
procedure WritePaths(AStrings: TStrings; AData: TvVectorialDocument);
procedure WritePath(AIndex: Integer; APath: TPath; AStrings: TStrings; AData: TvVectorialDocument);
procedure WriteTexts(AStrings: TStrings; AData: TvVectorialDocument);
procedure WriteText(AStrings: TStrings; lText: TvText; AData: TvVectorialDocument);
procedure WriteEntities(AStrings: TStrings; AData: TvVectorialDocument);
procedure ConvertFPVCoordinatesToSVGCoordinates(
const AData: TvVectorialDocument;
const ASrcX, ASrcY: Double; var ADestX, ADestY: double);
@ -61,19 +61,6 @@ begin
AStrings.Add(' sodipodi:docname="New document 1">');
end;
procedure TvSVGVectorialWriter.WritePaths(AStrings: TStrings; AData: TvVectorialDocument);
var
i: Integer;
lPath: TPath;
begin
for i := 0 to AData.GetPathCount() - 1 do
begin
lPath := AData.GetPath(i);
lPath.PrepareForSequentialReading;
WritePath(i ,lPath, AStrings, AData);
end;
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.
@ -227,25 +214,20 @@ begin
// Now data
AStrings.Add(' <g id="layer1">');
WritePaths(AStrings, AData);
WriteTexts(AStrings, AData);
WriteEntities(AStrings, AData);
AStrings.Add(' </g>');
// finalization
AStrings.Add('</svg>');
end;
procedure TvSVGVectorialWriter.WriteTexts(AStrings: TStrings; AData: TvVectorialDocument);
procedure TvSVGVectorialWriter.WriteText(AStrings: TStrings; lText: TvText; AData: TvVectorialDocument);
var
i, j, FontSize: Integer;
TextStr, FontName, SVGFontFamily: string;
lText: TvText;
PtX, PtY: double;
begin
for i := 0 to AData.GetTextCount() - 1 do
begin
TextStr := '';
lText := AData.GetText(i);
ConvertFPVCoordinatesToSVGCoordinates(
AData, lText.X, lText.Y, PtX, PtY);
@ -264,6 +246,20 @@ begin
// AStrings.Add(' id="tspan2828" ');
AStrings.Add(' >');
AStrings.Add(TextStr + '</tspan></text>');
end;
procedure TvSVGVectorialWriter.WriteEntities(AStrings: TStrings;
AData: TvVectorialDocument);
var
lEntity: TvEntity;
i: 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)
else if lEntity is TvText then WriteText(AStrings, TvText(lEntity), AData);
end;
end;