1 {
2 fpvectorial.pas
3 
4 Vector graphics document
5 
6 License: The same modified LGPL as the Free Pascal RTL
7          See the file COPYING.modifiedLGPL for more details
8 
9 AUTHORS: Felipe Monteiro de Carvalho
10 }
11 unit fpvectorial;
12 
13 {$ifdef fpc}
14   {$mode objfpc}{$h+}
15 {$endif}
16 
17 {$define USE_LCL_CANVAS}
18 {$ifdef USE_LCL_CANVAS}
19   {$define USE_CANVAS_CLIP_REGION}
20   {.$define DEBUG_CANVAS_CLIP_REGION}
21 {$endif}
22 {.$define FPVECTORIAL_DEBUG_DIMENSIONS}
23 {.$define FPVECTORIAL_TOCANVAS_DEBUG}
24 {.$define FPVECTORIAL_DEBUG_BLOCKS}
25 {.$define FPVECTORIAL_AUTOFIT_DEBUG}
26 {.$define FPVECTORIAL_SUPPORT_LAZARUS_1_6}
27 // visual debugs
28 {.$define FPVECTORIAL_TOCANVAS_ELLIPSE_VISUALDEBUG}
29 {.$define FPVECTORIAL_RENDERINFO_VISUALDEBUG}
30 
31 interface
32 
33 uses
34   Classes, SysUtils, Math, TypInfo, contnrs, types,
35   // FCL-Image
36   FPCanvas, FPImage, FPWriteBMP,
37   // lazutils
38   GraphType, Laz2_DOM,
39   // LCL
40   LazUTF8, LazRegions
41   {$ifdef USE_LCL_CANVAS}
42   , Graphics, LCLIntf, LCLType, IntfGraphics, InterfaceBase
43   {$endif}
44   ;
45 
46 type
47   TvVectorialFormat = (
48     vfUnknown,
49     { Multi-purpose document formats }
50     vfPDF, vfSVG, vfSVGZ, vfCorelDrawCDR, vfWindowsMetafileWMF, vfODG,
51     { CAD formats }
52     vfDXF,
53     { Geospatial formats }
54     vfLAS, vfLAZ,
55     { Printing formats }
56     vfPostScript, vfEncapsulatedPostScript,
57     { GCode formats }
58     vfGCodeAvisoCNCPrototipoV5, vfGCodeAvisoCNCPrototipoV6,
59     { Formula formats }
60     vfMathML,
61     { Text Document formats }
62     vfODT, vfDOCX, vfHTML,
63     { Raster Image formats }
64     vfRAW
65     );
66 
67   TvPageFormat = (vpA4, vpA3, vpA2, vpA1, vpA0);
68 
69   TvProgressEvent = procedure (APercentage: Byte) of object;
70 
71   {@@ This routine is called to add an item of caption AStr to an item
72     AParent, which is a pointer to another item as returned by a previous call
73     of this same proc. If AParent = nil then it should add the item to the
74     top of the tree. In all cases this routine should return a pointer to the
75     newly created item.
76   }
77   TvDebugAddItemProc = function (AStr: string; AParent: Pointer): Pointer of object;
78 
79 const
80   { Default extensions }
81   { Multi-purpose document formats }
82   STR_PDF_EXTENSION = '.pdf';
83   STR_POSTSCRIPT_EXTENSION = '.ps';
84   STR_SVG_EXTENSION = '.svg';
85   STR_SVGZ_EXTENSION = '.svgz';
86   STR_CORELDRAW_EXTENSION = '.cdr';
87   STR_WINMETAFILE_EXTENSION = '.wmf';
88   STR_AUTOCAD_EXCHANGE_EXTENSION = '.dxf';
89   STR_ENCAPSULATEDPOSTSCRIPT_EXTENSION = '.eps';
90   STR_LAS_EXTENSION = '.las';
91   STR_LAZ_EXTENSION = '.laz';
92   STR_RAW_EXTENSION = '.raw';
93   STR_MATHML_EXTENSION = '.mathml';
94   STR_ODG_EXTENSION = '.odg';
95   STR_ODT_EXTENSION = '.odt';
96   STR_DOCX_EXTENSION = '.docx';
97   STR_HTML_EXTENSION = '.html';
98 
99   STR_FPVECTORIAL_TEXT_HEIGHT_SAMPLE = 'Ćą';
100 
101   NUM_MAX_LISTSTYLES = 8;  // OpenDocument Limit is 10, MS Word Limit is 9
102 
103   // Convenience constant to convert text size points to mm
104   FPV_TEXT_POINT_TO_MM = 0.35278;
105 
106   TWO_PI = 2.0 * pi;
107 
108 type
109   TvCustomVectorialWriter = class;
110   TvCustomVectorialReader = class;
111   TvPage = class;
112   TvVectorialPage = class;
113   TvTextPageSequence = class;
114   TvEntity = class;
115   TPath = class;
116   TvVectorialDocument = class;
117   TvEmbeddedVectorialDoc = class;
118   TvRenderer = class;
119 
120   { Coordinates }
121 
122   T2DPoint = record
123     X, Y: Double;
124   end;
125   P2DPoint = ^T2DPoint;
126 
127   T3DPoint = record
128     X, Y, Z: Double;
129   end;
130   P3DPoint = ^T3DPoint;
131 
132   T2DPointsArray = array of T2DPoint;
133   T3DPointsArray = array of T3DPoint;
134   TPointsArray = array of TPoint;
135 
136   { Pen, Brush and Font }
137 
138   TvPen = record
139     Color: TFPColor;
140     Style: TFPPenStyle;
141     Width: Integer;
142     Pattern: array of LongWord;
143   end;
144   PvPen = ^TvPen;
145 
146   TvBrushKind = (bkSimpleBrush, bkHorizontalGradient, bkVerticalGradient,
147     bkOtherLinearGradient, bkRadialGradient);
148   TvCoordinateUnit = (vcuDocumentUnit, vcuPercentage);
149 
150   TvGradientFlag = (gfRelStartX, gfRelStartY, gfRelEndX, gfRelEndY, gfRelToUserSpace);
151   TvGradientFlags = set of TvGradientFlag;
152 
153   TvGradientColor = record
154     Color: TFPColor;
155     Position: Double;   // 0 ... 1
156   end;
157 
158   TvGradientColors = array of TvGradientColor;
159 
160   TvBrush = record
161     Color: TFPColor;
162     Style: TFPBrushStyle;
163     Kind: TvBrushKind;
164     Image: TFPCustomImage;
165     // Gradient filling support
166     Gradient_start: T2DPoint; // Start/end point of gradient, in pixels by default,
167     Gradient_end: T2DPoint;   // but if gfRel* in flags relative to entity boundary or user space
168     Gradient_flags: TvGradientFlags;
169     Gradient_cx, Gradient_cy, Gradient_r, Gradient_fx, Gradient_fy: Double;
170     Gradient_cx_Unit, Gradient_cy_Unit, Gradient_r_Unit, Gradient_fx_Unit, Gradient_fy_Unit: TvCoordinateUnit;
171     Gradient_colors: TvGradientColors;
172   end;
173   PvBrush = ^TvBrush;
174 
175   TvFont = record
176     Color: TFPColor;
177     Size: integer;
178     Name: utf8string;
179     {@@
180       Font orientation is measured in degrees and uses the
181       same direction as the LCL TFont.orientation, which is counter-clockwise.
182       Zero is the normal, horizontal, orientation, directed to the right.
183     }
184     Orientation: Double;
185     Bold: boolean;
186     Italic: boolean;
187     Underline: boolean;
188     StrikeThrough: boolean;
189   end;
190   PvFont = ^TvFont;
191 
192   TvSetStyleElement = (
193     // Pen, Brush and Font
194     spbfPenColor, spbfPenStyle, spbfPenWidth,
195     spbfBrushColor, spbfBrushStyle, spbfBrushGradient, spbfBrushKind,
196     spbfFontColor, spbfFontSize, spbfFontName, spbfFontBold, spbfFontItalic,
197     spbfFontUnderline, spbfFontStrikeThrough, spbfAlignment,
198     // TextAnchor
199     spbfTextAnchor,
200     // Page style
201     sseMarginTop, sseMarginBottom, sseMarginLeft, sseMarginRight
202     );
203 
204   TvSetStyleElements = set of TvSetStyleElement;
205   // for backwards compatibility, obsolete
206   TvSetPenBrushAndFontElement = TvSetStyleElement;
207   TvSetPenBrushAndFontElements = TvSetStyleElements;
208 
209   TvStyleKind = (
210     // Paragraph kinds
211     vskTextBody, vskHeading,
212     // Text-span kind
213     vskTextSpan);
214 
215   TvStyleAlignment = (vsaLeft, vsaRight, vsaJustifed, vsaCenter);
216 
217   TvTextAnchor = (vtaStart, vtaMiddle, vtaEnd);
218 
219   { TvStyle }
220 
221   TvStyle = class
222   protected
223     FExtraDebugStr: string;
224   public
225     Name: string;
226     Parent: TvStyle; // Can be nil
227     Kind: TvStyleKind;
228     Alignment: TvStyleAlignment;
229     HeadingLevel: Integer;
230     //
231     Pen: TvPen;
232     Brush: TvBrush;
233     Font: TvFont;
234     TextAnchor: TvTextAnchor;
235     // Page style
236     MarginTop, MarginBottom, MarginLeft, MarginRight: Double; // in mm
237     SuppressSpacingBetweenSameParagraphs : Boolean;
238     //
239     SetElements: TvSetStyleElements;
240     //
241     Constructor Create;
242 
GetKindnull243     function GetKind: TvStyleKind; // takes care of parenting
244     procedure Clear(); virtual;
245     procedure CopyFrom(AFrom: TvStyle);
246     procedure CopyFromEntity(AEntity: TvEntity);
247     procedure ApplyOverFromPen(APen: PvPen; ASetElements: TvSetStyleElements);
248     procedure ApplyOverFromBrush(ABrush: PvBrush; ASetElements: TvSetStyleElements);
249     procedure ApplyOverFromFont(AFont: PvFont; ASetElements: TvSetStyleElements);
250     procedure ApplyOver(AFrom: TvStyle); virtual;
251     procedure ApplyIntoEntity(ADest: TvEntity); virtual;
CreateStyleCombinedWithParentnull252     function CreateStyleCombinedWithParent: TvStyle;
GenerateDebugTreenull253     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; virtual;
254   end;
255 
256   TvListStyleKind = (vlskBullet, vlskNumeric);
257 
258   TvNumberFormat = (vnfDecimal,      // 0, 1, 2, 3...
259                     vnfLowerLetter,  // a, b, c, d...
260                     vnfLowerRoman,   // i, ii, iii, iv....
261                     vnfUpperLetter,  // A, B, C, D...
262                     vnfUpperRoman);  // I, II, III, IV....
263   { TvListLevelStyle }
264 
265   TvListLevelStyle = Class
266     Kind : TvListStyleKind;
267     Level : Integer;
268     Start : Integer; // For numbered lists only
269 
270     // Define the "leader", the stuff in front of each list item
271     Prefix : String;
272     Suffix : String;
273     Bullet : String; // Only applies to Kind=vlskBullet
274     NumberFormat : TvNumberFormat; // Only applies to Kind=vlskNumeric
275     DisplayLevels : Boolean; // Only applies to numbered lists.
276                              // If true, style is 1.1.1.1.
277                              //     else style is 1.
278     LeaderFontName : String; // Not used by odt...
279 
280     MarginLeft : Double; // mm
281     HangingIndent : Double; //mm
282     Alignment : TvStyleAlignment;
283 
284     Constructor Create;
285   end;
286 
287  { TvListStyle }
288 
289   TvListStyle = class
290   private
291     ListLevelStyles : TFPList;
292   public
293     Name : String;
294 
295     constructor Create;
296     destructor Destroy; override;
297 
298     procedure Clear;
AddListLevelStylenull299     function AddListLevelStyle : TvListLevelStyle;
GetListLevelStyleCountnull300     function GetListLevelStyleCount : Integer;
GetListLevelStylenull301     function GetListLevelStyle(AIndex: Integer): TvListLevelStyle;
302   end;
303 
304   { Polyline segments }
305 
306   TSegmentType = (
307     st2DLine, st2DLineWithPen, st2DBezier,
308     st3DLine, st3DBezier, stMoveTo,
309     st2DEllipticalArc);
310 
311   {@@
312     The coordinates in fpvectorial are given in millimeters and
313     the starting point is in the bottom-left corner of the document.
314     The X grows to the right and the Y grows to the top.
315   }
316   { TPathSegment }
317 
318   TPathSegment = class
319   protected
320     FPath: TPath;
321   public
322     SegmentType: TSegmentType;
323     // Fields for linking the list
324     Previous: TPathSegment;
325     Next: TPathSegment;
326     // mathematical methods
GetLengthnull327     function GetLength(): Double; virtual;
GetPointAndTangentForDistancenull328     function GetPointAndTangentForDistance(ADistance: Double; out AX, AY, ATangentAngle: Double): Boolean; virtual; // ATangentAngle in radians
GetStartPointnull329     function GetStartPoint(out APoint: T3DPoint): Boolean;
330     // edition methods
331     procedure Move(ADeltaX, ADeltaY: Double); virtual;
332     procedure Rotate(AAngle: Double; ABase: T3DPoint); virtual; // Angle in radians
GenerateDebugTreenull333     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; virtual;
334     // rendering
335     procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); virtual;
336     // helper methods
UseTopLeftCoordinatesnull337     function UseTopLeftCoordinates: Boolean;
338   end;
339 
340   {@@
341     In a 2D segment, the X and Y coordinates represent usually the
342     final point of the segment, being that it starts where the previous
343     segment ends. The exception is for the first segment of all, which simply
344     holds the starting point for the drawing and should always be of the type
345     stMoveTo.
346   }
347 
348   { T2DSegment }
349 
350   T2DSegment = class(TPathSegment)
351   public
352     X, Y: Double;
353     // mathematical methods
GetLengthnull354     function GetLength(): Double; override;
GetPointAndTangentForDistancenull355     function GetPointAndTangentForDistance(ADistance: Double; out AX, AY, ATangentAngle: Double): Boolean; override;
356     // edition methods
357     procedure Move(ADeltaX, ADeltaY: Double); override;
358     procedure Rotate(AAngle: Double; ABase: T3DPoint); override;
GenerateDebugTreenull359     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
360     // rendering
361     procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); override;
362   end;
363 
364   T2DSegmentWithPen = class(T2DSegment)
365   public
366     Pen: TvPen;
367   end;
368 
369   {@@
370     In Bezier segments, we remain using the X and Y coordinates for the ending point.
371     The starting point is where the previous segment ended, so that the intermediary
372     bezier control points are [X2, Y2] and [X3, Y3].
373 
374     Equations:
375 
376     B(t) = (1-t)³ [Prev.X, Prev.Y] + 3 (1-t)² t [X2, Y2] + 3 (1-t) t² [X3, Y3] + t³ [X,Y], 0<=t<=1
377 
378     B'(t) = 3 (1-t)² [X2-Prev.X, Y2-Prev.Y] + 6 (1-t) t [X3-X2, Y3-Y2] + 3 t² [X-X3,Y-Y3]
379   }
380 
381   { T2DBezierSegment }
382 
383   T2DBezierSegment = class(T2DSegment)
384   public
385     X2, Y2: Double;
386     X3, Y3: Double;
387     // mathematical methods
GetLengthnull388     function GetLength(): Double; override;
GetPointAndTangentForDistancenull389     function GetPointAndTangentForDistance(ADistance: Double; out AX, AY, ATangentAngle: Double): Boolean; override;
390     // edition methods
391     procedure Move(ADeltaX, ADeltaY: Double); override;
392     procedure Rotate(AAngle: Double; ABase: T3DPoint); override;
GenerateDebugTreenull393     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
394     // rendering
395     procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); override;
396   end;
397 
398   { T3DSegment }
399 
400   T3DSegment = class(TPathSegment)
401   public
402     {@@
403       Coordinates of the end of the segment.
404       For the first segment, this is the starting point.
405     }
406     X, Y, Z: Double;
407     procedure Move(ADeltaX, ADeltaY: Double); override;
408     // rendering
409     procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); override;
410   end;
411 
412   { T3DBezierSegment }
413 
414   T3DBezierSegment = class(T3DSegment)
415   public
416     X2, Y2, Z2: Double;
417     X3, Y3, Z3: Double;
418     procedure Move(ADeltaX, ADeltaY: Double); override;
419   end;
420 
421   // Elliptical Arc
422   // See http://www.w3.org/TR/SVG/paths.html#PathDataEllipticalArcCommands
423 
424   { T2DEllipticalArcSegment }
425 
426   T2DEllipticalArcSegment = class(T2DSegment)
427   private
428     E1, E2: T3DPoint;
AlignedEllipseCenterEquationT1null429     function AlignedEllipseCenterEquationT1(AParam: Double): Double;
430   public
431     RX, RY: Double; // RX and RY are the X and Y half axis sizes
432     XRotation: Double;  // rotation of x axis, in radians
433     LeftmostEllipse, ClockwiseArcFlag: Boolean;
434     CX, CY: Double; // Ellipse center
435     CenterSetByUser: Boolean; // defines if we should use LeftmostEllipse to calculate the center, or if CX, CY is set directly
436     procedure BezierApproximate(var Points: T3dPointsArray);
437     procedure PolyApproximate(var Points: T3dPointsArray);
438     procedure CalculateCenter;
439     procedure CalculateEllipseBoundingBox(out ALeft, ATop, ARight, ABottom: Double);
GenerateDebugTreenull440     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
441     procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); override;
442     procedure Move(ADeltaX, ADeltaY: Double); override;
443     procedure Rotate(AAngle: Double; ABase: T3DPoint); override;
444   end;
445 
446   TvFindEntityResult = (vfrNotFound, vfrFound, vfrSubpartFound);
447 
448   TvRenderInfo = record
449     // Input to the rendering, provided by the Document or some other
450     // top-level entity and propagated down to all sub-entities
451     Page: TvPage;
452     Renderer: TvRenderer;
453     BackgroundColor: TFPColor;
454     AdjustPenColorToBackground: Boolean;
455     Selected: TvEntity;
456     Canvas: TFPCustomCanvas;
457     DestX: Integer;
458     DestY: Integer;
459     MulX: Double;
460     MulY: Double;
461 
462     // Input to the rendering, other inputs
463     ForceRenderBlock: Boolean; // Blocks are usually invisible, but when rendering an insert, their drawing can be forced
464 
465     // Fields which are output from the rendering process
466     EntityCanvasMinXY, EntityCanvasMaxXY: TPoint; // The size utilized in the canvas to draw this entity, in pixels
467 
468     // errors
469     SelfEntity: TvEntity;
470     Parent: TvEntity;
471     Errors: TStringArray; //was: TStrings; -- avoid mem leak when copying RenderInfo
472   end;
473 
474   TvEntityFeatures = record
475     DrawsUpwards: Boolean; // TvText, TvEmbeddedVectorialDoc, etc draws upwards, but in the future we might have entities drawing downwards
476     DrawsUpwardHeightAdjustment: Integer; // in Canvas pixels
477     FirstLineHeight: Integer; // in Canvas pixels
478     TotalHeight: Integer; // in Canvas pixels
479   end;
480 
481   { Now all elements }
482 
483   {@@
484     All elements should derive from TvEntity, regardless of whatever properties
485     they might contain.
486   }
487 
488   { TvEntity }
489 
490   TvEntity = class
491   public
492     //not used currently Parent: TvEntity; // Might be nil if this is placed directly in the page!!!
493     X, Y, Z: Double;
494     constructor Create(APage: TvPage); virtual;
495     procedure Clear; virtual;
496     procedure SetPage(APage: TvPage); virtual;
497     // in CalculateBoundingBox always remember to treat correctly the case of ADest=nil!!!
498     // This cased is utilized to guess the size of a document even before getting a canvas to draw at
499     procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); virtual;
CalculateSizeInCanvasnull500     function CalculateSizeInCanvas(constref ARenderInfo: TvRenderInfo; APageHeight: Integer; AZoom: Double; out ALeft, ATop, AWidth, AHeight: Integer): Boolean;
501     procedure CalculateHeightInCanvas(constref ARenderInfo: TvRenderInfo; out AHeight: Integer);
502     // helper functions for CalculateBoundingBox & TvRenderInfo
503     procedure ExpandBoundingBox(constref ARenderInfo: TvRenderInfo; var ALeft, ATop, ARight, ABottom: Double);
504     class procedure CalcEntityCanvasMinMaxXY(var ARenderInfo: TvRenderInfo; APointX, APointY: Integer);
505     class procedure CalcEntityCanvasMinMaxXY_With2Points(var ARenderInfo: TvRenderInfo; AX1, AY1, AX2, AY2: Integer);
506     procedure MergeRenderInfo(var AFrom, ATo: TvRenderInfo);
507     class procedure InitializeRenderInfo(var ARenderInfo: TvRenderInfo; ASelf: TvEntity; ACreateObjs: Boolean = False);
508     class procedure FinalizeRenderInfo(var ARenderInfo: TvRenderInfo);
509     class procedure CopyAndInitDocumentRenderInfo(out ATo: TvRenderInfo; AFrom: TvRenderInfo; ACopyMinMax: Boolean = False; AAsChild: Boolean = True);
RenderInfo_GenerateParentTreenull510     function RenderInfo_GenerateParentTree(constref ARenderInfo: TvRenderInfo): string;
CentralizeY_InHeightnull511     function CentralizeY_InHeight(constref ARenderInfo: TvRenderInfo; AHeight: Double): Double;
GetHeightnull512     function  GetHeight(constref ARenderInfo: TvRenderInfo): Double;
GetWidthnull513     function  GetWidth(constref ARenderInfo: TvRenderInfo): Double;
514     {@@ ASubpart is only valid if this routine returns vfrSubpartFound }
GetLineIntersectionPointsnull515     function GetLineIntersectionPoints(ACoord: Double;
516       ACoordIsX: Boolean): TDoubleDynArray; virtual; // get all points where the entity inner area crosses a line
TryToSelectnull517     function TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult; virtual;
518     procedure Move(ADeltaX, ADeltaY: Double); virtual;
519     procedure MoveSubpart(ADeltaX, ADeltaY: Double; ASubpart: Cardinal); virtual;
GetSubpartCountnull520     function  GetSubpartCount: Integer; virtual;
521     procedure PositionSubparts(constref ARenderInfo: TvRenderInfo; ABaseX, ABaseY: Double); virtual;
522     procedure Scale(ADeltaScaleX, ADeltaScaleY: Double); virtual;
523     procedure Rotate(AAngle: Double; ABase: T3DPoint); virtual; // Angle in radians
524     // ADoDraw = False means that no drawing will actually be done, only the size info will be filled in ARenderInfo
525     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); virtual;
AdjustColorToBackgroundnull526     function AdjustColorToBackground(AColor: TFPColor; ARenderInfo: TvRenderInfo): TFPColor;
GetNormalizedPosnull527     function GetNormalizedPos(APage: TvVectorialPage; ANewMin, ANewMax: Double): T3DPoint;
GetEntityFeaturesnull528     function GetEntityFeatures(constref ARenderInfo: TvRenderInfo): TvEntityFeatures; virtual;
GenerateDebugTreenull529     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; virtual;
GenerateDebugStrForFPColornull530     class function GenerateDebugStrForFPColor(AColor: TFPColor): string;
GenerateDebugStrForStringnull531     class function GenerateDebugStrForString(AValue: string): string;
532   end;
533 
534   TvEntityClass = class of TvEntity;
535 
536   { TvNamedEntity }
537 
538   TvNamedEntity = class(TvEntity)
539   protected
540     FExtraDebugStr: string;
541     FPage: TvPage;
542   public
543     Name: string;
544     constructor Create(APage: TvPage); override;
545     procedure SetPage(APage: TvPage); override;
GenerateDebugTreenull546     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
547   end;
548 
549   { TvEntityWithPen }
550 
551   TvEntityWithPen = class(TvNamedEntity)
552   protected
CreatePathnull553     function CreatePath: TPath; virtual;
554   public
555     {@@ The global Pen for the entire entity. In the case of paths, individual
556         elements might be able to override this setting. }
557     Pen: TvPen;
558     constructor Create(APage: TvPage); override;
559     procedure ApplyPenToCanvas(constref ARenderInfo: TvRenderInfo); overload;
560     procedure ApplyPenToCanvas(constref ARenderInfo: TvRenderInfo; APen: TvPen); overload;
561     procedure AssignPen(APen: TvPen);
562     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
563   end;
564 
565   { TvEntityWithPenAndBrush }
566 
567   TvClipMode = (vcmNonzeroWindingRule, vcmEvenOddRule);
568 
569   TvEntityWithPenAndBrush = class(TvEntityWithPen)
570   public
571     procedure CalcGradientVector(out AGradientStart, AGradientEnd: T2dPoint;
572       const ARect: TRect; ADestX: Integer = 0; ADestY: Integer = 0;
573       AMulX: Double = 1.0; AMulY: Double = 1.0);
574     procedure DrawPolygon(var ARenderInfo: TvRenderInfo;
575       const APoints: TPointsArray; const APolyStarts: TIntegerDynArray; ARect: TRect);
576     procedure DrawPolygonBrushLinearGradient(var ARenderInfo: TvRenderInfo;
577       const APoints: TPointsArray;const APolyStarts: TIntegerDynArray;
578       ARect: TRect; AGradientStart, AGradientEnd: T2DPoint);
579     procedure DrawPolygonBrushRadialGradient(var ARenderInfo: TvRenderInfo;
580       const APoints: TPointsArray; ARect: TRect);
581     procedure DrawNativePolygonBrushRadialGradient(var ARenderInfo: TvRenderInfo;
582       const APoints: TPointsArray; ARect: TRect);
583     procedure DrawPolygonBorderOnly(var ARenderInfo: TvRenderInfo; const APoints: TPointsArray);
584   public
585     {@@ The global Brush for the entire entity. In the case of paths, individual
586         elements might be able to override this setting. }
587     Brush: TvBrush;
588     WindingRule: TvClipMode;
589     constructor Create(APage: TvPage); override;
590     procedure ApplyBrushToCanvas(constref ARenderInfo: TvRenderInfo); overload;
591     procedure ApplyBrushToCanvas(constref ARenderInfo: TvRenderInfo; ABrush: PvBrush); overload;
592     procedure AssignBrush(ABrush: PvBrush);
593     procedure DrawBrush(var ARenderInfo: TvRenderInfo);
594     procedure DrawBrushGradient(var ARenderInfo: TvRenderInfo; x1, y1, x2, y2: Integer); virtual;
595     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
GenerateDebugTreenull596     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
597   end;
598 
599   { TvEntityWithPenBrushAndFont }
600 
601   TvEntityWithPenBrushAndFont = class(TvEntityWithPenAndBrush)
602   public
603     Font: TvFont;
604     TextAnchor: TvTextAnchor;
605     constructor Create(APage: TvPage); override;
606     procedure ApplyFontToCanvas(ARenderInfo: TvRenderInfo); overload;
607     procedure ApplyFontToCanvas(ARenderInfo: TvRenderInfo; AFont: TvFont); overload;
608     procedure AssignFont(AFont: TvFont);
609     procedure Rotate(AAngle: Double; ABase: T3DPoint); override; // Angle in radians
610     procedure Scale(ADeltaScaleX, ADeltaScaleY: Double); override;
611     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
GenerateDebugTreenull612     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
613   end;
614 
615   { TvEntityWithStyle }
616 
617   TvEntityWithStyle = class(TvEntityWithPenBrushAndFont)
618   public
619     Style: TvStyle; // can be nil!
620     constructor Create(APage: TvPage); override;
621     destructor Destroy; override;
GetCombinedStylenull622     function GetCombinedStyle(AParent: TvEntityWithStyle): TvStyle;
623     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
624   end;
625 
626   TPath = class(TvEntityWithPenAndBrush)
627   private
628     // Used to speed up sequencial access in MoveSubpart
629     FCurMoveSubPartIndex: Integer;
630     FCurMoveSubPartSegment: TPathSegment;
631     //
632   public
633     FPolyPoints: TPointsArray;
634     FPolyStarts: TIntegerDynArray;
635   public
636     Len: Integer;
637     Points: TPathSegment;   // Beginning of the double-linked list
638     PointsEnd: TPathSegment;// End of the double-linked list
639     CurPoint: TPathSegment; // Used in PrepareForSequentialReading and Next
640     CurWalkDistanceInCurSegment: Double;// Used in PrepareForWalking and NextWalk
641     ClipPath: TPath;
642     ClipMode: TvClipMode;
643     constructor Create(APage: TvPage); override;
644     destructor Destroy; override;
645     procedure Clear; override;
646     procedure Assign(ASource: TPath);
647     procedure PrepareForSequentialReading;
648     procedure PrepareForWalking;
Nextnull649     function Next(): TPathSegment;
NextWalknull650     function NextWalk(ADistance: Double; out AX, AY, ATangentAngle: Double): Boolean;
651     procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
652     procedure AppendSegment(ASegment: TPathSegment);
653     procedure AppendMoveToSegment(AX, AY: Double);
654     procedure AppendLineToSegment(AX, AY: Double);
655     procedure AppendEllipticalArc(ARadX, ARadY, AXAxisRotation, ADestX, ADestY: Double; ALeftmostEllipse, AClockwiseArcFlag: Boolean); // See http://www.w3.org/TR/SVG/paths.html#PathDataEllipticalArcCommands
656     procedure AppendEllipticalArcWithCenter(ARadX, ARadY, AXAxisRotation, ADestX, ADestY, ACenterX, ACenterY: Double; AClockwiseArcFlag: Boolean); // See http://www.w3.org/TR/SVG/paths.html#PathDataEllipticalArcCommands
GetLineIntersectionPointsnull657     function GetLineIntersectionPoints(ACoord: Double; ACoordIsX: Boolean): TDoubleDynArray; override;
658     procedure Move(ADeltaX, ADeltaY: Double); override;
659     procedure MoveSubpart(ADeltaX, ADeltaY: Double; ASubpart: Cardinal); override;
MoveToSubpartnull660     function  MoveToSubpart(ASubpart: Cardinal): TPathSegment;
GetSubpartCountnull661     function  GetSubpartCount: Integer; override;
662     procedure Rotate(AAngle: Double; ABase: T3DPoint); override; // Angle in radians
663     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
664     procedure RenderInternalPolygon(constref ARenderInfo: TvRenderInfo);
GenerateDebugTreenull665     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
666   end;
667 
668   {@@
669     TvText represents a text entity.
670 
671     The text starts in X, Y and grows upwards, towards a bigger Y (fpvectorial coordinates)
672     or smaller Y (LCL coordinates).
673     It has the opposite direction of text in the LCL TCanvas.
674   }
675 
676 
677   { TvText }
678 
679   TvText = class(TvEntityWithStyle)
680   private
GetTextMetric_Descender_pxnull681     function GetTextMetric_Descender_px(constref ARenderInfo: TvRenderInfo): Integer;
682   public
683     Value: TStringList;
684     Render_NextText_X: Integer;
685     Render_Use_NextText_X: Boolean;
686     constructor Create(APage: TvPage); override;
687     destructor Destroy; override;
TryToSelectnull688     function TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult; override;
689     procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
690     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
GetEntityFeaturesnull691     function GetEntityFeatures(constref ARenderInfo: TvRenderInfo): TvEntityFeatures; override;
GenerateDebugTreenull692     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
693   end;
694 
695   { TvCurvedText }
696 
697   // TvCurvedText supports only one line
698   TvCurvedText = class(TvText)
699   public
700     Path: TPath;
701     //constructor Create(APage: TvPage); override;
702     //destructor Destroy; override;
TryToSelectnull703     //function TryToSelect(APos: TPoint; var ASubpart: Cardinal): TvFindEntityResult; override;
704     //procedure CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double); override;
705     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
GetEntityFeaturesnull706     //function GetEntityFeatures: TvEntityFeatures; override;
707     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
708   end;
709 
710   TvFieldKind = (vfkNumPages, vfkPage, vfkAuthor, vfkDateCreated, vfkDate);
711 
712   { TvField }
713 
714   TvField = Class(TvEntityWithStyle)
715   public
716     Kind : TvFieldKind;
717 
718     DateFormat : String;            // Only for Kind in (vfkDateCreated, vfkDate)
719                                     // Date Format is similar to MS Specification
720     NumberFormat : TvNumberFormat;  // Only for Kind in (vfkNumPages, vfkPage)
721 
722     constructor Create(APage : TvPage); override;
723   end;
724 
725   {@@
726   }
727 
728   { TvCircle }
729 
730   TvCircle = class(TvEntityWithPenAndBrush)
731   protected
CreatePathnull732     function CreatePath: TPath; override;
733   public
734     Radius: Double;
735     procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
736     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
737     procedure Rotate(AAngle: Double; ABase: T3DPoint); override; // Angle in radians
738   end;
739 
740   {@@
741   }
742 
743   { TvCircularArc }
744 
745   TvCircularArc = class(TvEntityWithPenAndBrush)
746   public
747     Radius: Double;
748     {@@ The Angle is measured in degrees in relation to the positive X axis }
749     StartAngle, EndAngle: Double;
750     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
751   end;
752 
753   {@@
754   }
755 
756   { TvEllipse }
757 
758   TvEllipse = class(TvEntityWithPenAndBrush)
759   protected
CreatePathnull760     function CreatePath: TPath; override;
761   public
762     // Mandatory fields
763     HorzHalfAxis: Double; // This half-axis is the horizontal one when Angle=0
764     VertHalfAxis: Double; // This half-axis is the vertical one when Angle=0
765     {@@ The Angle is measured in radians in relation to the positive X axis }
766     Angle: Double;
GetLineIntersectionPointsnull767     function GetLineIntersectionPoints(ACoord: Double; ACoordIsX: Boolean): TDoubleDynArray; override;
TryToSelectnull768     function TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult; override;
769     procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
770     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
771     procedure Rotate(AAngle: Double; ABase: T3DPoint); override; // Angle in radians
772   end;
773 
774   { TvRectangle }
775   { The point (X,Y) refers to the left/top corner of the rectangle! }
776 
777   TvRectangle = class(TvEntityWithPenBrushAndFont)
778   protected
CreatePathnull779     function CreatePath: TPath; override;
780   public
781     // A text displayed in the center of the square, usually empty
782     Text: string;
783     // Mandatory fields
784     CX, CY, CZ: Double;  // CX = width, CY = height, CZ = depth
785     // Corner rounding, zero indicates no rounding
786     RX, RY: Double;
787     // The Angle is measured in radians relative to the positive X axis.
788     // Center of rotation is (X,Y).
789     Angle: Double;
790     procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
791     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
792     procedure Rotate(AAngle: Double; ABase: T3DPoint); override; // Angle in radians
GenerateDebugTreenull793     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
794   end;
795 
796   { TvPolygon }
797 
798   TvPolygon = class(TvEntityWithPenBrushAndFont)
799   public
800     // A text displayed in the center of the square, usually empty
801     Text: string;
802     // All points of the polygon
803     Points: array of T3DPoint;
804     procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
805     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
806   end;
807 
808   {@@
809    DimensionLeft ---text--- DimensionRight
810                  |        |
811                  |        | BaseRight
812                  |
813                  | BaseLeft
814   }
815 
816   { TvAlignedDimension }
817 
818   TvAlignedDimension = class(TvEntityWithPen)
819   public
820     // Mandatory fields
821     BaseLeft, BaseRight, DimensionLeft, DimensionRight: T3DPoint;
822     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
GenerateDebugTreenull823     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
824   end;
825 
826   {@@
827 
828   }
829 
830   { TvRadialDimension }
831 
832   TvRadialDimension = class(TvEntityWithPen)
833   public
834     // Mandatory fields
835     IsDiameter: Boolean; // If false, it is a radius, if true, it is a diameter
836     Center, DimensionLeft, DimensionRight: T3DPoint; // Diameter uses both, Radius uses only DImensionLeft
837     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
GenerateDebugTreenull838     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
839   end;
840 
841   { TvArcDimension }
842 
843   TvArcDimension = class(TvEntityWithPen)
844   private
845     // Calculated fields
846     AngleBase, ArcLeft, ArcRight: T3DPoint;
847     al, bl, ar, br, AngleLeft, AngleRight: Double;
848   public
849     // Mandatory fields
850     ArcValue, ArcRadius: Double; // ArcValue is in degrees
851     TextPos, BaseLeft, BaseRight, DimensionLeft, DimensionRight: T3DPoint;
852     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
853     procedure CalculateExtraArcInfo;
GenerateDebugTreenull854     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
855   end;
856 
857   {@@
858    Vectorial images can contain raster images inside them and this entity
859    represents this.
860 
861    If the Width and Height differ from the same data in the image, then
862    the raster image will be stretched.
863 
864    X,Y represents the top-left corner of the image
865 
866    Note that TFPCustomImage does not implement a storage, so the property
867    RasterImage should be filled with either a FPImage.TFPMemoryImage or with
868    a TLazIntfImage. The property RasterImage might be nil.
869   }
870 
871   { TvRasterImage }
872 
873   TvRasterImage = class(TvNamedEntity)
874   public
875     RasterImage: TFPCustomImage;
876     Width, Height: Double;
877     AltText: string;
878     destructor Destroy; override;
879     procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
880     procedure CreateRGB888Image(AWidth, AHeight: Cardinal);
881     procedure CreateImageFromFile(AFilename: string);
882     procedure CreateImageFromStream(AStream: TStream; Handler:TFPCustomImageReader);
883     procedure InitializeWithConvertionOf3DPointsToHeightMap(APage: TvVectorialPage; AWidth, AHeight: Integer);
884     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
GenerateDebugTreenull885     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
886   end;
887 
888   { TvPoint }
889 
890   // Keep TvPoint as small as possible in memory foot-print for LAS support
891   TvPoint = class(TvEntity)
892   public
893     Pen: TvPen;
894     {constructor Create; override;
895     procedure ApplyPenToCanvas(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo);
896     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
897       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;}
898   end;
899 
900   { TvArrow }
901 
902   //
903   // The arrow look like this:
904   //
905   // A<------|B
906   //         |
907   //         |C
908   //
909   // A -> X,Y,Z
910   // B -> Base
911   // C -> ExtraLineBase, which exists if HasExtraLine=True
912 
913   TvArrow = class(TvEntityWithPenAndBrush)
914   public
915     Base: T3DPoint;
916     HasExtraLine: Boolean;
917     ExtraLineBase: T3DPoint;
918     ArrowLength: Double;
919     ArrowBaseLength: Double;
920     procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
921     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
922   end;
923 
924   {@@
925     The elements bellow describe a formula
926 
927     The main element of a formula is TvFormula which contains a horizontal list of
928     the elements of the formula. Those can then have sub-elements
929 
930     The formula starts in X, Y and grows downwards, towards a smaller Y
931   }
932 
933   TvFormula = class;
934 
935   TvFormulaElementKind = (
936     // Basic symbols
937     fekVariable,  // Text is the text of the variable
938     fekEqual,     // = symbol
939     fekSubtraction, // - symbol
940     fekMultiplication, // either a point . or a small x
941     fekSum,       // + symbol
942     fekPlusMinus, // The +/- symbol
943     fekLessThan, // The < symbol
944     fekLessOrEqualThan, // The <= symbol
945     fekGreaterThan, // The > symbol
946     fekGreaterOrEqualThan, // The >= symbol
947     fekHorizontalLine,
948     // More complex elements, utilized for graphical representation of formula
949     fekFraction,  // a division with Formula on the top and AdjacentFormula in the bottom
950     fekRoot,      // A root. For example sqrt(something). Number gives the root, usually 2, and inside it goes a Formula
951     fekPower,     // A Formula elevated to a AdjacentFormula, example: 2^5
952     fekSubscript, // A Formula with a subscripted element AdjacentFormula, example: Xi
953     fekSummation, // Sum of a variable given by Text set by Formula in the bottom and going up to AdjacentFormula in the top
954     fekFormula,   // A formula, stored in Formula
955     // Elements utilized for formulas for infix to RPN converion, not utilized for graphical representations
956     fekParentesesOpen,
957     freParentesesClose
958     );
959 
960   { TvFormulaElement }
961 
962   TvFormulaElement = class
963   public
964     Kind: TvFormulaElementKind;
965     Text: string;
966     Number: Double;
967     Formula: TvFormula;
968     AdjacentFormula: TvFormula;
969   public
970     Top, Left, Width, Height: Double;
CalculateHeightnull971     function CalculateHeight(ADest: TFPCustomCanvas): Double; // in millimeters
CalculateWidthnull972     function CalculateWidth(ADest: TFPCustomCanvas): Double; // in millimeters
AsTextnull973     function AsText: string;
974     procedure PositionSubparts(constref ARenderInfo: TvRenderInfo; ABaseX, ABaseY: Double);
975     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); virtual;
976     procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer); virtual;
GetPrecedenceFromKindnull977     class function GetPrecedenceFromKind(AKind: TvFormulaElementKind): Byte; // 0 is the smallest precedence
IsLeftAssociativeFromKindnull978     class function IsLeftAssociativeFromKind(AKind: TvFormulaElementKind): Boolean;
979   end;
980 
981   { TvFormula }
982 
983   TvFormula = class(TvEntityWithPenBrushAndFont)
984   private
985     FCurIndex: Integer;
986     procedure CallbackDeleteElement(data,arg:pointer);
987   protected
988     FElements: TFPList; // of TvFormulaElement
989     SpacingBetweenElementsX, SpacingBetweenElementsY: Integer;
990   public
991     Top, Left, Width, Height: Double;
992     constructor Create(APage: TvPage); override;
993     destructor Destroy; override;
994     //
GetFirstElementnull995     function GetFirstElement: TvFormulaElement;
GetNextElementnull996     function GetNextElement: TvFormulaElement;
997     procedure AddElement(AElement: TvFormulaElement);
AddElementWithKindnull998     function  AddElementWithKind(AKind: TvFormulaElementKind): TvFormulaElement;
AddElementWithKindAndTextnull999     function  AddElementWithKindAndText(AKind: TvFormulaElementKind; AText: string): TvFormulaElement;
1000     procedure AddItemsByConvertingInfixToRPN(AInfix: TFPList {of TvFormulaElement});
1001     procedure AddItemsByConvertingInfixStringToRPN(AStr: string);
1002     procedure TokenizeInfixString(AStr: string; AOutput: TFPList);
CalculateRPNFormulaValuenull1003     function  CalculateRPNFormulaValue: Double;
1004     procedure Clear; override;
1005     //
CalculateHeightnull1006     function CalculateHeight(ADest: TFPCustomCanvas): Double; virtual; // in millimeters
CalculateWidthnull1007     function CalculateWidth(ADest: TFPCustomCanvas): Double; virtual; // in millimeters
1008     procedure PositionSubparts(constref ARenderInfo: TvRenderInfo; ABaseX, ABaseY: Double); override;
1009     procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
1010     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
GenerateDebugTreenull1011     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
1012   end;
1013 
1014   { TvVerticalFormulaStack }
1015 
1016   TvVerticalFormulaStack = class(TvFormula)
1017   public
CalculateHeightnull1018     function CalculateHeight(ADest: TFPCustomCanvas): Double; override; // in millimeters
CalculateWidthnull1019     function CalculateWidth(ADest: TFPCustomCanvas): Double; override; // in millimeters
1020     procedure PositionSubparts(constref ARenderInfo: TvRenderInfo; ABaseX, ABaseY: Double); override;
GenerateDebugTreenull1021     //function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
1022   end;
1023 
1024   {@@
1025     A EntityWithSubEntities may have Pen, Brush and/or Font data associated with it, but it is disabled by default
1026     This data can be active recursively in all children of the group if set in the field
1027     SetPenBrushAndFontElements
1028   }
1029 
1030   { TvEntityWithSubEntities }
1031 
1032   TvEntityWithSubEntities = class(TvEntityWithStyle)
1033   private
1034     FCurIndex: Integer;
1035     procedure CallbackDeleteElement(data,arg:pointer);
1036   protected
1037     FElements: TFPList; // of TvEntity
1038   public
1039     SetPenBrushAndFontElements: TvSetPenBrushAndFontElements;// This is not currently implemented!
1040     constructor Create(APage: TvPage); override;
1041     destructor Destroy; override;
1042     //
GetFirstEntitynull1043     function GetFirstEntity: TvEntity;
GetNextEntitynull1044     function GetNextEntity: TvEntity;
GetEntitiesCountnull1045     function GetEntitiesCount: Integer;
GetEntitynull1046     function GetEntity(AIndex: Integer): TvEntity;
AddEntitynull1047     function AddEntity(AEntity: TvEntity): Integer;
GetEntityIndexnull1048     function GetEntityIndex(AEntity : TvEntity) : Integer;
DeleteEntitynull1049     function  DeleteEntity(AIndex: Cardinal): Boolean;
RemoveEntitynull1050     function  RemoveEntity(AEntity: TvEntity; AFreeAfterRemove: Boolean = True): Boolean;
1051     procedure Rotate(AAngle: Double; ABase: T3DPoint); override;
1052     procedure Clear; override;
1053     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
GenerateDebugTreenull1054     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
FindEntityWithReferencenull1055     function FindEntityWithReference(AEntity: TvEntity): Integer;
FindEntityWithNameAndTypenull1056     function FindEntityWithNameAndType(AName: string; AType: TvEntityClass {= TvEntity}; ARecursively: Boolean = False): TvEntity;
1057   end;
1058 
1059   {@@
1060     A block is a group of other elements. It is not rendered directly into the drawing,
1061     but instead is rendered via another item, called TvInsert
1062   }
1063 
1064   { TvBlock }
1065 
1066   TvBlock = class(TvEntityWithSubEntities)
1067   public
1068     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
1069   end;
1070 
1071   {@@
1072     A "Insert" inserts a copy of any other element in the specified position.
1073     Usually TvBlock entities are inserted, but any entity can be inserted.
1074   }
1075 
1076   { TvInsert }
1077 
1078   TvInsert = class(TvEntityWithStyle) // instead of TvNamedEntity so that it can pass its own style info to the InsertEntity
1079   public
1080     InsertEntity: TvEntity; // The entity to be inserted
1081     RotationAngle: Double; // in angles, normal is zero
1082     SetElements: TvSetStyleElements; // Defines which of Pen, Brush and Font will be applied to InsertEntity
1083     constructor Create(APage: TvPage); override;
1084     destructor Destroy; override;
1085     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
GenerateDebugTreenull1086     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
1087   end;
1088 
1089   {@@
1090     Layers are groups of elements.
1091     Layers are similar to blocks and the diference is that the layer draws
1092     its contents, while the block doesnt, and it cannot be pasted with an TvInsert.
1093   }
1094 
1095   { TvLayer }
1096 
1097   TvLayer = class(TvEntityWithSubEntities)
1098   public
1099   end;
1100 
1101   {@@
1102     TvParagraph represents a sequence of elements ordered as characters
1103     in a paragraph.
1104     The elements might be richly formatted text, but also images.
1105 
1106     The basic element to build the sequence is TvText. Note that the X, Y positions
1107     of elements will be all adjusted to fit the TvParagraph area
1108   }
1109 
1110   TvRichTextAutoExpand = (rtaeNone, etaeWidth, etaeHeight);
1111 
1112   { TvParagraph }
1113 
1114   TvParagraph = class(TvEntityWithSubEntities)
1115   public
1116     Width, Height: Double;
1117     AutoExpand: TvRichTextAutoExpand;
1118     ListStyle : TvListStyle; // For Bulleted or Numbered Lists...
1119     YPos_NeedsAdjustment_DelFirstLineBodyHeight: Boolean; // SVG coordinates for text are cumbersome, we need this
1120     constructor Create(APage: TvPage); override;
1121     destructor Destroy; override;
AddTextnull1122     function AddText(AText: string): TvText;
AddCurvedTextnull1123     function AddCurvedText(AText: string): TvCurvedText;
AddFieldnull1124     function AddField(AKind : TvFieldKind): TvField;
AddRasterImagenull1125     function AddRasterImage: TvRasterImage;
AddEmbeddedVectorialDocnull1126     function AddEmbeddedVectorialDoc: TvEmbeddedVectorialDoc;
1127     procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
TryToSelectnull1128     function TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult; override;
1129     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
GenerateDebugTreenull1130     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
1131   end;
1132 
1133   {@@
1134     TvList represents a list of bulleted texts, like:
1135 
1136     * First level
1137       - Second level
1138     * First level again
1139 
1140     The basic element to build the sequence is TvParagraph
1141   }
1142 
1143   { TvList }
1144 
1145   TvList = class(TvEntityWithSubEntities)
1146   public
1147     Parent : TvList;
1148     ListStyle : TvListStyle;
1149 
1150     constructor Create(APage: TvPage); override;  // MJT 31/08 added override;
1151     destructor Destroy; override;
tonull1152     // helper function to add the most often used sub-entities
1153     function AddParagraph(ASimpleText: string): TvParagraph;
AddListnull1154     function AddList: TvList;
1155     // other helper functions
GetLevelnull1156     function GetLevel: Integer;
GetBulletSizenull1157     function GetBulletSize: Double;
1158     procedure DrawBullet(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
1159       ALevel: Integer; AX, AY: Double; ADestX: Integer = 0; ADestY: Integer = 0;
1160       AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True);
1161     // overrides
1162     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
GenerateDebugTreenull1163     //function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;}
1164   end;
1165 
1166   {@@
1167     TvRichText represents a sequence of text paragraphs.
1168 
1169     The basic element to build the sequence is TvParagraph. Note that the X, Y positions
1170     of elements will be all adjusted to fit the TvRichText area
1171   }
1172 
1173   // Forward reference as Table Cells are TvRichText which in turn
1174   // can also contain tables...
1175   TvTable = class;
1176   TvTableRow = class;
1177 (*
1178   TvImage = Class;
1179 *)
1180   { TvRichText }
1181 
1182   TvRichText = class(TvEntityWithSubEntities)
1183   public
1184     Width, Height: Double;
1185     SpacingLeft, SpacingRight, SpacingTop, SpacingBottom: Double; // space around each side
1186     AutoExpand: TvRichTextAutoExpand;
1187     constructor Create(APage: TvPage); override;
1188     destructor Destroy; override;
1189     // Data writing methods
AddParagraphnull1190     function AddParagraph: TvParagraph;
AddListnull1191     function AddList: TvList;
AddTablenull1192     function AddTable: TvTable;
AddEmbeddedVectorialDocnull1193     function AddEmbeddedVectorialDoc: TvEmbeddedVectorialDoc;
AddRasterImagenull1194     function AddRasterImage: TvRasterImage;
1195     // Functions for rendering and calculating sizes
1196     procedure GetEffectiveCellSpacing(out ATopSpacing, ALeftSpacing, ARightSpacing, ABottomSpacing: Double); virtual;
CalculateCellHeight_ForWidthnull1197     function CalculateCellHeight_ForWidth(constref ARenderInfo: TvRenderInfo; AWidth: Double): Double; virtual;
CalculateMaxNeededWidthnull1198     function CalculateMaxNeededWidth(constref ARenderInfo: TvRenderInfo): Double; virtual;
TryToSelectnull1199     function TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult; override;
1200     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
GenerateDebugTreenull1201     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
1202   end;
1203 
1204   (*  Support for Adding Tables to the document
1205       Each Cell is a TvRichText to allow full formatted text contents
1206   *)
1207 
1208   TvUnits = (dimMillimeter, dimPercent, dimPoint);
1209 
1210   TvDimension = record
1211     Value : Double;
1212     Units : TvUnits;
1213   end;
1214 
1215   // Use tbtDefault if you don't want the Border settings to be written out
1216   TvTableBorderType = (tbtSingle, tbtDashed, tbtDouble, tbtNone, tbtDefault);
1217 
1218   TvTableBorder = record
1219     LineType : TvTableBorderType;
1220     Spacing : Double; // mm, default 0
1221     Color : TFPColor; // Ignored if (0, 0, 0, 0)
1222     Width : Double;   // mm, default 0.  Should really be in point for fine control
1223   end;
1224 
1225   // Can be applied to Tables AND Cells
1226   TvTableBorders = record
1227     Left : TvTableBorder;
1228     Right : TvTableBorder;
1229     Top : TvTableBorder;
1230     Bottom : TvTableBorder;
1231     InsideHoriz : TvTableBorder;  //  InsideXXX not normally applied to cells
1232     InsideVert : TvTableBorder;   //    (MS Word Table Styles has an exception)
1233   end;
1234 
1235   { TvTableCell }
1236 
1237   TvVerticalAlignment = (vaTop, vaBottom, vaCenter, cvaBoth);
1238   // Horizontal alignment taken from Paragraph Style
1239 
1240   TvTableCell = Class(TvRichText)
1241   public
1242     // MJT to Felipe:  It may be that Borders can be
1243     // added to TvRichText if odt supports paragraph
1244     // borders, in which case we can refactor a little and
1245     // rename TvTableBorders
1246     Row: TvTableRow;
1247     Borders: TvTableBorders;                  // Defaults to be ignored (tbtDefault)
1248     PreferredWidth: TvDimension;              // Optional
1249     VerticalAlignment: TvVerticalAlignment;   // Defaults to vaTop
1250     BackgroundColor: TFPColor;                // Optional
1251     BackgroundColorValid: Boolean;
1252     SpannedCols: Integer;                     // For merging horiz cells.  Default 1.
1253                                               // See diagram above TvTable Class
1254     SpacingDataValid: Boolean;                // TvRichText defines spacing, SpacingTop, SpacingLeft, etc
1255                                               // if SpacingDataValid is false use Row.Table.CallSpacing
1256                                               // instead. Units for SpacingTop, etc, in mm. Spacing is the
1257                                               // empty area around Cells (but inside them) without content.
1258 
1259     constructor Create(APage: TvPage); override;
1260     function GetEffectiveBorder(): TvTableBorders;
1261     procedure GetEffectiveCellSpacing(out ATopSpacing, ALeftSpacing, ARightSpacing, ABottomSpacing: Double); override;
1262     class procedure DrawBorder(ABorder: TvTableBorders;
1263       AX, AY, AWidth, AHeight: double;
1264       ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
1265       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
1266     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
1267     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
1268     class function GenerateDebugStrForBorders(ABorders: TvTableBorders): string;
1269   end;
1270 
1271   { TvTableRow }
1272 
1273   TvTableRow = Class(TvNamedEntity)
1274   private
1275     Cells: TFPList; // of TvTableCell
1276   Public
1277     Table: TvTable;                // Link to the parent table
1278     Height: Double;                // Units mm.  Use 0 for default height
1279     Header: Boolean;               // Repeat row across pages
1280     AllowSplitAcrossPage : Boolean;// Can this Row split across multiple pages?
1281     BackgroundColor: TFPColor;     // Optional
1282     BackgroundColorValid: Boolean;
1283     // row spacing data in mm, necessary for docx among other formats
1284     CellSpacing: Double;
1285     SpacingDataValid: Boolean;
1286 
1287     constructor create(APage : TvPage); override;
1288     destructor destroy; override;
1289 
1290     function AddCell: TvTableCell;
1291     function GetCellCount: Integer;
1292     function GetCell(AIndex: Integer): TvTableCell;
1293     function GetCellColNr(ACell: TvTableCell): Integer;
1294     function CalculateMaxCellSpacing_Y(): Double;
1295     //
1296     procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
1297     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
1298     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
1299   end;
1300 
1301   (*
1302       Note on the grid used for the table
1303 
1304       For the table shown below, three ColWidths must be defined.
1305 
1306       First row should only have 2 cells. First cell spans 2 columns.
1307       Second row should only have 2 cells. Second cell spans 2 columns.
1308       Third row should have 3 cells.  Each cell only spans 1 column (default)
1309 
1310    X,Y +-----+------+---------+
1311        |            |         |
1312        +-----+----------------+
1313        |     |                |
1314        +-----+------+---------+
1315        |     |      |         |
1316        +-----+------+---------+
1317 
1318        The table draws at X,Y and downwards
1319   *)
1320 
1321   // TvTable.Style should be a Table Style, not a Paragraph Style
1322   // and is optional.
1323   TvTable = class(TvEntityWithStyle)
1324   private
1325     Rows: TFPList;
1326     ColWidthsInMM: array of Double;   // calculated during Render
1327     TableWidth, TableHeight: Double;  // in mm; calculated during Render
1328     procedure CalculateColWidths(constref ARenderInfo: TvRenderInfo);
1329     procedure CalculateRowHeights(constref ARenderInfo: TvRenderInfo);
1330   public
1331     ColWidths: array of Double;       // Can be left empty for simple tables
1332                                       // MUST be fully defined for merging cells
1333     ColWidthsUnits : TvUnits;         // Cannot mix ColWidth Units.
1334     Borders : TvTableBorders;         // Defaults: single/black/inside and out
1335     PreferredWidth : TvDimension;     // Optional. Units mm.
1336     SpacingBetweenCells: Double;      // Units mm. Gap between Cells.
1337     CellSpacingLeft, CellSpacingRight, CellSpacingTop,
1338       CellSpacingBottom: Double;      // space around each side of cells, in mm
1339     BackgroundColor : TFPColor;       // Optional.
1340 
1341     constructor create(APage : TvPage); override;
1342     destructor destroy; override;
1343 
1344     function AddRow: TvTableRow;
1345     function GetRowCount : Integer;
1346     function GetRow(AIndex: Integer) : TvTableRow;
1347     //
1348     function GetColCount(): Integer;
1349     //
1350     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
1351     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
1352   end;
1353 
1354   { TvEmbeddedVectorialDoc }
1355 
1356   TvEmbeddedVectorialDoc = class(TvEntity)
1357   private
1358     FWidth, FHeight: Double;
1359   public
1360     Document: TvVectorialDocument;
1361     constructor create(APage : TvPage); override;
1362     destructor destroy; override;
1363     procedure UpdateDocumentSize();
1364     function GetWidth: Double;
1365     function GetHeight: Double;
1366     procedure SetWidth(AValue: Double);
1367     procedure SetHeight(AValue: Double);
1368     procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
1369     procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
1370     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
1371   end;
1372 
1373   TvVectorialReaderFlag = (vrfSVG_UseBottomLeftCoords, vrfWMF_UseBottomLeftCoords);
1374   TvVectorialReaderFlags = set of TvVectorialReaderFlag;
1375 
1376   TvVectorialReaderSettings = record
1377     VecReaderFlags: TvVectorialReaderFlags;
1378     HelperToolPath: string;
1379   end;
1380 
1381   { TvVectorialDocument }
1382 
1383   TvVectorialDocument = class
1384   private
1385     FOnProgress: TvProgressEvent;
1386     FPages: TFPList;
1387     FStyles: TFPList;
1388     FListStyles: TFPList;
1389     FCurrentPageIndex: Integer;
1390     FRenderer: TvRenderer;
1391     function CreateVectorialWriter(AFormat: TvVectorialFormat): TvCustomVectorialWriter;
1392     function CreateVectorialReader(AFormat: TvVectorialFormat): TvCustomVectorialReader;
1393   public
1394     Width, Height: Double; // in millimeters
1395     Name: string;
1396     Encoding: string; // The encoding on which to save the file, if empty UTF-8 will be utilized. This value is filled when reading
1397     ForcedEncodingOnRead: string; // if empty, no encoding will be forced when reading, but it can be set to a LazUtils compatible value
1398     // User-Interface information
1399     ZoomLevel: Double; // 1 = 100%
1400     { Selection fields }
1401     SelectedElement: TvEntity;
1402     // List of common styles, for conveniently finding them
1403     StyleTextBody, StyleHeading1, StyleHeading2, StyleHeading3,
1404       StyleHeading4, StyleHeading5, StyleHeading6: TvStyle;
1405     StyleTextBodyCentralized, StyleTextBodyBold: TvStyle; // text body modifications
1406     StyleHeading1Centralized, StyleHeading2Centralized, StyleHeading3Centralized: TvStyle; // heading modifications
1407     StyleBulletList, StyleNumberList : TvListStyle;
1408     StyleTextSpanBold, StyleTextSpanItalic, StyleTextSpanUnderline: TvStyle;
1409     // Reader properties
1410     ReaderSettings: TvVectorialReaderSettings;
1411     { Base methods }
1412     constructor Create; virtual;
1413     destructor Destroy; override;
1414     procedure Assign(ASource: TvVectorialDocument);
1415     procedure AssignTo(ADest: TvVectorialDocument);
1416     procedure WriteToFile(AFileName: string; AFormat: TvVectorialFormat); overload;
1417     procedure WriteToFile(AFileName: string); overload;
1418     procedure WriteToStream(AStream: TStream; AFormat: TvVectorialFormat);
1419     procedure WriteToStrings(AStrings: TStrings; AFormat: TvVectorialFormat);
1420     procedure ReadFromFile(AFileName: string; AFormat: TvVectorialFormat); overload;
1421     procedure ReadFromFile(AFileName: string); overload;
1422     procedure ReadFromStream(AStream: TStream; AFormat: TvVectorialFormat);
1423     procedure ReadFromStrings(AStrings: TStrings; AFormat: TvVectorialFormat);
1424     procedure ReadFromXML(ADoc: TXMLDocument; AFormat: TvVectorialFormat);
1425     class function GetFormatFromExtension(AFileName: string; ARaiseException: Boolean = True): TvVectorialFormat;
1426     function  GetDetailedFileFormat(): string;
1427     procedure GuessDocumentSize();
1428     procedure GuessGoodZoomLevel(AScreenSize: Integer = 500);
1429     { Page methods }
1430     function GetPage(AIndex: Integer): TvPage;
1431     function GetPageIndex(APage : TvPage): Integer;
1432     function GetPageAsVectorial(AIndex: Integer): TvVectorialPage;
1433     function GetPageAsText(AIndex: Integer): TvTextPageSequence;
1434     function GetPageCount: Integer;
1435     function GetCurrentPage: TvPage;
1436     function GetCurrentPageAsVectorial: TvVectorialPage;
1437     procedure SetCurrentPage(AIndex: Integer);
1438     procedure SetDefaultPageFormat(AFormat: TvPageFormat);
1439     function AddPage(AUseTopLeftCoords: Boolean = False): TvVectorialPage;
1440     function AddTextPageSequence(): TvTextPageSequence;
1441     { Style methods }
1442     function AddStyle(): TvStyle;
1443     function AddListStyle: TvListStyle;
1444     procedure AddStandardTextDocumentStyles(AFormat: TvVectorialFormat);
1445     function GetStyleCount: Integer;
1446     function GetStyle(AIndex: Integer): TvStyle;
1447     function FindStyleIndex(AStyle: TvStyle): Integer;
1448     function GetListStyleCount: Integer;
1449     function GetListStyle(AIndex: Integer): TvListStyle;
1450     function FindListStyleIndex(AListStyle: TvListStyle): Integer;
1451     { Data removing methods }
1452     procedure Clear; virtual;
1453     { Drawer selection methods }
1454     function GetRenderer: TvRenderer;
1455     procedure SetRenderer(ARenderer: TvRenderer);
1456     procedure ClearRenderer();
1457     { Debug methods }
1458     procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer = nil);
1459     { Events }
1460     property OnProgress: TvProgressEvent read FOnProgress write FOnprogress;
1461   end;
1462 
1463   { TvPage }
1464 
1465   TvPage = class
1466   private
1467     procedure InitializeRenderInfo(out ARenderInfo: TvRenderInfo; ACanvas: TFPCustomCanvas; AEntity: TvEntity);
1468   protected
1469     FOwner: TvVectorialDocument;
1470     FUseTopLeftCoordinates: Boolean;
1471   public
1472     // Document size for page-based documents
1473     Width, Height: Double; // in millimeters, may be 0 to use TvVectorialDocument defaults
1474     // Document size for other documents
1475     MinX, MinY, MinZ, MaxX, MaxY, MaxZ: Double;
1476     // Other basic document information
1477     BackgroundColor: TFPColor;
1478     AdjustPenColorToBackground: Boolean;
1479     RenderInfo: TvRenderInfo; // Prepared by the reader with info on how to draw the page
1480     { Base methods }
1481     constructor Create(AOwner: TvVectorialDocument); virtual;
1482     destructor Destroy; override;
1483     procedure Assign(ASource: TvPage); virtual;
1484     procedure SetPageFormat(AFormat: TvPageFormat);
1485     { Data reading methods }
1486     procedure CalculateDocumentSize; virtual;
1487     function  GetEntity(ANum: Cardinal): TvEntity; virtual; abstract;
1488     function  GetEntitiesCount: Integer; virtual; abstract;
1489     function  GetLastEntity(): TvEntity; virtual; abstract;
1490     function  GetEntityIndex(AEntity : TvEntity) : Integer; virtual; abstract;
1491     function  FindAndSelectEntity(Pos: TPoint): TvFindEntityResult; virtual; abstract;
1492     function  FindEntityWithNameAndType(AName: string; AType: TvEntityClass {= TvEntity}; ARecursively: Boolean = False): TvEntity; virtual; abstract;
1493     { Data removing methods }
1494     procedure Clear; virtual; abstract;
1495     function  DeleteEntity(AIndex: Cardinal): Boolean; virtual; abstract;
1496     function  RemoveEntity(AEntity: TvEntity; AFreeAfterRemove: Boolean = True): Boolean; virtual; abstract;
1497     { Data writing methods }
1498     function AddEntity(AEntity: TvEntity): Integer; virtual; abstract;
1499     { Drawing methods }
1500     procedure DrawBackground(ADest: TFPCustomCanvas); virtual; abstract;
1501     procedure RenderPageBorder(ADest: TFPCustomCanvas;
1502       ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); virtual; abstract;
1503     procedure Render(ADest: TFPCustomCanvas;
1504       ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0;
1505       ADoDraw: Boolean = true); virtual; abstract;
1506     procedure AutoFit(ADest: TFPCustomCanvas; AWidth, AHeight, ARenderHeight: Integer; out ADeltaX, ADeltaY: Integer; out AZoom: Double); virtual;
1507     procedure GetNaturalRenderPos(var APageHeight: Integer; out AMulY: Double); virtual; abstract;
1508     procedure SetNaturalRenderPos(AUseTopLeftCoords: Boolean); virtual;
1509     function HasNaturalRenderPos: Boolean;
1510     function GetTopLeftCoords_Adjustment(): Double;
1511     { Debug methods }
1512     procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer); virtual; abstract;
1513 
1514     property UseTopLeftCoordinates: Boolean read FUseTopLeftCoordinates write FUseTopLeftCoordinates;
1515   end;
1516 
1517   { TvVectorialPage }
1518 
1519   TvVectorialPage = class(TvPage)
1520   private
1521     FEntities: TFPList; // of TvEntity
1522     FTmpPath: TPath;
1523     FTmpText: TvText;
1524     FCurrentLayer: TvEntityWithSubEntities;
1525     //procedure RemoveCallback(data, arg: pointer);
1526     procedure ClearTmpPath();
1527     procedure AppendSegmentToTmpPath(ASegment: TPathSegment);
1528     procedure CallbackDeleteEntity(data,arg:pointer);
1529   public
1530     Owner: TvVectorialDocument;
1531     { Base methods }
1532     constructor Create(AOwner: TvVectorialDocument); override;
1533     destructor Destroy; override;
1534     procedure Assign(ASource: TvPage); override;
1535     { Data reading methods }
1536     function  GetEntity(ANum: Cardinal): TvEntity; override;
1537     function  GetEntitiesCount: Integer; override;
1538     function  GetLastEntity(): TvEntity; override;
1539     function  GetEntityIndex(AEntity : TvEntity) : Integer; override;
1540     function  FindAndSelectEntity(Pos: TPoint): TvFindEntityResult; override;
1541     function  FindEntityWithNameAndType(AName: string; AType: TvEntityClass {= TvEntity}; ARecursively: Boolean = False): TvEntity; override;
1542     { Data removing methods }
1543     procedure Clear; override;
1544     function  DeleteEntity(AIndex: Cardinal): Boolean; override;
1545     function  RemoveEntity(AEntity: TvEntity; AFreeAfterRemove: Boolean = True): Boolean; override;
1546     { Data writing methods }
1547     function AddEntity(AEntity: TvEntity): Integer; override;
1548     function  AddPathCopyMem(APath: TPath; AOnlyCreate: Boolean = False): TPath;
1549     procedure StartPath(AX, AY: Double); overload;
1550     procedure StartPath(); overload;
1551     procedure AddMoveToPath(AX, AY: Double);
1552     procedure AddLineToPath(AX, AY: Double); overload;
1553     procedure AddLineToPath(AX, AY: Double; AColor: TFPColor); overload;
1554     procedure AddLineToPath(AX, AY, AZ: Double); overload;
1555     procedure GetCurrentPathPenPos(var AX, AY: Double);
1556     procedure GetTmpPathStartPos(var AX, AY: Double);
1557     procedure AddBezierToPath(AX1, AY1, AX2, AY2, AX3, AY3: Double); overload;
1558     procedure AddBezierToPath(AX1, AY1, AZ1, AX2, AY2, AZ2, AX3, AY3, AZ3: Double); overload;
1559     procedure AddEllipticalArcToPath(ARadX, ARadY, AXAxisRotation, ADestX, ADestY: Double; ALeftmostEllipse, AClockwiseArcFlag: Boolean); // See http://www.w3.org/TR/SVG/paths.html#PathDataEllipticalArcCommands
1560     procedure AddEllipticalArcWithCenterToPath(ARadX, ARadY, AXAxisRotation, ADestX, ADestY, ACenterX, ACenterY: Double; AClockwiseArcFlag: Boolean);
1561     procedure SetBrushColor(AColor: TFPColor);
1562     procedure SetBrushStyle(AStyle: TFPBrushStyle);
1563     procedure SetPenColor(AColor: TFPColor);
1564     procedure SetPenStyle(AStyle: TFPPenStyle);
1565     procedure SetPenWidth(AWidth: Integer);
1566     procedure SetClipPath(AClipPath: TPath; AClipMode: TvClipMode);
1567     function  EndPath(AOnlyCreate: Boolean = False): TPath;
1568     function  AddText(AX, AY, AZ: Double; FontName: string; FontSize: integer; AText: utf8string; AOnlyCreate: Boolean = False): TvText; overload;
1569     function  AddText(AX, AY: Double; AStr: utf8string; AOnlyCreate: Boolean = False): TvText; overload;
1570     function  AddText(AX, AY, AZ: Double; AStr: utf8string; AOnlyCreate: Boolean = False): TvText; overload;
1571     function AddCircle(ACenterX, ACenterY, ARadius: Double; AOnlyCreate: Boolean = False): TvCircle;
1572     function AddCircularArc(ACenterX, ACenterY, ARadius, AStartAngle, AEndAngle: Double; AColor: TFPColor; AOnlyCreate: Boolean = False): TvCircularArc;
1573     function AddEllipse(CenterX, CenterY, HorzHalfAxis, VertHalfAxis, Angle: Double; AOnlyCreate: Boolean = False): TvEllipse;
1574     function AddBlock(AName: string; AX, AY, AZ: Double): TvBlock;
1575     function AddInsert(AX, AY, AZ: Double; AInsertEntity: TvEntity): TvInsert;
1576     // Layers
1577     function AddLayer(AName: string): TvLayer;
1578     function AddLayerAndSetAsCurrent(AName: string): TvLayer;
1579     procedure ClearLayerSelection();
1580     function SetCurrentLayer(ALayer: TvEntityWithSubEntities): Boolean;
1581     function GetCurrentLayer: TvEntityWithSubEntities;
1582     // Dimensions
1583     function AddAlignedDimension(BaseLeft, BaseRight, DimLeft, DimRight: T3DPoint; AOnlyCreate: Boolean = False): TvAlignedDimension;
1584     function AddRadialDimension(AIsDiameter: Boolean; ACenter, ADimLeft, ADimRight: T3DPoint; AOnlyCreate: Boolean = False): TvRadialDimension;
1585     function AddArcDimension(AArcValue, AArcRadius: Double; ABaseLeft, ABaseRight, ADimLeft, ADimRight, ATextPos: T3DPoint; AOnlyCreate: Boolean): TvArcDimension;
1586     //
1587     function AddPoint(AX, AY, AZ: Double): TvPoint;
1588     { Drawing methods }
1589     procedure PositionEntitySubparts(constref ARenderInfo: TvRenderInfo; ABaseX, ABaseY: Double);
1590     procedure DrawBackground(ADest: TFPCustomCanvas); override;
1591     procedure RenderPageBorder(ADest: TFPCustomCanvas;
1592       ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
1593     procedure Render(ADest: TFPCustomCanvas; ADestX: Integer = 0; ADestY: Integer = 0;
1594       AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = true); override;
1595     procedure GetNaturalRenderPos(var APageHeight: Integer; out AMulY: Double); override;
1596     { Debug methods }
1597     procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer); override;
1598     //
1599     property Entities[AIndex: Cardinal]: TvEntity read GetEntity;
1600   end;
1601 
1602   { TvTextPageSequence }
1603 
1604   {@@ Represents a sequence of text pages up to a page break }
1605 
1606   TvTextPageSequence = class(TvPage)
1607   public
1608     Footer, Header: TvRichText;
1609     MainText: TvRichText;
1610     { Base methods }
1611     constructor Create(AOwner: TvVectorialDocument); override;
1612     destructor Destroy; override;
1613     procedure Assign(ASource: TvPage); override;
1614     { Data reading methods }
1615     function  GetEntity(ANum: Cardinal): TvEntity; override;
1616     function  GetEntitiesCount: Integer; override;
1617     function  GetLastEntity(): TvEntity; override;
1618     function  GetEntityIndex(AEntity : TvEntity) : Integer; override;
1619     function  FindAndSelectEntity(Pos: TPoint): TvFindEntityResult; override;
1620     function  FindEntityWithNameAndType(AName: string; AType: TvEntityClass {= TvEntity}; ARecursively: Boolean = False): TvEntity; override;
1621     { Data removing methods }
1622     procedure Clear; override;
1623     function  DeleteEntity(AIndex: Cardinal): Boolean; override;
1624     function  RemoveEntity(AEntity: TvEntity; AFreeAfterRemove: Boolean = True): Boolean; override;
1625     { Data writing methods }
1626     function AddEntity(AEntity: TvEntity): Integer; override;
1627     { Data writing methods }
1628     function AddParagraph: TvParagraph;
1629     function AddList: TvList;
1630     function AddTable: TvTable;
1631     function AddEmbeddedVectorialDoc: TvEmbeddedVectorialDoc;
1632     //function AddImage: TvImage;
1633     { Drawing methods }
1634     procedure DrawBackground(ADest: TFPCustomCanvas); override;
1635     procedure RenderPageBorder(ADest: TFPCustomCanvas;
1636       ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
1637     procedure Render(ADest: TFPCustomCanvas; ADestX: Integer = 0; ADestY: Integer = 0;
1638       AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = true); override;
1639     procedure GetNaturalRenderPos(var APageHeight: Integer; out AMulY: Double); override;
1640     { Debug methods }
1641     procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer); override;
1642   end;
1643 
1644   {@@ TvVectorialReader class reference type }
1645 
1646   TvVectorialReaderClass = class of TvCustomVectorialReader;
1647 
1648   { TvCustomVectorialReader }
1649 
1650   TvCustomVectorialReader = class
1651   protected
1652     FFilename: string;
1653     class function GetTextContentsFromNode(ANode: TDOMNode): DOMString;
1654     class function RemoveLineEndingsAndTrim(AStr: string): string;
1655   public
1656     Settings: TvVectorialReaderSettings;
1657     { General reading methods }
1658     constructor Create; virtual;
1659     procedure ReadFromFile(AFileName: string; AData: TvVectorialDocument); virtual;
1660     procedure ReadFromStream(AStream: TStream; AData: TvVectorialDocument); virtual;
1661     procedure ReadFromStrings(AStrings: TStrings; AData: TvVectorialDocument); virtual;
1662     procedure ReadFromXML(ADoc: TXMLDocument; AData: TvVectorialDocument); virtual;
1663   end;
1664 
1665   {@@ TvVectorialWriter class reference type }
1666 
1667   TvVectorialWriterClass = class of TvCustomVectorialWriter;
1668 
1669   {@@ TvCustomVectorialWriter }
1670 
1671   { TvCustomVectorialWriter }
1672 
1673   TvCustomVectorialWriter = class
1674   public
1675     { General writing methods }
1676     constructor Create; virtual;
1677     procedure WriteToFile(AFileName: string; AData: TvVectorialDocument); virtual;
1678     procedure WriteToStream(AStream: TStream; AData: TvVectorialDocument); virtual;
1679     procedure WriteToStrings(AStrings: TStrings; AData: TvVectorialDocument); virtual;
1680   end;
1681 
1682   {@@ List of registered formats }
1683 
1684   TvVectorialFormatData = record
1685     ReaderClass: TvVectorialReaderClass;
1686     WriterClass: TvVectorialWriterClass;
1687     ReaderRegistered: Boolean;
1688     WriterRegistered: Boolean;
1689     Format: TvVectorialFormat;
1690   end;
1691 
1692   TvRenderer = class
1693   public
1694     procedure BeginRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean); virtual; abstract;
1695     procedure EndRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean); virtual; abstract;
1696     // TPath
1697     procedure TPath_Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean; APath: TPath); virtual; abstract;
1698   end;
1699   TvRendererClass = class of TvRenderer;
1700 
1701 var
1702   GvVectorialFormats: array of TvVectorialFormatData;
1703 
1704 const
1705   FormulaOperators = [fekSubtraction, fekMultiplication, fekSum, fekFraction, fekRoot, fekPower];
1706 
1707 procedure RegisterVectorialReader(
1708   AReaderClass: TvVectorialReaderClass;
1709   AFormat: TvVectorialFormat);
1710 procedure RegisterVectorialWriter(
1711   AWriterClass: TvVectorialWriterClass;
1712   AFormat: TvVectorialFormat);
1713 
1714 function Make2DPoint(AX, AY: Double): T3DPoint;
1715 function Dimension(AValue : Double; AUnits : TvUnits) : TvDimension;
1716 function ConvertDimensionToMM(ADimension: TvDimension; ATotalSize: Double): Double;
1717 procedure RegisterDefaultRenderer(ARenderer: TvRendererClass);
1718 
1719 implementation
1720 
1721 uses fpvutils;
1722 
1723 const
1724   Str_Error_Nil_Path = ' The program attempted to add a segment before creating a path';
1725   INVALID_RENDERINFO_CANVAS_XY = Low(Integer);
1726   Str_Line_Height_Tester = 'Áç';
1727 
1728 {$ifdef FPVECTORIAL_AUTOFIT_DEBUG}
1729 var
1730   AutoFitDebug: TStrings = nil;
1731 {$endif}
1732 
1733 var
1734   gDefaultRenderer: TvRendererClass = nil;
1735 
1736 {@@
1737   Registers a new reader for a format
1738 }
1739 procedure RegisterVectorialReader(
1740   AReaderClass: TvVectorialReaderClass;
1741   AFormat: TvVectorialFormat);
1742 var
1743   i, len: Integer;
1744   FormatInTheList: Boolean;
1745 begin
1746   len := Length(GvVectorialFormats);
1747   FormatInTheList := False;
1748 
1749   { First search for the format in the list }
1750   for i := 0 to len - 1 do
1751   begin
1752     if GvVectorialFormats[i].Format = AFormat then
1753     begin
1754       //if GvVectorialFormats[i].ReaderRegistered then
1755        //raise Exception.Create('RegisterVectorialReader: Reader class for format ' {+ AFormat} + ' already registered.');
1756 
1757       GvVectorialFormats[i].ReaderRegistered := True;
1758       GvVectorialFormats[i].ReaderClass := AReaderClass;
1759 
1760       FormatInTheList := True;
1761       Break;
1762     end;
1763   end;
1764 
1765   { If not already in the list, then add it }
1766   if not FormatInTheList then
1767   begin
1768     SetLength(GvVectorialFormats, len + 1);
1769 
1770     GvVectorialFormats[len].ReaderClass := AReaderClass;
1771     GvVectorialFormats[len].WriterClass := nil;
1772     GvVectorialFormats[len].ReaderRegistered := True;
1773     GvVectorialFormats[len].WriterRegistered := False;
1774     GvVectorialFormats[len].Format := AFormat;
1775   end;
1776 end;
1777 
1778 {@@
1779   Registers a new writer for a format
1780 }
1781 procedure RegisterVectorialWriter(
1782   AWriterClass: TvVectorialWriterClass;
1783   AFormat: TvVectorialFormat);
1784 var
1785   i, len: Integer;
1786   FormatInTheList: Boolean;
1787 begin
1788   len := Length(GvVectorialFormats);
1789   FormatInTheList := False;
1790 
1791   { First search for the format in the list }
1792   for i := 0 to len - 1 do
1793   begin
1794     if GvVectorialFormats[i].Format = AFormat then
1795     begin
1796       if GvVectorialFormats[i].WriterRegistered then
1797        raise Exception.Create('RegisterVectorialWriter: Writer class for format ' + {AFormat +} ' already registered.');
1798 
1799       GvVectorialFormats[i].WriterRegistered := True;
1800       GvVectorialFormats[i].WriterClass := AWriterClass;
1801 
1802       FormatInTheList := True;
1803       Break;
1804     end;
1805   end;
1806 
1807   { If not already in the list, then add it }
1808   if not FormatInTheList then
1809   begin
1810     SetLength(GvVectorialFormats, len + 1);
1811 
1812     GvVectorialFormats[len].ReaderClass := nil;
1813     GvVectorialFormats[len].WriterClass := AWriterClass;
1814     GvVectorialFormats[len].ReaderRegistered := False;
1815     GvVectorialFormats[len].WriterRegistered := True;
1816     GvVectorialFormats[len].Format := AFormat;
1817   end;
1818 end;
1819 
1820 function Make2DPoint(AX, AY: Double): T3DPoint;
1821 begin
1822   Result.X := AX;
1823   Result.Y := AY;
1824   Result.Z := 0;
1825 end;
1826 
1827 function Dimension(AValue: Double; AUnits: TvUnits): TvDimension;
1828 begin
1829   Result.Value := AValue;
1830   Result.Units := AUnits;
1831 end;
1832 
1833 function ConvertDimensionToMM(ADimension: TvDimension; ATotalSize: Double): Double;
1834 begin
1835   case ADimension.Units of
1836   dimMillimeter: Result := ADimension.Value;
1837   dimPercent:    Result := ATotalSize * ADimension.Value;
1838   dimPoint:      Result := ADimension.Value; // ToDo
1839   end;
1840 end;
1841 
1842 procedure RegisterDefaultRenderer(ARenderer: TvRendererClass);
1843 begin
1844   gDefaultRenderer := ARenderer;
1845 end;
1846 
1847 { TvStyle }
1848 
1849 constructor TvStyle.Create;
1850 begin
1851   // Defaults
1852   SuppressSpacingBetweenSameParagraphs:=False;
1853 end;
1854 
GetKindnull1855 function TvStyle.GetKind: TvStyleKind;
1856 begin
1857   if Parent = nil then Result := Kind
1858   else Result := Parent.GetKind();
1859 end;
1860 
1861 procedure TvStyle.Clear;
1862 begin
1863   Name := '';
1864   Parent := nil;
1865   Kind := vskTextBody;
1866   Alignment := vsaLeft;
1867 
1868   //
1869   {Pen.Color := col;
1870   Brush := nil;
1871   Font := nil;}
1872   SetElements := [];
1873   //
1874   MarginTop := 0;
1875   MarginBottom := 0;
1876   MarginLeft := 0;
1877   MarginRight := 0;
1878   //
1879 end;
1880 
1881 procedure TvStyle.CopyFrom(AFrom: TvStyle);
1882 begin
1883   Clear();
1884   ApplyOver(AFrom);
1885 end;
1886 
1887 procedure TvStyle.CopyFromEntity(AEntity: TvEntity);
1888 begin
1889 
1890 end;
1891 
1892 procedure TvStyle.ApplyOverFromPen(APen: PvPen; ASetElements: TvSetStyleElements);
1893 begin
1894   if spbfPenColor in ASetElements then
1895     Pen.Color := APen^.Color;
1896   if spbfPenStyle in ASetElements then
1897     Pen.Style := APen^.Style;
1898   if spbfPenWidth in ASetElements then
1899     Pen.Width := APen^.Width;
1900 
1901   SetElements += ASetElements * [spbfPenColor, spbfPenStyle, spbfPenWidth];
1902 end;
1903 
1904 procedure TvStyle.ApplyOverFromBrush(ABrush: PvBrush; ASetElements: TvSetStyleElements);
1905 begin
1906   if spbfBrushColor in ASetElements then
1907     Brush.Color := ABrush^.Color;
1908   if spbfBrushStyle in ASetElements then
1909     Brush.Style := ABrush^.Style;
1910   {if spbfBrushGradient in ASetElements then
1911     Brush.Gra := AFrom.Brush.Style;}
1912   if spbfBrushKind in ASetElements then
1913     Brush.Kind := ABrush^.Kind;
1914 
1915   SetElements += ASetElements * [spbfBrushColor, spbfBrushStyle, spbfBrushGradient, spbfBrushKind];
1916 end;
1917 
1918 procedure TvStyle.ApplyOverFromFont(AFont: PvFont; ASetElements: TvSetStyleElements);
1919 begin
1920 
1921 end;
1922 
1923 procedure TvStyle.ApplyOver(AFrom: TvStyle);
1924 begin
1925   if AFrom = nil then Exit;
1926 
1927   // Pen
1928 
1929   ApplyOverFromPen(@AFrom.Pen, AFrom.SetElements);
1930 
1931   // Brush
1932 
1933   ApplyOverFromBrush(@AFrom.Brush, AFrom.SetElements);
1934 
1935   // Font
1936 
1937   //ApplyOverFromFont(@AFrom.Font, AFrom.SetElements);
1938   if spbfFontColor in AFrom.SetElements then
1939     Font.Color := AFrom.Font.Color;
1940   if spbfFontSize in AFrom.SetElements then
1941     Font.Size := AFrom.Font.Size;
1942   if spbfFontName in AFrom.SetElements then
1943     Font.Name := AFrom.Font.Name;
1944   if spbfFontBold in AFrom.SetElements then
1945     Font.Bold := AFrom.Font.Bold;
1946   if spbfFontItalic in AFrom.SetElements then
1947     Font.Italic := AFrom.Font.Italic;
1948   If spbfFontUnderline in AFrom.SetElements then
1949     Font.Underline := AFrom.Font.Underline;
1950   If spbfFontStrikeThrough in AFrom.SetElements then
1951     Font.StrikeThrough := AFrom.Font.StrikeThrough;
1952   If spbfAlignment in AFrom.SetElements then
1953     Alignment := AFrom.Alignment;
1954 
1955   // TextAnchor
1956   if spbfTextAnchor in AFrom.SetElements then
1957     TextAnchor := AFrom.TextAnchor;
1958 
1959   // Style
1960 
1961   if sseMarginTop in AFrom.SetElements then
1962     MarginTop := AFrom.MarginTop;
1963   If sseMarginBottom in AFrom.SetElements then
1964     MarginBottom := AFrom.MarginBottom;
1965   If sseMarginLeft in AFrom.SetElements then
1966     MarginLeft := AFrom.MarginLeft;
1967   If sseMarginRight in AFrom.SetElements then
1968     MarginRight := AFrom.MarginRight;
1969 
1970   // Other
1971   SuppressSpacingBetweenSameParagraphs:=AFrom.SuppressSpacingBetweenSameParagraphs;
1972 
1973   SetElements := AFrom.SetElements + SetElements;
1974 end;
1975 
1976 procedure TvStyle.ApplyIntoEntity(ADest: TvEntity);
1977 var
1978   lCurEntity: TvEntity;
1979   ADestWithPen: TvEntityWithPen absolute ADest;
1980   ADestWithBrush: TvEntityWithPenAndBrush absolute ADest;
1981   ADestWithFont: TvEntityWithPenBrushAndFont absolute ADest;
1982 begin
1983   if ADest = nil then Exit;
1984 
1985   if ADest is TvEntityWithSubEntities then
1986   begin
1987     lCurEntity := (ADest as TvEntityWithSubEntities).GetFirstEntity();
1988     while lCurEntity <> nil do
1989     begin
1990       ApplyIntoEntity(lCurEntity);
1991       lCurEntity := (ADest as TvEntityWithSubEntities).GetNextEntity();
1992     end;
1993     Exit;
1994   end;
1995 
1996   // Pen
1997   if ADest is TvEntityWithPen then
1998   begin
1999     if spbfPenColor in SetElements then
2000       ADestWithPen.Pen.Color := Pen.Color;
2001     if spbfPenStyle in SetElements then
2002       ADestWithPen.Pen.Style := Pen.Style;
2003     if spbfPenWidth in SetElements then
2004       ADestWithPen.Pen.Width := Pen.Width;
2005   end;
2006 
2007   // Brush
2008   if ADest is TvEntityWithPenAndBrush then
2009   begin
2010     if spbfBrushColor in SetElements then
2011       ADestWithBrush.Brush.Color := Brush.Color;
2012     if spbfBrushStyle in SetElements then
2013       ADestWithBrush.Brush.Style := Brush.Style;
2014     {if spbfBrushGradient in SetElements then
2015       ADestWithBrush.Gra := AFrom.Brush.Style;}
2016     if spbfBrushKind in SetElements then
2017       ADestWithBrush.Brush.Kind := Brush.Kind;
2018   end;
2019 
2020   // Font
2021   if ADest is TvEntityWithPenBrushAndFont then
2022   begin
2023     if spbfFontColor in SetElements then
2024       ADestWithFont.Font.Color := Font.Color;
2025     if spbfFontSize in SetElements then
2026       ADestWithFont.Font.Size := Font.Size;
2027     if spbfFontName in SetElements then
2028       ADestWithFont.Font.Name := Font.Name;
2029     if spbfFontBold in SetElements then
2030       ADestWithFont.Font.Bold := Font.Bold;
2031     if spbfFontItalic in SetElements then
2032       ADestWithFont.Font.Italic := Font.Italic;
2033     If spbfFontUnderline in SetElements then
2034       ADestWithFont.Font.Underline := Font.Underline;
2035     If spbfFontStrikeThrough in SetElements then
2036       ADestWithFont.Font.StrikeThrough := Font.StrikeThrough;
2037     {If spbfAlignment in SetElements then
2038       ADestWithFont.Alignment := Alignment; }
2039 
2040     // TextAnchor
2041     if spbfTextAnchor in SetElements then
2042       ADestWithFont.TextAnchor := TextAnchor;
2043   end;
2044 end;
2045 
CreateStyleCombinedWithParentnull2046 function TvStyle.CreateStyleCombinedWithParent: TvStyle;
2047 begin
2048   Result := TvStyle.Create;
2049   Result.CopyFrom(Self);
2050   if Parent <> nil then Result.ApplyOver(Parent);
2051 end;
2052 
GenerateDebugTreenull2053 function TvStyle.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
2054   APageItem: Pointer): Pointer;
2055 var
2056   lStr, lParentName: string;
2057 begin
2058   if Parent <> nil then lParentName := Parent.Name
2059   else lParentName := '<No Parent>';
2060 
2061   lStr := Format('[%s] Name=%s Parent=%s',
2062     [Self.ClassName, Name, lParentName]);
2063 
2064   if spbfPenColor in SetElements then
2065     lStr := lStr + Format(' Pen.Color=%s', [TvEntity.GenerateDebugStrForFPColor(Pen.Color)]);
2066 {    spbfPenStyle, spbfPenWidth,
2067     spbfBrushColor, spbfBrushStyle, spbfBrushGradient,}
2068   if spbfFontColor in SetElements then
2069     lStr := lStr + Format(' Font.Color=%s', [TvEntity.GenerateDebugStrForFPColor(Pen.Color)]);
2070   if spbfFontSize in SetElements then
2071     lStr := lStr + Format(' Font.Size=%d', [Font.Size]);
2072   if spbfFontName in SetElements then
2073     lStr := lStr + ' Font.Name=' + Font.Name;
2074   if spbfFontBold in SetElements then
2075     if Font.Bold then lStr := lStr + Format(' Font.Bold=%s', [BoolToStr(Font.Bold)]);
2076   if spbfFontItalic in SetElements then
2077     if Font.Italic then lStr := lStr + Format(' Font.Bold=%s', [BoolToStr(Font.Italic)]);
2078 {
2079     spbfFontUnderline, spbfFontStrikeThrough, spbfAlignment,
2080     // Page style
2081     sseMarginTop, sseMarginBottom, sseMarginLeft, sseMarginRight
2082     );
2083    Font.Size, Font.Name, Font.Orientation,
2084     BoolToStr(Font.Underline),
2085     BoolToStr(Font.StrikeThrough),
2086     GetEnumName(TypeInfo(TvTextAnchor), integer(TextAnchor))}
2087   lStr := lStr + FExtraDebugStr;
2088   Result := ADestRoutine(lStr, APageItem);
2089 end;
2090 
2091 { TvListLevelStyle }
2092 
2093 constructor TvListLevelStyle.Create;
2094 begin
2095   Start := 1;
2096   Bullet := '&#183;';
2097   LeaderFontName := 'Symbol';
2098   Alignment := vsaLeft;
2099 end;
2100 
2101 { TvListStyle }
2102 
2103 constructor TvListStyle.Create;
2104 begin
2105   ListLevelStyles:=TFPList.Create;
2106 end;
2107 
2108 destructor TvListStyle.Destroy;
2109 begin
2110   Clear;
2111   ListLevelStyles.Free;
2112   ListLevelStyles := Nil;
2113 
2114   inherited Destroy;
2115 end;
2116 
2117 procedure TvListStyle.Clear;
2118 var
2119   i: Integer;
2120 begin
2121   for i := ListLevelStyles.Count-1 downto 0 do
2122   begin
2123     TvListLevelStyle(ListLevelStyles[i]).free;
2124     ListLevelStyles.Delete(i);
2125   end;
2126 end;
2127 
AddListLevelStylenull2128 function TvListStyle.AddListLevelStyle: TvListLevelStyle;
2129 begin
2130   Result := TvListLevelStyle.Create;
2131   ListLevelStyles.Add(Result);
2132 end;
2133 
GetListLevelStyleCountnull2134 function TvListStyle.GetListLevelStyleCount: Integer;
2135 begin
2136   Result := ListLevelStyles.Count;
2137 end;
2138 
GetListLevelStylenull2139 function TvListStyle.GetListLevelStyle(AIndex : Integer): TvListLevelStyle;
2140 begin
2141   Result := TvListLevelStyle(ListLevelStyles[Aindex]);
2142 end;
2143 
2144 { TvTableCell }
2145 
2146 constructor TvTableCell.Create(APage: TvPage);
2147 begin
2148   inherited Create(APage);
2149 
2150   Borders.Left.LineType:=tbtDefault;
2151   Borders.Right.LineType:=tbtDefault;
2152   Borders.Top.LineType:=tbtDefault;
2153   Borders.Bottom.LineType:=tbtDefault;
2154   Borders.InsideHoriz.LineType:=tbtDefault;
2155   Borders.InsideVert.LineType:=tbtDefault;
2156 
2157   SpacingLeft := 2;
2158   SpacingRight := 2;
2159   SpacingTop := 2;
2160   SpacingBottom := 2;
2161 
2162   SpannedCols := 1;
2163 end;
2164 
GetEffectiveBordernull2165 function TvTableCell.GetEffectiveBorder(): TvTableBorders;
2166 begin
2167   Result := Borders;
2168   if (Row <> nil) and (Row.Table <> nil) then
2169   begin
2170     if Borders.Left.LineType = tbtDefault then
2171       Result.Left := Row.Table.Borders.Left;
2172     if Borders.Right.LineType = tbtDefault then
2173       Result.Right := Row.Table.Borders.Right;
2174     if Borders.Top.LineType = tbtDefault then
2175       Result.Top := Row.Table.Borders.Top;
2176     if Borders.Bottom.LineType = tbtDefault then
2177       Result.Bottom := Row.Table.Borders.Bottom;
2178   end;
2179 end;
2180 
2181 procedure TvTableCell.GetEffectiveCellSpacing(out ATopSpacing, ALeftSpacing, ARightSpacing, ABottomSpacing: Double);
2182 begin
2183   ATopSpacing := 0;
2184   ALeftSpacing := 0;
2185   ARightSpacing := 0;
2186   ABottomSpacing := 0;
2187   if SpacingDataValid then
2188   begin
2189     ATopSpacing := SpacingTop;
2190     ALeftSpacing := SpacingLeft;
2191     ARightSpacing := SpacingRight;
2192     ABottomSpacing := SpacingBottom;
2193   end
2194   else if (Row <> nil) and (Row.SpacingDataValid) then
2195   begin
2196     ATopSpacing := Row.CellSpacing;
2197     ALeftSpacing := Row.CellSpacing;
2198     ARightSpacing := Row.CellSpacing;
2199     ABottomSpacing := Row.CellSpacing;
2200   end
2201   else if (Row <> nil) and (Row.Table <> nil) then
2202   begin
2203     ATopSpacing := Row.Table.CellSpacingLeft;
2204     ALeftSpacing := Row.Table.CellSpacingTop;
2205     ARightSpacing := Row.Table.CellSpacingRight;
2206     ABottomSpacing := Row.Table.CellSpacingBottom;
2207   end;
2208 end;
2209 
2210 class procedure TvTableCell.DrawBorder(ABorder: TvTableBorders;
2211   AX, AY, AWidth, AHeight: double;
2212   ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
2213   ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
2214 
2215   function CoordToCanvasX(ACoord: Double): Integer;
2216   begin
2217     Result := Round(ADestX + AmulX * ACoord);
2218   end;
2219 
2220   function CoordToCanvasY(ACoord: Double): Integer;
2221   begin
2222     Result := Round(ADestY + AmulY * ACoord);
2223   end;
2224 
2225 begin
2226   CalcEntityCanvasMinMaxXY(ARenderInfo, CoordToCanvasX(AX), CoordToCanvasY(AY));
2227   CalcEntityCanvasMinMaxXY(ARenderInfo, CoordToCanvasX(AX), CoordToCanvasY(AY+AHeight));
2228   ADest.Pen.Style := psSolid;
2229   ADest.Pen.FPColor := colBlack;
2230   if ABorder.Left.LineType <> tbtNone then
2231   begin
2232     ADest.Pen.Width := Round(ABorder.Left.Width * AMulX);
2233     ADest.Line(
2234       CoordToCanvasX(AX),
2235       CoordToCanvasY(AY),
2236       CoordToCanvasX(AX),
2237       CoordToCanvasY(AY+AHeight));
2238   end;
2239   if ABorder.Right.LineType <> tbtNone then
2240   begin
2241     ADest.Pen.Width := Round(ABorder.Right.Width * AMulX);
2242     ADest.Line(
2243       CoordToCanvasX(AX+AWidth),
2244       CoordToCanvasY(AY),
2245       CoordToCanvasX(AX+AWidth),
2246       CoordToCanvasY(AY+AHeight));
2247   end;
2248   if ABorder.Top.LineType <> tbtNone then
2249   begin
2250     ADest.Pen.Width := Round(ABorder.Top.Width * AMulX);
2251     ADest.Line(
2252       CoordToCanvasX(AX),
2253       CoordToCanvasY(AY),
2254       CoordToCanvasX(AX+AWidth),
2255       CoordToCanvasY(AY));
2256   end;
2257   if ABorder.Bottom.LineType <> tbtNone then
2258   begin
2259     ADest.Pen.Width := Round(ABorder.Bottom.Width * AMulX);
2260     ADest.Line(
2261       CoordToCanvasX(AX),
2262       CoordToCanvasY(AY+AHeight),
2263       CoordToCanvasX(AX+AWidth),
2264       CoordToCanvasY(AY+AHeight));
2265   end;
2266 end;
2267 
2268 procedure TvTableCell.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True);
2269 var
2270   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
2271   ADestX: Integer absolute ARenderInfo.DestX;
2272   ADestY: Integer absolute ARenderInfo.DestY;
2273   AMulX: Double absolute ARenderInfo.MulX;
2274   AMulY: Double absolute ARenderInfo.MulY;
2275   //
2276   lBorders: TvTableBorders;
2277   CellWidth, CellHeight, lCellSpacingX, lCellSpacingY, lTmp: Double;
2278   lColNr: Integer;
2279   i: Integer;
2280 begin
2281   // draw borders
2282   if (Row <> nil) and (Row.Table <> nil) and ADoDraw then
2283   begin
2284     lBorders := GetEffectiveBorder();
2285     lColNr := Row.GetCellColNr(Self);
2286 
2287     CellWidth := 0;
2288     for i := lColNr to lColNr+SpannedCols-1 do
2289     begin
2290       CellWidth := CellWidth + Row.Table.ColWidthsInMM[i];
2291     end;
2292     CellHeight := Row.Height;
2293 
2294     TvTableCell.DrawBorder(lBorders, X, Y, CellWidth, CellHeight,
2295       ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY);
2296   end;
2297 
2298   GetEffectiveCellSpacing(lCellSpacingX, lCellSpacingY, lTmp, lTmp);
2299   X := X + lCellSpacingX;
2300   Y := Y + lCellSpacingY;
2301   inherited Render(ARenderInfo, ADoDraw);
2302   X := X - lCellSpacingX;
2303   Y := Y - lCellSpacingY;
2304 end;
2305 
GenerateDebugTreenull2306 function TvTableCell.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer;
2307 begin
2308   FExtraDebugStr := Format(' Borders=%s PreferredWidth=%f VerticalAlignment=%s' +
2309     ' BackgroundColor=%s SpannedCols=%d',
2310     [GenerateDebugStrForBorders(Borders),
2311      PreferredWidth.Value,
2312      GetEnumName(TypeInfo(TvVerticalAlignment), integer(VerticalAlignment)),
2313      GenerateDebugStrForFPColor(BackgroundColor), SpannedCols]);
2314 
2315   Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
2316 end;
2317 
2318 class function TvTableCell.GenerateDebugStrForBorders(ABorders: TvTableBorders): string;
2319 begin
2320   Result := Format('L=%s:%f T=%s:%f R=%s:%f B=%s:%f',
2321     [GetEnumName(TypeInfo(TvTableBorderType), integer(ABorders.Left.LineType)),
2322      ABorders.Left.Width,
2323      GetEnumName(TypeInfo(TvTableBorderType), integer(ABorders.Top.LineType)),
2324      ABorders.Top.Width,
2325      GetEnumName(TypeInfo(TvTableBorderType), integer(ABorders.Right.LineType)),
2326      ABorders.Right.Width,
2327      GetEnumName(TypeInfo(TvTableBorderType), integer(ABorders.Bottom.LineType)),
2328      ABorders.Bottom.Width]);
2329 end;
2330 
2331 { TvTable }
2332 
2333 // Returns the table width
2334 procedure TvTable.CalculateColWidths(constref ARenderInfo: TvRenderInfo);
2335 var
2336   CurRow: TvTableRow;
2337   CurCell: TvTableCell;
2338   lWidth: Double;
2339   col, row, i: Integer;
2340   //DebugStr: string;
2341   OriginalColWidthsInMM: array of Double;
2342   CurRowTableWidth: Double;
2343 begin
2344   SetLength(ColWidthsInMM, GetColCount());
2345 
2346   // Process predefined widths
2347   for col := 0 to Length(ColWidthsInMM)-1 do
2348   begin
2349     ColWidthsInMM[col] := 0;
2350     if Length(ColWidths) > col then
2351       ColWidthsInMM[col] := ConvertDimensionToMM(Dimension(ColWidths[col], ColWidthsUnits), FPage.Width);
2352   end;
2353 
2354   // Process initial value for non-predefined widths
2355   OriginalColWidthsInMM := Copy(ColWidthsInMM, 0, Length(ColWidthsInMM));
2356   TableWidth := 0;
2357   for row := 0 to GetRowCount()-1 do
2358   begin
2359     CurRow := GetRow(row);
2360     CurRowTableWidth := 0;
2361 
2362     for col := 0 to CurRow.GetCellCount()-1 do
2363     begin
2364       CurCell := CurRow.GetCell(col);
2365       //DebugStr := ((CurCell.GetFirstEntity() as TvParagraph).GetFirstEntity() as TvText).Value.Text;
2366 
2367       // skip cells with span since they are complex
2368       // skip columns with width pre-set
2369       if (OriginalColWidthsInMM[col] > 0) then
2370       begin
2371         CurRowTableWidth := CurRowTableWidth + ColWidthsInMM[col];
2372         Continue;
2373       end;
2374       if (CurCell.SpannedCols > 1) then
2375       begin
2376         CurRowTableWidth := CurRowTableWidth + ColWidthsInMM[col];
2377         for i := 0 to CurCell.SpannedCols-1 do
2378           CurRowTableWidth := CurRowTableWidth + ColWidthsInMM[col+i];
2379         Continue;
2380       end;
2381 
2382       lWidth := CurCell.CalculateMaxNeededWidth(ARenderInfo);
2383       ColWidthsInMM[col] := Max(ColWidthsInMM[col], lWidth);
2384       CurRowTableWidth := CurRowTableWidth + ColWidthsInMM[col];
2385     end;
2386 
2387     TableWidth := Max(TableWidth, CurRowTableWidth);
2388   end;
2389 
2390   // If it goes over the page width, recalculate with equal sizes (in the future do better)
2391   if FPage.Width <= 0 then Exit;
2392   if TableWidth <= FPage.Width then Exit;
2393   TableWidth := FPage.Width;
2394   for col := 0 to Length(ColWidthsInMM)-1 do
2395   begin
2396     ColWidthsInMM[col] := FPage.Width / GetRowCount();
2397   end;
2398 end;
2399 
2400 procedure TvTable.CalculateRowHeights(constref ARenderInfo: TvRenderInfo);
2401 var
2402   col, row: Integer;
2403   CurRow: TvTableRow;
2404   CurCell: TvTableCell;
2405   lCellHeight: Double;
2406 begin
2407   TableHeight := 0;
2408 
2409   for row := 0 to GetRowCount()-1 do
2410   begin
2411     CurRow := GetRow(row);
2412     CurRow.Height := 0;
2413 
2414     for col := 0 to CurRow.GetCellCount()-1 do
2415     begin
2416       CurCell := CurRow.GetCell(col);
2417       lCellHeight := CurCell.CalculateCellHeight_ForWidth(ARenderInfo, ColWidthsInMM[col]);
2418       CurRow.Height := Max(CurRow.Height, lCellHeight);
2419     end;
2420 
2421     CurRow.Height := CurRow.Height + CurRow.CalculateMaxCellSpacing_Y();
2422     TableHeight := TableHeight + SpacingBetweenCells;
2423     CurRow.Y := TableHeight;
2424     TableHeight := TableHeight + CurRow.Height;
2425   end;
2426 
2427   TableHeight := TableHeight + SpacingBetweenCells;
2428 end;
2429 
2430 constructor TvTable.create(APage: TvPage);
2431 begin
2432   inherited Create(APage);
2433   Rows := TFPList.Create;
2434 
2435   // Use default cell border widths of 0.5 pts, like Word or Writer.
2436   Borders.Left.Width := 0.5 * FPV_TEXT_POINT_TO_MM;
2437   Borders.Right.Width := 0.5 * FPV_TEXT_POINT_TO_MM;
2438   Borders.Top.Width := 0.5 * FPV_TEXT_POINT_TO_MM;
2439   Borders.Bottom.Width := 0.5 * FPV_TEXT_POINT_TO_MM;
2440   Borders.InsideHoriz.Width := 0.5 * FPV_TEXT_POINT_TO_MM;
2441   Borders.InsideVert.Width := 0.5 * FPV_TEXT_POINT_TO_MM;
2442 end;
2443 
2444 destructor TvTable.destroy;
2445 var
2446   i: Integer;
2447 begin
2448   for i := Rows.Count-1 downto 0 do
2449   begin
2450     TvTableRow(Rows.Last).Free;
2451     Rows.Delete(Rows.Count-1);
2452   end;
2453 
2454   Rows.Free;
2455   Rows := nil;
2456 
2457   inherited destroy;
2458 end;
2459 
AddRownull2460 function TvTable.AddRow: TvTableRow;
2461 begin
2462   Result := TvTableRow.create(FPage);
2463   Result.Table := Self;
2464   Rows.Add(result);
2465 end;
2466 
GetRowCountnull2467 function TvTable.GetRowCount: Integer;
2468 begin
2469   Result := Rows.Count;
2470 end;
2471 
GetRownull2472 function TvTable.GetRow(AIndex: Integer): TvTableRow;
2473 begin
2474   Result := TvTableRow(Rows[AIndex]);
2475 end;
2476 
GetColCountnull2477 function TvTable.GetColCount(): Integer;
2478 var
2479   row, col, CurRowColCount: Integer;
2480   CurRow: TvTableRow;
2481   CurCell: TvTableCell;
2482 begin
2483   Result := 0;
2484   for row := 0 to GetRowCount()-1 do
2485   begin
2486     CurRow := GetRow(row);
2487     CurRowColCount := 0;
2488     for col := 0 to CurRow.GetCellCount()-1 do
2489     begin
2490       CurCell := CurRow.GetCell(col);
2491       CurRowColCount := CurRowColCount + CurCell.SpannedCols;
2492     end;
2493 
2494     Result := Max(Result, CurRowColCount);
2495   end;
2496 end;
2497 
2498 procedure TvTable.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
2499 var
2500   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
2501   ADestX: Integer absolute ARenderInfo.DestX;
2502   ADestY: Integer absolute ARenderInfo.DestY;
2503   AMulX: Double absolute ARenderInfo.MulX;
2504   AMulY: Double absolute ARenderInfo.MulY;
2505 
2506   function CoordToCanvasX(ACoord: Double): Integer;
2507   begin
2508     Result := Round(ADestX + AmulX * ACoord);
2509   end;
2510 
2511   function CoordToCanvasY(ACoord: Double): Integer;
2512   begin
2513     Result := Round(ADestY + AmulY * ACoord);
2514   end;
2515 
2516   function DeltaToCanvasY(ACoord: Double): Integer;
2517   begin
2518     Result := Round(AmulY * ACoord);
2519   end;
2520 
2521 var
2522   row: Integer;
2523   CurRow: TvTableRow;
2524   lEntityRenderInfo: TvRenderInfo;
2525 begin
2526   InitializeRenderInfo(ARenderInfo, Self);
2527 
2528   // First calculate the column widths and heights
2529   CalculateColWidths(ARenderInfo);
2530 
2531   // Now calculate the row heights
2532   CalculateRowHeights(ARenderInfo);
2533 
2534   // Draw the table border
2535   if ADoDraw then
2536   begin
2537     TvTableCell.DrawBorder(Borders, X, Y, TableWidth, TableHeight,
2538       ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY);
2539   end;
2540 
2541   // Now draw the table
2542   for row := 0 to GetRowCount()-1 do
2543   begin
2544     CurRow := GetRow(row);
2545 
2546     // changes from pos relative inside table (calculated in CalculateRowHeights) to absolute pos
2547     CurRow.Y := Y + CurRow.Y;
2548 
2549     CopyAndInitDocumentRenderInfo(lEntityRenderInfo, ARenderInfo);
2550     CurRow.Render(lEntityRenderInfo, ADoDraw);
2551     //MergeRenderInfo(lEntityRenderInfo, ARenderInfo); no need to merge, since TvTableCell.DrawBorder calculates the proper size
2552   end;
2553 end;
2554 
GenerateDebugTreenull2555 function TvTable.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
2556   APageItem: Pointer): Pointer;
2557 var
2558   i: Integer;
2559   lCurRow: TvTableRow;
2560 begin
2561   Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
2562 
2563   // data which goes into a separate item
2564   FExtraDebugStr := 'ColWidthsInMM=';
2565   for i := 0 to Length(ColWidthsInMM)-1 do
2566     FExtraDebugStr := FExtraDebugStr + Format('[%d]=%f ', [i, ColWidthsInMM[i]]);
2567   ADestRoutine(FExtraDebugStr, Result);
2568 
2569   // Add rows
2570   for i := 0 to GetRowCount()-1 do
2571   begin
2572     lCurRow := GetRow(i);
2573     lCurRow.GenerateDebugTree(ADestRoutine, Result);
2574   end;
2575 end;
2576 
2577 { TvEmbeddedVectorialDoc }
2578 
2579 constructor TvEmbeddedVectorialDoc.create(APage: TvPage);
2580 begin
2581   inherited create(APage);
2582   Document := TvVectorialDocument.Create();
2583   FWidth := -1;
2584   FHeight := -1;
2585 end;
2586 
2587 destructor TvEmbeddedVectorialDoc.destroy;
2588 begin
2589   Document.Free;
2590   inherited destroy;
2591 end;
2592 
2593 procedure TvEmbeddedVectorialDoc.UpdateDocumentSize;
2594 begin
2595   if (Document.Width = 0) or (Document.Height = 0) then
2596   begin
2597     Document.GuessDocumentSize();
2598   end;
2599 end;
2600 
GetWidthnull2601 function TvEmbeddedVectorialDoc.GetWidth: Double;
2602 begin
2603   if FWidth >= 0 then
2604     Result := FWidth
2605   else
2606     Result := Document.Width;
2607 end;
2608 
GetHeightnull2609 function TvEmbeddedVectorialDoc.GetHeight: Double;
2610 begin
2611   if FHeight >= 0 then
2612     Result := FHeight
2613   else
2614     Result := Document.Height;
2615 end;
2616 
2617 procedure TvEmbeddedVectorialDoc.SetWidth(AValue: Double);
2618 begin
2619   FWidth := AValue;
2620 end;
2621 
2622 procedure TvEmbeddedVectorialDoc.SetHeight(AValue: Double);
2623 begin
2624   FHeight := AValue;
2625 end;
2626 
2627 procedure TvEmbeddedVectorialDoc.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
2628   out ALeft, ATop, ARight, ABottom: Double);
2629 begin
2630   UpdateDocumentSize();
2631   ALeft := X;
2632   ATop := Y;
2633   ARight := X + GetWidth();
2634   ABottom := Y + GetHeight();
2635 end;
2636 
2637 procedure TvEmbeddedVectorialDoc.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
2638 var
2639   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
2640   ADestX: Integer absolute ARenderInfo.DestX;
2641   ADestY: Integer absolute ARenderInfo.DestY;
2642   AMulX: Double absolute ARenderInfo.MulX;
2643   AMulY: Double absolute ARenderInfo.MulY;
2644 
2645   function CoordToCanvasX(ACoord: Double): Integer;
2646   begin
2647     Result := Round(ADestX + AmulX * ACoord);
2648   end;
2649 
2650   function CoordToCanvasY(ACoord: Double): Integer;
2651   begin
2652     Result := Round(ADestY + AmulY * ACoord);
2653   end;
2654 
2655 var
2656   lPage: TvPage;
2657   lX_px, lY_px, lWidth_px, lHeight_px, lPageHeight, lDeltaX, lDeltaY: Integer;
2658   lMulY, lZoom: Double;
2659 begin
2660   inherited Render(ARenderInfo, ADoDraw);
2661 
2662   if Document.GetPageCount() = 0 then Exit;
2663 
2664   lPage := Document.GetPage(0);
2665   lPageHeight := Round(lPage.Height);
2666   lPage.GetNaturalRenderPos(lPageHeight, lMulY);
2667 
2668   UpdateDocumentSize();
2669   lX_px := CoordToCanvasX(X);
2670   lY_px := CoordToCanvasY(Y);
2671 
2672   // Ignore MulX/MulY here so that it doesn't affect AutoFit, this fixes an
2673   // issue where embeded svg in html was getting out of proportion if the zoom
2674   // was different than 1.0
2675   // Calculate the standard zoom (zoom with mulx=1.0)
2676   lWidth_px := Round(GetWidth());
2677   lHeight_px := Round(GetHeight());
2678   lPage.AutoFit(ADest, lWidth_px, lHeight_px, lHeight_px, lDeltaX, lDeltaY, lZoom);
2679   lZoom := Abs(lZoom);
2680   lX_px += lDeltaX;
2681   lY_px += lDeltaY;
2682   if AmulY * lMulY < 0 then
2683   begin
2684     lY_px := lY_px + lHeight_px;
2685   end;
2686   // recalculate lWidth_px/height considering now mulx/muly
2687   lWidth_px := Abs(CoordToCanvasX(GetWidth()));
2688   lHeight_px := Abs(CoordToCanvasY(GetHeight()));
2689 
2690   if ADoDraw then
2691   begin
2692     lPage.Render(ADest, lX_px, lY_px, AMulX * lZoom, AMulY * lMulY * lZoom);
2693     {ADest.Pen.FPColor := colRed;
2694     ADest.Pen.Style := psSolid;
2695     ADest.Rectangle(CoordToCanvasX(X), CoordToCanvasY(lY), CoordToCanvasX(X+Width), CoordToCanvasY(lY+Height));
2696     ADest.Rectangle(lX_px, lY_px, lX_px+100, lY_px+100);}
2697   end;
2698 
2699   if (ARenderInfo.Errors <> nil) and (lPage.RenderInfo.Errors <> nil) then
2700   begin
2701     AddStringsToArray(ARenderInfo.Errors, lPage.RenderInfo.Errors);
2702     // was: ARenderInfo.Errors.AddStrings(lPage.RenderInfo.Errors);
2703   end;
2704   CalcEntityCanvasMinMaxXY(ARenderInfo, CoordToCanvasX(X), CoordToCanvasY(Y));
2705   CalcEntityCanvasMinMaxXY(ARenderInfo,
2706     CoordToCanvasX(X + Document.Width),
2707     CoordToCanvasY(Y + Document.Height));
2708   CalcEntityCanvasMinMaxXY(ARenderInfo, lX_px, lY_px);
2709   CalcEntityCanvasMinMaxXY(ARenderInfo, lX_px+lWidth_px, lY_px+lHeight_px);
2710 end;
2711 
TvEmbeddedVectorialDoc.GenerateDebugTreenull2712 function TvEmbeddedVectorialDoc.GenerateDebugTree(
2713   ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer;
2714 begin
2715   Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
2716   Document.GenerateDebugTree(ADestRoutine, Result);
2717 end;
2718 
2719 { TvTableRow }
2720 
2721 constructor TvTableRow.create(APage: TvPage);
2722 begin
2723   inherited create(APage);
2724 
2725   Cells := TFPList.Create;
2726 
2727   Header := False;
2728 end;
2729 
2730 destructor TvTableRow.destroy;
2731 Var
2732   i : Integer;
2733 begin
2734   for i := Cells.Count-1 downto 0 do
2735   begin
2736     TvTableCell(Cells.Last).Free;
2737     Cells.Delete(Cells.Count-1);
2738   end;
2739 
2740   Cells.Free;
2741   Cells := Nil;
2742 
2743   inherited destroy;
2744 end;
2745 
AddCellnull2746 function TvTableRow.AddCell : TvTableCell;
2747 begin
2748   Result := TvTableCell.Create(FPage);
2749   Result.Row := Self;
2750   Cells.Add(Result);
2751 end;
2752 
GetCellCountnull2753 function TvTableRow.GetCellCount: Integer;
2754 begin
2755   Result := Cells.Count;
2756 end;
2757 
TvTableRow.GetCellnull2758 function TvTableRow.GetCell(AIndex: Integer): TvTableCell;
2759 begin
2760   Result := TvTableCell(Cells[AIndex]);
2761 end;
2762 
TvTableRow.GetCellColNrnull2763 function TvTableRow.GetCellColNr(ACell: TvTableCell): Integer;
2764 begin
2765   Result := Cells.IndexOf(Pointer(ACell));
2766 end;
2767 
CalculateMaxCellSpacing_Ynull2768 function TvTableRow.CalculateMaxCellSpacing_Y(): Double;
2769 Var
2770   i : Integer;
2771   CurCell: TvTableCell;
2772   lTopSpacing, lLeftSpacing, lRightSpacing, lBottomSpacing: Double;
2773 begin
2774   Result := 0;
2775   for i := 0 to GetCellCount()-1 do
2776   begin
2777     CurCell := GetCell(i);
2778     CurCell.GetEffectiveCellSpacing(lTopSpacing, lLeftSpacing, lRightSpacing, lBottomSpacing);
2779     Result := Max(Result, lBottomSpacing+lTopSpacing);
2780   end;
2781 end;
2782 
2783 procedure TvTableRow.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
2784   out ALeft, ATop, ARight, ABottom: Double);
2785 begin
2786   ALeft := X;
2787   ATop := Y;
2788   ARight := X + FPage.Width;
2789   ABottom := Y + Height;
2790 end;
2791 
2792 procedure TvTableRow.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True);
2793 var
2794   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
2795   ADestX: Integer absolute ARenderInfo.DestX;
2796   ADestY: Integer absolute ARenderInfo.DestY;
2797   AMulX: Double absolute ARenderInfo.MulX;
2798   AMulY: Double absolute ARenderInfo.MulY;
2799 
CoordToCanvasXnull2800   function CoordToCanvasX(ACoord: Double): Integer;
2801   begin
2802     Result := Round(ADestX + AmulX * ACoord);
2803   end;
2804 
CoordToCanvasYnull2805   function CoordToCanvasY(ACoord: Double): Integer;
2806   begin
2807     Result := Round(ADestY + AmulY * ACoord);
2808   end;
2809 
2810 var
2811   CurCell: TvTableCell;
2812   i: Integer;
2813   CurX_mm: Double = 0.0;
2814   lEntityRenderInfo: TvRenderInfo;
2815 begin
2816   InitializeRenderInfo(ARenderInfo, Self);
2817 
2818   for i := 0 to GetCellCount()-1 do
2819   begin
2820     CurCell := GetCell(i);
2821     CurCell.X := CurX_mm;
2822     CurCell.Y := Y;
2823     //ADest.Line(CoordToCanvasX(CurX_mm), CoordToCanvasY(Y), CoordToCanvasX(CurX_mm+1), CoordToCanvasY(Y+1));
2824     CopyAndInitDocumentRenderInfo(lEntityRenderInfo, ARenderInfo);
2825     CurCell.Render(lEntityRenderInfo, ADoDraw);
2826     if (Table <> nil) then
2827     begin
2828       if (Length(Table.ColWidthsInMM) > i) then
2829         CurX_mm := CurX_mm + Table.ColWidthsInMM[i];
2830     end;
2831 
2832     MergeRenderInfo(lEntityRenderInfo, ARenderInfo);
2833   end;
2834 end;
2835 
GenerateDebugTreenull2836 function TvTableRow.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
2837   APageItem: Pointer): Pointer;
2838 var
2839   i: Integer;
2840   lCurCell: TvTableCell;
2841 begin
2842   FExtraDebugStr := Format(' Height=%f CellSpacing=%f SpacingDataValid=%s',
2843     [Height, CellSpacing, BoolToStr(SpacingDataValid)]);
2844   Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
2845 
2846   // Add cells
2847   for i := 0 to GetCellCount()-1 do
2848   begin
2849     lCurCell := GetCell(i);
2850     lCurCell.GenerateDebugTree(ADestRoutine, Result);
2851   end;
2852 end;
2853 
2854 { T2DEllipticalArcSegment }
2855 
2856 // wp: no longer needed...
T2DEllipticalArcSegment.AlignedEllipseCenterEquationT1null2857 function T2DEllipticalArcSegment.AlignedEllipseCenterEquationT1(
2858   AParam: Double): Double;
2859 var
2860   lLeftSide, lRightSide, lArg: Double;
2861 begin
2862   // E1.Y - RY*sin(t1) = E2.Y - RY*sin(arccos((- E1.X + RX*cos(t1) + E2.X)/RX))
2863   lLeftSide := E1.Y - RY*sin(AParam);
2864   lArg := (- E1.X + RX*cos(AParam) + E2.X)/RX;
2865   if (lArg > 1) or (lArg < -1) then Exit($FFFFFFFF);
2866   lRightSide := E2.Y - RY*sin(arccos(lArg));
2867   Result := lLeftSide - lRightSide;
2868   if Result < 0 then Result := -1* Result;
2869 end;
2870 
2871 procedure T2DEllipticalArcSegment.BezierApproximate(var Points: T3dPointsArray);
2872 var
2873   P1, P2, P3, P4: T3dPoint;
2874   startangle, endangle: Double;
2875   startanglePi2, endanglePi2: Double;
2876   xstart, ystart: Double;
2877   nextx, nexty: Double;
2878   angle: Double;
2879   n: Integer;
2880 begin
2881   SetLength(Points, 30);
2882   n := 0;
2883 
2884   xstart := T2DSegment(Previous).X;
2885   ystart := T2DSegment(Previous).Y;
2886   startangle := CalcEllipsePointAngle(xstart, ystart, RX, RY, CX, CY, XRotation);
2887   endangle := CalcEllipsePointAngle(X, Y, RX, RY, CX, CY, XRotation);
2888   if endangle < 0 then endangle := 2*pi + endangle;
2889 
2890   angle := arctan2(-1,1);
2891   angle := radtodeg(angle);
2892 
2893   angle := radtodeg(startangle);
2894   angle := radtodeg(endangle);
2895 
2896   // Since the algorithm for bezier approximation requires that the angle
2897   // between start and end is at most pi/3 we have to progress in pi/3 steps.
2898   angle := startangle + pi/3;
2899   while true do
2900   begin
2901     if angle >= endangle then begin
2902       EllipticalArcToBezier(CX, CY, RX, RY, startAngle, endangle, Points[n], Points[n+1], Points[n+2], Points[n+3]);
2903       inc(n, 4);
2904       break;
2905     end else
2906       EllipticalArcToBezier(CX, CY, RX, RY, startangle, angle, Points[n], Points[n+1], Points[n+2], Points[n+3]);
2907     inc(n, 4);
2908     startangle := angle;
2909     angle := angle + pi/2;
2910   end;
2911   SetLength(Points, n);
2912 end;
2913 
2914 procedure T2DEllipticalArcSegment.PolyApproximate(var Points: T3dPointsArray);
2915 const
2916   BUFSIZE = 100;
2917 var
2918   t, tstart, tend, dt: Double;
2919   xstart, ystart: Double;
2920   n: Integer;
2921   done: Boolean;
2922   clockwise: Boolean;
2923 begin
2924   n := 0;
2925   SetLength(Points, BUFSIZE);
2926 
2927   dt := DegToRad(1.0);  // 1-degree increments
2928 
2929   xstart := T2DSegment(Previous).X;
2930   ystart := T2DSegment(Previous).Y;
2931   tstart := CalcEllipsePointAngle(xstart, ystart, RX, RY, CX, CY, XRotation);
2932   tend := CalcEllipsePointAngle(X, Y, RX, RY, CX, CY, XRotation);
2933 
2934   // Flip clockwise flag in case of top/left coordinates
2935   clockwise := ClockwiseArcFlag xor UseTopLeftCoordinates;
2936 
2937   if clockwise then
2938   begin
2939     // clockwise --> angle decreases --> tstart must be > tend
2940     dt := -dt;
2941     if tstart < tend then tstart := TWO_PI + tstart;
2942   end else
2943   begin
2944     // counter-clockwise --> angle increases --> tstart must be < tend
2945     if tend < tstart then tend := TWO_PI + tend;
2946   end;
2947 
2948   done := false;
2949   t := tstart;
2950   while not done do begin
2951     if (clockwise and (t < tend)) or         // angle decreases
2952        (not clockwise and (t > tend)) then   // angle increases
2953     begin
2954       t := tend;
2955       done := true;
2956     end;
2957     if n >= Length(Points) then
2958       SetLength(Points, Length(Points) + BUFSIZE);
2959     CalcEllipsePoint(t, RX, RY, CX, CY, XRotation, Points[n].x, Points[n].y);
2960     inc(n);
2961     t := t + dt;      // Note: dt is < 0 in clockwise case
2962   end;
2963   SetLength(Points, n);
2964 end;
2965 
2966 procedure T2DEllipticalArcSegment.Move(ADeltaX, ADeltaY: Double);
2967 begin
2968   inherited Move(ADeltaX, ADeltaY);
2969 
2970   E1.X := E1.X + ADeltaX;
2971   E1.X := E1.Y + ADeltaY;
2972 
2973   E2.X := E2.X + ADeltaX;
2974   E2.X := E2.Y + ADeltaY;
2975 
2976   CX := CX + ADeltaX;
2977   CY := CY + ADeltaY;
2978 end;
2979 
2980 
2981 procedure T2DEllipticalArcSegment.Rotate(AAngle: Double; ABase: T3dPoint);
2982 var
2983   p: T3DPoint;
2984 begin
2985   inherited Rotate(AAngle, ABase);
2986 
2987   p := fpvutils.Rotate3DPointInXY(E1, ABase, AAngle);
2988   E1.X := p.X;
2989   E1.Y := p.Y;
2990 
2991   p := fpvutils.Rotate3DPointInXY(E2, ABase, AAngle);
2992   E2.X := p.X;
2993   E2.Y := p.Y;
2994 
2995   p := fpvutils.Rotate3DPointInXY(Make2dPoint(CX, CY), ABase, AAngle);
2996   CX := p.X;
2997   CY := p.Y;
2998 end;
2999 
3000 // wp: no longer needed...
3001 procedure T2DEllipticalArcSegment.CalculateCenter;
3002 var
3003   XStart, YStart, lT1: Double;
3004   CX1, CY1, CX2, CY2, LeftMostX, LeftMostY, RightMostX, RightMostY: Double;
3005   RotatedCenter: T3DPoint;
3006 begin
3007   if CenterSetByUser then Exit;
3008 
3009   // Rotated Ellipse equation:
3010   // (xcosθ+ysinθ)^2 / RX^2 + (ycosθ−xsinθ)^2 / RY^2 = 1
3011   //
3012   // parametrized:
3013   // x = Cx + RX*cos(t)*cos(phi) - RY*sin(t)*sin(phi)  [1]
3014   // y = Cy + RY*sin(t)*cos(phi) + RX*cos(t)*sin(phi)  [2]
3015 
3016   if Previous = nil then
3017   begin
3018     CX := X - RX*Cos(0)*Cos(XRotation) + RY*Sin(0)*Sin(XRotation);
3019     CY := Y - RY*Sin(0)*Cos(XRotation) - RX*Cos(0)*Sin(XRotation);
3020     Exit;
3021   end;
3022 
3023   XStart := T2DSegment(Previous).X;
3024   YStart := T2DSegment(Previous).Y;
3025 
3026   //  Solve by rotating everything to align the ellipse to the axises and then rotating back again
3027   E1 := Rotate3DPointInXY(Make3DPoint(XStart,YStart), Make3DPoint(0,0),-1*XRotation);
3028   E2 := Rotate3DPointInXY(Make3DPoint(X,Y), Make3DPoint(0,0),-1*XRotation);
3029 
3030   // parametrized:
3031   // CX = E1.X - RX*cos(t1)
3032   // CY = E1.Y - RY*sin(t1)
3033   // CX = E2.X - RX*cos(t2)
3034   // CY = E2.Y - RY*sin(t2)
3035   //
3036   // E1.X - RX*cos(t1) = E2.X - RX*cos(t2)
3037   // E1.Y - RY*sin(t1) = E2.Y - RY*sin(t2)
3038   //
3039   // (- E1.X + RX*cos(t1) + E2.X)/RX = cos(t2)
3040   // arccos((- E1.X + RX*cos(t1) + E2.X)/RX) = t2
3041   //
3042   // E1.Y - RY*sin(t1) = E2.Y - RY*sin(arccos((- E1.X + RX*cos(t1) + E2.X)/RX))
3043 
3044   // SolveNumerically
3045 
3046   lT1 := SolveNumericallyAngle(@AlignedEllipseCenterEquationT1, 0.0001, 20);
3047 
3048   CX1 := E1.X - RX*cos(lt1);
3049   CY1 := E1.Y - RY*sin(lt1);
3050 
3051   // Rotate back!
3052   RotatedCenter := Rotate3DPointInXY(Make3DPoint(CX1,CY1), Make3DPoint(0,0),XRotation);
3053   CX1 := RotatedCenter.X;
3054   CY1 := RotatedCenter.Y;
3055 
3056   // The other ellipse is symmetrically positioned
3057   if (CX1 > Xstart) then
3058     CX2 := X - (CX1-Xstart)
3059   else
3060     CX2 := Xstart - (CX1-X);
3061   //
3062   if (CY1 > Y) then
3063     CY2 := Ystart - (CY1-Y)
3064   else
3065     CY2 := Y - (CY1-Ystart);
3066 
3067   // Achar qual é a da esquerda e qual a da direita
3068   if CX1 < CX2 then
3069   begin
3070     LeftMostX := CX1;
3071     LeftMostY := CY1;
3072     RightMostX := CX2;
3073     RightMostY := CY2;
3074   end
3075   else
3076   begin
3077     LeftMostX := CX2;
3078     LeftMostY := CY2;
3079     RightMostX := CX1;
3080     RightMostY := CY1;
3081   end;
3082 
3083   if LeftmostEllipse then
3084   begin
3085     CX := LeftMostX;
3086     CY := LeftMostY;
3087   end
3088   else
3089   begin
3090     CX := RightMostX;
3091     CY := RightMostY;
3092   end;
3093 end;
3094 
3095 procedure T2DEllipticalArcSegment.CalculateEllipseBoundingBox(out ALeft, ATop, ARight, ABottom: Double);
3096 var
3097   t1, t2, t3: Double;
3098   x1, x2, x3: Double;
3099   y1, y2, y3: Double;
3100 begin
3101   ALeft := 0;
3102   ATop := 0;
3103   ARight := 0;
3104   ABottom := 0;
3105   if Previous = nil then Exit;
3106 
3107   // Alligned Ellipse equation:
3108   // x^2 / RX^2 + Y^2 / RY^2 = 1
3109   //
3110   // Rotated Ellipse equation:
3111   // (xcosθ+ysinθ)^2 / RX^2 + (ycosθ−xsinθ)^2 / RY^2 = 1
3112   //
3113   // parametrized:
3114   // x = Cx + a*cos(t)*cos(phi) - b*sin(t)*sin(phi)  [1]
3115   // y = Cy + b*sin(t)*cos(phi) + a*cos(t)*sin(phi)  [2]
3116   // ...where ellipse has centre (h,k) semimajor axis a and semiminor axis b, and is rotated through angle phi.
3117   //
3118   // You can then differentiate and solve for gradient = 0:
3119   // 0 = dx/dt = -a*sin(t)*cos(phi) - b*cos(t)*sin(phi)
3120   // => tan(t) = -b*tan(phi)/a   [3]
3121   // => t = arctan(-b*tan(phi)/a) + n*Pi   [4]
3122   //
3123   // And the same for Y
3124   // 0 = dy/dt = b*cos(t)*cos(phi) - a*sin(t)*sin(phi)
3125   // a*sin(t)/cos(t) = b*cos(phi)/sin(phi)
3126   // => tan(t) = b*cotan(phi)/a
3127   // => t = arctan(b*cotan(phi)/a) + n*Pi   [5]
3128   //
3129   // calculate some values of t for n in -1, 0, 1 and see which are the smaller, bigger ones
3130   // done!
3131 
3132   CalculateCenter();
3133 
3134   if XRotation = 0 then
3135   begin
3136     ALeft := CX-RX;
3137     ARight := CX+RX;
3138     ATop := CY+RY;
3139     ABottom := CY-RY;
3140   end
3141   else
3142   begin
3143     // Search for the minimum and maximum X
3144     // There are two solutions in each 2pi range
3145     t1 := arctan(-RY*tan(XRotation)/RX);
3146     t2 := arctan(-RY*tan(XRotation)/RX) + pi; //Pi/2;    // why add pi/2 ??
3147 //    t3 := arctan(-RY*tan(XRotation)/RX) + Pi;
3148 
3149     x1 := Cx + RX*Cos(t1)*Cos(XRotation)-RY*Sin(t1)*Sin(XRotation);
3150     x2 := Cx + RX*Cos(t2)*Cos(XRotation)-RY*Sin(t2)*Sin(XRotation);
3151 //    x3 := Cx + RX*Cos(t3)*Cos(XRotation)-RY*Sin(t3)*Sin(XRotation);
3152 
3153     ALeft := Min(x1, x2);
3154   //  ALeft := Min(ALeft, x3);
3155 
3156     ARight := Max(x1, x2);
3157     //ARight := Max(ARight, x3);
3158 
3159     // Now the same for Y
3160 
3161     t1 := arctan(RY*cotan(XRotation)/RX);
3162     t2 := arctan(RY*cotan(XRotation)/RX) + pi; //Pi/2;   // why add pi/2 ??
3163 //    t3 := arctan(RY*cotan(XRotation)/RX) + 3*Pi/2;
3164 
3165     y1 := CY + RY*Sin(t1)*Cos(XRotation)+RX*Cos(t1)*Sin(XRotation);
3166     y2 := CY + RY*Sin(t2)*Cos(XRotation)+RX*Cos(t2)*Sin(XRotation);
3167 //    y3 := CY + RY*Sin(t3)*Cos(XRotation)+RX*Cos(t3)*Sin(XRotation);
3168 
3169     ATop := Max(y1, y2);
3170   //  ATop := Max(ATop, y3);
3171 
3172     ABottom := Min(y1, y2);
3173 //    ABottom := Min(ABottom, y3);
3174     {
3175     ATop := Min(y1, y2);
3176     ATop := Min(ATop, y3);
3177 
3178     ABottom := Max(y1, y2);
3179     ABottom := Max(ABottom, y3);
3180     }
3181   end;
3182 end;
3183 
GenerateDebugTreenull3184 function T2DEllipticalArcSegment.GenerateDebugTree(
3185   ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer;
3186 var
3187   lStr: string;
3188   lStrLeftmostEllipse, lStrClockwiseArcFlag: string;
3189 begin
3190   if LeftmostEllipse then lStrLeftmostEllipse := 'true'
3191   else lStrLeftmostEllipse := 'false';
3192   if ClockwiseArcFlag then lStrClockwiseArcFlag := 'true'
3193   else lStrClockwiseArcFlag := 'false';
3194   lStr := Format('[%s] X=%f Y=%f RX=%f RY=%f LeftmostEllipse=%s ClockwiseArcFlag=%s CX=%f CY=%f',
3195     [Self.ClassName, X, Y, RX, RY, lStrLeftmostEllipse, lStrClockwiseArcFlag, CX, CY]);
3196   Result := ADestRoutine(lStr, APageItem);
3197 end;
3198 
3199 procedure T2DEllipticalArcSegment.AddToPoints(ADestX, ADestY: Integer;
3200   AMulX, AMulY: Double; var Points: TPointsArray);
3201 var
3202   pts3D: T3DPointsArray;
3203   i, n: Integer;
3204 begin
3205   SetLength(pts3d, 0);
3206   PolyApproximate(pts3D);
3207   n := Length(Points);
3208   SetLength(Points, n + Length(pts3D) - 1);  // we don't need the start point --> -1
3209   for i:=0 to High(pts3D)-1 do    // i=0 is end point of prev segment -> we can skip it.
3210   begin
3211     Points[n].X := CoordToCanvasX(pts3D[i].X, ADestX, AMulX);
3212     Points[n].Y := CoordToCanvasY(pts3D[i].Y, ADestY, AMulY);
3213     inc(n);
3214   end;
3215 end;
3216 
3217 { TvVerticalFormulaStack }
3218 
CalculateHeightnull3219 function TvVerticalFormulaStack.CalculateHeight(ADest: TFPCustomCanvas): Double;
3220 var
3221   lElement: TvFormulaElement;
3222 begin
3223   Result := 0;
3224   lElement := GetFirstElement();
3225   while lElement <> nil do
3226   begin
3227     Result := Result + lElement.CalculateHeight(ADest) + SpacingBetweenElementsY;
3228     lElement := GetNextElement;
3229   end;
3230   // Remove an extra spacing, since it is added even to the last item
3231   Result := Result - SpacingBetweenElementsY;
3232   // Cache the result
3233   Height := Result;
3234 end;
3235 
CalculateWidthnull3236 function TvVerticalFormulaStack.CalculateWidth(ADest: TFPCustomCanvas): Double;
3237 var
3238   lElement: TvFormulaElement;
3239 begin
3240   Result := 0;
3241 
3242   lElement := GetFirstElement();
3243   while lElement <> nil do
3244   begin
3245     Result := Max(Result, lElement.CalculateWidth(ADest));
3246     lElement := GetNextElement;
3247   end;
3248 
3249   // Cache the result
3250   Width := Result;
3251 end;
3252 
3253 procedure TvVerticalFormulaStack.PositionSubparts(constref ARenderInfo: TvRenderInfo;
3254   ABaseX, ABaseY: Double);
3255 var
3256   lElement: TvFormulaElement;
3257   lPosX: Double = 0;
3258   lPosY: Double = 0;
3259 begin
3260   CalculateHeight(ARenderInfo.Canvas);
3261   CalculateWidth(ARenderInfo.Canvas);
3262   Left := ABaseX;
3263   Top := ABaseY;
3264 
3265   // Then calculate the position of each element
3266   lElement := GetFirstElement();
3267   while lElement <> nil do
3268   begin
3269     lElement.Left := Left;
3270     lElement.Top := Top - lPosY;
3271     lPosY := lPosY + lElement.Height + SpacingBetweenElementsY;
3272 
3273     lElement.PositionSubparts(ARenderInfo, ABaseX, ABaseY);
3274 
3275     lElement := GetNextElement();
3276   end;
3277 end;
3278 
3279 { TPathSegment }
3280 
GetLengthnull3281 function TPathSegment.GetLength: Double;
3282 begin
3283   Result := 0;
3284 end;
3285 
GetPointAndTangentForDistancenull3286 function TPathSegment.GetPointAndTangentForDistance(ADistance: Double; out AX, AY, ATangentAngle: Double): Boolean;
3287 begin
3288   Result := False;
3289   AX := 0;
3290   AY := 0;
3291   ATangentAngle := 0;
3292 end;
3293 
GetStartPointnull3294 function TPathSegment.GetStartPoint(out APoint: T3DPoint): Boolean;
3295 begin
3296   Result := False;
3297   if Previous = nil then Exit;
3298   if (Previous is T3DSegment) then
3299   begin
3300     Result := True;
3301     APoint.X := T3DSegment(Previous).X;
3302     APoint.Y := T3DSegment(Previous).Y;
3303     APoint.Z := T3DSegment(Previous).Z;
3304     Exit;
3305   end;
3306   if (Previous is T2DSegment) then
3307   begin
3308     Result := True;
3309     APoint.X := T2DSegment(Previous).X;
3310     APoint.Y := T2DSegment(Previous).Y;
3311     APoint.Z := 0;
3312     Exit;
3313   end;
3314 end;
3315 
3316 procedure TPathSegment.Move(ADeltaX, ADeltaY: Double);
3317 begin
3318 
3319 end;
3320 
3321 procedure TPathSegment.Rotate(AAngle: Double; ABase: T3DPoint);
3322 begin
3323 
3324 end;
3325 
GenerateDebugTreenull3326 function TPathSegment.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
3327   APageItem: Pointer): Pointer;
3328 var
3329   lStr, lTypeStr: string;
3330 begin
3331   lTypeStr := GetEnumName(TypeInfo(TSegmentType), integer(SegmentType));
3332   lStr := Format('[%s] Type=%s', [Self.ClassName, lTypeStr]);
3333   Result := ADestRoutine(lStr, APageItem);
3334 end;
3335 
3336 procedure TPathSegment.AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double;
3337   var Points: TPointsArray);
3338 begin
3339   // Override by descendants
3340 end;
3341 
UseTopLeftCoordinatesnull3342 function TPathSegment.UseTopLeftCoordinates: Boolean;
3343 begin
3344   Result := (FPath <> nil) and FPath.FPage.UseTopLeftCoordinates;
3345 end;
3346 
3347 
3348 { T2DSegment }
3349 
GetLengthnull3350 function T2DSegment.GetLength: Double;
3351 var
3352   lStartPoint: T3DPoint;
3353 begin
3354   Result := 0;
3355   if not GetStartPoint(lStartPoint) then Exit;
3356   Result := sqrt(sqr(X - lStartPoint.X) + sqr(Y + lStartPoint.Y));
3357 end;
3358 
GetPointAndTangentForDistancenull3359 function T2DSegment.GetPointAndTangentForDistance(ADistance: Double; out AX,
3360   AY, ATangentAngle: Double): Boolean;
3361 var
3362   lStartPoint: T3DPoint;
3363 begin
3364   Result:=inherited GetPointAndTangentForDistance(ADistance, AX, AY, ATangentAngle);
3365   if not GetStartPoint(lStartPoint) then Exit;
3366   Result := LineEquation_GetPointAndTangentForLength(lStartPoint, Make3DPoint(X, Y), ADistance, AX, AY, ATangentAngle);
3367 end;
3368 
3369 procedure T2DSegment.Move(ADeltaX, ADeltaY: Double);
3370 begin
3371   X := X + ADeltaX;
3372   Y := Y + ADeltaY;
3373 end;
3374 
3375 procedure T2DSegment.Rotate(AAngle: Double; ABase: T3DPoint);
3376 var
3377   lRes: T3DPoint;
3378 begin
3379   inherited Rotate(AAngle, ABase);
3380   lRes := fpvutils.Rotate3DPointInXY(Make3DPoint(X, Y), ABase, AAngle);
3381   X := lRes.X;
3382   Y := lRes.Y;
3383 end;
3384 
GenerateDebugTreenull3385 function T2DSegment.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
3386   APageItem: Pointer): Pointer;
3387 var
3388   lStr, lTypeStr: string;
3389 begin
3390   lTypeStr := GetEnumName(TypeInfo(TSegmentType), integer(SegmentType));
3391   lStr := Format('[%s] Type=%s X=%f Y=%f', [Self.ClassName, lTypeStr, X, Y]);
3392   Result := ADestRoutine(lStr, APageItem);
3393 end;
3394 
3395 procedure T2DSegment.AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double;
3396   var Points: TPointsArray);
3397 var
3398   n: Integer;
3399 begin
3400   n := Length(Points);
3401   SetLength(Points, n + 1);
3402   Points[n].X := CoordToCanvasX(Points[n].X, ADestX, AMulX);
3403   Points[n].Y := CoordToCanvasY(Points[n].Y, ADestY, AMulY);
3404 end;
3405 
3406 { T2DBezierSegment }
3407 
GetLengthnull3408 function T2DBezierSegment.GetLength: Double;
3409 var
3410   lStartPoint: T3DPoint;
3411 begin
3412   Result := 0;
3413   if not GetStartPoint(lStartPoint) then Exit;
3414   Result := BezierEquation_GetLength(lStartPoint, Make3DPoint(X2, Y2),
3415     Make3DPoint(X3, Y3), Make3DPoint(X, Y), 0);
3416 end;
3417 
GetPointAndTangentForDistancenull3418 function T2DBezierSegment.GetPointAndTangentForDistance(ADistance: Double; out
3419   AX, AY, ATangentAngle: Double): Boolean;
3420 var
3421   lStartPoint: T3DPoint;
3422 begin
3423   Result:=inherited GetPointAndTangentForDistance(ADistance, AX, AY,
3424     ATangentAngle);
3425   if not GetStartPoint(lStartPoint) then Exit;
3426   Result := BezierEquation_GetPointAndTangentForLength(lStartPoint, Make3DPoint(X2, Y2),
3427     Make3DPoint(X3, Y3), Make3DPoint(X, Y), ADistance, AX, AY, ATangentAngle);
3428 end;
3429 
3430 procedure T2DBezierSegment.Move(ADeltaX, ADeltaY: Double);
3431 begin
3432   inherited Move(ADeltaX, ADeltaY);
3433   X2 := X2 + ADeltaX;
3434   Y2 := Y2 + ADeltaY;
3435   X3 := X3 + ADeltaX;
3436   Y3 := Y3 + ADeltaY;
3437 end;
3438 
3439 procedure T2DBezierSegment.Rotate(AAngle: Double; ABase: T3dPoint);
3440 var
3441   p: T3DPoint;
3442 begin
3443   inherited Rotate(AAngle, ABase);
3444 
3445   p := fpvutils.Rotate3DPointInXY(Make3DPoint(X2, Y2), ABase, AAngle);
3446   X2 := p.X;
3447   Y2 := p.Y;
3448 
3449   p := fpvutils.Rotate3DPointInXY(Make3DPoint(X3, Y3), ABase, AAngle);
3450   X3 := p.X;
3451   Y3 := p.Y;
3452 end;
3453 
GenerateDebugTreenull3454 function T2DBezierSegment.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
3455   APageItem: Pointer): Pointer;
3456 var
3457   lStr: string;
3458 begin
3459   lStr := Format('[%s] X=%f Y=%f CX2=%f CY2=%f CX3=%f CY3=%f', [Self.ClassName, X, Y, X2, Y2, X3, Y3]);
3460   Result := ADestRoutine(lStr, APageItem);
3461 end;
3462 
3463 procedure T2DBezierSegment.AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double;
3464   var Points: TPointsArray);
3465 var
3466   pts: TPointsArray;
3467   coordX, coordY, coord2X, coord2Y, coord3X, coord3Y, coord4X, coord4Y: Integer;
3468   i, n: Integer;
3469   prev: TPoint;
3470 begin
3471   if not (Previous is T2DSegment) then
3472     raise Exception.Create('T2DBezierSegment must follow a T2DSegment.');
3473 
3474   coordX := CoordToCanvasX(T2DSegment(Previous).X, ADestX, AMulX);  // start pt
3475   coordY := CoordToCanvasY(T2DSegment(Previous).Y, ADestY, AMulY);
3476   coord4X := CoordToCanvasX(X, ADestX, AMulX);   // end pt
3477   coord4Y := CoordToCanvasY(Y, ADestY, AMulY);
3478   coord2X := CoordToCanvasX(X2, ADestX, AMulX);  // ctrl pt 1
3479   coord2Y := CoordToCanvasY(Y2, ADestY, AMulY);
3480   coord3X := CoordToCanvasX(X3, ADestX, AMulX);  // ctrl pt 2
3481   coord3Y := CoordToCanvasY(Y3, ADestY, AMulY);
3482 
3483   SetLength(pts, 0);
3484   AddBezierToPoints(
3485     Make3DPoint(coordX, coordY),
3486     Make3DPoint(coord2X, coord2Y),
3487     Make3DPoint(coord3X, coord3Y),
3488     Make3DPoint(coord4X, coord4Y),
3489     pts);
3490 
3491   if Length(pts) = 0 then
3492     exit;
3493 
3494   n := Length(Points);
3495   prev := Points[n-1];
3496   SetLength(Points, n + Length(pts));
3497   for i:=0 to High(pts) do
3498   begin
3499     if (pts[i].X = prev.X) and (pts[i].Y = prev.Y) then   // skip subsequent coincident points
3500       Continue;
3501     Points[n] := pts[i];
3502     prev := pts[i];
3503     inc(n);
3504   end;
3505   SetLength(Points, n);
3506 end;
3507 
3508 { T3DSegment }
3509 
3510 procedure T3DSegment.Move(ADeltaX, ADeltaY: Double);
3511 begin
3512   X := X + ADeltaX;
3513   Y := Y + ADeltaY;
3514 end;
3515 
3516 { This is preliminary... }
3517 procedure T3DSegment.AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double;
3518   var Points: TPointsArray);
3519 var
3520   n: Integer;
3521 begin
3522   n := Length(Points);
3523   SetLength(Points, n + 1);
3524   Points[n].X := CoordToCanvasX(Points[n].X, ADestX, AMulX);
3525   Points[n].Y := CoordToCanvasY(Points[n].Y, ADestY, AMulY);
3526 end;
3527 
3528 { T3DBezierSegment }
3529 
3530 procedure T3DBezierSegment.Move(ADeltaX, ADeltaY: Double);
3531 begin
3532   inherited Move(ADeltaX, ADeltaY);
3533   X2 := X2 + ADeltaX;
3534   Y2 := Y2 + ADeltaY;
3535   X3 := X3 + ADeltaX;
3536   Y3 := Y3 + ADeltaY;
3537 end;
3538 
3539 { TvEntity }
3540 
3541 constructor TvEntity.Create(APage: TvPage);
3542 begin
3543 end;
3544 
3545 procedure TvEntity.Clear;
3546 begin
3547   X := 0.0;
3548   Y := 0.0;
3549   Z := 0.0;
3550 end;
3551 
3552 procedure TvEntity.SetPage(APage: TvPage);
3553 begin
3554 
3555 end;
3556 
3557 procedure TvEntity.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
3558   out ALeft, ATop, ARight, ABottom: Double);
3559 begin
3560   ALeft := X;
3561   ATop := Y;
3562   ARight := X+1;
3563   ABottom := Y+1;
3564 end;
3565 
3566 // returns false if the element is invisible
CalculateSizeInCanvasnull3567 function TvEntity.CalculateSizeInCanvas(constref ARenderInfo: TvRenderInfo;
3568   APageHeight: Integer; AZoom: Double;
3569   out ALeft, ATop, AWidth, AHeight: Integer): Boolean;
3570 var
3571   lRenderInfo: TvRenderInfo;
3572   lMulY: Double;
3573 begin
3574   Result := True;
3575   CopyAndInitDocumentRenderInfo(lRenderInfo, ARenderInfo);
3576   ARenderInfo.Page.GetNaturalRenderPos(APageHeight, lMulY);
3577   AZoom := Abs(AZoom);
3578   lRenderInfo.DestX := 0;
3579   lRenderInfo.DestY := APageHeight;
3580   lRenderInfo.MulX := AZoom;
3581   lRenderInfo.MulY := AZoom * lMulY;
3582   Render(lRenderInfo, False);
3583   ALeft := lRenderInfo.EntityCanvasMinXY.X;
3584   ATop := lRenderInfo.EntityCanvasMinXY.Y;
3585   AWidth := lRenderInfo.EntityCanvasMaxXY.X - lRenderInfo.EntityCanvasMinXY.X;
3586   AHeight := lRenderInfo.EntityCanvasMaxXY.Y - lRenderInfo.EntityCanvasMinXY.Y;
3587   if (lRenderInfo.EntityCanvasMinXY.X = INVALID_RENDERINFO_CANVAS_XY) or
3588      (lRenderInfo.EntityCanvasMinXY.Y = INVALID_RENDERINFO_CANVAS_XY) or
3589      (lRenderInfo.EntityCanvasMaxXY.Y = INVALID_RENDERINFO_CANVAS_XY) or
3590      (lRenderInfo.EntityCanvasMaxXY.Y = INVALID_RENDERINFO_CANVAS_XY) then
3591      Result := False;
3592 end;
3593 
3594 procedure TvEntity.CalculateHeightInCanvas(constref ARenderInfo: TvRenderInfo; out AHeight: Integer);
3595 var
3596   AMulX: Double absolute ARenderInfo.MulX;
3597   AMulY: Double absolute ARenderInfo.MulY;
3598   //
3599   lRenderInfo: TvRenderInfo;
3600 begin
3601   lRenderInfo.Canvas := ARenderInfo.Canvas;
3602   lRenderInfo.DestX := 0;
3603   lRenderInfo.DestY := 0;
3604   lRenderInfo.MulX := AMulX;
3605   lRenderInfo.MulY := AMulY;
3606   Render(lRenderInfo, False);
3607   AHeight := lRenderInfo.EntityCanvasMaxXY.Y - lRenderInfo.EntityCanvasMinXY.Y;
3608 end;
3609 
3610 procedure TvEntity.ExpandBoundingBox(constref ARenderInfo: TvRenderInfo; var ALeft, ATop, ARight, ABottom: Double);
3611 var
3612   lLeft, lTop, lRight, lBottom: Double;
3613 begin
3614   CalculateBoundingBox(ARenderInfo, lLeft, lTop, lRight, lBottom);
3615   if lLeft < ALeft then ALeft := lLeft;
3616   if lTop < ATop then ATop := lTop;
3617   if lRight > ARight then ARight := lRight;
3618   if lBottom > ABottom then ABottom := lBottom;
3619 end;
3620 
3621 class procedure TvEntity.CalcEntityCanvasMinMaxXY(
3622   var ARenderInfo: TvRenderInfo; APointX, APointY: Integer);
3623 begin
3624   if ARenderInfo.EntityCanvasMinXY.X = INVALID_RENDERINFO_CANVAS_XY then
3625     ARenderInfo.EntityCanvasMinXY.X := APointX
3626   else ARenderInfo.EntityCanvasMinXY.X := Min(ARenderInfo.EntityCanvasMinXY.X, APointX);
3627   if ARenderInfo.EntityCanvasMinXY.Y = INVALID_RENDERINFO_CANVAS_XY then
3628     ARenderInfo.EntityCanvasMinXY.Y := APointY
3629   else ARenderInfo.EntityCanvasMinXY.Y := Min(ARenderInfo.EntityCanvasMinXY.Y, APointY);
3630   if ARenderInfo.EntityCanvasMaxXY.X = INVALID_RENDERINFO_CANVAS_XY then
3631     ARenderInfo.EntityCanvasMaxXY.X := APointX
3632   else ARenderInfo.EntityCanvasMaxXY.X := Max(ARenderInfo.EntityCanvasMaxXY.X, APointX);
3633   if ARenderInfo.EntityCanvasMaxXY.Y = INVALID_RENDERINFO_CANVAS_XY then
3634     ARenderInfo.EntityCanvasMaxXY.Y := APointY
3635   else ARenderInfo.EntityCanvasMaxXY.Y := Max(ARenderInfo.EntityCanvasMaxXY.Y, APointY);
3636 end;
3637 
3638 class procedure TvEntity.CalcEntityCanvasMinMaxXY_With2Points(
3639   var ARenderInfo: TvRenderInfo; AX1, AY1, AX2, AY2: Integer);
3640 begin
3641   CalcEntityCanvasMinMaxXY(ARenderInfo, AX1, AY1);
3642   CalcEntityCanvasMinMaxXY(ARenderInfo, AX2, AY2);
3643 end;
3644 
3645 procedure TvEntity.MergeRenderInfo(var AFrom, ATo: TvRenderInfo);
3646 begin
3647   CalcEntityCanvasMinMaxXY(ATo, AFrom.EntityCanvasMinXY.X, AFrom.EntityCanvasMinXY.Y);
3648   CalcEntityCanvasMinMaxXY(ATo, AFrom.EntityCanvasMaxXY.X, AFrom.EntityCanvasMaxXY.Y);
3649 end;
3650 
3651 class procedure TvEntity.InitializeRenderInfo(var ARenderInfo: TvRenderInfo; ASelf: TvEntity; ACreateObjs: Boolean);
3652 begin
3653   // Don't change these because otherwise we lose the value set by the page
3654   // See CopyAndInitDocumentRenderInfo
3655   // ARenderInfo.BackgroundColor := colBlack;
3656   // ARenderInfo.AdjustPenColorToBackground := True;
3657   // ARenderInfo.Selected := nil;
3658   // ATo.Parent := AFrom.Self;
3659 
3660   ARenderInfo.EntityCanvasMinXY := Point(INVALID_RENDERINFO_CANVAS_XY, INVALID_RENDERINFO_CANVAS_XY);
3661   ARenderInfo.EntityCanvasMaxXY := Point(INVALID_RENDERINFO_CANVAS_XY, INVALID_RENDERINFO_CANVAS_XY);
3662   ARenderInfo.ForceRenderBlock := False;
3663 
3664   ARenderInfo.SelfEntity := ASelf;
3665   if ACreateObjs then
3666     SetLength(ARenderInfo.Errors, 0);
3667     //ARenderInfo.Errors := TStringList.Create;
3668     // Avoid memory leak when RenderInfo is copied
3669 end;
3670 
3671 class procedure TvEntity.FinalizeRenderInfo(var ARenderInfo: TvRenderInfo);
3672 begin
3673   Finalize(ARenderInfo.Errors);
3674 {
3675   if ARenderInfo.Errors <> nil then
3676     ARenderInfo.Errors.Free;
3677   ARenderInfo.Errors := nil;
3678 }
3679 end;
3680 
3681 class procedure TvEntity.CopyAndInitDocumentRenderInfo(out ATo: TvRenderInfo;
3682   AFrom: TvRenderInfo; ACopyMinMax: Boolean = False; AAsChild: Boolean = True);
3683 begin
3684   InitializeRenderInfo(ATo, nil);
3685   ATo.DestX := AFrom.DestX;
3686   ATo.DestY := AFrom.DestY;
3687   ATo.MulX := AFrom.MulX;
3688   ATo.MulY := AFrom.MulY;
3689   ATo.Page := AFrom.Page;
3690   ATo.Canvas := AFrom.Canvas;
3691   ATo.Renderer := AFrom.Renderer;
3692   ATo.AdjustPenColorToBackground := AFrom.AdjustPenColorToBackground;
3693   ATo.BackgroundColor := AFrom.BackgroundColor;
3694   ATo.Selected := AFrom.Selected;
3695   if AAsChild then
3696   begin
3697     ATo.Parent := AFrom.SelfEntity;
3698   end
3699   else
3700   begin
3701     ATo.SelfEntity := AFrom.SelfEntity;
3702     ATo.Parent := AFrom.Parent;
3703   end;
3704   ATo.Errors := AFrom.Errors;
3705   if ACopyMinMax then
3706   begin
3707     ATo.EntityCanvasMinXY := AFrom.EntityCanvasMinXY;
3708     ATo.EntityCanvasMaxXY := AFrom.EntityCanvasMaxXY;
3709   end;
3710 end;
3711 
RenderInfo_GenerateParentTreenull3712 function TvEntity.RenderInfo_GenerateParentTree(constref ARenderInfo: TvRenderInfo): string;
3713 var
3714   lCurEntity: TvEntity;
3715 begin
3716   lCurEntity := Self;
3717   Result := '';
3718   while lCurEntity <> nil do
3719   begin
3720     if Result <> '' then
3721       Result := '->' + Result;
3722     Result := lCurEntity.ClassName + Result;
3723     if lCurEntity is TvNamedEntity then
3724       Result := TvNamedEntity(lCurEntity).Name + ':' + Result;
3725     lCurEntity := ARenderInfo.Parent;
3726   end;
3727 end;
3728 
CentralizeY_InHeightnull3729 function TvEntity.CentralizeY_InHeight(constref ARenderInfo: TvRenderInfo; AHeight: Double): Double;
3730 var
3731   lHeight: Double;
3732 begin
3733   lHeight := GetHeight(ARenderInfo);
3734   Result := Y + Abs(AHeight - lHeight) / 2;
3735 end;
3736 
GetHeightnull3737 function TvEntity.GetHeight(constref ARenderInfo: TvRenderInfo): Double;
3738 var
3739   ALeft, ATop, ARight, ABottom: Double;
3740 begin
3741   CalculateBoundingBox(ARenderInfo, ALeft, ATop, ARight, ABottom);
3742   Result := Abs(ATop - ABottom);
3743 end;
3744 
GetWidthnull3745 function TvEntity.GetWidth(constref ARenderInfo: TvRenderInfo): Double;
3746 var
3747   ALeft, ATop, ARight, ABottom: Double;
3748 begin
3749   CalculateBoundingBox(ARenderInfo, ALeft, ATop, ARight, ABottom);
3750   Result := Abs(ALeft - ARight);
3751 end;
3752 
TvEntity.GetLineIntersectionPointsnull3753 function TvEntity.GetLineIntersectionPoints(ACoord: Double;
3754   ACoordIsX: Boolean): TDoubleDynArray;
3755 begin
3756   SetLength(Result, 0);
3757 end;
3758 
TryToSelectnull3759 function TvEntity.TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult;
3760 begin
3761   Result := vfrNotFound;
3762 end;
3763 
3764 procedure TvEntity.Move(ADeltaX, ADeltaY: Double);
3765 begin
3766   X := X + ADeltaX;
3767   Y := Y + ADeltaY;
3768 end;
3769 
3770 procedure TvEntity.MoveSubpart(ADeltaX, ADeltaY: Double; ASubpart: Cardinal);
3771 begin
3772 
3773 end;
3774 
TvEntity.GetSubpartCountnull3775 function TvEntity.GetSubpartCount: Integer;
3776 begin
3777   Result := 0;
3778 end;
3779 
3780 procedure TvEntity.PositionSubparts(constref ARenderInfo: TvRenderInfo; ABaseX, ABaseY: Double);
3781 begin
3782 
3783 end;
3784 
3785 procedure TvEntity.Scale(ADeltaScaleX, ADeltaScaleY: Double);
3786 begin
3787 
3788 end;
3789 
3790 procedure TvEntity.Rotate(AAngle: Double; ABase: T3DPoint);
3791 begin
3792 
3793 end;
3794 
3795 procedure TvEntity.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
3796 begin
3797   InitializeRenderInfo(ARenderInfo, Self);
3798 end;
3799 
AdjustColorToBackgroundnull3800 function TvEntity.AdjustColorToBackground(AColor: TFPColor; ARenderInfo: TvRenderInfo): TFPColor;
3801 begin
3802   Result := AColor;
3803   if not ARenderInfo.AdjustPenColorToBackground then Exit;
3804   // Adjust only if the contranst is really low
3805   if (Abs(AColor.Red - ARenderInfo.BackgroundColor.Red) <= $100) and
3806      (Abs(AColor.Green - ARenderInfo.BackgroundColor.Green) <= $100) and
3807      (Abs(AColor.Blue - ARenderInfo.BackgroundColor.Blue) <= $100) then
3808   begin
3809     if (ARenderInfo.BackgroundColor.Red <= $1000) and
3810        (ARenderInfo.BackgroundColor.Green <= $1000) and
3811        (ARenderInfo.BackgroundColor.Blue <= $1000) then
3812       Result := colWhite
3813     else Result := colBlack;
3814   end;
3815 end;
3816 
TvEntity.GetNormalizedPosnull3817 function TvEntity.GetNormalizedPos(APage: TvVectorialPage; ANewMin,
3818   ANewMax: Double): T3DPoint;
3819 begin
3820   Result.X := (X - APage.MinX) * (ANewMax - ANewMin) / (APage.MaxX - APage.MinX) + ANewMin;
3821   Result.Y := (Y - APage.MinY) * (ANewMax - ANewMin) / (APage.MaxY - APage.MinY) + ANewMin;
3822   Result.Z := (Z - APage.MinZ) * (ANewMax - ANewMin) / (APage.MaxZ - APage.MinZ) + ANewMin;
3823 end;
3824 
TvEntity.GetEntityFeaturesnull3825 function TvEntity.GetEntityFeatures(constref ARenderInfo: TvRenderInfo): TvEntityFeatures;
3826 begin
3827   Result.DrawsUpwards := False;
3828   Result.DrawsUpwardHeightAdjustment := 0;
3829   Result.FirstLineHeight := 0;
3830   Result.TotalHeight := 0;
3831 end;
3832 
GenerateDebugTreenull3833 function TvEntity.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
3834   APageItem: Pointer): Pointer;
3835 var
3836   lStr: string;
3837 begin
3838   lStr := Format('[%s] X=%f Y=%f', [Self.ClassName, X, Y]);
3839   Result := ADestRoutine(lStr, APageItem);
3840 end;
3841 
TvEntity.GenerateDebugStrForFPColornull3842 class function TvEntity.GenerateDebugStrForFPColor(AColor: TFPColor): string;
3843 begin
3844   Result := IntToHex(AColor.Red div $100, 2) + IntToHex(AColor.Green div $100, 2) + IntToHex(AColor.Blue div $100, 2) + IntToHex(AColor.Alpha div $100, 2);
3845 end;
3846 
3847 // modified c-style string quoting
TvEntity.GenerateDebugStrForStringnull3848 class function TvEntity.GenerateDebugStrForString(AValue: string): string;
3849 begin
3850   Result := AValue;
3851   Result := StringReplace(Result, '\', '\\', [rfReplaceAll]);
3852   Result := StringReplace(Result, #$7, '\a', [rfReplaceAll]);
3853   Result := StringReplace(Result, #$8, '\b', [rfReplaceAll]);
3854   Result := StringReplace(Result, #$C, '\f', [rfReplaceAll]);
3855   Result := StringReplace(Result, #$A, '\n', [rfReplaceAll]);
3856   Result := StringReplace(Result, #$D, '\r', [rfReplaceAll]);
3857   Result := StringReplace(Result, #$9, '\t', [rfReplaceAll]);
3858   Result := StringReplace(Result, #$B, '\v', [rfReplaceAll]);
3859 end;
3860 
3861 { TvNamedEntity }
3862 
3863 constructor TvNamedEntity.Create(APage: TvPage);
3864 begin
3865   inherited Create(APage);
3866   FPage := APage;
3867 end;
3868 
3869 procedure TvNamedEntity.SetPage(APage: TvPage);
3870 begin
3871   FPage := APage;
3872 end;
3873 
TvNamedEntity.GenerateDebugTreenull3874 function TvNamedEntity.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
3875   APageItem: Pointer): Pointer;
3876 var
3877   lStr: string;
3878 begin
3879   lStr := Format('[%s] Name="%s" X=%f Y=%f' + FExtraDebugStr, [Self.ClassName, Name, X, Y]);
3880   Result := ADestRoutine(lStr, APageItem);
3881 end;
3882 
3883 { TvEntityWithPen }
3884 
3885 constructor TvEntityWithPen.Create(APage: TvPage);
3886 begin
3887   inherited Create(APage);
3888   Pen.Style := psSolid;
3889   Pen.Color := colBlack;
3890   Pen.Width := 1;
3891 end;
3892 
3893 procedure TvEntityWithPen.ApplyPenToCanvas(constref ARenderInfo: TvRenderInfo);
3894 begin
3895   ApplyPenToCanvas(ARenderInfo, Pen);
3896 end;
3897 
3898 procedure TvEntityWithPen.ApplyPenToCanvas(constref ARenderInfo: TvRenderInfo; APen: TvPen);
3899 var
3900   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
3901 begin
3902   if ADest = nil then
3903     exit;
3904   ADest.Pen.FPColor := AdjustColorToBackground(APen.Color, ARenderInfo);
3905   ADest.Pen.Width := Max(1, APen.Width);   // wp: why was here "1;//APen.Width;" ???
3906   ADest.Pen.Style := APen.Style;
3907   {$ifdef USE_LCL_CANVAS}
3908   if (APen.Style = psPattern) then
3909   begin
3910     TCanvas(ADest).Pen.SetPattern(APen.Pattern);
3911     if APen.Width = 1 then TCanvas(ADest).Pen.Cosmetic := false;
3912   end;
3913   {$endif}
3914 end;
3915 
3916 procedure TvEntityWithPen.AssignPen(APen: TvPen);
3917 begin
3918   Pen.Style := APen.Style;
3919   Pen.Color := APen.Color;
3920   Pen.Width := APen.Width;
3921 end;
3922 
TvEntityWithPen.CreatePathnull3923 function TvEntityWithPen.CreatePath: TPath;
3924 begin
3925   Result := nil;
3926 end;
3927 
3928 procedure TvEntityWithPen.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
3929 begin
3930   inherited Render(ARenderInfo, ADoDraw);
3931   ApplyPenToCanvas(ARenderInfo);
3932 end;
3933 
3934 { TvEntityWithPenAndBrush }
3935 
3936 constructor TvEntityWithPenAndBrush.Create(APage: TvPage);
3937 begin
3938   inherited Create(APage);
3939   Brush.Style := bsClear;
3940   Brush.Color := colBlue;
3941 end;
3942 
3943 procedure TvEntityWithPenAndBrush.ApplyBrushToCanvas(constref ARenderInfo: TvRenderInfo);
3944 begin
3945   ApplyBrushToCanvas(ARenderInfo, @Brush);
3946 end;
3947 
3948 procedure TvEntityWithPenAndBrush.ApplyBrushToCanvas(constref ARenderInfo: TvRenderInfo;
3949   ABrush: PvBrush);
3950 begin
3951   if ARenderInfo.Canvas = nil then
3952     exit;
3953   ARenderInfo.Canvas.Brush.FPColor := ABrush^.Color;
3954   ARenderInfo.Canvas.Brush.Style := ABrush^.Style;
3955 end;
3956 
3957 procedure TvEntityWithPenAndBrush.AssignBrush(ABrush: PvBrush);
3958 begin
3959   Brush := ABrush^;
3960 end;
3961 
3962 { Calculates the canvas coordinates of the gradient vector (i.e. x,y of start
3963   and end of gradient.
3964   ARect is the bounding box of the shape in which the gradient will be painted.
3965   It must be in canvas coordinates (pixels).
3966   Note that the gradient vector need not be along the edges of this rectangle. }
3967 procedure TvEntityWithPenAndBrush.CalcGradientVector(
3968   out AGradientStart, AGradientEnd: T2dPoint; const ARect: TRect;
3969   ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
3970 begin
3971   AGradientStart := Point2D(Brush.Gradient_start.X, Brush.Gradient_start.Y);
3972   AGradientEnd := Point2D(Brush.Gradient_end.X, Brush.Gradient_end.Y);
3973   if (gfRelToUserSpace in Brush.Gradient_flags) then
3974   begin
3975     if (gfRelStartX in Brush.Gradient_flags) then
3976       AGradientStart.X := AGradientStart.X * FPage.Width;
3977     if (gfRelStartY in Brush.Gradient_flags) then
3978       AGradientStart.Y := AGradientStart.Y * FPage.Height;
3979     if (gfRelEndX in Brush.Gradient_flags) then
3980       AGradientEnd.X := AGradientEnd.X * FPage.Width;
3981     if (gfRelEndY in Brush.Gradient_flags) then
3982       AGradientEnd.Y := AGradientEnd.Y * FPage.Height;
3983     AGradientStart.X := CoordToCanvasX(AGradientStart.X, ADestX, AMulX);
3984     AGradientStart.Y := CoordToCanvasY(AGradientStart.Y, ADestY, AMulY);
3985     AGradientEnd.X := CoordToCanvasX(AGradientEnd.X, ADestX, AMulX);
3986     AGradientEnd.Y := CoordToCanvasY(AGradientEnd.Y, ADestY, AMulY);
3987   end else
3988   begin
3989     if (gfRelStartX in Brush.Gradient_flags) then
3990       AGradientStart.X := ARect.Left + AGradientStart.X * (ARect.Right - ARect.Left)
3991     else
3992       AGradientStart.X := CoordToCanvasX(AGradientStart.X, ADestX, AMulX);
3993     if (gfRelStartY in Brush.Gradient_flags) then
3994       AGradientStart.Y := ARect.Top + AGradientStart.Y * (ARect.Bottom - ARect.Left)
3995     else
3996       AGradientStart.Y := CoordToCanvasY(AGradientStart.Y, ADestY, AMulY);
3997     if (gfRelEndX in Brush.Gradient_flags) then
3998       AGradientEnd.X := ARect.Left + AGradientEnd.X * (ARect.Right - ARect.Left) else
3999       AGradientEnd.X := CoordToCanvasX(AGradientEnd.X, ADestX, AMulX);
4000     if (gfRelEndY in Brush.Gradient_flags) then
4001       AGradientEnd.Y := ARect.Top + AGradientEnd.Y * (ARect.Bottom - ARect.Top) else
4002       AGradientEnd.Y := CoordToCanvasY(AGradientEnd.Y, ADestY, AMulY);
4003   end;
4004 end;
4005 
4006 { Fills a polygon with the color of the current brush. The routine can handle
4007   non-contiguous polygons (holes!) correctly using the ScanLine algorithm and
4008   the even-odd rule
4009   http://www.tutorialspoint.com/computer_graphics/polygon_filling_algorithm.htm
4010 
4011   The array APoints must be in canvas units.
4012 
4013   NOTES:
4014   - The method only performs a solid fill, i.e. Brush.Style is ignored
4015   - The method modifies the current pen. }
4016 procedure TvEntityWithPenAndBrush.DrawPolygon(var ARenderInfo: TvRenderInfo; const APoints: TPointsArray;
4017   const APolyStarts: TIntegerDynArray; ARect: TRect);
4018 var
4019   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
4020   //
4021   scanlineY, scanLineY1, scanLineY2: Integer;
4022   lPoints, pts: T2DPointsArray;
4023   j: Integer;
4024 begin
4025   if ARect.Top < ARect.Bottom then
4026   begin
4027     scanLineY1 := ARect.Top;
4028     scanLineY2 := ARect.Bottom;
4029   end else
4030   begin
4031     scanLineY1 := ARect.Bottom;
4032     scanLineY2 := ARect.Top;
4033   end;
4034 
4035   // Prepare points as needed by the GetLinePolygonIntersectionPoints procedure
4036   SetLength(pts, Length(APoints));
4037   for j := 0 to High(APoints) do
4038     pts[j] := Point2D(APoints[j].X, APoints[j].Y);
4039 
4040   // Prepare parameters and polygon points
4041   ADest.Pen.Style := psSolid;
4042   ADest.Pen.Width := 1;
4043   ADest.Pen.FPColor := Brush.Color;
4044 
4045   // Fill polygon by drawing horizontal line segments
4046   scanlineY := scanlineY1;
4047   while (scanlineY <= scanlineY2) do begin
4048     // Find intersection points of horizontal scan line with polygon
4049     // with polygon
4050     lPoints := GetLinePolygonIntersectionPoints(scanlineY, pts, APolyStarts, false);
4051     if Length(lPoints) < 2 then begin
4052       inc(scanlineY);
4053       Continue;
4054     end;
4055     // Draw lines between intersection points, skip every second pair
4056     j := 0;
4057     while j < High(lPoints) do
4058     begin
4059       ADest.Line(round(lPoints[j].X), round(lPoints[j].Y), round(lPoints[j+1].X), round(lPoints[j+1].Y));
4060       inc(j, 2);
4061     end;
4062     // Proceed to next scan line
4063     inc(scanlineY);
4064   end;
4065 end;
4066 
4067 { Paints the border around the shape. Ignores the brush.
4068   APoints must be in canvas units. }
4069 procedure TvEntityWithPenAndBrush.DrawPolygonBorderOnly(
4070   var ARenderInfo: TvRenderInfo; const APoints: TPointsArray);
4071 var
4072   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
4073   //
4074   j: Integer;
4075 begin
4076   if Pen.Style <> psClear then
4077   begin
4078     ApplyPenToCanvas(ARenderInfo);
4079     ADest.MoveTo(APoints[0].X, APoints[0].Y);
4080     for j:=1 to High(APoints) do
4081       ADest.LineTo(APoints[j].X, APoints[j].Y);
4082   end;
4083 end;
4084 
4085 { Fills the entity with a linear gradient.
4086   Assumes that the boundary is already in canvas units and is specified by
4087   polygon APoints.
4088   NOTE: The method modifies the current pen. }
4089 procedure TvEntityWithPenAndBrush.DrawPolygonBrushLinearGradient(
4090   var ARenderInfo: TvRenderInfo;
4091   const APoints: TPointsArray; const APolyStarts: TIntegerDynArray;
4092   ARect: TRect; AGradientStart, AGradientEnd: T2DPoint);
4093 var
4094   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
4095   //
4096   lPoints, pts: T2DPointsArray;
4097   i, j: Integer;
4098   pf: Double;          // fraction of path travelled along gradient vector
4099   px, py: Double;
4100   phi: Double;
4101   sinphi, cosphi: float;
4102   coord, coord1, coord2, dcoord: Double;
4103   coordIsX: Boolean;
4104   p1, p2: T2dPoint;
4105   gv: T2dPoint;        // gradient vector
4106   gvlen: Double;       // length of gradient vector
4107   gstart: Double;      // Gradient start point (1-dim)
4108   dir: Integer;
4109   lStr: String;
4110 begin
4111   // Direction of gradient vector. The gradient vector begins at the first
4112   // color position and ends at the last color position specified in the
4113   // brush's Gradient_colors.
4114   gv := Point2D(AGradientEnd.X-AGradientStart.X, AGradientEnd.Y-AGradientStart.Y);
4115   gvlen := sqrt(sqr(gv.x) + sqr(gv.y));
4116   if gvlen = 0 then
4117     exit;
4118 
4119   // Find boundary points where the gradient starts and ends. The gradient is
4120   // always travered from 0% to 100% color fractions.
4121   p1 := Point2D(
4122     IfThen(AGradientEnd.x > AGradientStart.x, ARect.Left, ARect.Right),
4123     IfThen(AGradientEnd.Y > AGradientStart.y, ARect.Top, ARect.Bottom)
4124   );
4125   p2 := Point2D(
4126     IfThen(AGradientEnd.x > AGradientStart.x, ARect.Right, ARect.Left),
4127     IfThen(AGradientEnd.Y > AGradientStart.y, ARect.Bottom, ARect.Top)
4128   );
4129 
4130   // Prepare parameters and polygon points
4131   ADest.Pen.Style := psSolid;
4132   ADest.Pen.Width := 1;
4133 
4134   SetLength(pts, Length(APoints));
4135   case Brush.Kind of
4136     bkVerticalGradient:
4137       begin // Run vertically, horizontal lines have same color
4138         coord1 := p1.y;
4139         coord2 := p2.y;
4140         dcoord := IfThen(AGradientEnd.Y > AGradientStart.Y, 1.0, -1.0);
4141         gstart := coord1;
4142         dir := round(dcoord);
4143         for i := 0 to High(APoints) do
4144           pts[i] := Point2D(APoints[i].X, APoints[i].Y);
4145         coordIsX := false;
4146         gstart := coord1;
4147       end;
4148     bkHorizontalGradient:
4149       begin  // Run horizontally, vertical lines have same color
4150         coord1 := p1.x;
4151         coord2 := p2.x;
4152         dcoord := IfThen(AGradientEnd.X > AGradientStart.X, 1.0, -1.0);
4153         gstart := coord1;
4154         dir := round(dcoord);
4155         for i := 0 to High(APoints) do
4156           pts[i] := Point2D(APoints[i].X, APoints[i].Y);
4157         coordIsX := true;
4158       end;
4159     bkOtherLinearGradient:
4160       begin  // Run along gradient vector, lines perpendicular to gradient vector
4161         phi := arctan2(gv.y, gv.x);
4162         Sincos(phi, sinphi, cosphi);
4163         coordIsX := (abs(sinphi) <= sin(pi/4));
4164         if not coordIsX then begin
4165           phi := -(pi/2 - phi);
4166           Sincos(phi, sinphi, cosphi);
4167         end;
4168         // p1 is the boundary point around which the shape is rotated in order to
4169         // to get the gradient vector in horizontal or vertical direction for
4170         // easier finding of intersection points.
4171         // Projection of vector from GradientStart to p1 onto gradient vector
4172         coord1 := (((p1.x - AGradientStart.X)*gv.x) + (p1.y - AGradientStart.Y)*gv.y) / gvlen;
4173         // dto for p2.
4174         coord2 := (((p2.x - AGradientStart.X)*gv.x) + (p2.y - AGradientStart.Y)*gv.Y) / gvlen;
4175         // Steps for walking along the gradient vector. Note: too-wide steps
4176         // could result in painting gaps, but this is avoided by using a
4177         // 2-pixel wide pen below.
4178         dcoord := 1.0; // --- some gaps with 1.0 / abs(cosphi);
4179         gstart := -coord1;
4180         dir := +1;
4181         // Rotate polygon point such that gradient axis is parallel to x axis
4182         // (if angle < 45°) or y axis (if angle > 45°)
4183         // Rotation center is the projection of the corner of the bounding box
4184         // onto the gradient vector
4185         p1 := Point2D(
4186           AGradientStart.X + coord1 * gv.x / gvlen,
4187           AGradientStart.Y + coord1 * gv.y / gvlen
4188         );
4189         for j := 0 to High(APoints) do
4190         begin
4191           px := APoints[j].X - p1.x;
4192           py := APoints[j].Y - p1.y;
4193           pts[j] := Point2D(px*cosPhi + py*sinPhi, -px*sinPhi + py*cosPhi);
4194         end;
4195         // Begin painting at corner
4196         coord2 := coord2 - coord1;
4197         coord1 := 0;
4198         ADest.Pen.Width := 2;  // make sure that there are no gaps due to rounding errors
4199       end;
4200   end;
4201 
4202   // Draw gradient
4203   coord := coord1;
4204   while ((dcoord > 0) and (coord <= coord2)) or (dcoord < 0) and (coord >= coord2) do
4205   begin
4206     // Find intersection points of gradient line (normal to gradient vector)
4207     // with polygon
4208     lPoints := GetLinePolygonIntersectionPoints(coord, pts, APolyStarts, coordIsX);
4209     if Length(lPoints) < 2 then begin
4210       coord := coord + dcoord;
4211       Continue;
4212     end;
4213 
4214     // Prepare intersection points for painting
4215     case Brush.Kind of
4216       bkVerticalGradient:
4217         // Add loop variable as mssing y coordinate of intersection points
4218         for j := 0 to High(lPoints) do lPoints[j].Y := coord;
4219       bkHorizontalGradient:
4220         // Add loop variable as mssing x coordinate of intersection points
4221         for j := 0 to High(lPoints) do lPoints[j].X := coord;
4222       bkOtherLinearGradient:
4223         // Rotate back
4224         for j := 0 to High(lPoints) do
4225           lPoints[j] := Point2D(
4226             lPoints[j].X * cosPhi - lPoints[j].Y * sinPhi + p1.x,
4227             lPoints[j].X * sinPhi + lPoints[j].Y * cosPhi + p1.y
4228           );
4229     end;
4230 
4231     // Determine color from fraction (pf) of path travelled along gradient vector
4232     pf := (coord - gstart) * dir / gvlen;
4233     if Length(Brush.Gradient_colors) > 0 then
4234     begin
4235       ADest.Pen.FPColor := GradientColor(Brush.Gradient_colors, pf);
4236     end
4237     else
4238     begin
4239       lStr := RenderInfo_GenerateParentTree(ARenderInfo);
4240       if ARenderInfo.Errors <> nil then
4241         AddStringToArray(ARenderInfo.Errors, Format('[%s] Empty Brush.Gradient_colors', [lStr]));
4242         //was: ARenderInfo.Errors.Add(Format('[%s] Empty Brush.Gradient_colors', [lStr]));
4243       ADest.Pen.FPColor := colBlack;
4244     end;
4245 
4246     // Draw gradient lines between intersection points
4247     j := 0;
4248     while j < High(lPoints) do
4249     begin
4250       ADest.Line(round(lPoints[j].X), round(lPoints[j].Y), round(lPoints[j+1].X), round(lPoints[j+1].Y));
4251       inc(j, 2);
4252     end;
4253 
4254     // Proceed to next line
4255     coord := coord + dcoord;
4256   end;
4257 end;
4258 
4259 procedure TvEntityWithPenAndBrush.DrawPolygonBrushRadialGradient(
4260   var ARenderInfo: TvRenderInfo;
4261   const APoints: TPointsArray; ARect: TRect);
4262 var
4263   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
4264   //
4265   i, j: Integer;
4266   lx, ly: Integer;
4267   lDist: Double;
4268   lGradient_cx_px, lGradient_cy_px, lGradient_r_px, lGradient_fx_px, lGradient_fy_px: Double;
4269   lWidth, lHeight, lBiggestHalfSide: Integer;
4270   lBiggestSizeIsY: Boolean;
4271   lColor: TFPColor;
4272 
4273   function Gradient_value_to_px(AValue: Double; AUnit: TvCoordinateUnit; AIsY: Boolean): Integer;
4274   var
4275     lSideLen: Integer;
4276   begin
4277     Result := 0;
4278     if AIsY then lSideLen := (ARect.Bottom-ARect.Top)
4279     else lSideLen := (ARect.Right-ARect.Left);
4280     case AUnit of
4281     //vcuDocumentUnit: Result := ;
4282     vcuPercentage:   Result := Round(lSideLen * AValue);
4283     end;
4284   end;
4285 
4286   function Distance_To_RadialGradient_Color(ADist: Double): TFPColor;
4287   var
4288     k: Integer;
4289   begin
4290     Result := colTransparent;
4291     for k := 0 to Length(Brush.Gradient_colors)-1 do
4292     begin
4293       if k = 0 then
4294       begin
4295         Result := Brush.Gradient_colors[k].Color;
4296         Continue;
4297       end;
4298 
4299       if ADist < Brush.Gradient_colors[k].Position then
4300       begin
4301         Result := MixColors(
4302           Brush.Gradient_colors[k-1].Color, Brush.Gradient_colors[k].Color,
4303           ADist - Brush.Gradient_colors[k-1].Position,
4304           Brush.Gradient_colors[k].Position - Brush.Gradient_colors[k-1].Position);
4305         Exit;
4306       end;
4307     end;
4308   end;
4309 
4310 begin
4311   lWidth := (ARect.Right-ARect.Left);
4312   lHeight := (ARect.Bottom-ARect.Top);
4313   lBiggestSizeIsY := lHeight > lWidth;
4314   if lBiggestSizeIsY then lBiggestHalfSide := Round(lHeight / 2)
4315   else lBiggestHalfSide := Round(lWidth / 2);
4316 
4317   // Calculate Gradient_X_px
4318   lGradient_cx_px := Gradient_value_to_px(Brush.Gradient_cx, Brush.Gradient_cx_Unit, False);
4319   lGradient_cy_px := Gradient_value_to_px(Brush.Gradient_cy, Brush.Gradient_cy_Unit, True);
4320   lGradient_r_px := Gradient_value_to_px(Brush.Gradient_r, Brush.Gradient_r_Unit, lBiggestSizeIsY);
4321   lGradient_fx_px := Gradient_value_to_px(Brush.Gradient_fx, Brush.Gradient_fx_Unit, False);
4322   lGradient_fy_px := Gradient_value_to_px(Brush.Gradient_fy, Brush.Gradient_fy_Unit, True);
4323 
4324   // pixel-by-pixel version
4325   for i := 0 to lWidth-1 do
4326   begin
4327     for J := 0 to lHeight-1 do
4328     begin
4329       lx := ARect.Left + i;
4330       ly := ARect.Top + j;
4331       if not IsPointInPolygon(lx, ly, APoints) then Continue;
4332 
4333       lDist := sqrt(sqr(i-lGradient_cx_px)+sqr(j-lGradient_cy_px));
4334       lDist := lDist / lBiggestHalfSide;
4335       lDist := Min(Max(0, lDist), 1);
4336       lColor := Distance_To_RadialGradient_Color(lDist);
4337       ADest.Colors[lx, ly] := AlphaBlendColor(ADest.Colors[lx, ly], lColor);
4338     end;
4339   end;
4340 end;
4341 
4342 procedure TvEntityWithPenAndBrush.DrawNativePolygonBrushRadialGradient(
4343   var ARenderInfo: TvRenderInfo; const APoints: TPointsArray; ARect: TRect);
4344 {$ifndef FPVECTORIAL_SUPPORT_LAZARUS_1_6}
4345 {$ifdef USE_LCL_CANVAS}
4346 var
4347   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
4348   //
4349   lLogRadGrad: TLogRadialGradient;
4350   lBrush, lOldBrush: HBRUSH;
4351   i: Integer;
4352 
4353   function Gradient_value_to_px(AValue: Double; AUnit: TvCoordinateUnit; AIsY: Boolean): Integer;
4354   var
4355     lSideLen: Integer;
4356   begin
4357     Result := 0;
4358     if AIsY then lSideLen := (ARect.Bottom-ARect.Top)
4359     else lSideLen := (ARect.Right-ARect.Left);
4360     case AUnit of
4361     vcuDocumentUnit: Result := Round(AValue);
4362     vcuPercentage:   Result := Round(lSideLen * AValue);
4363     end;
4364   end;
4365 
4366 {$endif}
4367 {$endif}
4368 begin
4369   {$ifndef FPVECTORIAL_SUPPORT_LAZARUS_1_6}
4370   {$ifdef USE_LCL_CANVAS}
4371   lLogRadGrad.radCenterX := Gradient_value_to_px(Brush.Gradient_cx, Brush.Gradient_cx_Unit, False);
4372   lLogRadGrad.radCenterY := Gradient_value_to_px(Brush.Gradient_cy, Brush.Gradient_cy_Unit, False);
4373   lLogRadGrad.radRadius := Gradient_value_to_px(Brush.Gradient_r, Brush.Gradient_r_Unit, True);
4374   lLogRadGrad.radFocalX := Gradient_value_to_px(Brush.Gradient_fx, Brush.Gradient_fx_Unit, True);
4375   lLogRadGrad.radFocalY := Gradient_value_to_px(Brush.Gradient_fy, Brush.Gradient_fy_Unit, False);
4376 
4377   SetLength(lLogRadGrad.radStops, Length(Brush.Gradient_colors));
4378   for i := 0 to Length(Brush.Gradient_colors)-1 do
4379   begin
4380     lLogRadGrad.radStops[i].radColorA := Brush.Gradient_colors[i].Color.alpha;
4381     lLogRadGrad.radStops[i].radColorR := Brush.Gradient_colors[i].Color.red;
4382     lLogRadGrad.radStops[i].radColorG := Brush.Gradient_colors[i].Color.green;
4383     lLogRadGrad.radStops[i].radColorB := Brush.Gradient_colors[i].Color.blue;
4384     lLogRadGrad.radStops[i].radPosition := Brush.Gradient_colors[i].Position;
4385   end;
4386 
4387   lBrush := LCLIntf.CreateBrushWithRadialGradient(lLogRadGrad);
4388   lOldBrush := TCanvas(ADest).Brush.Handle;
4389   TCanvas(ADest).Brush.Handle := lBrush;
4390   TCanvas(ADest).Polygon(APoints);
4391   TCanvas(ADest).Brush.Handle := lOldBrush;
4392   {$endif}
4393   {$endif}
4394 end;
4395 
4396 procedure TvEntityWithPenAndBrush.DrawBrushGradient(
4397   var ARenderInfo: TvRenderInfo; x1, y1, x2, y2: Integer);
4398 var
4399   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
4400   ADestX: Integer absolute ARenderInfo.DestX;
4401   ADestY: Integer absolute ARenderInfo.DestY;
4402   AMulX: Double absolute ARenderInfo.MulX;
4403   AMulY: Double absolute ARenderInfo.MulY;
4404   //
4405   tmpPath: TPath;
4406   polypoints: TPointsArray;
4407   polystarts: TIntegerDynArray;
4408   lRect: TRect;
4409   gv1, gv2: T2dPoint;
4410   j: Integer;
4411 begin
4412   tmpPath := CreatePath;
4413   if tmpPath = nil then
4414     exit;
4415   try
4416     ConvertPathToPolygons(tmpPath, ADestX, ADestY, AMulX, AMulY, polypoints, polystarts);
4417 
4418     // Boundary rect of shape filled with a gradient
4419     lRect := Rect(x1, y1, x2, y2);
4420     NormalizeRect(lRect);
4421 
4422     case Brush.Kind of
4423       bkHorizontalGradient,
4424       bkVerticalGradient,
4425       bkOtherLinearGradient:
4426         begin
4427           // calculate gradient vector
4428           CalcGradientVector(gv1, gv2, lRect, ADestX, ADestY, AMulX, AMulY);
4429           // Draw the gradient
4430           DrawPolygonBrushLinearGradient(ARenderInfo, polyPoints, polystarts, lRect, gv1, gv2);
4431         end;
4432       bkRadialGradient:
4433        {$ifdef USE_LCL_CANVAS}
4434         if Widgetset.GetLCLCapability(lcRadialGradientBrush) = LCL_CAPABILITY_YES then
4435           DrawNativePolygonBrushRadialGradient(ARenderInfo, polypoints, Bounds(0, 0, 1, 1))
4436         else
4437        {$endif}
4438           DrawPolygonBrushRadialGradient(ARenderInfo, polypoints, lRect);
4439     end;
4440 
4441     // Paint outline
4442     DrawPolygonBorderOnly(ARenderInfo, polyPoints);
4443 
4444   finally
4445     tmpPath.Free;
4446   end;
4447 end;
4448 (*
4449 { Fills the entity's shape with a gradient.
4450   Assumes that the boundary is in fpv units and provides parameters (ADestX,
4451   ADestY, AMulX, AMulY) for conversion to canvas pixels. }
4452 procedure TvEntityWithPenAndBrush.DrawBrushGradient(ADest: TFPCustomCanvas;
4453   var ARenderInfo: TvRenderInfo; x1, y1, x2, y2: Integer;
4454   ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double);
4455 
CoordToCanvasXnull4456   function CoordToCanvasX(ACoord: Double): Integer;
4457   begin
4458     Result := Round(ADestX + AmulX * ACoord);
4459   end;
4460 
4461   function CoordToCanvasY(ACoord: Double): Integer;
4462   begin
4463     Result := Round(ADestY + AmulY * ACoord);
4464   end;
4465 
4466   function CanvasToCoordY(ACanvas: Integer): Double;
4467   begin
4468     Result := (ACanvas - ADestY) / AmulY;
4469   end;
4470 
4471   function CanvasToCoordX(ACanvas: Integer): Double;
4472   begin
4473     Result := (ACanvas - ADestX) / AmulX;
4474   end;
4475 
4476 var
4477   i, j: Integer;
4478   lPoints: TDoubleDynArray;
4479   lCanvasPts: array[0..1] of Integer;
4480   lColor, lColor1, lColor2: TFPColor;
4481 begin
4482   if not (Brush.Kind in [bkVerticalGradient, bkHorizontalGradient]) then
4483     Exit;
4484 
4485   lColor1 := Brush.Gradient_colors[1].Color;
4486   lColor2 := Brush.Gradient_colors[0].Color;
4487   if Brush.Kind = bkVerticalGradient then
4488   begin
4489     for i := y1 to y2 do
4490     begin
4491       lPoints := GetLineIntersectionPoints(CanvasToCoordY(i), False);
4492       if Length(lPoints) < 2 then Continue;
4493       lColor := MixColors(lColor1, lColor2, i-y1, y2-y1);
4494       ADest.Pen.FPColor := lColor;
4495       ADest.Pen.Style := psSolid;
4496       j := 0;
4497       while j < Length(lPoints) do
4498       begin
4499         lCanvasPts[0] := CoordToCanvasX(lPoints[j]);
4500         lCanvasPts[1] := CoordToCanvasX(lPoints[j+1]);
4501         ADest.Line(lCanvasPts[0], i, lCanvasPts[1], i);
4502         inc(j, 2);
4503       end;
4504     end;
4505   end
4506   else if Brush.Kind = bkHorizontalGradient then
4507   begin
4508     for i := x1 to x2 do
4509     begin
4510       lPoints := GetLineIntersectionPoints(CanvasToCoordX(i), True);
4511       if Length(lPoints) < 2 then Continue;
4512       lColor := MixColors(lColor1, lColor2, i-x1, x2-x1);
4513       ADest.Pen.FPColor := lColor;
4514       ADest.Pen.Style := psSolid;
4515       j := 0;
4516       while (j+1 < Length(lPoints)) do
4517       begin
4518         lCanvasPts[0] := CoordToCanvasY(lPoints[j]);
4519         lCanvasPts[1] := CoordToCanvasY(lPoints[j+1]);
4520         ADest.Line(i, lCanvasPts[0], i, lCanvasPts[1]);
4521         inc(j , 2);
4522       end;
4523     end;
4524   end;
4525 end;      *)
4526 
4527 procedure TvEntityWithPenAndBrush.DrawBrush(var ARenderInfo: TvRenderInfo);
4528 var
4529   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
4530   ADestX: Integer absolute ARenderInfo.DestX;
4531   ADestY: Integer absolute ARenderInfo.DestY;
4532   AMulX: Double absolute ARenderInfo.MulX;
4533   AMulY: Double absolute ARenderInfo.MulY;
4534   //
4535   tmpPath: TPath;
4536   polypoints: TPointsArray;
4537   polystarts: TIntegerDynArray;
4538 begin
4539   tmpPath := CreatePath;
4540   if tmpPath = nil then
4541     exit;
4542   try
4543     ConvertPathToPolygons(tmpPath, ADestX, ADestY, AMulX, AMulY, polypoints, polystarts);
4544     ADest.Polygon(polypoints);
4545   finally
4546     tmpPath.Free;
4547   end;
4548 end;
4549 
4550 procedure TvEntityWithPenAndBrush.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
4551 begin
4552   inherited Render(ARenderInfo, ADoDraw);
4553   ApplyBrushToCanvas(ARenderInfo);
4554 end;
4555 
GenerateDebugTreenull4556 function TvEntityWithPenAndBrush.GenerateDebugTree(
4557   ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer;
4558 var
4559   lStr: string;
4560 begin
4561   lStr := Format('[%s] Name=%s X=%f Y=%f Pen=[Color=%s Style=%s] Brush=[Color=%s Style=%s Kind=%s] %s',
4562     [Self.ClassName, Self.Name, X, Y,
4563     GenerateDebugStrForFPColor(Pen.Color),
4564     GetEnumName(TypeInfo(TFPPenStyle), integer(Pen.Style)),
4565     GenerateDebugStrForFPColor(Brush.Color),
4566     GetEnumName(TypeInfo(TFPBrushStyle), integer(Brush.Style)),
4567     GetEnumName(TypeInfo(TvBrushKind), integer(Brush.Kind)),
4568     FExtraDebugStr]);
4569   Result := ADestRoutine(lStr, APageItem);
4570 end;
4571 
4572 
4573 { TvEntityWithPenBrushAndFont }
4574 
4575 constructor TvEntityWithPenBrushAndFont.Create(APage: TvPage);
4576 begin
4577   inherited Create(APage);
4578   Font.Color := colBlack;
4579   Font.Size := 10;
4580 end;
4581 
4582 procedure TvEntityWithPenBrushAndFont.ApplyFontToCanvas(ARenderInfo: TvRenderInfo);
4583 begin
4584   ApplyFontToCanvas(ARenderInfo, Font);
4585 end;
4586 
4587 procedure TvEntityWithPenBrushAndFont.ApplyFontToCanvas(
4588   ARenderInfo: TvRenderInfo; AFont: TvFont);
4589 var
4590   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
4591   ADestX: Integer absolute ARenderInfo.DestX;
4592   ADestY: Integer absolute ARenderInfo.DestY;
4593   AMulX: Double absolute ARenderInfo.MulX;
4594   AMulY: Double absolute ARenderInfo.MulY;
4595   //
4596   {$ifdef USE_LCL_CANVAS}
4597   ALCLDest: TCanvas absolute ARenderInfo.Canvas;
4598   {$endif}
4599   lFPColor: TFPColor;
4600 begin
4601   if ADest = nil then
4602     exit;
4603   ADest.Font.Name := AFont.Name;
4604   if AFont.Size = 0 then AFont.Size := 10;
4605   ADest.Font.Size := Round(AmulX * AFont.Size);
4606   ADest.Font.Bold := AFont.Bold;
4607   ADest.Font.Italic := AFont.Italic;
4608   ADest.Font.Underline := AFont.Underline;
4609   {$IF (FPC_FULLVERSION<=20600) or (FPC_FULLVERSION=20602)}
4610   ADest.Font.StrikeTrough := AFont.StrikeThrough; //old version with typo
4611   {$ELSE}
4612   ADest.Font.StrikeThrough := AFont.StrikeThrough;
4613   {$ENDIF}
4614 
4615   {$ifdef USE_LCL_CANVAS}
4616   ALCLDest.Font.Orientation := Round(AFont.Orientation * 10);  // wp: was * 16
4617   {$endif}
4618   lFPColor := AdjustColorToBackground(AFont.Color, ARenderInfo);
4619   ADest.Font.FPColor := lFPColor;
4620 end;
4621 
4622 procedure TvEntityWithPenBrushAndFont.AssignFont(AFont: TvFont);
4623 begin
4624   Font.Color := AFont.Color;
4625   Font.Size := AFont.Size;
4626   Font.Name := AFont.Name;
4627   Font.Orientation := AFont.Orientation;
4628   Font.Bold := AFont.Bold;
4629   Font.Italic := AFont.Italic;
4630   Font.Underline := AFont.Underline;
4631   Font.StrikeThrough := AFont.StrikeThrough;
4632 end;
4633 
4634 procedure TvEntityWithPenBrushAndFont.Rotate(AAngle: Double; ABase: T3DPoint);
4635 begin
4636   inherited Rotate(AAngle, ABase);
4637   Font.Orientation := RadToDeg(AAngle);
4638 end;
4639 
4640 procedure TvEntityWithPenBrushAndFont.Scale(ADeltaScaleX, ADeltaScaleY: Double);
4641 begin
4642   inherited Scale(ADeltaScaleX, ADeltaScaleY);
4643   Font.Size := Round(Font.Size * ADeltaScaleX);
4644 end;
4645 
4646 procedure TvEntityWithPenBrushAndFont.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
4647 begin
4648   inherited Render(ARenderInfo, ADoDraw);
4649   ApplyFontToCanvas(ARenderInfo);
4650 end;
4651 
TvEntityWithPenBrushAndFont.GenerateDebugTreenull4652 function TvEntityWithPenBrushAndFont.GenerateDebugTree(
4653   ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer;
4654 var
4655   lStr: string;
4656 begin
4657   Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
4658   // Add the font debug info in a sub-item
4659   lStr := Format('[Font] Color=%s Size=%d Name=%s Orientation=%f Bold=%s Italic=%s Underline=%s StrikeThrough=%s',
4660     [GenerateDebugStrForFPColor(Font.Color),
4661     Font.Size, Font.Name, Font.Orientation,
4662     BoolToStr(Font.Bold),
4663     BoolToStr(Font.Italic),
4664     BoolToStr(Font.Underline),
4665     BoolToStr(Font.StrikeThrough)
4666     ]);
4667   ADestRoutine(lStr, Result);
4668 end;
4669 
4670 { TvEntityWithStyle }
4671 
4672 constructor TvEntityWithStyle.Create(APage: TvPage);
4673 begin
4674   inherited Create(APage);
4675 end;
4676 
4677 destructor TvEntityWithStyle.Destroy;
4678 begin
4679   inherited Destroy;
4680 end;
4681 
TvEntityWithStyle.GetCombinedStylenull4682 function TvEntityWithStyle.GetCombinedStyle(AParent: TvEntityWithStyle): TvStyle;
4683 begin
4684   if (AParent <> nil) and (Style = nil) then Result := AParent.Style
4685   else Result := Style;
4686 end;
4687 
4688 procedure TvEntityWithStyle.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
4689 begin
4690   inherited Render(ARenderInfo, ADoDraw);
4691   if (Style <> nil) then
4692   begin
4693     ApplyPenToCanvas(ARenderInfo, Style.Pen);
4694     ApplyBrushToCanvas(ARenderInfo, @Style.Brush);
4695     ApplyFontToCanvas(ARenderInfo, Style.Font);
4696   end;
4697 end;
4698 
4699 { TPath }
4700 
4701 constructor TPath.Create(APage: TvPage);
4702 begin
4703   inherited Create(APage);
4704   FCurMoveSubPartIndex := -1;
4705 end;
4706 
4707 //GM: Follow the path to cleanly release the chained list!
4708 destructor TPath.Destroy;
4709 begin
4710   Clear;
4711   inherited Destroy;
4712 end;
4713 
4714 procedure TPath.Clear;
4715 var
4716   p, pp, np: TPathSegment;
4717 begin
4718   p:=PointsEnd;
4719   if (p<>nil) then
4720   begin
4721     np:=p.Next;
4722     while (p<>nil) do
4723     begin
4724       pp:=p.Previous;
4725       p.Next:=nil;
4726       p.Previous:=nil;
4727       FreeAndNil(p);
4728       p:=pp;
4729     end;
4730     p:=np;
4731     while (p<>nil) do
4732     begin
4733       np:=p.Next;
4734       p.Next:=nil;
4735       p.Previous:=nil;
4736       FreeAndNil(p);
4737       p:=np;
4738     end;
4739   end;
4740   PointsEnd:=nil;
4741   Points:=nil;
4742 
4743   inherited Clear;
4744 end;
4745 
4746 procedure TPath.Assign(ASource: TPath);
4747 begin
4748   Len := ASource.Len;
4749   Points := ASource.Points;
4750   PointsEnd := ASource.PointsEnd;
4751   CurPoint := ASource.CurPoint;
4752   Pen := ASource.Pen;
4753   Brush := ASource.Brush;
4754   ClipPath := ASource.ClipPath;
4755   ClipMode := ASource.ClipMode;
4756 end;
4757 
4758 procedure TPath.PrepareForSequentialReading;
4759 begin
4760   CurPoint := nil;
4761 end;
4762 
4763 procedure TPath.PrepareForWalking;
4764 begin
4765   PrepareForSequentialReading();
4766   CurWalkDistanceInCurSegment := 0;
4767   Next();
4768 end;
4769 
Nextnull4770 function TPath.Next(): TPathSegment;
4771 begin
4772   if CurPoint = nil then Result := Points
4773   else Result := CurPoint.Next;
4774 
4775   CurPoint := Result;
4776 end;
4777 
4778 // Walk is walking a distance in the path and obtaining the point where we land and the current tangent
4779 // Returns true if successful, false otherwise
4780 // ATangentAngle - In radians
TPath.NextWalknull4781 function TPath.NextWalk(ADistance: Double; out AX, AY, ATangentAngle: Double): Boolean;
4782 var
4783   lCurPoint: TPathSegment;
4784   lCurPointLen: Double;
4785 begin
4786   Result := False;
4787   lCurPoint := CurPoint;
4788   CurWalkDistanceInCurSegment := ADistance + CurWalkDistanceInCurSegment;
4789   if lCurPoint = nil then Exit;
4790   lCurPointLen := lCurPoint.GetLength();
4791 
4792   // get the current segment
4793   while CurWalkDistanceInCurSegment >= lCurPointLen do
4794   begin
4795     CurWalkDistanceInCurSegment := CurWalkDistanceInCurSegment - lCurPointLen;
4796     lCurPoint := Next();
4797     if lCurPoint = nil then Exit;
4798     lCurPointLen := lCurPoint.GetLength();
4799   end;
4800 
4801   Result := lCurPoint.GetPointAndTangentForDistance(CurWalkDistanceInCurSegment, AX, AY, ATangentAngle);
4802 end;
4803 
4804 procedure TPath.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
4805   out ALeft, ATop, ARight, ABottom: Double);
4806 var
4807   lSegment: TPathSegment;
4808   l2DSegment: T2DSegment;
4809   lFirstValue: Boolean = True;
4810 begin
4811   inherited CalculateBoundingBox(ARenderInfo, ALeft, ATop, ARight, ABottom);
4812 
4813   PrepareForSequentialReading();
4814   lSegment := Next();
4815   while lSegment <> nil do
4816   begin
4817     if lSegment is T2DSegment then
4818     begin
4819       l2DSegment := T2DSegment(lSegment);
4820       if lFirstValue then
4821       begin
4822         ALeft := l2DSegment.X;
4823         ATop := l2DSegment.Y;
4824         ARight := l2DSegment.X;
4825         ABottom := l2DSegment.Y;
4826         lFirstValue := False;
4827       end
4828       else
4829       begin
4830         if l2DSegment.X < ALeft then ALeft := l2DSegment.X;
4831         if l2DSegment.Y < ATop then ATop := l2DSegment.Y;
4832         if l2DSegment.X > ARight then ARight := l2DSegment.X;
4833         if l2DSegment.Y > ABottom then ABottom := l2DSegment.Y;
4834       end;
4835     end;
4836 
4837     lSegment := Next();
4838   end;
4839 end;
4840 
4841 procedure TPath.AppendSegment(ASegment: TPathSegment);
4842 var
4843   L: Integer;
4844 begin
4845   ASegment.FPath := self;
4846 
4847   // Check if we are the first segment in the tmp path
4848   if PointsEnd = nil then
4849   begin
4850     if Len <> 0 then
4851       Exception.Create('[TPath.AppendSegment] Assertion failed Len <> 0 with PointsEnd = nil');
4852 
4853     Points := ASegment;
4854     PointsEnd := ASegment;
4855     Len := 1;
4856     Exit;
4857   end;
4858 
4859   L := Len;
4860   Inc(Len);
4861 
4862   // Adds the element to the end of the list
4863   PointsEnd.Next := ASegment;
4864   ASegment.Previous := PointsEnd;
4865   PointsEnd := ASegment;
4866 end;
4867 
4868 procedure TPath.AppendMoveToSegment(AX, AY: Double);
4869 var
4870   segment: T2DSegment;
4871 begin
4872   segment := T2DSegment.Create;
4873   segment.SegmentType := stMoveTo;
4874   segment.X := AX;
4875   segment.Y := AY;
4876   AppendSegment(segment);
4877 end;
4878 
4879 procedure TPath.AppendLineToSegment(AX, AY: Double);
4880 var
4881   segment: T2DSegment;
4882 begin
4883   segment := T2DSegment.Create;
4884   segment.SegmentType := st2DLine;
4885   segment.X := AX;
4886   segment.Y := AY;
4887   AppendSegment(segment);
4888 end;
4889 
4890 procedure TPath.AppendEllipticalArc(ARadX, ARadY, AXAxisRotation, ADestX,
4891   ADestY: Double; ALeftmostEllipse, AClockwiseArcFlag: Boolean);
4892 var
4893   segment: T2DEllipticalArcSegment;
4894 begin
4895   segment := T2DEllipticalArcSegment.Create;
4896   segment.SegmentType := st2DEllipticalArc;
4897   segment.X := ADestX;
4898   segment.Y := ADestY;
4899   segment.RX := ARadX;
4900   segment.RY := ARadY;
4901   segment.XRotation := AXAxisRotation;
4902   segment.LeftmostEllipse := ALeftmostEllipse;
4903   segment.ClockwiseArcFlag := AClockwiseArcFlag;
4904 
4905   AppendSegment(segment);
4906 end;
4907 
4908 procedure TPath.AppendEllipticalArcWithCenter(ARadX, ARadY, AXAxisRotation,
4909   ADestX, ADestY, ACenterX, ACenterY: Double; AClockwiseArcFlag: Boolean);
4910 var
4911   segment: T2DEllipticalArcSegment;
4912 begin
4913   segment := T2DEllipticalArcSegment.Create;
4914   segment.SegmentType := st2DEllipticalArc;
4915   segment.X := ADestX;
4916   segment.Y := ADestY;
4917   segment.RX := ARadX;
4918   segment.RY := ARadY;
4919   segment.CX := ACenterX;
4920   segment.CY := ACenterY;
4921   segment.XRotation := AXAxisRotation;
4922   segment.LeftmostEllipse := False; // which value would it have?
4923   segment.ClockwiseArcFlag := AClockwiseArcFlag;
4924   segment.CenterSetByUser := True;
4925 
4926   AppendSegment(segment);
4927 end;
4928 
4929 procedure TPath.Move(ADeltaX, ADeltaY: Double);
4930 var
4931   i: Integer;
4932 begin
4933   inherited Move(ADeltaX, ADeltaY);
4934   for i := 0 to GetSubpartCount()-1 do
4935   begin
4936     MoveSubpart(ADeltaX, ADeltaY, i);
4937   end;
4938 end;
4939 
4940 procedure TPath.MoveSubpart(ADeltaX, ADeltaY: Double; ASubpart: Cardinal);
4941 var
4942   lCurPart: TPathSegment;
4943 begin
4944   if (ASubPart < 0) or (ASubPart > Len) then
4945     raise Exception.Create(Format('[TPath.MoveSubpart] Invalid index %d', [ASubpart]));
4946 
4947   // Move to the subpart
4948   lCurPart := MoveToSubpart(ASubpart);
4949 
4950   // Do the change
4951   lCurPart.Move(ADeltaX, ADeltaY);
4952 end;
4953 
TPath.MoveToSubpartnull4954 function TPath.MoveToSubpart(ASubpart: Cardinal): TPathSegment;
4955 var
4956   i: Integer;
4957 begin
4958   if (ASubPart < 0) or (ASubPart > Len) then
4959     raise Exception.Create(Format('[TPath.MoveToSubpart] Invalid index %d', [ASubpart]));
4960 
4961   // Move to the subpart
4962   if (ASubPart = FCurMoveSubPartIndex) then
4963   begin
4964     Result := FCurMoveSubPartSegment;
4965   end
4966   else if (FCurMoveSubPartSegment <> nil) and (ASubPart = FCurMoveSubPartIndex + 1) then
4967   begin
4968     Result := FCurMoveSubPartSegment.Next;
4969     FCurMoveSubPartIndex := FCurMoveSubPartIndex + 1;
4970     FCurMoveSubPartSegment := Result;
4971   end
4972   else if (FCurMoveSubPartSegment <> nil) and (ASubPart = FCurMoveSubPartIndex - 1) then
4973   begin
4974     Result := FCurMoveSubPartSegment.Previous;
4975     FCurMoveSubPartIndex := FCurMoveSubPartIndex - 1;
4976     FCurMoveSubPartSegment := Result;
4977   end
4978   else
4979   begin
4980     Result := Points;
4981 
4982     for i := 0 to ASubpart-1 do
4983       Result := Result.Next;
4984 
4985     FCurMoveSubPartIndex := ASubpart;
4986     FCurMoveSubPartSegment := Result;
4987   end;
4988 end;
4989 
GetSubpartCountnull4990 function TPath.GetSubpartCount: Integer;
4991 begin
4992   Result := Len;
4993 end;
4994 
4995 procedure TPath.Rotate(AAngle: Double; ABase: T3DPoint);
4996 var
4997   i: Integer;
4998   lCurPart: TPathSegment;
4999 begin
5000   inherited Rotate(AAngle, ABase);
5001   for i := 0 to GetSubpartCount()-1 do
5002   begin
5003     // Move to the subpart
5004     lCurPart := MoveToSubpart(i);
5005     // Rotate it
5006     lCurPart.Rotate(AAngle, ABase);
5007   end;
5008 end;
5009 
5010 { Only correct for straight segments. This must have been checked before! }
TPath.GetLineIntersectionPointsnull5011 function TPath.GetLineIntersectionPoints(ACoord: Double;
5012   ACoordIsX: Boolean): TDoubleDynArray;
5013 const
5014   COUNT = 100;
5015 var
5016   seg: TPathSegment;
5017   seg2D: T2DSegment; // absolute seg;
5018   j: Integer;
5019   p, p1, p2: T3DPoint;
5020   n: Integer;
5021 begin
5022   SetLength(Result, COUNT);
5023   PrepareForSequentialReading;
5024   n := 0;
5025   if ACoordIsX then
5026     for j:=0 to Len-1 do
5027     begin
5028       seg := TPathSegment(Next);
5029       if seg.GetStartPoint(p) and (seg is T2DSegment) then
5030       begin
5031         seg2D := T2DSegment(seg);
5032         if p.X < seg2D.X then begin
5033           p1 := Make3DPoint(p.X, p.Y);
5034           p2 := Make3DPoint(seg2D.X, seg2D.Y);
5035         end else
5036         begin
5037           p1 := Make3DPoint(seg2D.X, seg2D.Y);
5038           p2 := Make3DPoint(p.X, p.Y);
5039         end;
5040         if (p1.X < ACoord) and (ACoord <= p2.X) then
5041         begin
5042           if n >= Length(Result) then
5043             SetLength(Result, Length(Result) + COUNT);
5044           if (p1.X = p2.X) then
5045             Result[n] := p1.Y else
5046             Result[n] := p1.Y + (ACoord - p1.X) * (p2.Y - p1.Y) / (p2.X - p1.X);
5047           inc(n);
5048         end;
5049       end;
5050     end
5051   else
5052     for j := 0 to Len-1 do
5053     begin
5054       seg := TPathSegment(Next);
5055       if seg.GetStartPoint(p) and (seg is T2DSegment) then
5056       begin
5057         seg2D := T2DSegment(seg);
5058         if p.Y < seg2D.Y then
5059         begin
5060           p1 := Make3DPoint(p.X, p.Y);
5061           p2 := Make3DPoint(seg2D.X, seg2D.Y);
5062         end else
5063         begin
5064           p1 := Make3DPoint(seg2D.X, seg2D.Y);
5065           p2 := Make3DPoint(p.X, p.Y);
5066         end;
5067         if (p1.Y < ACoord) and (ACoord <= p2.Y) then
5068         begin
5069           if n >= Length(Result) then
5070             SetLength(Result, Length(Result) + COUNT);
5071           if (p1.Y = p2.Y) then
5072             Result[n] := p1.X else
5073             Result[n] := p1.X + (ACoord - p1.Y) * (p2.X - p1.x) / (p2.Y - p1.Y);
5074           inc(n);
5075         end;
5076       end;
5077     end;
5078   SetLength(Result, n);
5079 end;
5080 
5081 procedure TPath.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
5082 begin
5083   inherited Render(ARenderInfo, ADoDraw);
5084   ARenderInfo.Renderer.TPath_Render(ARenderInfo, ADoDraw, Self);
5085 end;
5086 
5087 
5088 (*
5089 procedure TPath.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
5090   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
5091 
5092   function CanFill: Boolean;
5093   var
5094     seg: TPathSegment;
5095     j: Integer;
5096   begin
5097     Result := true;
5098     PrepareForSequentialReading;
5099     for j := 0 to Len - 1 do
5100     begin
5101       seg := TPathSegment(Next());
5102       if seg.SegmentType in [st2DBezier, st3dBezier, st2DEllipticalArc] then
5103       begin
5104         Result := false;
5105         exit;
5106       end;
5107     end;
5108   end;
5109 
5110 const
5111   POINT_BUFFER = 100;
5112 var
5113   i, j: Integer;
5114   PosX, PosY: Double; // Not modified by ADestX, etc
5115   CoordX, CoordY: Integer;
5116   CurSegment: TPathSegment;
5117   Cur2DSegment: T2DSegment absolute CurSegment;
5118   Cur2DBSegment: T2DBezierSegment absolute CurSegment;
5119   Cur2DArcSegment: T2DEllipticalArcSegment absolute CurSegment;
5120   x1, y1, x2, y2: Integer;
5121   // For bezier
5122   CoordX2, CoordY2, CoordX3, CoordY3, CoordX4, CoordY4, CoordX5, CoordY5: Integer;
5123   // For polygons
5124   lPoints, pts: array of TPoint;
5125   NumPoints: Integer;
5126   pts3d: T3dPointsArray = nil;
5127   // for elliptical arcs
5128   BoxLeft, BoxTop, BoxRight, BoxBottom: Double;
5129   EllipseRect: TRect;
5130    // Clipping Region
5131   {$ifdef USE_LCL_CANVAS}
5132   ClipRegion, OldClipRegion: HRGN;
5133   ACanvas: TCanvas absolute ADest;
5134   {$endif}
5135 begin
5136   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
5137 
5138   PosX := 0;
5139   PosY := 0;
5140 //  ADest.Brush.Style := bsClear;
5141 
5142   ADest.MoveTo(ADestX, ADestY);
5143                            {
5144   // Set the path Pen and Brush options
5145   ADest.Pen.Style := Pen.Style;
5146   ADest.Pen.Width := Round(Pen.Width * AMulX);
5147   if ADest.Pen.Width < 1 then ADest.Pen.Width := 1;
5148   if (Pen.Width <= 2) and (ADest.Pen.Width > 2) then ADest.Pen.Width := 2;
5149   if (Pen.Width <= 5) and (ADest.Pen.Width > 5) then ADest.Pen.Width := 5;
5150   ADest.Pen.FPColor := AdjustColorToBackground(Pen.Color, ARenderInfo);
5151   {$ifdef USE_LCL_CANVAS}
5152   if (Pen.Style = psPattern)  then
5153     ACanvas.Pen.SetPattern(Pen.Pattern);
5154   {$endif}
5155   ADest.Brush.FPColor := Brush.Color;
5156                             }
5157   // Prepare the Clipping Region, if any
5158   {$ifdef USE_CANVAS_CLIP_REGION}
5159   if ClipPath <> nil then
5160   begin
5161     OldClipRegion := LCLIntf.CreateEmptyRegion();
5162     GetClipRgn(ACanvas.Handle, OldClipRegion);
5163     ClipRegion := ConvertPathToRegion(ClipPath, ADestX, ADestY, AMulX, AMulY);
5164     SelectClipRgn(ACanvas.Handle, ClipRegion);
5165     DeleteObject(ClipRegion);
5166     // debug info
5167     {$ifdef DEBUG_CANVAS_CLIP_REGION}
5168     ConvertPathToPoints(CurPath.ClipPath, ADestX, ADestY, AMulX, AMulY);
5169     ACanvas.Polygon(lPoints);
5170     {$endif}
5171   end;
5172   {$endif}
5173 
5174   // useful in some paths, like stars!
5175   {  -- wp: causes artifacts in case of concave path
5176   if ADoDraw then
5177     RenderInternalPolygon(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY);
5178   }
5179 
5180   if CanFill then
5181   begin
5182     // Manually fill polygon with gradient
5183     {$IFDEF USE_LCL_CANVAS}
5184     if ADoDraw and (Brush.Kind in [bkHorizontalGradient, bkVerticalGradient]) then
5185     begin
5186       x1 := MaxInt;
5187       y1 := MaxInt;
5188       x2 := -MaxInt;
5189       y2 := -MaxInt;
5190       PrepareForSequentialReading;
5191       for j := 0 to Len - 1 do
5192       begin
5193         CurSegment := TPathSegment(Next);
5194         CoordX := CoordToCanvasX(Cur2DSegment.X, ADestX, AMulX);
5195         CoordY := CoordToCanvasY(Cur2DSegment.Y, ADestY, AMulY);
5196         x1 := Min(x1, CoordX);
5197         y1 := Min(y1, CoordY);
5198         x2 := Max(x2, CoordX);
5199         y2 := Max(y2, CoordY);
5200       end;
5201       DrawBrushGradient(ADest, ARenderInfo, x1, y1, x2, y2, ADestX, ADestY, AMulX, AMulY);
5202     end;
5203     {$ENDIF}
5204   end;
5205 
5206   //
5207   // For other paths, draw more carefully
5208   //
5209   ApplyPenToCanvas(ADest, ARenderInfo, Pen);  // Restore pen
5210   PrepareForSequentialReading;
5211 
5212   SetLength(lPoints, POINT_BUFFER);
5213   NumPoints := 0;
5214 
5215   for j := 0 to Len - 1 do
5216   begin
5217     //WriteLn('j = ', j);
5218     CurSegment := TPathSegment(Next());
5219 
5220     case CurSegment.SegmentType of
5221     stMoveTo:
5222     begin
5223       CoordX := CoordToCanvasX(Cur2DSegment.X, ADestX, AMulX);
5224       CoordY := CoordToCanvasY(Cur2DSegment.Y, ADestY, AMulY);
5225 
5226       if ADoDraw then
5227       begin
5228         // Draw previous polygon
5229         if NumPoints > 0 then
5230           begin
5231           SetLength(lPoints, NumPoints);
5232           if Length(lPoints) = 2 then
5233             ADest.Line(lPoints[0].X, lPoints[0].Y, lPoints[1].X, lPoints[1].Y)
5234           else
5235             ADest.Polygon(lPoints);
5236           // Start new polygon
5237           SetLength(lPoints, POINT_BUFFER);
5238           NumPoints := 0;
5239         end;
5240 
5241         lPoints[0].X := CoordX;
5242         lPoints[0].Y := CoordY;
5243         NumPoints := 1;
5244       end;
5245 
5246 
5247       {
5248       if ADoDraw then
5249         ADest.MoveTo(CoordX, CoordY);
5250         }
5251       CalcEntityCanvasMinMaxXY(ARenderInfo, CoordX, CoordY);
5252       PosX := Cur2DSegment.X;
5253       PosY := Cur2DSegment.Y;
5254       {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
5255       Write(Format(' M%d,%d', [CoordX, CoordY]));
5256       {$endif}
5257     end;
5258 
5259     // This element can override temporarely the Pen
5260 
5261     // TO DO: Paint these segments with correct pen at end !!!!
5262 
5263 
5264     st2DLineWithPen:
5265     begin
5266       ADest.Pen.FPColor := AdjustColorToBackground(T2DSegmentWithPen(Cur2DSegment).Pen.Color, ARenderInfo);
5267       CoordX := CoordToCanvasX(PosX, ADestX, AMulX);
5268       CoordY := CoordToCanvasY(PosY, ADestY, AMulY);
5269       CoordX2 := CoordToCanvasX(Cur2DSegment.X, ADestX, AMulX);
5270       CoordY2 := CoordToCanvasY(Cur2DSegment.Y, ADestY, AMulY);
5271       CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, CoordX, CoordY, CoordX2, CoordY2);
5272       if ADoDraw then
5273       begin
5274         if NumPoints >= Length(lPoints) then
5275           SetLength(lPoints, Length(lPoints) + POINT_BUFFER);
5276         lPoints[NumPoints].X := CoordX2;
5277         lPoints[NumPoints].Y := CoordY2;
5278         inc(NumPoints);
5279 //        ADest.Line(CoordX, CoordY, CoordX2, CoordY2);
5280       end;
5281 
5282       PosX := Cur2DSegment.X;
5283       PosY := Cur2DSegment.Y;
5284 
5285       ADest.Pen.FPColor := Pen.Color;
5286 
5287       {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
5288       Write(Format(' L%d,%d', [CoordX2, CoordY2]));
5289       {$endif}
5290     end;
5291 
5292     st2DLine, st3DLine:
5293     begin
5294       CoordX := CoordToCanvasX(PosX, ADestX, AMulX);
5295       CoordY := CoordToCanvasY(PosY, ADestY, AMulY);
5296       CoordX2 := CoordToCanvasX(Cur2DSegment.X, ADestX, AMulX);
5297       CoordY2 := CoordToCanvasY(Cur2DSegment.Y, ADestY, AMulY);
5298       CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, CoordX, CoordY, CoordX2, CoordY2);
5299       if ADoDraw then
5300       begin
5301         if NumPoints >= Length(lPoints) then
5302           SetLength(lPoints, Length(lPoints) + POINT_BUFFER);
5303         lPoints[NumPoints].X := CoordX2;
5304         lPoints[NumPoints].Y := CoordY2;
5305         inc(NumPoints);
5306 //        ADest.Line(CoordX, CoordY, CoordX2, CoordY2);
5307       end;
5308       PosX := Cur2DSegment.X;
5309       PosY := Cur2DSegment.Y;
5310       {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
5311       Write(Format(' L%d,%d', [CoordX2, CoordY2]));
5312       {$endif}
5313     end;
5314 
5315     { To draw a bezier we need to divide the interval in parts and make
5316       lines between this parts }
5317     st2DBezier, st3DBezier:
5318     begin
5319       CoordX := CoordToCanvasX(PosX, ADestX, AMulX);
5320       CoordY := CoordToCanvasY(PosY, ADestY, AMulY);
5321       CoordX2 := CoordToCanvasX(Cur2DBSegment.X2, ADestX, AMulX);
5322       CoordY2 := CoordToCanvasY(Cur2DBSegment.Y2, ADestY, AMulY);
5323       CoordX3 := CoordToCanvasX(Cur2DBSegment.X3, ADestX, AMulX);
5324       CoordY3 := CoordToCanvasY(Cur2DBSegment.Y3, ADestY, AMulY);
5325       CoordX4 := CoordToCanvasX(Cur2DBSegment.X, ADestX, AMulX);
5326       CoordY4 := CoordToCanvasY(Cur2DBSegment.Y, ADestY, AMulY);
5327 //      SetLength(lPoints, 0);
5328       CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, CoordX, CoordY, CoordX2, CoordY2);
5329       CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, CoordX3, CoordY3, CoordX4, CoordY4);
5330       SetLength(pts, 0);
5331       AddBezierToPoints(
5332         Make2DPoint(CoordX, CoordY),
5333         Make2DPoint(CoordX2, CoordY2),
5334         Make2DPoint(CoordX3, CoordY3),
5335         Make2DPoint(CoordX4, CoordY4),
5336         pts //lPoints
5337       );
5338 
5339       if ADoDraw then
5340       begin
5341         if NumPoints + Length(pts) >= POINT_BUFFER then
5342           SetLength(lPoints, NumPoints + Length(pts));
5343         for i:=0 to High(pts) do
5344         begin
5345           lPoints[NumPoints].X := pts[i].X;
5346           lPoints[NumPoints].Y := pts[i].Y;
5347           inc(numPoints);
5348         end;
5349       end;
5350 
5351       ADest.Brush.Style := Brush.Style;
5352       {
5353       if (Length(lPoints) >= 3) and ADoDraw then
5354         ADest.Polygon(lPoints);
5355        }
5356       PosX := Cur2DSegment.X;
5357       PosY := Cur2DSegment.Y;
5358 
5359       {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
5360       Write(Format(' ***C%d,%d %d,%d %d,%d %d,%d',
5361         [CoordToCanvasX(PosX, ADestX, AMulX), CoordToCanvasY(PosY, ADestY, AMulY),
5362          CoordToCanvasX(Cur2DBSegment.X2, ADestX, AMulX), CoordToCanvasY(Cur2DBSegment.Y2, ADestY, AMulY),
5363          CoordToCanvasX(Cur2DBSegment.X3, ADestX, AMulX), CoordToCanvasY(Cur2DBSegment.Y3, ADestY, AMulY),
5364          CoordToCanvasX(Cur2DBSegment.X, ADestX, AMulX), CoordToCanvasY(Cur2DBSegment.Y, ADestY, AMulY)]));
5365       {$endif}
5366     end;
5367 
5368     st2DEllipticalArc:
5369     begin
5370       CoordX := CoordToCanvasX(PosX, ADestX, AMulX);                   // start point of segment
5371       CoordY := CoordToCanvasY(PosY, ADestY, AMulY);
5372       CoordX2 := CoordToCanvasX(Cur2DArcSegment.RX, ADestX, AMulX);    // major axis radius
5373       CoordY2 := CoordToCanvasY(Cur2DArcSegment.RY, ADestY, AMulY);    // minor axis radius
5374       CoordX3 := CoordToCanvasX(Cur2DArcSegment.XRotation, 0, sign(AMulX));   // axis rotation angle
5375       CoordX4 := CoordToCanvasX(Cur2DArcSegment.X, ADestX, AMulX);     // end point of segment
5376       CoordY4 := CoordToCanvasY(Cur2DArcSegment.Y, ADestY, AMulY);
5377       CoordX5 := CoordToCanvasX(Cur2DArcSegment.Cx, ADestX, AMulX);    // Ellipse center
5378       CoordY5 := CoordToCanvasY(Cur2DArcSegment.Cy, ADestY, AMulY);
5379 //      SetLength(lPoints, 0);
5380 
5381       Cur2DArcSegment.CalculateEllipseBoundingBox(nil, BoxLeft, BoxTop, BoxRight, BoxBottom);
5382 
5383       EllipseRect.Left := CoordToCanvasX(BoxLeft, ADestX, AMulX);
5384       EllipseRect.Top := CoordToCanvasY(BoxTop, ADestY, AMulY);
5385       EllipseRect.Right := CoordToCanvasX(BoxRight, ADestX, AMulX);
5386       EllipseRect.Bottom := CoordToCanvasY(BoxBottom, ADestY, AMulY);
5387 
5388       {$ifdef FPVECTORIAL_TOCANVAS_ELLIPSE_VISUALDEBUG}
5389       ACanvas.Pen.Color := clRed;
5390       ACanvas.Brush.Style := bsClear;
5391       ACanvas.Rectangle(  // Ellipse bounding box
5392         EllipseRect.Left, EllipseRect.Top, EllipseRect.Right, EllipseRect.Bottom);
5393       ACanvas.Line(CoordX5-5, CoordY5, CoordX5+5, CoordY5);  // Ellipse center
5394       ACanvas.Line(CoordX5, CoordY5-5, CoordX5, CoordY5+5);
5395       ACanvas.Pen.Color := clBlue;
5396       ACanvas.Line(CoordX-5, CoordY, CoordX+5, CoordY);      // Start point
5397       ACanvas.Line(CoordX, CoordY-5, CoordX, CoordY+5);
5398       ACanvas.Line(CoordX4-5, CoordY4, CoordX4+5, CoordY4);  // End point
5399       ACanvas.Line(CoordX4, CoordY4-5, CoordX4, CoordY4+5);
5400 
5401       {$endif}
5402 
5403 //      ADest.Brush.Style := Brush.Style;
5404       CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo,
5405         EllipseRect.Left, EllipseRect.Top, EllipseRect.Right, EllipseRect.Bottom);
5406 
5407       if ADoDraw then
5408       begin
5409         Cur2DArcSegment.PolyApproximate(pts3D);
5410 //        Cur2DArcSegment.BezierApproximate(pts3D);
5411         if NumPoints + Length(pts3D) >= POINT_BUFFER then
5412           SetLength(lPoints, NumPoints + Length(pts3D));
5413         for i:=1 to High(pts3D) do        // i=0 is end point of prev segment -> we can skip it.
5414         begin
5415           lPoints[NumPoints].X := CoordToCanvasX(pts3D[i].X, ADestX, AMulX);
5416           lPoints[NumPoints].Y := CoordToCanvasY(pts3D[i].Y, ADestY, AMulY);
5417           inc(numPoints);
5418         end;
5419         {
5420         SetLength(lPoints, Length(pts3D));
5421         for i:=0 to High(pts3D) do
5422         begin
5423           lPoints[i].X := CoordToCanvasX(pts3D[i].X, ADestX, AMulX);
5424           lPoints[i].Y := CoordToCanvasY(pts3D[i].Y, ADestY, AMulY);
5425         end;
5426         ADest.Polygon(lPoints);
5427         }
5428                                {
5429         i := 0;
5430         while i < Length(lPoints) do
5431         begin
5432           ADest.Polygon([lPoints[i], lPoints[i+1], lPoints[i+2], lPoints[i+3]]);
5433           inc(i, 4);
5434         end;
5435         }
5436         {
5437         // Arc draws counterclockwise
5438         if Cur2DArcSegment.ClockwiseArcFlag then
5439           ACanvas.Arc(
5440             EllipseRect.Left, EllipseRect.Top, EllipseRect.Right, EllipseRect.Bottom,
5441             CoordX4, CoordY4, CoordX, CoordY)
5442         else
5443           ACanvas.Arc(
5444             EllipseRect.Left, EllipseRect.Top, EllipseRect.Right, EllipseRect.Bottom,
5445             CoordX, CoordY, CoordX4, CoordY4);
5446         end;
5447         }
5448       end;
5449       PosX := Cur2DArcSegment.X;
5450       PosY := Cur2DArcSegment.Y;
5451 
5452       {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
5453       {Write(Format(' ***C%d,%d %d,%d %d,%d %d,%d',
5454         [CoordToCanvasX(PosX), CoordToCanvasY(PosY),
5455          CoordToCanvasX(Cur2DBSegment.X2), CoordToCanvasY(Cur2DBSegment.Y2),
5456          CoordToCanvasX(Cur2DBSegment.X3), CoordToCanvasY(Cur2DBSegment.Y3),
5457          CoordToCanvasX(Cur2DBSegment.X), CoordToCanvasY(Cur2DBSegment.Y)]));}
5458       {$endif}
5459     end;
5460     end;
5461   end;
5462   {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
5463   WriteLn('');
5464   {$endif}
5465 
5466   // Draw polygon
5467   if ADoDraw then begin
5468     SetLength(lPoints, NumPoints);
5469     if Length(lPoints) = 2 then
5470       ADest.Line(lPoints[0].X, lPoints[0].Y, lPoints[1].X, lPoints[1].Y)
5471     else
5472       ADest.Polygon(lPoints);
5473   end;
5474 
5475   // Restores the previous Clip Region
5476   {$ifdef USE_CANVAS_CLIP_REGION}
5477   if ClipPath <> nil then
5478   begin
5479     SelectClipRgn(ACanvas.Handle, OldClipRegion); //Using OldClipRegion crashes in Qt
5480   end;
5481   {$endif}
5482 end;
5483                              *)
5484 
5485 procedure TPath.RenderInternalPolygon(constref ARenderInfo: TvRenderInfo);
5486 var
5487   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
5488   ADestX: Integer absolute ARenderInfo.DestX;
5489   ADestY: Integer absolute ARenderInfo.DestY;
5490   AMulX: Double absolute ARenderInfo.MulX;
5491   AMulY: Double absolute ARenderInfo.MulY;
5492   //
5493 
CoordToCanvasXnull5494   function CoordToCanvasX(ACoord: Double): Integer;
5495   begin
5496     Result := Round(ADestX + AmulX * ACoord);
5497   end;
5498 
CoordToCanvasYnull5499   function CoordToCanvasY(ACoord: Double): Integer;
5500   begin
5501     Result := Round(ADestY + AmulY * ACoord);
5502   end;
5503 
5504 var
5505   j: Integer;
5506   CoordX, CoordY: Integer;
5507   CurSegment: TPathSegment;
5508   Cur2DSegment: T2DSegment absolute CurSegment;
5509   Cur2DBSegment: T2DBezierSegment absolute CurSegment;
5510   Cur2DArcSegment: T2DEllipticalArcSegment absolute CurSegment;
5511   // For bezier
5512   // For polygons
5513   MultiPoints: array of array of TPoint;
5514   lCurPoligon, lCurPoligonStartIndex: Integer;
5515 begin
5516   //
5517   // For solid paths, draw a polygon for the main internal area
5518   //
5519   // If there is a move-to in the middle of the path, we should
5520   // draw then multiple poligons
5521   //
5522   if Brush.Style <> bsClear then
5523   begin
5524     PrepareForSequentialReading;
5525 
5526     {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
5527     Write(' Solid Path Internal Area');
5528     {$endif}
5529     ADest.Brush.Style := Brush.Style;
5530     ADest.Pen.Style := psClear;
5531 
5532     SetLength(MultiPoints, 1);
5533     SetLength(MultiPoints[0], Len);
5534     lCurPoligon := 0;
5535     lCurPoligonStartIndex := 0;
5536 
5537     for j := 0 to Len - 1 do
5538     begin
5539       //WriteLn('j = ', j);
5540       CurSegment := TPathSegment(Next());
5541 
5542       if (j > 0) and (CurSegment.SegmentType = stMoveTo) then
5543       begin
5544         SetLength(MultiPoints[lCurPoligon], j-lCurPoligonStartIndex);
5545         Inc(lCurPoligon);
5546         SetLength(MultiPoints, lCurPoligon+1);
5547         SetLength(MultiPoints[lCurPoligon], Len);
5548         lCurPoligonStartIndex := j;
5549       end;
5550 
5551       CoordX := CoordToCanvasX(Cur2DSegment.X);
5552       CoordY := CoordToCanvasY(Cur2DSegment.Y);
5553 
5554       MultiPoints[lCurPoligon][j-lCurPoligonStartIndex].X := CoordX;
5555       MultiPoints[lCurPoligon][j-lCurPoligonStartIndex].Y := CoordY;
5556 
5557       {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
5558       Write(Format(' P%d,%d', [CoordY, CoordY]));
5559       {$endif}
5560     end;
5561 
5562     // Cut off excess from the last poligon
5563     SetLength(MultiPoints[lCurPoligon], Len-lCurPoligonStartIndex);
5564 
5565     // Draw each polygon now
5566     for j := 0 to lCurPoligon do
5567     begin
5568       ADest.Polygon(MultiPoints[j]);
5569     end;
5570 
5571     {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
5572     Write(' Now the details ');
5573     {$endif}
5574   end;
5575 end;
5576 
GenerateDebugTreenull5577 function TPath.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
5578   APageItem: Pointer): Pointer;
5579 var
5580   lStr: string;
5581   lCurPathSeg: TPathSegment;
5582 begin
5583   lStr := Format('[%s] Name=%s Pen.Color=%s Pen.Style=%s Brush.Color=%s Brush.Style=%s'
5584     + ' Brush.Kind=%s',
5585     [Self.ClassName, Self.Name,
5586     GenerateDebugStrForFPColor(Pen.Color),
5587     GetEnumName(TypeInfo(TFPPenStyle), integer(Pen.Style)),
5588     GenerateDebugStrForFPColor(Brush.Color),
5589     GetEnumName(TypeInfo(TFPBrushStyle), integer(Brush.Style)),
5590     GetEnumName(TypeInfo(TvBrushKind), integer(Brush.Kind))
5591     ]);
5592   Result := ADestRoutine(lStr, APageItem);
5593   // Add sub-entities
5594   PrepareForSequentialReading();
5595   lCurPathSeg := Next();
5596   while lCurPathSeg <> nil do
5597   begin
5598     lCurPathSeg.GenerateDebugTree(ADestRoutine, Result);
5599     lCurPathSeg := Next();
5600   end;
5601 end;
5602 
5603 { TvText }
5604 
TvText.GetTextMetric_Descender_pxnull5605 function TvText.GetTextMetric_Descender_px(constref ARenderInfo: TvRenderInfo): Integer;
5606 var
5607   {$ifdef USE_LCL_CANVAS}
5608   ACanvas: TCanvas absolute ARenderInfo.Canvas;
5609   tm: TLCLTextMetric;
5610   {$else}
5611   lFontSizePx: Integer;
5612   lTextSize: TSize;
5613   {$endif}
5614 begin
5615   Result := 0;
5616 
5617   {$IFDEF USE_LCL_CANVAS}
5618   if ACanvas.GetTextMetrics(tm) then
5619     Result := tm.Descender;
5620   {$ELSE}
5621   lFontSizePx := Font.Size;        // is without multiplier!
5622   if lFontSizePx = 0 then lFontSizePx := 10;
5623   lTextSize := ADest.TextExtent(Str_Line_Height_Tester);
5624   Result := (lTextSize.CY - lFontSizePx) div 2;  // rough estimate only
5625   {$ENDIF}
5626 end;
5627 
5628 constructor TvText.Create(APage: TvPage);
5629 begin
5630   inherited Create(APage);
5631   Value := TStringList.Create;
5632   Font.Color := colBlack;
5633 end;
5634 
5635 destructor TvText.Destroy;
5636 begin
5637   Value.Free;
5638   inherited Destroy;
5639 end;
5640 
TryToSelectnull5641 function TvText.TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult;
5642 var
5643   lProximityFactor: Integer;
5644 begin
5645   lProximityFactor := ASnapFlexibility;
5646   if (APos.X > X - lProximityFactor) and (APos.X < X + lProximityFactor)
5647     and (APos.Y > Y - lProximityFactor) and (APos.Y < Y + lProximityFactor) then
5648     Result := vfrFound
5649   else Result := vfrNotFound;
5650 end;
5651 
5652 procedure TvText.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
5653   out ALeft, ATop, ARight, ABottom: Double);
5654 var
5655   i: Integer;
5656   lSize: TSize;
5657   lWidth, lHeight: Integer;
5658   lRenderInfo: TvRenderInfo;
5659   lText: String;
5660   {$ifdef USE_LCL_CANVAS}
5661   ACanvas: TCanvas absolute ARenderInfo.Canvas;
5662   {$endif}
5663 begin
5664   //lText := Value.Text; // For debugging
5665   InitializeRenderInfo(lRenderInfo, Self);
5666   lRenderInfo.Canvas := ARenderInfo.Canvas;
5667   lRenderInfo.DestX := ARenderInfo.DestX;
5668   lRenderInfo.DestY := ARenderInfo.DestY;
5669   lRenderInfo.MulX := ARenderInfo.MulX;
5670   lRenderInfo.MulY := ARenderInfo.MulY;
5671   inherited Render(lRenderInfo, False);
5672 
5673   ALeft := X;
5674   ATop := Y;
5675   lWidth := 0;
5676   lHeight := 0;
5677   ARight := ALeft;
5678   ABottom := ATop;
5679   if (ARenderInfo.Canvas = nil) or (not (ARenderInfo.Canvas is TCanvas)) then Exit;
5680 
5681   for i := 0 to Value.Count-1 do
5682   begin
5683     lText := Value.Strings[i];
5684     lSize := ACanvas.TextExtent(lText);
5685     lWidth := Max(lWidth, lSize.cx);
5686     lSize := ACanvas.TextExtent(Str_Line_Height_Tester);
5687     lHeight := lHeight + lSize.cy + 2;
5688   end;
5689 
5690   ALeft := X;
5691   ATop := Y - lHeight;
5692   ARight := ALeft + lWidth;
5693   ABottom := Y;
5694 end;
5695 
5696 procedure TvText.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
5697 const
5698   LINE_SPACING = 0.2;  // fraction of font height for line spacing
5699 var
5700   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
5701   ADestX: Integer absolute ARenderInfo.DestX;
5702   ADestY: Integer absolute ARenderInfo.DestY;
5703   AMulX: Double absolute ARenderInfo.MulX;
5704   AMulY: Double absolute ARenderInfo.MulY;
5705   //
5706   i: Integer;
5707   //
5708   pt, refPt: TPoint;
5709   LowerDimY, UpperDimY, CurDimY: Double;
5710   XAnchorAdjustment: Integer;
5711   lLongestLine, lLineWidth, lFontSizePx, lFontDescenderPx: Integer;
5712   lText: string;
5713   lDescender: Integer;
5714   phi: Double;
5715   {$ifdef USE_LCL_CANVAS}
5716   ACanvas: TCanvas absolute ARenderInfo.Canvas;
5717   lTextSize: TSize;
5718   lTextWidth: Integer;
5719   {$endif}
5720 begin
5721   lText := Value.Text + Format(' F=%d', [ACanvas.Font.Size]); // for debugging
5722   inherited Render(ARenderInfo, ADoDraw);
5723 
5724   InitializeRenderInfo(ARenderInfo, Self);
5725 
5726   // Don't draw anything if we have alpha=zero
5727   if Font.Color.Alpha = 0 then Exit;
5728   ADest.Font.FPColor := AdjustColorToBackground(Font.Color, ARenderInfo);
5729 
5730   // Font metric
5731   lFontSizePx := Font.Size;        // is without multiplier!
5732   if lFontSizePx = 0 then lFontSizePx := 10;
5733   lTextSize := ADest.TextExtent(Str_Line_Height_Tester);
5734   lDescender := GetTextMetric_Descender_px(ARenderInfo);
5735 
5736   // Angle of text rotation
5737   phi := sign(AMulY) * DegToRad(Font.Orientation);
5738 
5739   // Reference point of the entity (X,Y) in pixels
5740   // rotation center in case of rotated text
5741   refPt := Point(
5742     round(CoordToCanvasX(X, ADestX, AMulX)),
5743     round(CoordToCanvasY(Y, ADestY, AMulY))
5744   );
5745 
5746   // if an anchor is set, use it
5747   // to do this, first search for the longest line
5748   XAnchorAdjustment := 0;
5749   if TextAnchor <> vtaStart then
5750   begin
5751     lLongestLine := 0;
5752     for i := 0 to Value.Count - 1 do
5753     begin
5754       lLineWidth := ACanvas.TextWidth(Value.Strings[i]);   // contains multiplier
5755       if lLineWidth > lLongestLine then
5756         lLongestLine := lLineWidth;
5757     end;
5758     case TextAnchor of
5759       vtaMiddle : XAnchorAdjustment := -lLongestLine div 2;
5760       vtaEnd    : XAnchorAdjustment := -lLongestLine;
5761     end;
5762   end;
5763 
5764   // Begin first line at reference point and grow downwards.
5765   // ...
5766   // We need to keep the order of lines drawing correct regardless of
5767   // the drawing direction
5768   lowerDimY := refPt.Y - (lTextSize.CY - lDescender); // lowerDim.Y := refPt.Y + lFontSizePx * (1 + LINE_SPACING) * Value.Count * AMulY
5769   upperDimY := refPt.Y;
5770   curDimY := IfThen(AMulY < 0, lowerDimY, upperDimY);
5771 
5772   // TvText supports multiple lines
5773   for i := 0 to Value.Count - 1 do
5774   begin
5775     lText := Value.Strings[i];
5776     if not Render_Use_NextText_X then
5777       Render_NextText_X := refPt.X + XAnchorAdjustment;
5778 
5779     // Start point of text, rotated around the reference point
5780     pt := Point(round(Render_NextText_X), round(curDimY));  // before rotation
5781     pt := Rotate2dPoint(pt, refPt, -Phi);                   // after rotation
5782 
5783     // Paint line
5784     if ADoDraw then
5785     begin
5786       ADest.TextOut(pt.x, pt.y, lText);
5787     end;
5788 
5789     // Calc text boundaries respecting text rotation.
5790     CalcEntityCanvasMinMaxXY(ARenderInfo, pt.x, pt.y);
5791     lTextSize := ACanvas.TextExtent(lText);
5792     lTextWidth := lTextSize.cx;
5793     // Reserve vertical space for </br> and similar line ending constructs
5794     if (lText = '') then
5795       lTextSize.cy := ACanvas.TextHeight(STR_FPVECTORIAL_TEXT_HEIGHT_SAMPLE);
5796     // other end of the text
5797     pt := Point(round(Render_NextText_X) + lTextWidth, round(curDimY) + lTextSize.cy );
5798     pt := Rotate2dPoint(pt, refPt, -Phi);
5799     CalcEntityCanvasMinMaxXY(ARenderInfo, pt.x, pt.y);
5800 
5801     // Prepare next line
5802     Render_NextText_X := Render_NextText_X + lTextWidth;
5803     curDimY := IfThen(AMulY < 0,
5804       curDimY - (lFontSizePx * (1 + LINE_SPACING) * AMulY),
5805       curDimY + (lFontSizePx * (1 + LINE_SPACING) * AMulY));
5806     // wp: isn't this the same as
5807     // curDimY := curDimY + (lFontSizePx * (1 + LINE_SPACING) * abs(AMulY);
5808   end;
5809 end;
5810 
GetEntityFeaturesnull5811 function TvText.GetEntityFeatures(constref ARenderInfo: TvRenderInfo): TvEntityFeatures;
5812 var
5813   ActualText: String;
5814   lHeight_px: Integer = 0;
5815 begin
5816   // Calculate the total height
5817   CalculateHeightInCanvas(ARenderInfo, lHeight_px);
5818   Result.TotalHeight := lHeight_px;
5819 
5820   Result.DrawsUpwardHeightAdjustment := 0;
5821   if (not FPage.UseTopLeftCoordinates) then
5822     Result.DrawsUpwardHeightAdjustment := lHeight_px;
5823 
5824   Result.FirstLineHeight := 0;
5825   if (Value.Count > 0) then
5826   begin
5827     ActualText := Value.Text;
5828     Value.Text := Value.Strings[0];
5829     CalculateHeightInCanvas(ARenderInfo, lHeight_px);
5830     Result.FirstLineHeight := lHeight_px - GetTextMetric_Descender_px(ARenderInfo);
5831 
5832     Value.Text := ActualText;
5833   end;
5834   Result.DrawsUpwards := True;
5835 end;
5836 
GenerateDebugTreenull5837 function TvText.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
5838   APageItem: Pointer): Pointer;
5839 var
5840   lStr, lValueStr: string;
5841 begin
5842   lValueStr := GenerateDebugStrForString(Value.Text);
5843   lStr := Format('[%s] Name=%s X=%f Y=%f Text="%s" [.Font=>] Color=%s Size=%d Name=%s Orientation=%f Bold=%s Italic=%s Underline=%s StrikeThrough=%s TextAnchor=%s',
5844     [
5845     Self.ClassName, Name, X, Y, lValueStr,
5846     GenerateDebugStrForFPColor(Font.Color),
5847     Font.Size, Font.Name, Font.Orientation,
5848     BoolToStr(Font.Bold),
5849     BoolToStr(Font.Italic),
5850     BoolToStr(Font.Underline),
5851     BoolToStr(Font.StrikeThrough),
5852     GetEnumName(TypeInfo(TvTextAnchor), integer(TextAnchor))
5853   ]);
5854   Result := ADestRoutine(lStr, APageItem);
5855   // Add the style as a sub-item
5856   if Style <> nil then
5857   begin
5858     Style.GenerateDebugTree(ADestRoutine, Result);
5859   end;
5860 end;
5861 
5862 { TvCurvedText }
5863 
5864 procedure TvCurvedText.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
5865 var
5866   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
5867   ADestX: Integer absolute ARenderInfo.DestX;
5868   ADestY: Integer absolute ARenderInfo.DestY;
5869   AMulX: Double absolute ARenderInfo.MulX;
5870   AMulY: Double absolute ARenderInfo.MulY;
5871   //
5872   i, lCharLen: Integer;
5873   lText, lUTF8Char: string;
5874   lX, lY, lTangentAngle, lTextHeight: Double;
5875   pt: TPoint;
5876   //lLeft, lTop, lWidth, lHeight: Integer;
5877 begin
5878   inherited Render(ARenderInfo, False);
5879 
5880   InitializeRenderInfo(ARenderInfo, Self);
5881        (*
5882   if not ADoDraw then
5883   begin
5884     //Path.CalculateSizeInCanvas(ADest, lLeft, lTop, lWidth, lHeight);
5885     Exit;
5886   end;   *)
5887 
5888   // Don't draw anything if we have alpha=zero
5889   if Font.Color.Alpha = 0 then Exit;
5890   if Path = nil then Exit;
5891 
5892   ADest.Font.FPColor := AdjustColorToBackground(Font.Color, ARenderInfo);
5893   if Value.Count = 0 then Exit;
5894   lText := Value.Strings[0];
5895   Render_NextText_X := CoordToCanvasX(X, ADestX, AMulX);
5896 
5897   Path.PrepareForWalking();
5898   Path.NextWalk(0, lX, lY, lTangentAngle);
5899 
5900   // render each character separately
5901   for i := 0 to UTF8Length(lText)-1 do
5902   begin
5903     lUTF8Char := UTF8Copy(lText, i+1, 1);
5904     ADest.Font.Orientation := Round(Math.radtodeg(lTangentAngle)*10);
5905 
5906     // Without adjustment the text is down bellow the path, but we want it on top of it
5907     {lTextHeight := Abs(AMulY) * ADest.TextHeight(lUTF8Char);
5908     lX := lX - Sin(Pi / 2 - lTangentAngle) * lTextHeight;
5909     lY := lY + Cos(Pi / 2 - lTangentAngle) * lTextHeight;}
5910 
5911     pt := Point(CoordToCanvasX(lX, ADestX, AMulX), CoordToCanvasY(lY, ADestY, AMulY));
5912     CalcEntityCanvasMinMaxXY(ARenderInfo, pt.x, pt.y);
5913 
5914     if ADoDraw then
5915       ADest.TextOut(pt.X, pt.Y, lUTF8Char);
5916 
5917     lCharLen := ADest.TextWidth(lUTF8Char);
5918     Path.NextWalk(lCharLen, lX, lY, lTangentAngle);
5919   end;
5920 end;
5921 
GenerateDebugTreenull5922 function TvCurvedText.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
5923   APageItem: Pointer): Pointer;
5924 begin
5925   Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
5926   if Path <> nil then
5927     Path.GenerateDebugTree(ADestRoutine, Result);
5928 end;
5929 
5930 { TvField }
5931 
5932 constructor TvField.Create(APage: TvPage);
5933 begin
5934   inherited Create(APage);
5935 
5936   DateFormat := 'dd/MM/yyyy hh:mm:ss';
5937   NumberFormat := vnfDecimal;
5938 end;
5939 
5940 { TvCircle }
5941 
5942 procedure TvCircle.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
5943   out ALeft, ATop, ARight, ABottom: Double);
5944 begin
5945   ALeft := X - Radius;
5946   ARight := X + Radius;
5947   ATop := Y + Radius;
5948   ABottom := Y - Radius;
5949 end;
5950 
CreatePathnull5951 function TvCircle.CreatePath: TPath;
5952 begin
5953   Result := TPath.Create(FPage);
5954   Result.AppendMoveToSegment(X + Radius, Y);
5955   Result.AppendEllipticalArcWithCenter(Radius, Radius, 0, X - Radius, Y, X, Y, true);
5956   Result.AppendEllipticalArcWithCenter(Radius, Radius, 0, X + Radius, Y, X, Y, true);
5957 end;
5958 
5959 procedure TvCircle.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
5960 var
5961   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
5962   ADestX: Integer absolute ARenderInfo.DestX;
5963   ADestY: Integer absolute ARenderInfo.DestY;
5964   AMulX: Double absolute ARenderInfo.MulX;
5965   AMulY: Double absolute ARenderInfo.MulY;
5966   //
5967   x1, y1, x2, y2: Integer;
5968 begin
5969   inherited Render(ARenderInfo, ADoDraw);
5970 
5971   x1 := CoordToCanvasX(X - Radius, ADestX, AMulX);
5972   y1 := CoordToCanvasY(Y - Radius, ADestY, AMulY);
5973   x2 := CoordToCanvasX(X + Radius, ADestX, AMulX);
5974   y2 := CoordToCanvasY(Y + Radius, ADestY, AMulY);
5975   CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
5976 
5977   if ADoDraw then
5978   begin
5979     if Brush.Kind <> bkSimpleBrush then
5980       // Draw gradient and border
5981       DrawBrushGradient(ARenderInfo, x1, y1, x2, y2)
5982     else
5983       // Draw uniform fill and border
5984       DrawBrush(ARenderInfo);
5985   end;
5986 end;
5987 
5988 procedure TvCircle.Rotate(AAngle: Double; ABase: T3DPoint);
5989 var
5990   ctr: T3dPoint;
5991 begin
5992   ctr := Rotate3dPointInXY(Make3dPoint(X,Y), ABase, -AAngle);
5993     // use inverted angle due to sign convention in Rotate3DPointInXY
5994   X := ctr.X;
5995   Y := ctr.Y;
5996 end;
5997 
5998 { TvCircularArc }
5999 
6000 procedure TvCircularArc.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
6001 var
6002   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
6003   ADestX: Integer absolute ARenderInfo.DestX;
6004   ADestY: Integer absolute ARenderInfo.DestY;
6005   AMulX: Double absolute ARenderInfo.MulX;
6006   AMulY: Double absolute ARenderInfo.MulY;
6007   //
6008 
6009   function CoordToCanvasX(ACoord: Double): Integer;
6010   begin
6011     Result := Round(ADestX + AmulX * ACoord);
6012   end;
6013 
6014   function CoordToCanvasY(ACoord: Double): Integer;
6015   begin
6016     Result := Round(ADestY + AmulY * ACoord);
6017   end;
6018 
6019 var
6020   FinalStartAngle, FinalEndAngle: double;
6021   BoundsLeft, BoundsTop, BoundsRight, BoundsBottom,
6022    IntStartAngle, IntAngleLength, IntTmp: Integer;
6023   {$ifdef USE_LCL_CANVAS}
6024   ALCLDest: TCanvas absolute ADest;
6025   {$endif}
6026 begin
6027   inherited Render(ARenderInfo, ADoDraw);
6028   {$ifdef USE_LCL_CANVAS}
6029   // ToDo: Consider a X axis inversion
6030   // If the Y axis is inverted, then we need to mirror our angles as well
6031   BoundsLeft := CoordToCanvasX(X - Radius);
6032   BoundsTop := CoordToCanvasY(Y - Radius);
6033   BoundsRight := CoordToCanvasX(X + Radius);
6034   BoundsBottom := CoordToCanvasY(Y + Radius);
6035   {if AMulY > 0 then
6036   begin}
6037     FinalStartAngle := StartAngle;
6038     FinalEndAngle := EndAngle;
6039   {end
6040   else // AMulY is negative
6041   begin
6042     // Inverting the angles generates the correct result for Y axis inversion
6043     if CurArc.EndAngle = 0 then FinalStartAngle := 0
6044     else FinalStartAngle := 360 - 1* CurArc.EndAngle;
6045     if CurArc.StartAngle = 0 then FinalEndAngle := 0
6046     else FinalEndAngle := 360 - 1* CurArc.StartAngle;
6047   end;}
6048   IntStartAngle := Round(16*FinalStartAngle);
6049   IntAngleLength := Round(16*(FinalEndAngle - FinalStartAngle));
6050   // On Gtk2 and Carbon, the Left really needs to be to the Left of the Right position
6051   // The same for the Top and Bottom
6052   // On Windows it works fine either way
6053   // On Gtk2 if the positions are inverted then the arcs are screwed up
6054   // In Carbon if the positions are inverted, then the arc is inverted
6055   if BoundsLeft > BoundsRight then
6056   begin
6057     IntTmp := BoundsLeft;
6058     BoundsLeft := BoundsRight;
6059     BoundsRight := IntTmp;
6060   end;
6061   if BoundsTop > BoundsBottom then
6062   begin
6063     IntTmp := BoundsTop;
6064     BoundsTop := BoundsBottom;
6065     BoundsBottom := IntTmp;
6066   end;
6067   // Arc(ALeft, ATop, ARight, ABottom, Angle16Deg, Angle16DegLength: Integer);
6068   {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
6069 //    WriteLn(Format('Drawing Arc Center=%f,%f Radius=%f StartAngle=%f AngleLength=%f',
6070 //      [CurArc.CenterX, CurArc.CenterY, CurArc.Radius, IntStartAngle/16, IntAngleLength/16]));
6071   {$endif}
6072   ALCLDest.Arc(
6073     BoundsLeft, BoundsTop, BoundsRight, BoundsBottom,
6074     IntStartAngle, IntAngleLength
6075     );
6076   // Debug info
6077 //      {$define FPVECTORIALDEBUG}
6078 //      {$ifdef FPVECTORIALDEBUG}
6079 //      WriteLn(Format('Drawing Arc x1y1=%d,%d x2y2=%d,%d start=%d end=%d',
6080 //        [BoundsLeft, BoundsTop, BoundsRight, BoundsBottom, IntStartAngle, IntAngleLength]));
6081 //      {$endif}
6082 {      ADest.TextOut(CoordToCanvasX(CurArc.CenterX), CoordToCanvasY(CurArc.CenterY),
6083     Format('R=%d S=%d L=%d', [Round(CurArc.Radius*AMulX), Round(FinalStartAngle),
6084     Abs(Round((FinalEndAngle - FinalStartAngle)))]));
6085   ADest.Pen.Color := TColor($DDDDDD);
6086   ADest.Rectangle(
6087     BoundsLeft, BoundsTop, BoundsRight, BoundsBottom);
6088   ADest.Pen.Color := clBlack;}
6089   {$endif}
6090 end;
6091 
6092 { TvEllipse }
6093 
CreatePathnull6094 function TvEllipse.CreatePath: TPath;
6095 var
6096   p1, p2: T2dPoint;
6097 begin
6098   Result := TPath.Create(FPage);
6099 
6100   CalcEllipsePoint(0,  HorzHalfAxis,VertHalfAxis, X,Y, Angle, p1.x, p1.y);
6101   CalcEllipsePoint(pi, HorzHalfAxis,VertHalfAxis, X,Y, Angle, p2.x, p2.y);
6102 
6103   Result.AppendMoveToSegment(p1.x, p1.y);
6104   Result.AppendEllipticalArcWithCenter(HorzHalfAxis, VertHalfAxis, Angle, p2.x, p2.y, X, Y, false);
6105   Result.AppendEllipticalArcWithCenter(HorzHalfAxis, VertHalfAxis, Angle, p1.x, p1.y, X, Y, false);
6106 end;
6107 
6108 // wp: no longer needed
GetLineIntersectionPointsnull6109 function TvEllipse.GetLineIntersectionPoints(ACoord: Double; ACoordIsX: Boolean): TDoubleDynArray;
6110 begin
6111   SetLength(Result, 2);
6112   // this is for axis-aligned ellipses
6113   // (X-Xcenter)^2 / Rx^2 + (Y-Ycenter)^2 / Ry^2 <= 1
6114   if ACoordIsX then
6115   begin
6116     // Y = sqrt( 1 - (X-Xcenter)^2 / Rx^2 ) * Ry + Ycenter
6117     Result[0] := Max(0, 1-sqr(ACoord-X) / sqr(HorzHalfAxis));
6118     Result[0] := sqrt(Result[0]) * VertHalfAxis + Y;
6119     Result[1] := Max(0, 1-sqr(ACoord-X) / sqr(HorzHalfAxis));
6120     Result[1] := -1 * sqrt(Result[1]) * VertHalfAxis + Y;
6121   end
6122   else
6123   begin
6124     Result[0] := Max(0, 1-sqr(ACoord-Y) / sqr(VertHalfAxis));
6125     Result[0] := sqrt(Result[0]) * HorzHalfAxis + X;
6126     Result[1] := Max(0, 1-sqr(ACoord-Y) / sqr(VertHalfAxis));
6127     Result[1] := -1 * sqrt(Result[1]) * HorzHalfAxis + X;
6128   end;
6129 end;
6130 
TryToSelectnull6131 function TvEllipse.TryToSelect(APos: TPoint; var ASubpart: Cardinal;
6132   ASnapFlexibility: Integer): TvFindEntityResult;
6133 begin
6134   // this is for axis-aligned ellipses
6135   // (X-Xcenter)^2 / Rx^2 + (Y-Ycenter)^2 / Ry^2 <= 1
6136   Result := vfrNotFound;
6137   //Result := vfrFound;
6138 end;
6139 
6140 procedure TvEllipse.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
6141   out ALeft, ATop, ARight, ABottom: Double);
6142 var
6143   t, tmp: Double;
6144 begin
6145   { To calculate the bounding rectangle we can do this:
6146 
6147     Ellipse equations:
6148     You could try using the parametrized equations for an ellipse rotated by
6149     an arbitrary angle:
6150 
6151     x = cx + a*cos(t)*cos(Angle) - b*sin(t)*sin(Angle)
6152     y = cy + b*sin(t)*cos(Angle) + a*cos(t)*sin(Angle)
6153 
6154     You can then differentiate and solve for gradient = 0:
6155     0 = dx/dt = -a*sin(t)*cos(Angle) - b*cos(t)*sin(Angle)
6156       ==> tan(t) = -b*tan(Angle)/a
6157       ==> t = arctan(-b*tan(Angle)/a)
6158       ==> left and right corner of bounding box
6159 
6160     On the other axis:
6161     0 = dy/dt = b*cos(t)*cos(Angle) - a*sin(t)*sin(Angle)
6162       ==> tan(t) = b*cot(Angle)/a
6163       ==> t = arctan(b*cot(Angle)/a)
6164       ==> top and bottom corner of bounding box
6165   }
6166   if Angle <> 0.0 then
6167   begin
6168     t := arctan(-VertHalfAxis*tan(Angle)/HorzHalfAxis);
6169     tmp := abs(HorzHalfAxis*cos(t)*cos(Angle) - VertHalfAxis*sin(t)*sin(Angle));
6170     ALeft := X - Round(tmp);
6171     ARight := X + Round(tmp);
6172     t := arctan(VertHalfAxis*cot(Angle) / HorzHalfAxis);
6173     tmp := abs(VertHalfAxis*sin(t)*cos(Angle) + HorzHalfAxis*cos(t)*sin(Angle));
6174     ATop := Y + Round(tmp);
6175     ABottom := Y - Round(tmp);
6176   end else
6177   begin
6178     ALeft := X - HorzHalfAxis;
6179     ARight := X + HorzHalfAxis;
6180     ATop := Y + VertHalfAxis;       // wp: changed from - to +
6181     ABottom := Y - VertHalfAxis;    // ... and this from + to -
6182   end;
6183 end;
6184 
6185 procedure TvEllipse.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
6186 var
6187   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
6188   ADestX: Integer absolute ARenderInfo.DestX;
6189   ADestY: Integer absolute ARenderInfo.DestY;
6190   AMulX: Double absolute ARenderInfo.MulX;
6191   AMulY: Double absolute ARenderInfo.MulY;
6192   //
6193   x1, y1, x2, y2: Integer;
6194   fx1, fx2, fy1, fy2: Double;
6195 begin
6196   inherited Render(ARenderInfo, ADoDraw);
6197 
6198   CalculateBoundingBox(ARenderInfo, fx1, fy1, fx2, fy2);
6199   x1 := CoordToCanvasX(fx1, ADestX, AMulX);
6200   x2 := CoordToCanvasX(fx2, ADestX, AMulX);
6201   y1 := CoordToCanvasY(fy1, ADestY, AMulY);
6202   y2 := CoordToCanvasY(fy2, ADestY, AMulY);
6203   CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
6204 
6205   if ADoDraw then
6206   begin
6207     if Brush.Kind <> bkSimpleBrush then
6208       // Draw gradient and border
6209       DrawBrushGradient(ARenderInfo, x1, y1, x2, y2)
6210     else
6211       // Draw uniform fill and border
6212       DrawBrush(ARenderInfo);
6213 //      ADest.Ellipse(x1, y1, x2, y2);
6214   end;
6215 end;
6216                                               (*
6217 procedure TvEllipse.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
6218   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
6219 
6220   function CoordToCanvasX(ACoord: Double): Integer;
6221   begin
6222     Result := Round(ADestX + AmulX * ACoord);
6223   end;
6224 
6225   function CoordToCanvasY(ACoord: Double): Integer;
6226   begin
6227     Result := Round(ADestY + AmulY * ACoord);
6228   end;
6229 
6230 var
6231   PointList: array[0..6] of TPoint;
6232   f: TPoint;
6233   dk, x1, x2, y1, y2: Integer;
6234   fx1, fy1, fx2, fy2: Double;
6235   {$ifdef USE_LCL_CANVAS}
6236   ALCLDest: TCanvas absolute ADest;
6237   {$endif}
6238 begin
6239   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
6240 
6241   CalculateBoundingBox(ADest, fx1, fy1, fx2, fy2);
6242   x1 := CoordToCanvasX(fx1);
6243   x2 := CoordToCanvasX(fx2);
6244   y1 := CoordToCanvasY(fy1);
6245   y2 := CoordToCanvasY(fy2);
6246 
6247   {$ifdef USE_LCL_CANVAS}
6248   if Angle <> 0 then
6249   begin
6250     dk := Round(0.654 * Abs(y2-y1));
6251     f.x := Round(X);
6252     f.y := Round(Y - 1);
6253     PointList[0] := Rotate2DPoint(Point(x1, f.y), f, Angle) ;  // Startpoint
6254     PointList[1] := Rotate2DPoint(Point(x1,  f.y - dk), f, Angle);
6255     //Controlpoint of Startpoint first part
6256     PointList[2] := Rotate2DPoint(Point(x2- 1,  f.y - dk), f, Angle);
6257     //Controlpoint of secondpoint first part
6258     PointList[3] := Rotate2DPoint(Point(x2 -1 , f.y), f, Angle);
6259     // Firstpoint of secondpart
6260     PointList[4] := Rotate2DPoint(Point(x2-1 , f.y + dk), f, Angle);
6261     // Controllpoint of secondpart firstpoint
6262     PointList[5] := Rotate2DPoint(Point(x1, f.y +  dk), f, Angle);
6263     // Conrollpoint of secondpart endpoint
6264     PointList[6] := PointList[0];   // Endpoint of
6265      // Back to the startpoint
6266      if ADoDraw then
6267       ALCLDest.PolyBezier(Pointlist[0]);
6268   end
6269   else
6270   {$endif}
6271   begin
6272     if ADoDraw then ADest.Ellipse(x1, y1, x2, y2);
6273   end;
6274   // Apply brush gradient
6275   if x1 > x2 then
6276   begin
6277     dk := x1;
6278     x1 := x2;
6279     x2 := dk;
6280   end;
6281   if y1 > y2 then
6282   begin
6283     dk := y1;
6284     y1 := y2;
6285     y2 := dk;
6286   end;
6287   DrawBrushGradient(ADest, ARenderInfo, x1, y1, x2, y2, ADestX, ADestY, AMulX, AMulY);
6288 
6289   CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
6290 end;                                            *)
6291 
6292 procedure TvEllipse.Rotate(AAngle: Double; ABase: T3DPoint);
6293 var
6294   ctr: T3dPoint;
6295 begin
6296   ctr := Rotate3dPointInXY(Make3dPoint(X,Y), ABase, -AAngle);
6297     // use inverted angle due to sign convention in Rotate3DPointInXY
6298   X := ctr.X;
6299   Y := ctr.Y;
6300   Angle := AAngle + Angle;
6301 end;
6302 
6303 
6304 { TvRectangle }
6305 
6306 procedure TvRectangle.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
6307   out ALeft, ATop, ARight, ABottom: Double);
6308 var
6309   pts: Array[0..3] of T3DPoint;
6310   j: Integer;
6311 begin
6312   if Angle <> 0 then
6313   begin
6314     pts[0] := Make3dPoint(X, Y);  // corner points, ignoring rounded corner!
6315     pts[1] := Make3dPoint(X+CX, Y);
6316     pts[2] := Make3dPoint(X+CX, Y-CY);
6317     pts[3] := Make3dPoint(X, Y-CY);
6318     for j:=0 to High(pts) do
6319       pts[j] := Rotate3DPointInXY(pts[j], pts[0], -Angle);   // left/top is rot center!
6320       // Use inverted angle due to sign convention in Rotate3DPointInXY
6321     ALeft := pts[0].x;
6322     ARight := Pts[0].x;
6323     ATop := pts[0].y;
6324     ABottom := pts[0].y;
6325     for j:=1 to High(pts) do
6326     begin
6327       ALeft := Min(ALeft, pts[j].x);
6328       ARight := Max(ARight, pts[j].x);
6329       ATop := Max(ATop, pts[j].y);
6330       ABottom := Min(ABottom, pts[j].y);
6331     end;
6332   end else
6333   begin
6334     ALeft := X;
6335     ATop := Y;
6336     ARight := X + CX;
6337     ABottom := IfThen(FPage.FUseTopLeftCoordinates, Y + CY, Y - CY);
6338   end;
6339 end;
6340 
CreatePathnull6341 function TvRectangle.CreatePath: TPath;
6342 var
6343   pts: T3dPointsArray;
6344   ctr: T3dPoint;
6345   j: Integer;
6346   phi, lYAdj: Double;
6347 begin
6348   lYAdj := FPage.GetTopLeftCoords_Adjustment(); // top/left: +1, bottom/left: -1
6349 
6350   if (RX > 0) and (RY > 0) then
6351   begin
6352     SetLength(pts, 9);
6353     pts[0] := Make3dPoint(X, Y+lYAdj*RY);           {    1              2    }
6354     pts[1] := Make3dPoint(X+RX, Y);                 {  0,8                3  }
6355     pts[2] := Make3dPoint(X+CX-RX, Y);              {                        }
6356     pts[3] := Make3dPoint(X+CX, Y+lYAdj*RY);        {                        }
6357     pts[4] := Make3dPoint(X+CX, Y+lYAdj*(CY-RY));   {  7                  4  }
6358     pts[5] := Make3dPoint(X+CX-RX, Y+lYAdj*CY);     {    6              5    }
6359     pts[6] := Make3dPoint(X+RX, Y+lYAdj*CY);
6360     pts[7] := Make3dPoint(X, Y+lYAdj*(CY-RY));
6361     pts[8] := Make3dPoint(X, Y+lYAdj*RY);
6362   end
6363   else
6364   begin
6365     SetLength(pts, 5);
6366     pts[0] := Make3dPoint(X, Y);
6367     pts[1] := Make3dPoint(X+CX, Y);
6368     pts[2] := Make3dPoint(X+CX, Y+lYAdj*CY);
6369     pts[3] := Make3dPoint(X, Y+lYAdj*CY);
6370     pts[4] := Make3dPoint(X, Y);
6371   end;
6372   ctr := Make3DPoint(X, Y);  // Rotation center
6373   phi := -Angle;             // Angle must be inverted due to sign convention in Rotate3DPointInXY
6374   for j:=0 to High(pts) do
6375     pts[j] := Rotate3DPointInXY(pts[j], ctr, phi);
6376 
6377   Result := TPath.Create(FPage);
6378   if (RX > 0) and (RY > 0) then
6379   begin
6380     Result.AppendMoveToSegment(pts[0].x, pts[0].y);
6381     Result.AppendEllipticalArcWithCenter(RX, RY, phi, pts[1].x, pts[1].y,
6382       pts[1].x, pts[0].y, true);
6383     Result.AppendLineToSegment(pts[2].x, pts[2].y);
6384     Result.AppendEllipticalArcWithCenter(RX, RY, phi, pts[3].x, pts[3].y,
6385       pts[2].x, pts[3].y, true);
6386     Result.AppendLineToSegment(pts[4].x, pts[4].y);
6387     Result.AppendEllipticalArcWithCenter(RX, RY, phi, pts[5].x, pts[5].y,
6388       pts[5].x, pts[4].y, true);
6389     Result.AppendLineToSegment(pts[6].x, pts[6].y);
6390     Result.AppendEllipticalArcWithCenter(RX, RY, phi, pts[7].x, pts[7].y,
6391       pts[6].x, pts[7].y, true);
6392     Result.AppendLineToSegment(pts[8].x, pts[8].y);
6393   end else
6394   begin
6395     Result.AppendMoveToSegment(pts[0].x, pts[0].y);
6396     Result.AppendLineToSegment(pts[1].x, pts[1].y);
6397     Result.AppendLineToSegment(pts[2].x, pts[2].y);
6398     Result.AppendLineToSegment(pts[3].x, pts[3].y);
6399     Result.AppendLineToSegment(pts[4].x, pts[4].y);
6400   end;
6401 end;
6402 
6403 procedure TvRectangle.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
6404 var
6405   ADestX: Integer absolute ARenderInfo.DestX;
6406   ADestY: Integer absolute ARenderInfo.DestY;
6407   AMulX: Double absolute ARenderInfo.MulX;
6408   AMulY: Double absolute ARenderInfo.MulY;
6409   //
6410   x1, y1, x2, y2: Integer;
6411   fx1, fy1, fx2, fy2: Double;
6412 begin
6413   inherited Render(ARenderInfo, ADoDraw);
6414 
6415   CalculateBoundingBox(ARenderInfo, fx1, fy1, fx2, fy2);
6416   x1 := CoordToCanvasX(fx1, ADestX, AMulX);
6417   x2 := CoordToCanvasX(fx2, ADestX, AMulX);
6418   y1 := CoordToCanvasY(fy1, ADestY, AMulY);
6419   y2 := CoordToCanvasY(fy2, ADestY, AMulY);
6420   CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
6421 
6422   if ADoDraw then
6423   begin
6424     if Brush.Kind <> bkSimpleBrush then
6425       // Draw gradient and border
6426       DrawBrushGradient(ARenderInfo, x1, y1, x2, y2)
6427     else
6428       // Draw uniform fill and border
6429       DrawBrush(ARenderInfo);
6430   end;
6431 end;
6432                             (*
6433 procedure TvRectangle.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
6434   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
6435 
6436   function CoordToCanvasX(ACoord: Double): Integer;
6437   begin
6438     Result := Round(ADestX + AmulX * ACoord);
6439   end;
6440 
6441   function CoordToCanvasY(ACoord: Double): Integer;
6442   begin
6443     Result := Round(ADestY + AmulY * ACoord);
6444   end;
6445 
6446 var
6447   x1, x2, y1, y2: Integer;
6448   fx1, fy1, fx2, fy2: Double;
6449 begin
6450   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
6451 
6452   CalculateBoundingBox(ADest, fx1, fy1, fx2, fy2);
6453   x1 := CoordToCanvasX(fx1);
6454   x2 := CoordToCanvasX(fx2);
6455   y1 := CoordToCanvasY(fy1);
6456   y2 := CoordToCanvasY(fy2);
6457 
6458   if ADoDraw then
6459   begin
6460     {$ifdef USE_LCL_CANVAS}
6461     if (RX = 0) and (RY = 0) then
6462       ADest.Rectangle(x1, y1, x2, y2)
6463     else
6464       LCLIntf.RoundRect(TCanvas(ADest).Handle, x1, y1, x2, y2, Round(rx), Round(ry));
6465     {$else}
6466     ADest.Rectangle(x1, y1, x2, y2)
6467     {$endif}
6468   end;
6469 
6470   CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
6471 end;                 *)
6472 
6473 procedure TvRectangle.Rotate(AAngle: Double; ABase: T3DPoint);
6474 var
6475   ref: T3dPoint;  // reference point of rectangle
6476 begin
6477   ref := Rotate3dPointInXY(Make3dPoint(X, Y), ABase, -AAngle);
6478   X := ref.X;
6479   Y := ref.Y;
6480   Angle := AAngle + Angle;
6481 end;
6482 
GenerateDebugTreenull6483 function TvRectangle.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
6484   APageItem: Pointer): Pointer;
6485 var
6486   lStr: string;
6487 begin
6488   Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
6489   // Add the font debug info in a sub-item
6490   lStr := Format('[TvRectangle] Text=%s CX=%f CY=%f CZ=%f RX=%f RY=%f',
6491     [Text,
6492     CX, CY, CZ,
6493     RX, RY
6494     ]);
6495   ADestRoutine(lStr, Result);
6496 end;
6497 
6498 { TvPolygon }
6499 
6500 procedure TvPolygon.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
6501   out ALeft, ATop, ARight, ABottom: Double);
6502 var
6503   i: Integer;
6504 begin
6505   inherited CalculateBoundingBox(ARenderInfo, ALeft, ATop, ARight, ABottom);
6506   for i := 0 to Length(Points)-1 do
6507   begin
6508     ALeft := Min(ALeft, Points[i].X);
6509     ATop := Min(ATop, Points[i].Y);
6510     ARight := Max(ARight, Points[i].X);
6511     ABottom := Max(ABottom, Points[i].Y);
6512   end;
6513 end;
6514 
6515 procedure TvPolygon.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
6516 var
6517   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
6518   ADestX: Integer absolute ARenderInfo.DestX;
6519   ADestY: Integer absolute ARenderInfo.DestY;
6520   AMulX: Double absolute ARenderInfo.MulX;
6521   AMulY: Double absolute ARenderInfo.MulY;
6522   //
6523   lPoints: array of TPoint;
6524   i: Integer;
6525   x1, x2, y1, y2: Integer;
6526   polystarts: TIntegerDynArray;
6527   lRect: TRect;
6528   gv1, gv2: T2DPoint;
6529 begin
6530   inherited Render(ARenderInfo, ADoDraw);
6531 
6532   x1 := MaxInt;
6533   y1 := maxInt;
6534   x2 := -MaxInt;
6535   y2 := -MaxInt;
6536   SetLength(lPoints, Length(Points));
6537   for i := 0 to High(Points) do
6538   begin
6539     lPoints[i].X := CoordToCanvasX(Points[i].X, ADestX, AMulX);
6540     lPoints[i].Y := CoordToCanvasY(Points[i].Y, ADestY, AMulY);
6541     x1 := min(x1, lPoints[i].X);
6542     y1 := min(y1, lPoints[i].Y);
6543     x2 := max(x2, lPoints[i].X);
6544     y2 := max(y2, lPoints[i].Y);
6545   end;
6546   CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
6547 
6548   if ADoDraw then
6549     if (Length(lPoints) > 2) then
6550     begin
6551       case Brush.Kind of
6552         bkSimpleBrush:
6553           ADest.Polygon(lPoints);  // fills the polygon and paints the border
6554         bkHorizontalGradient,
6555         bkVerticalGradient,
6556         bkOtherLinearGradient:
6557           begin
6558             // Border will be drawn later (gradient painting needs its own pen)
6559             ADest.Pen.Style := psClear;
6560             // Boundary rect of shape to be filled by a gradient
6561             lRect := Rect(x1, y1, x2, y2);
6562             // Calculate gradient vector
6563             CalcGradientVector(gv1, gv2, lRect, ADestX, ADestY, AMulX, AMulY);
6564             // Indexes where polygon starts: no multiple polygones here
6565             SetLength(polyStarts, 1);
6566             polyStarts[0] := 0;
6567             // Draw the gradient
6568             DrawPolygonBrushLinearGradient(ARenderInfo, lPoints, polyStarts, lRect, gv1, gv2);
6569             // Draw border
6570             DrawPolygonBorderOnly(ARenderInfo, lPoints);
6571           end;
6572         bkRadialGradient:
6573           begin
6574             // Border will be drawn later (gradient painting needs its own pen)
6575             ADest.Pen.Style := psClear;
6576             // Draw the gradient
6577             DrawPolygonBrushRadialGradient(ARenderInfo, lPoints, lRect);
6578             // Draw border
6579             DrawPolygonBorderOnly(ARenderInfo, lPoints);
6580           end;
6581       end;
6582     end;
6583 end;
6584 
6585 
6586 { TvAlignedDimension }
6587 
6588 procedure TvAlignedDimension.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
6589 var
6590   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
6591   ADestX: Integer absolute ARenderInfo.DestX;
6592   ADestY: Integer absolute ARenderInfo.DestY;
6593   AMulX: Double absolute ARenderInfo.MulX;
6594   AMulY: Double absolute ARenderInfo.MulY;
6595 
6596   function CoordToCanvasX(ACoord: Double): Integer;
6597   begin
6598     Result := Round(ADestX + AmulX * ACoord);
6599   end;
6600 
6601   function CoordToCanvasY(ACoord: Double): Integer;
6602   begin
6603     Result := Round(ADestY + AmulY * ACoord);
6604   end;
6605 
6606 var
6607   Points: array of TPoint;
6608   UpperDim, LowerDim: T3DPoint;
6609   {$ifdef USE_LCL_CANVAS}
6610   ALCLDest: TCanvas absolute ADest;
6611   {$endif}
6612   txt: String;
6613 begin
6614   ADest.Pen.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
6615   ADest.Pen.Width := 1;
6616   ADest.Pen.Style := psSolid;
6617   //
6618   // Draws this shape:
6619   // horizontal     vertical
6620   // ___
6621   // | |     or   ---| X cm
6622   //   |           --|
6623   // Which marks the dimension
6624   ADest.MoveTo(CoordToCanvasX(BaseRight.X), CoordToCanvasY(BaseRight.Y));
6625   ADest.LineTo(CoordToCanvasX(DimensionRight.X), CoordToCanvasY(DimensionRight.Y));
6626   ADest.LineTo(CoordToCanvasX(DimensionLeft.X), CoordToCanvasY(DimensionLeft.Y));
6627   ADest.LineTo(CoordToCanvasX(BaseLeft.X), CoordToCanvasY(BaseLeft.Y));
6628   // Now the arrows
6629   // horizontal
6630   SetLength(Points, 3);
6631   if DimensionRight.Y = DimensionLeft.Y then
6632   begin
6633     ADest.Brush.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
6634     ADest.Brush.Style := bsSolid;
6635     // Left arrow
6636     Points[0] := Point(CoordToCanvasX(DimensionLeft.X), CoordToCanvasY(DimensionLeft.Y));
6637     Points[1] := Point(Points[0].X + 7, Points[0].Y - 3);
6638     Points[2] := Point(Points[0].X + 7, Points[0].Y + 3);
6639     CalcEntityCanvasMinMaxXY(ARenderInfo, Points[0].X, Points[1].Y);
6640     if ADoDraw then ADest.Polygon(Points);
6641     // Right arrow
6642     Points[0] := Point(CoordToCanvasX(DimensionRight.X), CoordToCanvasY(DimensionRight.Y));
6643     Points[1] := Point(Points[0].X - 7, Points[0].Y - 3);
6644     Points[2] := Point(Points[0].X - 7, Points[0].Y + 3);
6645     CalcEntityCanvasMinMaxXY(ARenderInfo, Points[0].X, Points[2].Y);
6646     if ADoDraw then ADest.Polygon(Points);
6647     ADest.Brush.Style := bsClear;
6648     // Dimension text
6649     LowerDim.X := DimensionRight.X-DimensionLeft.X;
6650     ADest.Font.Size := 10;
6651     ADest.Font.Orientation := 0;
6652     ADest.Font.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
6653     txt := Format('%.1f', [LowerDim.X]);
6654     Points[0].X := CoordToCanvasX((DimensionLeft.X+DimensionRight.X)/2)-ADest.TextWidth(txt) div 2;
6655     Points[0].Y := CoordToCanvasY(DimensionLeft.Y);
6656     if ADoDraw then
6657       ADest.TextOut(Points[0].X, Points[0].Y-Round(ADest.Font.Size*1.5), txt);
6658     CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo,
6659       Points[0].X, Points[0].Y - round(ADest.Font.Size*1.5),
6660       Points[0].X + ADest.TextWidth(txt), Points[0].Y);
6661   end
6662   else
6663   begin
6664     ADest.Brush.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
6665     ADest.Brush.Style := bsSolid;
6666     // There is no upper/lower preference for DimensionLeft/Right, so we need to check
6667     if DimensionLeft.Y > DimensionRight.Y then
6668     begin
6669       UpperDim := DimensionLeft;
6670       LowerDim := DimensionRight;
6671     end
6672     else
6673     begin
6674       UpperDim := DimensionRight;
6675       LowerDim := DimensionLeft;
6676     end;
6677     // Upper arrow
6678     Points[0] := Point(CoordToCanvasX(UpperDim.X), CoordToCanvasY(UpperDim.Y));
6679     Points[1] := Point(Points[0].X + Round(AMulX), Points[0].Y - Round(AMulY*3));
6680     Points[2] := Point(Points[0].X - Round(AMulX), Points[0].Y - Round(AMulY*3));
6681     if ADoDraw then ADest.Polygon(Points);
6682     CalcEntityCanvasMinMaxXY(ARenderInfo, Points[1].X, Points[0].Y);
6683     // Lower arrow
6684     Points[0] := Point(CoordToCanvasX(LowerDim.X), CoordToCanvasY(LowerDim.Y));
6685     Points[1] := Point(Points[0].X + Round(AMulX), Points[0].Y + Round(AMulY*3));
6686     Points[2] := Point(Points[0].X - Round(AMulX), Points[0].Y + Round(AMulY*3));
6687     if ADoDraw then ADest.Polygon(Points);
6688     CalcEntityCanvasMinMaxXY(ARenderInfo, Points[2].X, Points[0].Y);
6689     ADest.Brush.Style := bsClear;
6690     // Dimension text
6691     LowerDim.Y := DimensionRight.Y-DimensionLeft.Y;
6692     if LowerDim.Y < 0 then LowerDim.Y := -1 * LowerDim.Y;
6693     ADest.Font.Size := 10;
6694     ADest.Font.Orientation := 900;
6695     ADest.Font.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
6696     txt := Format('%.1f', [LowerDim.Y]);
6697     Points[0].X := CoordToCanvasX(DimensionLeft.X);
6698     Points[0].Y := CoordToCanvasY((DimensionLeft.Y+DimensionRight.Y)/2)
6699       - sign(AMulY) * ADest.TextWidth(txt) div 2;
6700     if ADoDraw then
6701       ADest.TextOut(Points[0].X-Round(ADest.Font.Size*1.5), Points[0].Y, txt);
6702     ADest.Font.Orientation := 0;
6703     CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo,
6704       Points[0].X - Round(ADest.Font.Size*1.5), Points[0].Y,
6705       Points[0].X, Points[0].Y + ADest.TextWidth(txt)
6706       );
6707   end;
6708   SetLength(Points, 0);
6709 
6710   {$IFDEF FPVECTORIAL_DEBUG_DIMENSIONS}
6711   WriteLn(Format('[TvAlignedDimension.Render] BaseRightXY=%f | %f DimensionRightXY=%f | %f DimensionLeftXY=%f | %f',
6712     [BaseRight.X, BaseRight.Y, DimensionRight.X, DimensionRight.Y, DimensionLeft.X, DimensionLeft.Y]));
6713   {$ENDIF}
6714 
6715 {      // Debug info
6716   ADest.TextOut(CoordToCanvasX(CurDim.BaseRight.X), CoordToCanvasY(CurDim.BaseRight.Y), 'BR');
6717   ADest.TextOut(CoordToCanvasX(CurDim.DimensionRight.X), CoordToCanvasY(CurDim.DimensionRight.Y), 'DR');
6718   ADest.TextOut(CoordToCanvasX(CurDim.DimensionLeft.X), CoordToCanvasY(CurDim.DimensionLeft.Y), 'DL');
6719   ADest.TextOut(CoordToCanvasX(CurDim.BaseLeft.X), CoordToCanvasY(CurDim.BaseLeft.Y), 'BL');}
6720 end;
6721 
GenerateDebugTreenull6722 function TvAlignedDimension.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
6723   APageItem: Pointer): Pointer;
6724 var
6725   lStr: string;
6726 begin
6727   Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
6728   // Add the font debug info in a sub-item
6729   lStr := Format('[TvAlignedDimension] BaseLeft=%f %f BaseRight=%f %f DimensionLeft=%f %f DimensionRight=%f %f',
6730     [BaseLeft.X, BaseLeft.Y,
6731      BaseRight.X, BaseRight.Y,
6732      DimensionLeft.X, DimensionLeft.Y,
6733      DimensionRight.X, DimensionRight.Y
6734     ]);
6735   ADestRoutine(lStr, Result);
6736 end;
6737 
6738 { TvRadialDimension }
6739 
6740 procedure TvRadialDimension.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
6741 var
6742   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
6743   ADestX: Integer absolute ARenderInfo.DestX;
6744   ADestY: Integer absolute ARenderInfo.DestY;
6745   AMulX: Double absolute ARenderInfo.MulX;
6746   AMulY: Double absolute ARenderInfo.MulY;
6747 
6748   function CoordToCanvasX(ACoord: Double): Integer;
6749   begin
6750     Result := Round(ADestX + AmulX * ACoord);
6751   end;
6752 
6753   function CoordToCanvasY(ACoord: Double): Integer;
6754   begin
6755     Result := Round(ADestY + AmulY * ACoord);
6756   end;
6757 
6758 var
6759   Points: array of TPoint;
6760   lAngle, lRadius: Double;
6761   {$ifdef USE_LCL_CANVAS}
6762   ALCLDest: TCanvas absolute ADest;
6763   {$endif}
6764 begin
6765   ADest.Pen.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
6766   ADest.Pen.Width := 1;
6767   ADest.Pen.Style := psSolid;
6768 
6769   // The size of the radius of the circle
6770   lRadius := sqrt(sqr(Center.X - DimensionLeft.X) + sqr(Center.Y - DimensionLeft.Y));
6771   // The angle to the first dimension
6772   lAngle := arctan((DimensionLeft.Y - Center.Y) / (DimensionLeft.X - Center.X));
6773 
6774   // Get an arrow in the right part of the circle
6775   SetLength(Points, 3);
6776   ADest.Brush.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
6777   ADest.Brush.Style := bsSolid;
6778   Points[0] := Point(CoordToCanvasX(Center.X + lRadius),     CoordToCanvasY(Center.Y));
6779   Points[1] := Point(CoordToCanvasX(Center.X + lRadius*0.8), CoordToCanvasY(Center.Y - lRadius*0.1));
6780   Points[2] := Point(CoordToCanvasX(Center.X + lRadius*0.8), CoordToCanvasY(Center.Y + lRadius*0.1));
6781   // Now rotate it to the actual position
6782   Points[0] := Rotate2DPoint(Points[0], Point(CoordToCanvasX(Center.X), CoordToCanvasY(Center.Y)),  lAngle);
6783   Points[1] := Rotate2DPoint(Points[1], Point(CoordToCanvasX(Center.X),  CoordToCanvasY(Center.Y)), lAngle);
6784   Points[2] := Rotate2DPoint(Points[2], Point(CoordToCanvasX(Center.X),  CoordToCanvasY(Center.Y)), lAngle);
6785 
6786   if ADoDraw then
6787   begin
6788     if not IsDiameter then
6789     begin
6790       // Basic line
6791       ADest.MoveTo(CoordToCanvasX(Center.X), CoordToCanvasY(Center.Y));
6792       ADest.LineTo(CoordToCanvasX(DimensionLeft.X), CoordToCanvasY(DimensionLeft.Y));
6793 
6794       // Draw the arrow
6795       ADest.Polygon(Points);
6796       ADest.Brush.Style := bsClear;
6797 
6798       // Dimension text
6799       Points[0].X := CoordToCanvasX(Center.X);
6800       Points[0].Y := CoordToCanvasY(Center.Y);
6801       ADest.Font.Size := 10;
6802       ADest.Font.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
6803       ADest.TextOut(Points[0].X, Points[0].Y, Format('%.1f', [lRadius]));
6804     end
6805     else
6806     begin
6807       // Basic line
6808       ADest.MoveTo(CoordToCanvasX(DimensionLeft.X), CoordToCanvasY(DimensionLeft.Y));
6809       ADest.LineTo(CoordToCanvasX(DimensionRight.X), CoordToCanvasY(DimensionRight.Y));
6810 
6811       // Draw the first arrow
6812       ADest.Polygon(Points);
6813       ADest.Brush.Style := bsClear;
6814 
6815       // And the second
6816       Points[0] := Point(CoordToCanvasX(Center.X + lRadius),     CoordToCanvasY(Center.Y));
6817       Points[1] := Point(CoordToCanvasX(Center.X + lRadius*0.8), CoordToCanvasY(Center.Y - lRadius*0.1));
6818       Points[2] := Point(CoordToCanvasX(Center.X + lRadius*0.8), CoordToCanvasY(Center.Y + lRadius*0.1));
6819       // Now rotate it to the actual position
6820       Points[0] := Rotate2DPoint(Points[0], Point(CoordToCanvasX(Center.X), CoordToCanvasY(Center.Y)),  lAngle + Pi);
6821       Points[1] := Rotate2DPoint(Points[1], Point(CoordToCanvasX(Center.X),  CoordToCanvasY(Center.Y)), lAngle + Pi);
6822       Points[2] := Rotate2DPoint(Points[2], Point(CoordToCanvasX(Center.X),  CoordToCanvasY(Center.Y)), lAngle + Pi);
6823       //
6824       ADest.Polygon(Points);
6825       ADest.Brush.Style := bsClear;
6826 
6827       // Dimension text
6828       Points[0].X := CoordToCanvasX(Center.X);
6829       Points[0].Y := CoordToCanvasY(Center.Y);
6830       ADest.Font.Size := 10;
6831       ADest.Font.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
6832       ADest.TextOut(Points[0].X, Points[0].Y, Format('%.1f', [lRadius * 2]));
6833     end;
6834   end;
6835 
6836   SetLength(Points, 0);
6837 end;
6838 
GenerateDebugTreenull6839 function TvRadialDimension.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
6840   APageItem: Pointer): Pointer;
6841 var
6842   lStr, lIsDiameterStr: string;
6843 begin
6844   Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
6845   // Add the font debug info in a sub-item
6846   if IsDiameter then lIsDiameterStr := 'true' else lIsDiameterStr := 'false';
6847   lStr := Format('[TvAlignedDimension] IsDiameter=%s Center=%f %f DimensionLeft=%f %f DimensionRight=%f %f',
6848     [lIsDiameterStr,
6849      Center.X, Center.Y,
6850      DimensionLeft.X, DimensionLeft.Y,
6851      DimensionRight.X, DimensionRight.Y
6852     ]);
6853   ADestRoutine(lStr, Result);
6854 end;
6855 
6856 { TvArcDimension }
6857 
6858 procedure TvArcDimension.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
6859 var
6860   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
6861   ADestX: Integer absolute ARenderInfo.DestX;
6862   ADestY: Integer absolute ARenderInfo.DestY;
6863   AMulX: Double absolute ARenderInfo.MulX;
6864   AMulY: Double absolute ARenderInfo.MulY;
6865 
6866   function CoordToCanvasX(ACoord: Double): Integer;
6867   begin
6868     Result := Round(ADestX + AmulX * ACoord);
6869   end;
6870 
6871   function CoordToCanvasY(ACoord: Double): Integer;
6872   begin
6873     Result := Round(ADestY + AmulY * ACoord);
6874   end;
6875 
6876 var
6877   Points: array of TPoint;
6878   lTriangleCenter, lTriangleCorner: T3DPoint;
6879   {$ifdef USE_LCL_CANVAS}
6880   ALCLDest: TCanvas absolute ADest;
6881   {$endif}
6882   txt: String;
6883 begin
6884   ADest.Pen.FPColor := colYellow;//AdjustColorToBackground(colBlack, ARenderInfo);
6885   ADest.Pen.Width := 1;
6886   ADest.Pen.Style := psSolid;
6887 
6888   // Debug lines
6889   //ADest.Line(CoordToCanvasX(BaseLeft.X), CoordToCanvasY(BaseLeft.Y), CoordToCanvasX(DimensionLeft.X), CoordToCanvasY(DimensionLeft.Y));
6890   //ADest.Line(CoordToCanvasX(BaseRight.X), CoordToCanvasY(BaseRight.Y), CoordToCanvasX(DimensionRight.X), CoordToCanvasY(DimensionRight.Y));
6891 
6892   // Now the arc
6893   if ADoDraw then
6894     ALCLDest.Arc(
6895       CoordToCanvasX(BaseLeft.X - ArcRadius), CoordToCanvasY(BaseLeft.Y - ArcRadius),
6896       CoordToCanvasX(BaseLeft.X + ArcRadius), CoordToCanvasY(BaseLeft.Y + ArcRadius),
6897       CoordToCanvasX(DimensionRight.X), CoordToCanvasY(DimensionRight.Y),
6898       CoordToCanvasX(DimensionLeft.X),  CoordToCanvasY(DimensionLeft.Y));
6899 
6900   // Now the arrows
6901   SetLength(Points, 3);
6902   CalculateExtraArcInfo();
6903   ADest.Brush.FPColor := colYellow;//AdjustColorToBackground(colBlack, ARenderInfo);
6904   ADest.Brush.Style := bsSolid;
6905 
6906   // Left Arrow
6907   Points[0] := Point(CoordToCanvasX(ArcLeft.X), CoordToCanvasY(ArcLeft.Y));
6908   lTriangleCenter.X := Cos(AngleLeft+Pi/2) * -(ArcRadius/10) + ArcLeft.X;
6909   lTriangleCenter.Y := Sin(AngleLeft+Pi/2) * -(ArcRadius/10) + ArcLeft.Y;
6910   lTriangleCorner := Rotate3DPointInXY(lTriangleCenter, ArcLeft, Pi * 10 / 180);
6911   Points[1] := Point(CoordToCanvasX(lTriangleCorner.X), CoordToCanvasY(lTriangleCorner.Y));
6912   lTriangleCorner := Rotate3DPointInXY(lTriangleCenter, ArcLeft, - Pi * 10 / 180);
6913   Points[2] := Point(CoordToCanvasX(lTriangleCorner.X), CoordToCanvasY(lTriangleCorner.Y));
6914   if ADoDraw then
6915     ADest.Polygon(Points);
6916 
6917   // Right Arrow
6918   Points[0] := Point(CoordToCanvasX(ArcRight.X), CoordToCanvasY(ArcRight.Y));
6919   lTriangleCenter.X := Cos(AngleRight+Pi/2) * (ArcRadius/10) + ArcRight.X;
6920   lTriangleCenter.Y := Sin(AngleRight+Pi/2) * (ArcRadius/10) + ArcRight.Y;
6921   lTriangleCorner := Rotate3DPointInXY(lTriangleCenter, ArcRight, Pi * 10 / 180);
6922   Points[1] := Point(CoordToCanvasX(lTriangleCorner.X), CoordToCanvasY(lTriangleCorner.Y));
6923   lTriangleCorner := Rotate3DPointInXY(lTriangleCenter, ArcRight, - Pi * 10 / 180);
6924   Points[2] := Point(CoordToCanvasX(lTriangleCorner.X), CoordToCanvasY(lTriangleCorner.Y));
6925   ADest.Polygon(Points);
6926   if ADoDraw then
6927     ADest.Brush.Style := bsClear;
6928 
6929   // Dimension text
6930   Points[0].X := CoordToCanvasX(TextPos.X);
6931   Points[0].Y := CoordToCanvasY(TextPos.Y);
6932   ADest.Font.Size := 10;
6933   ADest.Font.Orientation := 0;
6934   ADest.Font.FPColor := colYellow;//AdjustColorToBackground(colBlack, ARenderInfo);
6935   txt := Format('%.1fº', [ArcValue]);
6936   if ADoDraw then
6937     ADest.TextOut(Points[0].X, Points[0].Y-Round(ADest.Font.Size*1.5), txt);
6938 end;
6939 
6940 procedure TvArcDimension.CalculateExtraArcInfo;
6941 begin
6942   // Line equation of the Left line
6943   AngleLeft := arctan(Abs(BaseLeft.Y-DimensionLeft.Y)/Abs(BaseLeft.X-DimensionLeft.X));
6944   if DimensionLeft.X<BaseLeft.X then AngleLeft := Pi-AngleLeft;
6945   al := Tan(AngleLeft);
6946   bl := BaseLeft.Y - al * BaseLeft.X;
6947 
6948   // Line equation of the Right line
6949   AngleRight := arctan(Abs(BaseRight.Y-DimensionRight.Y)/Abs(BaseRight.X-DimensionRight.X));
6950   if DimensionRight.X<BaseRight.X then AngleRight := Pi-AngleRight;
6951   ar := Tan(AngleRight);
6952   br := BaseRight.Y - ar * BaseRight.X;
6953 
6954   // The lines meet at the AngleBase
6955   AngleBase.X := (bl - br) / (ar - al);
6956   AngleBase.Y := al * AngleBase.X + bl;
6957 
6958   //  And also now the left and right points of the arc
6959   ArcLeft.X := Cos(AngleLeft) * ArcRadius + AngleBase.X;
6960   ArcLeft.Y := Sin(AngleLeft) * ArcRadius + AngleBase.Y;
6961   ArcRight.X := Cos(AngleRight) * ArcRadius + AngleBase.X;
6962   ArcRight.Y := Sin(AngleRight) * ArcRadius + AngleBase.Y;
6963 end;
6964 
GenerateDebugTreenull6965 function TvArcDimension.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
6966   APageItem: Pointer): Pointer;
6967 var
6968   lStr: string;
6969 begin
6970   Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
6971   // Add the font debug info in a sub-item
6972   lStr := Format('[TvArcDimension] ArcValue=%f ArcRadius=%f TextPos=%f %f BaseLeft=%f %f BaseRight=%f %f DimensionLeft=%f %f DimensionRight=%f %f',
6973     [ArcValue, ArcRadius,
6974      TextPos.X, TextPos.Y,
6975      BaseLeft.X, BaseLeft.Y,
6976      BaseRight.X, BaseRight.Y,
6977      DimensionLeft.X, DimensionLeft.Y,
6978      DimensionRight.X, DimensionRight.Y
6979     ]);
6980   ADestRoutine(lStr, Result);
6981 end;
6982 
6983 { TvRasterImage }
6984 
6985 destructor TvRasterImage.Destroy;
6986 begin
6987   if Assigned(RasterImage) then RasterImage.Free;
6988   inherited Destroy;
6989 end;
6990 
6991 procedure TvRasterImage.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
6992   out ALeft, ATop, ARight, ABottom: Double);
6993 begin
6994   ALeft := X;
6995   ATop := Y;
6996   ARight := X + Width;
6997   ABottom := Y + Height;
6998 end;
6999 
7000 procedure TvRasterImage.CreateRGB888Image(AWidth, AHeight: Cardinal);
7001 {$ifdef USE_LCL_CANVAS}
7002 var
7003   AImage: TLazIntfImage;
7004   lRawImage: TRawImage;
7005 {$endif}
7006 begin
7007 {$ifdef USE_LCL_CANVAS}
7008   lRawImage.Init;
7009   lRawImage.Description.Init_BPP24_R8G8B8_BIO_TTB(AWidth, AHeight);
7010   lRawImage.CreateData(True);
7011   AImage := TLazIntfImage.Create(AWidth, AHeight);
7012   AImage.SetRawImage(lRawImage);
7013 
7014   RasterImage := AImage;
7015 {$endif}
7016 end;
7017 
7018 procedure TvRasterImage.CreateImageFromFile(AFilename: string);
7019 {$ifdef USE_LCL_CANVAS}
7020 var
7021   AImage: TLazIntfImage;
7022   lRawImage: TRawImage;
7023 {$endif}
7024 begin
7025 {$ifdef USE_LCL_CANVAS}
7026   lRawImage.Init;
7027   lRawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(0,0);
7028   lRawImage.CreateData(false);
7029   AImage := TLazIntfImage.Create(0,0);
7030   AImage.SetRawImage(lRawImage);
7031   AImage.LoadFromFile(AFilename);
7032 
7033   RasterImage := AImage;
7034 {$endif}
7035 end;
7036 
7037 procedure TvRasterImage.CreateImageFromStream(AStream: TStream; Handler:TFPCustomImageReader);
7038 {$ifdef USE_LCL_CANVAS}
7039 var
7040   AImage: TLazIntfImage;
7041   lRawImage: TRawImage;
7042 {$endif}
7043 begin
7044 {$ifdef USE_LCL_CANVAS}
7045   lRawImage.Init;
7046   lRawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(0,0);
7047   lRawImage.CreateData(false);
7048   AImage := TLazIntfImage.Create(0,0);
7049   AImage.SetRawImage(lRawImage);
7050   AImage.LoadFromStream(AStream, Handler);
7051 
7052   RasterImage := AImage;
7053 {$endif}
7054 end;
7055 
7056 procedure TvRasterImage.InitializeWithConvertionOf3DPointsToHeightMap(APage: TvVectorialPage; AWidth, AHeight: Integer);
7057 var
7058   lEntity: TvEntity;
7059   i: Integer;
7060   lPos: TPoint;
7061   lValue: TFPColor;
7062   PreviousValue: Word;
7063   PreviousCount: Integer;
7064 begin
7065   lValue := colBlack;
7066 
7067   // First setup the map and initialize it
7068   if RasterImage <> nil then RasterImage.Free;
7069   RasterImage := TFPMemoryImage.create(AWidth, AHeight);
7070 
7071   // Now go through all points and attempt to fit them to our grid
7072   for i := 0 to APage.GetEntitiesCount - 1 do
7073   begin
7074     lEntity := APage.GetEntity(i);
7075     if lEntity is TvPoint then
7076     begin
7077       lPos.X := Round((lEntity.X - APage.MinX) * AWidth / (APage.MaxX - APage.MinX));
7078       lPos.Y := Round((lEntity.Y - APage.MinY) * AHeight / (APage.MaxY - APage.MinY));
7079 
7080       if lPos.X >= AWidth then lPos.X := AWidth-1;
7081       if lPos.Y >= AHeight then lPos.Y := AHeight-1;
7082       if lPos.X < 0 then lPos.X := 0;
7083       if lPos.Y < 0 then lPos.Y := 0;
7084 
7085       // Calculate the height of this point
7086       PreviousValue := lValue.Red;
7087       lValue.Red := Round((lEntity.Z - APage.MinZ) * $FFFF / (APage.MaxZ - APage.MinZ));
7088 
7089       // And apply it as a fraction of the total number of points which fall in this square
7090       // we store the number of points in the Alpha channel
7091       PreviousCount := lValue.Alpha div $100;
7092       lValue.Red := Round((PreviousCount * PreviousValue + lValue.Red) / (PreviousCount + 1));
7093 
7094       lValue.Green := lValue.Red;
7095       lValue.Blue := lValue.Red;
7096       lValue.Alpha := lValue.Alpha + $100;
7097       //lValue.alpha:=;
7098       RasterImage.Colors[lPos.X, lPos.Y] := lValue;
7099     end;
7100   end;
7101 end;
7102 
7103 procedure TvRasterImage.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
7104 var
7105   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
7106   ADestX: Integer absolute ARenderInfo.DestX;
7107   ADestY: Integer absolute ARenderInfo.DestY;
7108   AMulX: Double absolute ARenderInfo.MulX;
7109   AMulY: Double absolute ARenderInfo.MulY;
7110 
7111   function CoordToCanvasX(ACoord: Double): Integer;
7112   begin
7113     Result := Round(ADestX + AmulX * ACoord);
7114   end;
7115 
7116   function CoordToCanvasY(ACoord: Double): Integer;
7117   begin
7118     Result := Round(ADestY + AmulY * ACoord);
7119   end;
7120 
7121 var
7122   lFinalX, lFinalY, lFinalW, lFinalH: Integer;
7123   {$ifdef USE_LCL_CANVAS}
7124   lBitmap: TBitmap;
7125   lMemoryStream: TMemoryStream;
7126   lImageWriter: TFPWriterBMP;
7127   {$endif}
7128 begin
7129   if (RasterImage = nil) then Exit;
7130   if (RasterImage.Width = 0) or (RasterImage.Height = 0) then Exit;
7131 
7132   lFinalX := CoordToCanvasX(X);
7133   lFinalY := CoordToCanvasY(Y);
7134 
7135   {$ifdef USE_LCL_CANVAS}
7136   lBitmap := TBitmap.Create;
7137   lMemoryStream := TMemoryStream.Create;
7138   lImageWriter := TFPWriterBMP.Create;
7139   try
7140     // Previous try, but didn't work for some particular PNG images =(
7141     // For example: qr_www_lazarus_freepascal_org.svg
7142     // The image appeared corrupted in Qt, as if with wrong pixel format =(
7143     // It also didn't work in Gtk at all due to not matching Gdk format =(
7144     // But if it worked it would have been faster =)
7145     // Old code:
7146     // lBitmap.LoadFromIntfImage(TLazIntfImage(RasterImage));
7147     // New code:
7148     RasterImage.SaveToStream(lMemoryStream, lImageWriter);
7149     lMemoryStream.Position := 0;
7150     lBitmap.LoadFromStream(lMemoryStream);
7151 
7152     // without stretch support
7153     //TCanvas(ADest).Draw(lFinalX, lFinalY, lBitmap);
7154 
7155     // with stretch support
7156     lFinalW := Round(Width * AMulX);
7157     if lFinalW < 0 then lFinalW := lFinalW * -1;
7158     lFinalH := Round(Height * AMulY);
7159     if lFinalH < 0 then lFinalH := lFinalH * -1;
7160     if ADoDraw then
7161       TCanvas(ADest).StretchDraw(Bounds(lFinalX, lFinalY, lFinalW, lFinalH), lBitmap);
7162   finally
7163     lImageWriter.Free;
7164     lMemoryStream.Free;
7165     lBitmap.Free;
7166   end;
7167   {$endif}
7168 
7169   CalcEntityCanvasMinMaxXY(ARenderInfo, lFinalX, lFinalY);
7170   CalcEntityCanvasMinMaxXY(ARenderInfo, lFinalX+lFinalW, lFinalY+lFinalH);
7171 
7172   //ADest.Draw(lFinalX, lFinalY, RasterImage); doesnt work
7173 end;
7174 
GenerateDebugTreenull7175 function TvRasterImage.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
7176   APageItem: Pointer): Pointer;
7177 var
7178   lStr: string;
7179 begin
7180   Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
7181   // Add the debug info in a sub-item
7182   if RasterImage <> nil then
7183   begin
7184     lStr := Format('[TvRasterImage] Width=%f Height=%f RasterImage.Width=%d RasterImage.Height=%d AltText=%s',
7185       [Width, Height, RasterImage.Width, RasterImage.Height, AltText]);
7186     ADestRoutine(lStr, Result);
7187   end;
7188 end;
7189 
7190 { TvArrow }
7191 
7192 procedure TvArrow.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out
7193   ALeft, ATop, ARight, ABottom: Double);
7194 begin
7195 
7196 end;
7197 
7198 procedure TvArrow.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
7199 var
7200   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
7201   ADestX: Integer absolute ARenderInfo.DestX;
7202   ADestY: Integer absolute ARenderInfo.DestY;
7203   AMulX: Double absolute ARenderInfo.MulX;
7204   AMulY: Double absolute ARenderInfo.MulY;
7205 
7206   function CoordToCanvasX(ACoord: Double): Integer;
7207   begin
7208     Result := Round(ADestX + AmulX * ACoord);
7209   end;
7210 
7211   function CoordToCanvasY(ACoord: Double): Integer;
7212   begin
7213     Result := Round(ADestY + AmulY * ACoord);
7214   end;
7215 
7216 var
7217   lArrow, lBase, lExtraBase: TPoint;
7218   lPointD, lPointE, lPointF: T3DPoint;
7219   lPoints: array[0..2] of TPoint;
7220   AlfaAngle: Double;
7221 begin
7222   ApplyPenToCanvas(ARenderInfo);
7223   ApplyBrushToCanvas(ARenderInfo);
7224 
7225   lArrow.X := CoordToCanvasX(X);
7226   lArrow.Y := CoordToCanvasY(Y);
7227   lBase.X := CoordToCanvasX(Base.X);
7228   lBase.Y := CoordToCanvasY(Base.Y);
7229   lExtraBase.X := CoordToCanvasX(ExtraLineBase.X);
7230   lExtraBase.Y := CoordToCanvasY(ExtraLineBase.Y);
7231 
7232   // Start with the lines
7233 
7234   ADest.Line(lArrow, lBase);
7235 
7236   if HasExtraLine then
7237     ADest.Line(lBase, lExtraBase);
7238 
7239   // Now draw the arrow head
7240   lPoints[0].X := CoordToCanvasX(X);
7241   lPoints[0].Y := CoordToCanvasY(Y);
7242   //
7243   // Here a lot of trigonometry comes to play, it is hard to explain in text, but in essence
7244   //
7245   // A line L is formed by the points A (Arrow head) and B (Base)
7246   // Our smaller triangle starts at a point D in this line which has length ArrowLength counting from A
7247   // This forms a rectangle triangle with a line paralel to the X axis
7248   // Alfa is the angle between A and the line parallel to the X axis
7249   //
7250   // This brings this equations:
7251   // AlfaAngle := arctg((B.Y - A.Y) / (B.X - A.X));
7252   // Sin(Alfa) := (D.Y - A.Y) / ArrowLength
7253   // Cos(Alfa) := (D.X - A.X) / ArrowLength
7254   //
7255   // Then at this point D we start a line perpendicular to the line L
7256   // And with this line we progress a length of ArrowBaseLength/2
7257   // This line, the D point and a line parallel to the Y axis for another
7258   // rectangle triangle with the same Alfa angle at the point D
7259   // The point at the end of the hipotenuse of this triangle is our point E
7260   // So we have more equations:
7261   //
7262   // Sin(Alfa) := (E.x - D.X) / (ArrowBaseLength/2)
7263   // Cos(Alfa) := (E.Y - D.Y) / (ArrowBaseLength/2)
7264   //
7265   // And the same in the opposite direction for our point F:
7266   //
7267   // Sin(Alfa) := (D.X - F.X) / (ArrowBaseLength/2)
7268   // Cos(Alfa) := (D.Y - F.Y) / (ArrowBaseLength/2)
7269   //
7270   if (Base.X - X) = 0 then
7271     AlfaAngle := 0
7272   else
7273     AlfaAngle := ArcTan((Base.Y - Y) / (Base.X - X));
7274   lPointD.Y := Sin(AlfaAngle) * ArrowLength + Y;
7275   lPointD.X := Cos(AlfaAngle) * ArrowLength + X;
7276   lPointE.X := Sin(AlfaAngle) * (ArrowBaseLength/2) + lPointD.X;
7277   lPointE.Y := Cos(AlfaAngle) * (ArrowBaseLength/2) + lPointD.Y;
7278   lPointF.X := - Sin(AlfaAngle) * (ArrowBaseLength/2) + lPointD.X;
7279   lPointF.Y := - Cos(AlfaAngle) * (ArrowBaseLength/2) + lPointD.Y;
7280   lPoints[1].X := CoordToCanvasX(lPointE.X);
7281   lPoints[1].Y := CoordToCanvasY(lPointE.Y);
7282   lPoints[2].X := CoordToCanvasX(lPointF.X);
7283   lPoints[2].Y := CoordToCanvasY(lPointF.Y);
7284   if ADoDraw then ADest.Polygon(lPoints);
7285 end;
7286 
7287 { TvFormulaElement }
7288 
CalculateHeightnull7289 function TvFormulaElement.CalculateHeight(ADest: TFPCustomCanvas): Double;
7290 var
7291   lLineHeight: Integer;
7292 begin
7293   if ADest <> nil then
7294     lLineHeight := TCanvas(ADest).TextHeight(STR_FPVECTORIAL_TEXT_HEIGHT_SAMPLE) + 2
7295   else
7296     lLineHeight := 15;
7297 
7298   case Kind of
7299     //fekVariable,  // Text is the text of the variable
7300     //fekEqual,     // = symbol
7301     //fekSubtraction, // - symbol
7302     //fekMultiplication, // either a point . or a small x
7303     //fekSum,       // + symbol
7304     //fekPlusMinus, // The +/- symbol
7305     fekHorizontalLine: Result := 5;
7306     fekFraction:
7307     begin
7308       Formula.CalculateHeight(ADest);
7309       AdjacentFormula.CalculateHeight(ADest);
7310       Result := Formula.Height + AdjacentFormula.Height * 1.2;
7311     end;
7312     fekRoot: Result := Formula.CalculateHeight(ADest) * 1.2;
7313     fekPower: Result := lLineHeight * 1.2;
7314     fekSummation: Result := lLineHeight * 1.5;
7315     fekFormula: Result := Formula.CalculateHeight(ADest);
7316   else
7317     Result := lLineHeight;
7318   end;
7319 
7320   Height := Result;
7321 end;
7322 
CalculateWidthnull7323 function TvFormulaElement.CalculateWidth(ADest: TFPCustomCanvas): Double;
7324 var
7325   lText: String;
7326 begin
7327   Result := 0;
7328 
7329   lText := AsText;
7330   if lText <> '' then
7331   begin
7332     if ADest = nil then Result := 10 * UTF8Length(lText)
7333     else Result := TCanvas(ADest).TextWidth(lText);
7334   end;
7335 
7336   case Kind of
7337     fekMultiplication: Result := 0;
7338     fekHorizontalLine: Result := 25;
7339     //
7340     fekFraction:
7341     begin
7342       Formula.CalculateWidth(ADest);
7343       AdjacentFormula.CalculateWidth(ADest);
7344       Result := Max(Formula.Width, AdjacentFormula.Width);
7345     end;
7346     fekRoot: Result := Formula.CalculateWidth(ADest) + 10;
7347     fekPower, fekSubscript:
7348     begin
7349       Result := Formula.CalculateWidth(ADest) +
7350         AdjacentFormula.CalculateWidth(ADest) / 2;
7351     end;
7352     fekSummation: Result := 8;
7353     fekFormula: Result := Formula.CalculateWidth(ADest);
7354   else
7355   end;
7356 
7357   Width := Result;
7358 end;
7359 
AsTextnull7360 function TvFormulaElement.AsText: string;
7361 begin
7362   case Kind of
7363     fekVariable:  Result := Text;
7364     fekEqual:     Result := '=';
7365     fekSubtraction: Result := '-';
7366     fekMultiplication: Result := 'x';
7367     fekSum:       Result := '+';
7368     fekPlusMinus: Result := '+/-';
7369     fekLessThan:  Result := '<';
7370     fekLessOrEqualThan: Result := '<=';
7371     fekGreaterThan: Result := '>';
7372     fekGreaterOrEqualThan: Result := '>=';
7373     fekHorizontalLine: Result := '=';
7374   // More complex elements
7375   else
7376     Result := Format('[%s]', [GetEnumName(TypeInfo(TvFormulaElementKind), integer(Kind))]);
7377   end;
7378 end;
7379 
7380 procedure TvFormulaElement.PositionSubparts(constref ARenderInfo: TvRenderInfo;
7381   ABaseX, ABaseY: Double);
7382 var
7383   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
7384   //
7385   lCentralizeFactor: Double = 0;
7386   lCentralizeFactorAdj: Double = 0;
7387 begin
7388   case Self.Kind of
7389     fekFraction:
7390     begin
7391       // Check which fraction is the largest and centralize the other one
7392       Self.Formula.CalculateWidth(ADest);
7393       Self.AdjacentFormula.CalculateWidth(ADest);
7394       if Self.Formula.Width > Self.AdjacentFormula.Width then
7395       begin
7396         lCentralizeFactor := 0;
7397         lCentralizeFactorAdj := Self.Formula.Width / 2 - Self.AdjacentFormula.Width / 2;
7398       end
7399       else
7400       begin
7401         lCentralizeFactor := Self.AdjacentFormula.Width / 2 - Self.Formula.Width / 2;
7402         lCentralizeFactorAdj := 0;
7403       end;
7404 
7405       Self.Formula.PositionSubparts(ARenderInfo, Self.Left + lCentralizeFactor, Self.Top);
7406       Self.AdjacentFormula.PositionSubparts(ARenderInfo, Self.Left + lCentralizeFactorAdj, Self.Top - Self.Formula.Height - 3);
7407     end;
7408     fekRoot:
7409     begin
7410       // Give a factor for the root drawing
7411       Self.Formula.PositionSubparts(ARenderInfo, Self.Left + 10, Self.Top);
7412     end;
7413     fekPower:
7414     begin
7415       Self.Formula.PositionSubparts(ARenderInfo, Self.Left, Self.Top);
7416       Self.AdjacentFormula.PositionSubparts(ARenderInfo, Self.Left + Self.Formula.Width, Self.Top);
7417     end;
7418     fekSubscript:
7419     begin
7420       Self.Formula.PositionSubparts(ARenderInfo, Self.Left, Self.Top);
7421       Self.AdjacentFormula.PositionSubparts(ARenderInfo, Self.Left + Self.Formula.Width, Self.Top - Self.Formula.Height / 2);
7422     end;
7423     fekSummation:
7424     begin
7425       // main/bottom formula
7426       Self.Formula.PositionSubparts(ARenderInfo, Self.Left, Self.Top - 30);
7427       // top formula
7428       Self.AdjacentFormula.PositionSubparts(ARenderInfo, Self.Left, Self.Top);
7429     end;
7430     fekFormula:
7431     begin
7432       Self.Formula.PositionSubparts(ARenderInfo, Self.Left, Self.Top);
7433     end;
7434   end;
7435 end;
7436 
7437 procedure TvFormulaElement.Render(var ARenderInfo: TvRenderInfo;
7438   ADoDraw: Boolean);
7439 var
7440   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
7441   ADestX: Integer absolute ARenderInfo.DestX;
7442   ADestY: Integer absolute ARenderInfo.DestY;
7443   AMulX: Double absolute ARenderInfo.MulX;
7444   AMulY: Double absolute ARenderInfo.MulY;
7445 
7446   function CoordToCanvasX(ACoord: Double): Integer;
7447   begin
7448     Result := Round(ADestX + AmulX * ACoord);
7449   end;
7450 
7451   function CoordToCanvasY(ACoord: Double): Integer;
7452   begin
7453     Result := Round(ADestY + AmulY * ACoord);
7454   end;
7455 
7456 var
7457   LeftC, TopC: Integer;
7458   lPt: array[0..3] of TPoint;
7459   lOldFontSize: Integer;
7460   lStr: string;
7461 begin
7462   LeftC := CoordToCanvasX(Left);
7463   TopC := CoordToCanvasY(Top);
7464 
7465   if ADoDraw then
7466     case Kind of
7467       fekVariable: ADest.TextOut(LeftC, TopC, Text);
7468       fekEqual:    ADest.TextOut(LeftC, TopC, '=');
7469       fekSubtraction: ADest.TextOut(LeftC, TopC, '-');
7470       fekMultiplication:
7471       begin
7472         // Don't draw anything, leave an empty space, it looks better
7473         //ADest.TextOut(LeftC, TopC, 'x'); // × -> Unicode times symbol
7474       end;
7475       fekSum:      ADest.TextOut(LeftC, TopC, '+');
7476       fekPlusMinus:ADest.TextOut(LeftC, TopC, '±');
7477       fekLessThan: ADest.TextOut(LeftC, TopC, '<');
7478       fekLessOrEqualThan: ADest.TextOut(LeftC, TopC, '≤');
7479       fekGreaterThan: ADest.TextOut(LeftC, TopC, '>');
7480       fekGreaterOrEqualThan: ADest.TextOut(LeftC, TopC, '≥');
7481       fekHorizontalLine: ADest.Line(LeftC, TopC, CoordToCanvasX(Left+Width), TopC);
7482       // Complex ones
7483       fekFraction:
7484       begin
7485         Formula.Render(ARenderInfo, ADoDraw);
7486         AdjacentFormula.Render(ARenderInfo, ADoDraw);
7487 
7488         // Division line
7489         lPt[0].X := CoordToCanvasX(Formula.Left);
7490         lPt[1].X := CoordToCanvasX(Formula.Left + Formula.Width);
7491         lPt[0].Y := CoordToCanvasY(Formula.Top - Formula.Height);
7492         lPt[1].Y := CoordToCanvasY(Formula.Top - Formula.Height);
7493         ADest.Line(lPt[0].X, lPt[0].Y, lPt[1].X, lPt[1].Y);
7494       end;
7495       fekRoot:
7496       begin
7497         Formula.Render(ARenderInfo, ADoDraw);
7498 
7499         // Root drawing
7500         lPt[0].X := CoordToCanvasX(Left);
7501         lPt[0].Y := CoordToCanvasY(Top - Formula.Height * 0.7 + 5);
7502         // diagonal down
7503         lPt[1].X := CoordToCanvasX(Left + 5);
7504         lPt[1].Y := CoordToCanvasY(Top - Formula.Height * 0.7);
7505         // up
7506         lPt[2].X := CoordToCanvasX(Left + 5);
7507         lPt[2].Y := CoordToCanvasY(Top);
7508         // straight right
7509         lPt[3].X := CoordToCanvasX(Left + Formula.Width);
7510         lPt[3].Y := CoordToCanvasY(Top);
7511         //
7512         ADest.Polyline(lPt);
7513       end;
7514       fekPower:
7515       begin
7516         Formula.Render(ARenderInfo, ADoDraw);
7517         // The superscripted power
7518         lOldFontSize := ADest.Font.Size;
7519         if lOldFontSize = 0 then ADest.Font.Size := 5
7520         else ADest.Font.Size := lOldFontSize div 2;
7521         AdjacentFormula.Render(ARenderInfo, ADoDraw);
7522         ADest.Font.Size := lOldFontSize;
7523       end;
7524       fekSubscript:
7525       begin
7526         Formula.Render(ARenderInfo, ADoDraw);
7527         // The subscripted item
7528         lOldFontSize := ADest.Font.Size;
7529         if lOldFontSize = 0 then ADest.Font.Size := 5
7530         else ADest.Font.Size := lOldFontSize div 2;
7531         AdjacentFormula.Render(ARenderInfo, ADoDraw);
7532         ADest.Font.Size := lOldFontSize;
7533       end;
7534       fekSummation:
7535       begin
7536         // Draw the summation symbol
7537         lOldFontSize := ADest.Font.Size;
7538         ADest.Font.Size := 15;
7539         lStr := #$E2#$88#$91; // Unicode Character 'N-ARY SUMMATION' (U+2211)
7540         ADest.TextOut(LeftC, TopC, lStr);
7541         ADest.Font.Size := lOldFontSize;
7542 
7543         // Draw the bottom/main formula
7544         Formula.Render(ARenderInfo, ADoDraw);
7545 
7546         // Draw the top formula
7547         AdjacentFormula.Render(ARenderInfo, ADoDraw);
7548       end;
7549       fekFormula:
7550       begin
7551         // Draw the formula
7552         Formula.Render(ARenderInfo, ADoDraw);
7553       end;
7554     end;
7555 end;
7556 
7557 procedure TvFormulaElement.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
7558   APageItem: Pointer);
7559 var
7560   lDBGItem, lDBGFormula, lDBGFormulaBottom: Pointer;
7561   lStr: string;
7562 begin
7563   lStr := Format('%s [%s]', [Self.AsText(), GetEnumName(TypeInfo(TvFormulaElementKind), integer(Kind))]);
7564   lStr := lStr + Format(' Left=%f Top=%f Width=%f Height=%f', [Left, Top, Width, Height]);
7565   lDBGItem := ADestRoutine(lStr, APageItem);
7566 
7567   case Kind of
7568     fekFraction, fekPower, fekSubscript, fekSummation:
7569     begin
7570       lDBGFormula := ADestRoutine('Main Formula', lDBGItem);
7571       Formula.GenerateDebugTree(ADestRoutine, lDBGFormula);
7572       if Kind in [fekPower, fekSummation] then
7573         lDBGFormulaBottom := ADestRoutine('Top Formula', lDBGItem)
7574       else
7575         lDBGFormulaBottom := ADestRoutine('Bottom Formula', lDBGItem);
7576       AdjacentFormula.GenerateDebugTree(ADestRoutine, lDBGFormulaBottom);
7577     end;
7578     fekRoot: Formula.GenerateDebugTree(ADestRoutine, lDBGItem);
7579     //fekSomatory: Result := 1.5;
7580     fekFormula: Formula.GenerateDebugTree(ADestRoutine, lDBGItem);
7581   end;
7582 end;
7583 
7584 // http://en.wikipedia.org/wiki/Shunting-yard_algorithm
TvFormulaElement.GetPrecedenceFromKindnull7585 class function TvFormulaElement.GetPrecedenceFromKind(
7586   AKind: TvFormulaElementKind): Byte;
7587 begin
7588   Result := 0;
7589   case AKind of
7590   fekSubtraction, fekSum: Result := 2;
7591   fekMultiplication, fekFraction: Result := 3;
7592   //fekRoot,   // A root. For example sqrt(something). Number gives the root, usually 2, and inside it goes a Formula
7593   fekPower: Result := 4;
7594   end;
7595 end;
7596 
7597 // See http://en.wikipedia.org/wiki/Shunting-yard_algorithm
TvFormulaElement.IsLeftAssociativeFromKindnull7598 class function TvFormulaElement.IsLeftAssociativeFromKind(
7599   AKind: TvFormulaElementKind): Boolean;
7600 begin
7601   Result := True;
7602   case AKind of
7603   fekPower: Result := False;
7604   end;
7605 end;
7606 
7607 { TvFormula }
7608 
7609 procedure TvFormula.CallbackDeleteElement(data, arg: pointer);
7610 begin
7611   TvFormulaElement(data).Free;
7612 end;
7613 
7614 constructor TvFormula.Create(APage: TvPage);
7615 begin
7616   inherited Create(APage);
7617   FElements := TFPList.Create;
7618   SpacingBetweenElementsX := 5;
7619   SpacingBetweenElementsY := 1; // elements already give a fair amount of vertical spacing in their own area
7620 end;
7621 
7622 destructor TvFormula.Destroy;
7623 begin
7624   FElements.Free;
7625   inherited Destroy;
7626 end;
7627 
GetFirstElementnull7628 function TvFormula.GetFirstElement: TvFormulaElement;
7629 begin
7630   if FElements.Count = 0 then Exit(nil);
7631   Result := TvFormulaElement(FElements.Items[0]);
7632   FCurIndex := 1;
7633 end;
7634 
GetNextElementnull7635 function TvFormula.GetNextElement: TvFormulaElement;
7636 begin
7637   if FElements.Count <= FCurIndex then Exit(nil);
7638   Result := TvFormulaElement(FElements.Items[FCurIndex]);
7639   Inc(FCurIndex);
7640 end;
7641 
7642 procedure TvFormula.AddElement(AElement: TvFormulaElement);
7643 begin
7644   FElements.Add(AElement);
7645 end;
7646 
AddElementWithKindnull7647 function TvFormula.AddElementWithKind(AKind: TvFormulaElementKind): TvFormulaElement;
7648 begin
7649   Result := AddElementWithKindAndText(AKind, '');
7650 end;
7651 
AddElementWithKindAndTextnull7652 function TvFormula.AddElementWithKindAndText(AKind: TvFormulaElementKind;
7653   AText: string): TvFormulaElement;
7654 begin
7655   Result := TvFormulaElement.Create;
7656   Result.Kind := AKind;
7657   Result.Text := AText;
7658   AddElement(Result);
7659 
7660   case AKind of
7661     fekFraction, fekPower, fekSubscript, fekSummation:
7662     begin
7663       Result.Formula := TvFormula.Create(FPage);
7664       Result.AdjacentFormula := TvFormula.Create(FPage);
7665     end;
7666     fekRoot:
7667     begin
7668       Result.Formula := TvFormula.Create(FPage);
7669     end;
7670   end;
7671 end;
7672 
7673 // Based on:
7674 // http://en.wikipedia.org/wiki/Shunting-yard_algorithm
7675 procedure TvFormula.AddItemsByConvertingInfixToRPN(AInfix: TFPList);
7676 var
7677   OperatorStack: TObjectStack;
7678   i: Integer;
7679   CurItem: TvFormulaElement;
7680 
7681   procedure PopFromStackIntoList(APopTopOperators: Boolean; APopUntilParenteses: Boolean);
7682   var
7683     lElement: TvFormulaElement;
7684     lAllowContinue: Boolean;
7685   begin
7686     while OperatorStack.Count > 0 do
7687     begin
7688       lElement := OperatorStack.Pop() as TvFormulaElement;
7689 
7690       // while there is an operator token, o2, at the top of the stack, and
7691       // either o1 is left-associative and its precedence is equal to that of o2,
7692       // or o1 has precedence less than that of o2,
7693       if APopTopOperators then
7694       begin
7695         if not (lElement.Kind in FormulaOperators) then Exit;
7696 
7697         lAllowContinue := TvFormulaElement.IsLeftAssociativeFromKind(lElement.Kind)
7698          and (TvFormulaElement.GetPrecedenceFromKind(lElement.Kind) =
7699               TvFormulaElement.GetPrecedenceFromKind(CurItem.Kind));
7700         lAllowContinue := lAllowContinue or
7701           (TvFormulaElement.GetPrecedenceFromKind(lElement.Kind) >
7702           TvFormulaElement.GetPrecedenceFromKind(CurItem.Kind));
7703         if not lAllowContinue then Exit;
7704       end;
7705 
7706       if APopUntilParenteses and (lElement.Kind = fekParentesesOpen) then Exit;
7707 
7708       FElements.Add(lElement);
7709     end;
7710   end;
7711 
7712 begin
7713   Clear();
7714 
7715   OperatorStack := TObjectStack.Create;
7716   try
7717     for i := 0 to AInfix.Count-1 do
7718     begin
7719       CurItem := TvFormulaElement(AInfix.Items[i]);
7720       case CurItem.Kind of
7721       fekVariable:
7722       begin
7723         FElements.Add(CurItem);
7724       end;
7725       fekSubtraction, fekMultiplication, fekSum, fekFraction:
7726       begin
7727         PopFromStackIntoList(True, False);
7728         OperatorStack.Push(CurItem);
7729       end;
7730       fekParentesesOpen:
7731       begin
7732         OperatorStack.Push(CurItem);
7733       end;
7734       freParentesesClose:
7735       begin
7736         PopFromStackIntoList(False, True);
7737       end;
7738       end;
7739     end;
7740 
7741     PopFromStackIntoList(True, False);
7742   finally
7743     OperatorStack.Free;
7744   end;
7745 end;
7746 
7747 procedure TvFormula.AddItemsByConvertingInfixStringToRPN(AStr: string);
7748 var
7749   lInfix: TFPList;
7750 begin
7751   lInfix := TFPList.Create;
7752   try
7753     TokenizeInfixString(AStr, lInfix);
7754     AddItemsByConvertingInfixToRPN(lInfix);
7755   finally
7756     lInfix.Free;
7757   end;
7758 end;
7759 
7760 procedure TvFormula.TokenizeInfixString(AStr: string; AOutput: TFPList);
7761 const
7762   Str_Space: Char = ' ';
7763 
7764   procedure AddToken(AStr: string);
7765   var
7766     lToken: TvFormulaElement;
7767     lStr: string;
7768     FPointSeparator: TFormatSettings;
7769   begin
7770     FPointSeparator := DefaultFormatSettings;
7771     FPointSeparator.DecimalSeparator := '.';
7772     FPointSeparator.ThousandSeparator := '#';// disable the thousand separator
7773 
7774     lStr := Trim(AStr);
7775     if lStr = '' then Exit;
7776 
7777     lToken := TvFormulaElement.Create;
7778 
7779     // Moves
7780     case lStr[1] of
7781     '*': lToken.Kind := fekMultiplication;
7782     '/': lToken.Kind := fekFraction;
7783     '+': lToken.Kind := fekSum;
7784     '-': lToken.Kind := fekSubtraction;
7785     '(': lToken.Kind := fekParentesesOpen;
7786     ')': lToken.Kind := freParentesesClose;
7787     else
7788       lToken.Kind := fekVariable;
7789       lToken.Number := StrToFloat(AStr, FPointSeparator);
7790     end;
7791 
7792     AOutput.Add(lToken);
7793   end;
7794 
7795 var
7796   i: Integer;
7797   lTmpStr: string = '';
7798   lState: Integer;
7799   lCurChar: Char;
7800 begin
7801   lState := 0;
7802 
7803   i := 1;
7804   while i <= Length(AStr) do
7805   begin
7806     case lState of
7807     0: // Adding to the tmp string
7808     begin
7809       lCurChar := AStr[i];
7810       if lCurChar = Str_Space then
7811       begin
7812         //lState := 1;
7813         AddToken(lTmpStr);
7814         lTmpStr := '';
7815       end
7816       else if lCurChar in ['/', '*', '+', '-', '(', ')'] then
7817       begin
7818         if lTmpStr <> '' then AddToken(lTmpStr);
7819         lTmpStr := '';
7820         lState := 0;
7821         AddToken(lCurChar);
7822       end
7823       else
7824       begin
7825         lTmpStr := lTmpStr + lCurChar;
7826       end;
7827     end;
7828     end;
7829 
7830     Inc(i);
7831   end;
7832 
7833   // If there is a token still to be added, add it now
7834   if (lState = 0) and (lTmpStr <> '') then AddToken(lTmpStr);
7835 end;
7836 
7837 // The formula must be in RPN for this to work
TvFormula.CalculateRPNFormulaValuenull7838 function TvFormula.CalculateRPNFormulaValue: Double;
7839 var
7840   lOperand_A, lOperand_B, CurElement: TvFormulaElement;
7841   i: Integer;
7842 begin
7843   lOperand_A := nil;
7844   lOperand_B := nil;
7845   Result := 0;
7846   for i := 0 to FElements.Count-1 do
7847   begin
7848     CurElement := TvFormulaElement(FElements.Items[i]);
7849     case CurElement.Kind of
7850     fekVariable:
7851     begin
7852       if lOperand_A = nil then lOperand_A := CurElement
7853       else lOperand_B := CurElement;
7854     end;
7855     fekSubtraction:
7856     begin
7857       lOperand_A.Number := lOperand_A.Number - lOperand_B.Number;
7858       lOperand_B := nil;
7859     end;
7860     fekMultiplication:
7861     begin
7862       lOperand_A.Number := lOperand_A.Number * lOperand_B.Number;
7863       lOperand_B := nil;
7864     end;
7865     fekSum:
7866     begin
7867       lOperand_A.Number := lOperand_A.Number + lOperand_B.Number;
7868       lOperand_B := nil;
7869     end;
7870     fekFraction:
7871     begin
7872       lOperand_A.Number := lOperand_A.Number / lOperand_B.Number;
7873       lOperand_B := nil;
7874     end;
7875     end;
7876   end;
7877 
7878   Result := lOperand_A.Number;
7879 end;
7880 
7881 procedure TvFormula.Clear;
7882 begin
7883   inherited Clear;
7884   FElements.ForEachCall(@CallbackDeleteElement, nil);
7885   FElements.Clear;
7886 end;
7887 
CalculateHeightnull7888 function TvFormula.CalculateHeight(ADest: TFPCustomCanvas): Double;
7889 var
7890   lElement: TvFormulaElement;
7891 begin
7892   if ADest <> nil then
7893     Result := TCanvas(ADest).TextHeight(STR_FPVECTORIAL_TEXT_HEIGHT_SAMPLE) + 2
7894   else
7895     Result := 15;
7896 
7897   lElement := GetFirstElement();
7898   while lElement <> nil do
7899   begin
7900     Result := Max(Result, lElement.CalculateHeight(ADest));
7901     lElement := GetNextElement;
7902   end;
7903 
7904   // Cache the result
7905   Height := Result;
7906 end;
7907 
CalculateWidthnull7908 function TvFormula.CalculateWidth(ADest: TFPCustomCanvas): Double;
7909 var
7910   lElement: TvFormulaElement;
7911 begin
7912   Result := 0;
7913   lElement := GetFirstElement();
7914   while lElement <> nil do
7915   begin
7916     if lElement.Kind <> fekMultiplication then
7917       Result := Result + lElement.CalculateWidth(ADest) + SpacingBetweenElementsX;
7918     lElement := GetNextElement;
7919   end;
7920   // Remove an extra spacing, since it is added even to the last item
7921   Result := Result - SpacingBetweenElementsX;
7922   // Cache the result
7923   Width := Result;
7924 end;
7925 
7926 procedure TvFormula.PositionSubparts(constref ARenderInfo: TvRenderInfo;
7927   ABaseX, ABaseY: Double);
7928 var
7929   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
7930   //
7931   lElement: TvFormulaElement;
7932   lPosX: Double = 0;
7933   lMaxHeight: Double = 0;
7934 begin
7935   CalculateHeight(ADest);
7936   CalculateWidth(ADest);
7937   Left := ABaseX;
7938   Top := ABaseY;
7939 
7940   // Then calculate the position of each element
7941   lElement := GetFirstElement();
7942   if lElement = nil then Exit;
7943   while lElement <> nil do
7944   begin
7945     lElement.Left := Left + lPosX;
7946     lPosX := lPosX + lElement.Width + SpacingBetweenElementsX;
7947     lElement.Top := Top;
7948     lMaxHeight := Max(lMaxHeight, lElement.Height);
7949 
7950     lElement.PositionSubparts(ARenderInfo, ABaseX, ABaseY);
7951 
7952     lElement := GetNextElement();
7953   end;
7954 
7955   // Go back and make a second loop to
7956   // check if there are any high elements in the same line,
7957   // and if yes, centralize the smaller ones
7958   lElement := GetFirstElement();
7959   if lElement = nil then Exit;
7960   while lElement <> nil do
7961   begin
7962     if lElement.Height < lMaxHeight then
7963     begin
7964       lElement.Top := Top - lMaxHeight / 2 + lElement.Height / 2;
7965     end;
7966 
7967     lElement := GetNextElement();
7968   end;
7969 end;
7970 
7971 procedure TvFormula.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
7972   out ALeft, ATop, ARight, ABottom: Double);
7973 var
7974   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
7975 begin
7976   ALeft := X;
7977   ATop := Y;
7978   ARight := CalculateWidth(ADest);
7979   if ADest = nil then ABottom := CalculateHeight(ADest) * 15
7980   else ABottom := CalculateHeight(ADest) * TCanvas(ADest).TextHeight('Źç');
7981   ARight := X + ARight;
7982   ABottom := Y + ABottom;
7983 end;
7984 
7985 procedure TvFormula.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
7986 var
7987   lElement: TvFormulaElement;
7988 begin
7989   inherited Render(ARenderInfo, ADoDraw);
7990 
7991   // First position all elements
7992   PositionSubparts(ARenderInfo, Left, Top);
7993 
7994   // Now draw them all
7995   lElement := GetFirstElement();
7996   if lElement = nil then Exit;
7997   while lElement <> nil do
7998   begin
7999     lElement.Render(ARenderInfo, ADoDraw);
8000 
8001     lElement := GetNextElement();
8002   end;
8003 end;
8004 
GenerateDebugTreenull8005 function TvFormula.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
8006   APageItem: Pointer): Pointer;
8007 var
8008   lFormulaElement: TvFormulaElement;
8009   lStr: string;
8010 begin
8011   lStr := Format('[%s]', [Self.ClassName]);
8012   lStr := lStr + Format(' Left=%f Top=%f Width=%f Height=%f', [Left, Top, Width, Height]);
8013   Result := ADestRoutine(lStr, APageItem);
8014 
8015   lFormulaElement := GetFirstElement();
8016   while lFormulaElement <> nil do
8017   begin
8018     lFormulaElement.GenerateDebugTree(ADestRoutine, Result);
8019 
8020     lFormulaElement := GetNextElement()
8021   end;
8022 end;
8023 
8024 { TvEntityWithSubEntities }
8025 
8026 procedure TvEntityWithSubEntities.CallbackDeleteElement(data, arg: pointer);
8027 begin
8028   TvEntity(data).Free;
8029 end;
8030 
8031 constructor TvEntityWithSubEntities.Create(APage: TvPage);
8032 begin
8033   inherited Create(APage);
8034   FElements := TFPList.Create;
8035 end;
8036 
8037 destructor TvEntityWithSubEntities.Destroy;
8038 var
8039   i: Integer;
8040 begin
8041   for i:= FElements.Count-1 downto 0 do
8042     TvEntity(FElements[i]).Free;
8043   FElements.Free;
8044   inherited Destroy;
8045 end;
8046 
TvEntityWithSubEntities.GetFirstEntitynull8047 function TvEntityWithSubEntities.GetFirstEntity: TvEntity;
8048 begin
8049   if FElements.Count = 0 then Exit(nil);
8050   Result := TvEntity(FElements.Items[0]);
8051   FCurIndex := 1;
8052 end;
8053 
GetNextEntitynull8054 function TvEntityWithSubEntities.GetNextEntity: TvEntity;
8055 begin
8056   if FElements.Count <= FCurIndex then Exit(nil);
8057   Result := TvEntity(FElements.Items[FCurIndex]);
8058   Inc(FCurIndex);
8059 end;
8060 
GetEntitiesCountnull8061 function TvEntityWithSubEntities.GetEntitiesCount: Integer;
8062 begin
8063   Result := FElements.Count;
8064 end;
8065 
TvEntityWithSubEntities.GetEntitynull8066 function TvEntityWithSubEntities.GetEntity(AIndex: Integer): TvEntity;
8067 begin
8068   Result := TvEntity(FElements.Items[AIndex]);
8069 end;
8070 
TvEntityWithSubEntities.AddEntitynull8071 function TvEntityWithSubEntities.AddEntity(AEntity: TvEntity): Integer;
8072 begin
8073   //AEntity.Parent := Self;
8074   AEntity.SetPage(Self.FPage);
8075   Result := FElements.Add(AEntity);
8076 end;
8077 
GetEntityIndexnull8078 function TvEntityWithSubEntities.GetEntityIndex(AEntity: TvEntity): Integer;
8079 var
8080   i: Integer;
8081 begin
8082   Result := -1;
8083   for i := 0 to FElements.Count-1 do
8084     if TvEntity(FElements.Items[i]) = AEntity then Exit(i);
8085 end;
8086 
TvEntityWithSubEntities.DeleteEntitynull8087 function TvEntityWithSubEntities.DeleteEntity(AIndex: Cardinal): Boolean;
8088 var
8089   lEntity: TvEntity;
8090 begin
8091   lEntity := TvEntity(FElements.Items[AIndex]);
8092   FElements.Remove(lEntity);
8093   lEntity.Free;
8094   Result := True;
8095 end;
8096 
TvEntityWithSubEntities.RemoveEntitynull8097 function TvEntityWithSubEntities.RemoveEntity(AEntity: TvEntity;
8098   AFreeAfterRemove: Boolean): Boolean;
8099 var
8100   lIndex: Integer;
8101 begin
8102   Result := False;
8103   lIndex := FindEntityWithReference(AEntity);
8104   if lIndex < 0 then Exit;
8105   if AFreeAfterRemove then DeleteEntity(lIndex)
8106   else FElements.Remove(AEntity);
8107   Result := True;
8108 end;
8109 
8110 procedure TvEntityWithSubEntities.Rotate(AAngle: Double; ABase: T3DPoint);
8111 var
8112   i: Integer;
8113 begin
8114   for i := 0 to FElements.Count-1 do
8115   begin
8116     TvEntity(FElements.Items[i]).Rotate(AAngle, ABase);
8117   end;
8118 end;
8119 
8120 procedure TvEntityWithSubEntities.Clear;
8121 begin
8122   inherited Clear;
8123   FElements.ForEachCall(@CallbackDeleteElement, nil);
8124   FElements.Clear;
8125 end;
8126 
8127 procedure TvEntityWithSubEntities.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
8128 var
8129   lEntity: TvEntity;
8130   rinfo: TvRenderInfo;
8131   isFirst: Boolean;
8132 begin
8133   rinfo := ARenderInfo;
8134   inherited Render(ARenderInfo, ADoDraw);
8135   isFirst := true;
8136   lEntity := GetFirstEntity();
8137   while lEntity <> nil do
8138   begin
8139     {$IFDEF FPVECTORIAL_DEBUG_BLOCKS}
8140     //WriteLn(Format('[TvInsert.Render] Name=%s Block=%s Entity=%s EntityXY=%f | %f BlockXY=%f | %f InsertXY=%f | %f',
8141     //  [Name, Block.Name, lEntity.ClassName, lEntity.X, lEntity.Y, Block.X, Block.Y, X, Y]));
8142     {$ENDIF}
8143 
8144     // Render
8145     lEntity.Render(ARenderInfo, ADoDraw);
8146 
8147     if isFirst then
8148     begin
8149       rinfo := ARenderInfo;
8150       isFirst := false;
8151     end else
8152       CalcEntityCanvasMinMaxXY_With2Points(rinfo,
8153         ARenderInfo.EntityCanvasMinXY.X,
8154         ARenderInfo.EntityCanvasMinXY.Y,
8155         ARenderInfo.EntityCanvasMaxXY.X,
8156         ARenderInfo.EntityCanvasMaxXY.Y
8157       );
8158 
8159     {$ifdef FPVECTORIAL_AUTOFIT_DEBUG}
8160     if AutoFitDebug <> nil then AutoFitDebug.Add(Format('=[%s] MinX=%d MinY=%d MaxX=%d MaxY=%d',
8161       [lEntity.ClassName, ARenderInfo.EntityCanvasMinXY.X, ARenderInfo.EntityCanvasMinXY.Y,
8162        ARenderInfo.EntityCanvasMaxXY.X, ARenderInfo.EntityCanvasMaxXY.Y]));
8163     {$endif}
8164 
8165     lEntity := GetNextEntity();
8166   end;
8167 
8168   ARenderInfo := rinfo;
8169 end;
8170 
GenerateDebugTreenull8171 function TvEntityWithSubEntities.GenerateDebugTree(
8172   ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer;
8173 var
8174   lStr: string;
8175   lCurEntity: TvEntity;
8176 begin
8177   lStr := Format('[%s] Name="%s" X=%f Y=%f' + FExtraDebugStr,
8178     [Self.ClassName, Self.Name, X, Y]);
8179 
8180   // Add styles
8181   // Pen
8182   if spbfPenColor in SetPenBrushAndFontElements then
8183     lStr := lStr + Format(' Pen.Color=%s', [GenerateDebugStrForFPColor(Pen.Color)]);
8184   if spbfPenStyle in SetPenBrushAndFontElements then
8185     lStr := lStr + Format(' Pen.Style=%s', [GetEnumName(TypeInfo(TFPPenStyle), integer(Pen.Style))]);
8186   if spbfPenWidth in SetPenBrushAndFontElements then
8187     lStr := lStr + Format(' Pen.Width=%d', [Pen.Width]);
8188   // Brush
8189   if spbfBrushColor in SetPenBrushAndFontElements then
8190     lStr := lStr + Format(' Brush.Color=%s', [GenerateDebugStrForFPColor(Brush.Color)]);
8191   if spbfBrushStyle in SetPenBrushAndFontElements then
8192     lStr := lStr + Format(' Brush.Style=%s', [GetEnumName(TypeInfo(TFPBrushStyle), integer(Brush.Style))]);
8193   // Font
8194   if spbfFontColor in SetPenBrushAndFontElements then
8195     lStr := lStr + Format(' Font.Color=%s', [GenerateDebugStrForFPColor(Font.Color)]);
8196   if spbfFontSize in SetPenBrushAndFontElements then
8197     lStr := lStr + Format(' Font.Size=%d', [Font.Size]);
8198 
8199   Result := ADestRoutine(lStr, APageItem);
8200 
8201   // Add sub-entities
8202   lCurEntity := GetFirstEntity();
8203   while lCurEntity <> nil do
8204   begin
8205     lCurEntity.GenerateDebugTree(ADestRoutine, Result);
8206     lCurEntity := GetNextEntity();
8207   end;
8208 end;
8209 
FindEntityWithReferencenull8210 function TvEntityWithSubEntities.FindEntityWithReference(AEntity: TvEntity
8211   ): Integer;
8212 var
8213   i: Integer;
8214 begin
8215   Result := -1;
8216   for i := 0 to FElements.Count - 1 do
8217   begin
8218     if TvEntity(FElements.Items[i]) = AEntity then Exit(i);
8219   end;
8220 end;
8221 
TvEntityWithSubEntities.FindEntityWithNameAndTypenull8222 function TvEntityWithSubEntities.FindEntityWithNameAndType(AName: string;
8223   AType: TvEntityClass; ARecursively: Boolean): TvEntity;
8224 var
8225   lCurEntity: TvEntity;
8226   lCurName: String;
8227 begin
8228   Result := nil;
8229   lCurEntity := GetFirstEntity();
8230   while lCurEntity <> nil do
8231   begin
8232     if (lCurEntity is TvNamedEntity) then
8233       lCurName := TvNamedEntity(lCurEntity).Name
8234     else
8235       lCurName := '';
8236 
8237     if (lCurEntity is AType) and
8238       (lCurEntity is TvNamedEntity) and (lCurName = AName) then
8239     begin
8240       Result := lCurEntity;
8241       Exit;
8242     end;
8243 
8244     if ARecursively and (lCurEntity is TvEntityWithSubEntities) then
8245     begin
8246       Result := TvEntityWithSubEntities(lCurEntity).FindEntityWithNameAndType(AName, AType, True);
8247       if Result <> nil then Exit;
8248     end;
8249 
8250     lCurEntity := GetNextEntity();
8251   end;
8252 end;
8253 
8254 { TvInsert }
8255 
8256 constructor TvInsert.Create(APage: TvPage);
8257 begin
8258   inherited Create(APage);
8259   Style := TvStyle.Create;
8260 end;
8261 
8262 destructor TvInsert.Destroy;
8263 begin
8264   FreeAndNil(Style);
8265   inherited Destroy;
8266 end;
8267 
8268 procedure TvInsert.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
8269 var
8270   OldForceRenderBlock: Boolean;
8271 begin
8272   inherited Render(ARenderInfo, ADoDraw);
8273   if InsertEntity = nil then Exit;
8274   // If we are inserting a block, make sure it will render its contents
8275   OldForceRenderBlock := ARenderInfo.ForceRenderBlock;
8276   ARenderInfo.ForceRenderBlock := True;
8277   // If necessary rotate the canvas
8278   if RotationAngle <> 0 then
8279   begin
8280     InsertEntity.Rotate(RotationAngle, Make3DPoint(0, 0));
8281   end;
8282   // Alter the position of the elements to consider the positioning of the BLOCK and of the INSERT
8283   InsertEntity.Move(X, Y);
8284   Style.ApplyOverFromPen(@Pen, SetElements);
8285   Style.ApplyOverFromBrush(@Brush, SetElements);
8286   Style.ApplyOverFromFont(@Font, SetElements);
8287   Style.ApplyIntoEntity(InsertEntity);
8288   // Render
8289   InsertEntity.Render(ARenderInfo, ADoDraw);
8290   // Change them back
8291   InsertEntity.Move(-X, -Y);
8292   // And unrotate it back again
8293   if RotationAngle <> 0 then
8294   begin
8295     InsertEntity.Rotate(-1 * RotationAngle, Make3DPoint(0, 0));
8296   end;
8297   ARenderInfo.ForceRenderBlock := OldForceRenderBlock;
8298 end;
8299 
GenerateDebugTreenull8300 function TvInsert.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
8301   APageItem: Pointer): Pointer;
8302 begin
8303   FExtraDebugStr := Format(' RotationAngle(degrees)=%f', [RotationAngle * 180 / Pi]);
8304   if InsertEntity is TvNamedEntity then
8305     FExtraDebugStr := FExtraDebugStr + Format(' InsertEntity="%s"', [TvNamedEntity(InsertEntity).Name]);
8306   Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
8307 end;
8308 
8309 { TvBlock }
8310 
8311 procedure TvBlock.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
8312 var
8313   lEntity: TvEntity;
8314 begin
8315   // blocks are invisible by themselves
8316   //inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
8317   if not ARenderInfo.ForceRenderBlock then Exit;
8318 
8319   lEntity := GetFirstEntity();
8320   while lEntity <> nil do
8321   begin
8322     {$IFDEF FPVECTORIAL_DEBUG_BLOCKS}
8323     WriteLn(Format('[TvInsert.Render] Name=%s Block=%s Entity=%s EntityXY=%f | %f BlockXY=%f | %f InsertXY=%f | %f',
8324       [Name, Block.Name, lEntity.ClassName, lEntity.X, lEntity.Y, Block.X, Block.Y, X, Y]));
8325     {$ENDIF}
8326 
8327     // Alter the position of the elements to consider the positioning of the BLOCK and of the INSERT
8328     lEntity.Move(X, Y);
8329     // Render
8330     lEntity.Render(ARenderInfo, ADoDraw);
8331     // Change them back
8332     lEntity.Move(-X, -Y);
8333 
8334     lEntity := GetNextEntity();
8335   end;
8336 end;
8337 
8338 { TvParagraph }
8339 
8340 constructor TvParagraph.Create(APage: TvPage);
8341 begin
8342   inherited Create(APage);
8343 end;
8344 
8345 destructor TvParagraph.Destroy;
8346 begin
8347   inherited Destroy;
8348 end;
8349 
AddTextnull8350 function TvParagraph.AddText(AText: string): TvText;
8351 begin
8352   Result := TvText.Create(FPage);
8353   Result.Value.Text := AText;
8354   AddEntity(Result);
8355 end;
8356 
TvParagraph.AddCurvedTextnull8357 function TvParagraph.AddCurvedText(AText: string): TvCurvedText;
8358 begin
8359   Result := TvCurvedText.Create(FPage);
8360   Result.Value.Text := AText;
8361   AddEntity(Result);
8362 end;
8363 
AddFieldnull8364 function TvParagraph.AddField(AKind: TvFieldKind): TvField;
8365 begin
8366   Result := TvField.Create(FPage);
8367   Result.Kind := AKind;
8368   AddEntity(Result);
8369 end;
8370 
AddRasterImagenull8371 function TvParagraph.AddRasterImage: TvRasterImage;
8372 begin
8373   Result := TvRasterImage.Create(FPage);
8374   AddEntity(Result);
8375 end;
8376 
TvParagraph.AddEmbeddedVectorialDocnull8377 function TvParagraph.AddEmbeddedVectorialDoc: TvEmbeddedVectorialDoc;
8378 begin
8379   Result := TvEmbeddedVectorialDoc.Create(FPage);
8380   AddEntity(Result);
8381 end;
8382 
8383 procedure TvParagraph.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
8384   out ALeft, ATop, ARight, ABottom: Double);
8385 var
8386   lEntity: TvEntity;
8387   lCurWidth: Double = 0.0;
8388   lCurHeight: Double = 0.0;
8389   lLeft, lTop, lRight, lBottom: Double;
8390   lText: TvText absolute lEntity;
8391   {$ifdef USE_LCL_CANVAS}
8392   ACanvas: TCanvas absolute ARenderInfo.Canvas;
8393   {$endif}
8394 begin
8395   ALeft := X;
8396   ATop := Y;
8397   ARight := X;
8398   ABottom := Y;
8399 
8400   lEntity := GetFirstEntity();
8401   while lEntity <> nil do
8402   begin
8403     if Style <> nil then
8404       Style.ApplyIntoEntity(lEntity);
8405     lEntity.CalculateBoundingBox(ARenderInfo, lLeft, lTop, lRight, lBottom);
8406     lCurWidth := lCurWidth + (lRight - lLeft);
8407     lCurHeight := Max(lCurHeight, Abs(lTop - lBottom));
8408     lEntity := GetNextEntity();
8409   end;
8410 
8411   ALeft := X;
8412   ATop := Y - lCurHeight;
8413   ARight := X + lCurWidth;
8414   ABottom := Y;
8415 end;
8416 
TryToSelectnull8417 function TvParagraph.TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult;
8418 begin
8419   Result:=inherited TryToSelect(APos, ASubpart, ASnapFlexibility);
8420 end;
8421 
8422 procedure TvParagraph.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
8423 var
8424   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
8425   ADestX: Integer absolute ARenderInfo.DestX;
8426   ADestY: Integer absolute ARenderInfo.DestY;
8427   AMulX: Double absolute ARenderInfo.MulX;
8428   AMulY: Double absolute ARenderInfo.MulY;
8429   //
8430   lCurWidth: Double = 0.0;
8431   lLeft, lTop, lRight, lBottom: Double;
8432   OldTextX: Double = 0.0;
8433   OldTextY: Double = 0.0;
8434   lEntity: TvEntity;
8435   lText: TvText; // absolute lEntity;
8436   lPrevText: TvText = nil;
8437   lFirstText: Boolean = True;
8438   lResetOldStyle: Boolean = False;
8439   lEntityRenderInfo: TvRenderInfo;
8440   CurX, CurY, lHeight_px: Integer;
8441   lFeatures: TvEntityFeatures;
8442 begin
8443   InitializeRenderInfo(ARenderInfo, Self);
8444   InitializeRenderInfo(lEntityRenderInfo, Self);
8445 
8446   // Don't call inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
8447   lEntity := GetFirstEntity();
8448   while lEntity <> nil do
8449   begin
8450     lFeatures := lEntity.GetEntityFeatures(ARenderInfo);
8451     lHeight_px := 0;
8452     if YPos_NeedsAdjustment_DelFirstLineBodyHeight then
8453       lHeight_px := -1 * lFeatures.FirstLineHeight;
8454     if (lFeatures.DrawsUpwardHeightAdjustment > 0) then
8455       lHeight_px := lFeatures.DrawsUpwardHeightAdjustment - lFeatures.FirstLineHeight;
8456 
8457     if lEntity is TvText then
8458     begin
8459       lText := TvText(lEntity);  // cannot debug with "absolute"...
8460 
8461       // Set the text style if not already set
8462       lResetOldStyle := False;
8463       if (Style <> nil) and (lText.Style = nil) then
8464       begin
8465         lText.Style := Style;
8466         lResetOldStyle := True
8467       end;
8468 
8469       // Direct text position setting resets the auto-positioning
8470       if (OldTextX <> lText.X) or (OldTextY <> lText.Y) then
8471       begin
8472         lCurWidth := 0;
8473         lFirstText := True;
8474       end;
8475 
8476       OldTextX := lText.X;
8477       OldTextY := lText.Y;
8478       CurX := CoordToCanvasX(lText.X + X + lCurWidth, ADestX, AMulX);
8479       CurY := CoordToCanvasY(lText.Y + Y, ADestY, AMulY);
8480       lText.X := 0;
8481       lText.Y := 0;
8482       CurY += lHeight_px;
8483       lText.Render_Use_NextText_X := not lFirstText;
8484       if lText.Render_Use_NextText_X then
8485         lText.Render_NextText_X := lPrevText.Render_NextText_X;
8486 
8487       // Style apply
8488       if Style <> nil then
8489         Style.ApplyIntoEntity(lText);
8490 
8491       CopyAndInitDocumentRenderInfo(lEntityRenderInfo, ARenderInfo);
8492       lEntityRenderInfo.DestX := CurX;
8493       lEntityRenderInfo.DestY := CurY;
8494       lText.Render(lEntityRenderInfo, ADoDraw);
8495       lText.CalculateBoundingBox(ARenderInfo, lLeft, lTop, lRight, lBottom);
8496       lCurWidth := lCurWidth + Abs(lRight - lLeft);
8497       lFirstText := False;
8498       lPrevText := lText;
8499 
8500       lText.X := OldTextX;
8501       lText.Y := OldTextY;
8502       if lResetOldStyle then
8503         TvText(lEntity).Style := nil;
8504     end
8505     else
8506     begin
8507       OldTextX := lEntity.X;
8508       OldTextY := lEntity.Y;
8509       lEntity.X := lEntity.X + X + lCurWidth;
8510       lEntity.Y := lEntity.Y + Y;
8511 
8512       CopyAndInitDocumentRenderInfo(lEntityRenderInfo, ARenderInfo);
8513       lEntityRenderInfo.Canvas := ADest;
8514       lEntityRenderInfo.DestX := ADestX;
8515       lEntityRenderInfo.DestY := ADestY + lHeight_px;
8516       lEntityRenderInfo.MulX := AMulX;
8517       lEntityRenderInfo.MulY := AMulY;
8518       lEntity.Render(lEntityRenderInfo, ADoDraw);
8519 
8520       lEntity.X := OldTextX;
8521       lEntity.Y := OldTextY;
8522     end;
8523 
8524     MergeRenderInfo(lEntityRenderInfo, ARenderInfo);
8525 
8526     lEntity := GetNextEntity();
8527   end;
8528 end;
8529 
GenerateDebugTreenull8530 function TvParagraph.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
8531   APageItem: Pointer): Pointer;
8532 begin
8533   Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
8534 end;
8535 
8536 { TvList }
8537 
8538 constructor TvList.Create(APage: TvPage);
8539 begin
8540   inherited Create(APage);
8541 
8542   Parent := Nil;
8543 end;
8544 
8545 destructor TvList.Destroy;
8546 begin
8547   inherited Destroy;
8548 end;
8549 
AddParagraphnull8550 function TvList.AddParagraph(ASimpleText: string): TvParagraph;
8551 begin
8552   Result := TvParagraph.Create(FPage);
8553   // TODO:
8554 //  if FPage <> nil then
8555 //    Result.ListStyle := FPage.FOwner.GetListStyleByLevel(ALevel);
8556   if ASimpleText <> '' then
8557     Result.AddText(ASimpleText);
8558   AddEntity(Result);
8559 end;
8560 
AddListnull8561 function TvList.AddList: TvList;
8562 begin
8563   Result := TvList.Create(FPage);
8564 
8565   Result.Style := Style;
8566   Result.ListStyle := ListStyle;
8567   Result.Parent := Self;
8568 
8569   AddEntity(Result);
8570 end;
8571 
GetLevelnull8572 function TvList.GetLevel: Integer;
8573 var
8574   oListItem : TvList;
8575 begin
8576   Result := 0;
8577 
8578   oListItem := Parent;
8579 
8580   while (oListItem<>Nil) do
8581   begin
8582     oListItem := oListItem.Parent;
8583 
8584     inc(Result);
8585   end;
8586 end;
8587 
GetBulletSizenull8588 function TvList.GetBulletSize: Double;
8589 begin
8590   Result := Font.Size;
8591   if Result = 0 then Result := 10;
8592   Result := Result * 1.5; // for upper/lower spacing
8593 end;
8594 
8595 procedure TvList.DrawBullet(ADest: TFPCustomCanvas;
8596   var ARenderInfo: TvRenderInfo; ALevel: Integer; AX, AY: Double;
8597   ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double;
8598   ADoDraw: Boolean);
8599 
8600   function CoordToCanvasX(ACoord: Double): Integer;
8601   begin
8602     Result := Round(ADestX + AmulX * ACoord);
8603   end;
8604 
8605   function CoordToCanvasY(ACoord: Double): Integer;
8606   begin
8607     Result := Round(ADestY + AmulY * ACoord);
8608   end;
8609 
8610 var
8611   lBulletSpacing: Double;
8612   lLevel: Integer;
8613 begin
8614   lBulletSpacing := GetBulletSize() / 2;
8615   ADest.Pen.Style := psSolid;
8616   ADest.Pen.FPColor := colBlack;
8617   ADest.Brush.Style := bsSolid;
8618   ADest.Brush.FPColor := colBlack;
8619   lLevel := GetLevel();
8620 
8621   // level 0  - filled circle
8622   // level 1  - circle with empty filling
8623   // lebel 2+ - filled square
8624   case lLevel of
8625     1: ADest.Brush.Style := bsClear;
8626   end;
8627 
8628   case lLevel of
8629   0, 1:
8630   begin
8631     ADest.Ellipse(CoordToCanvasX(AX + lBulletSpacing), CoordToCanvasY(AY + lBulletSpacing*4), // ToDo: Figure out why this needs to be like that for curved_text.html to render well
8632       CoordToCanvasX(AX + lBulletSpacing*2), CoordToCanvasY(AY + lBulletSpacing*5));
8633   end;
8634   else
8635     ADest.Rectangle(CoordToCanvasX(AX + lBulletSpacing), CoordToCanvasY(AY + lBulletSpacing*4),
8636       CoordToCanvasX(AX + lBulletSpacing*2), CoordToCanvasY(AY + lBulletSpacing*5));
8637   end;
8638 end;
8639 
8640 procedure TvList.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True);
8641 var
8642   ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
8643   ADestX: Integer absolute ARenderInfo.DestX;
8644   ADestY: Integer absolute ARenderInfo.DestY;
8645   AMulX: Double absolute ARenderInfo.MulX;
8646   AMulY: Double absolute ARenderInfo.MulY;
8647 
8648   function CoordToCanvasX(ACoord: Double): Integer;
8649   begin
8650     Result := Round(ADestX + AmulX * ACoord);
8651   end;
8652 
8653   function CoordToCanvasY(ACoord: Double): Integer;
8654   begin
8655     Result := Round(ADestY + AmulY * ACoord);
8656   end;
8657 
8658 var
8659   lEntity: TvEntity;
8660   lPara: TvParagraph absolute lEntity;
8661   lList: TvList absolute lEntity;
8662   lEntityRenderInfo: TvRenderInfo;
8663   CurX, CurY, lBulletSize, lItemHeight: Double;
8664   lHeight_px: Integer;
8665 begin
8666   InitializeRenderInfo(ARenderInfo, Self);
8667 
8668   // Don't call inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
8669 
8670   lBulletSize := GetBulletSize() * Abs(AMulX);
8671   CurX := X + lBulletSize;
8672   CurY := Y;
8673 
8674   lEntity := GetFirstEntity();
8675   while lEntity <> nil do
8676   begin
8677     // handle both directions of drawing
8678     lHeight_px := 0;
8679     lEntity.CalculateHeightInCanvas(ARenderInfo, lHeight_px);
8680 
8681     // draw the bullet (if necessary)
8682     if lEntity is TvParagraph then
8683     begin
8684       DrawBullet(ADest, lEntityRenderInfo, GetLevel(),
8685         X, CurY, ADestX, ADestY+lHeight_px, AMulX, AMulY, ADoDraw);
8686     end;
8687 
8688     // attempt to centralize the item
8689     lEntity.X := CurX;
8690     lEntity.Y := CurY;
8691     lItemHeight := lEntity.GetHeight(ARenderInfo);
8692     if lItemHeight < lBulletSize then
8693     begin
8694       lItemHeight := lBulletSize;
8695       lEntity.Y := lEntity.CentralizeY_InHeight(ARenderInfo, lBulletSize);
8696     end;
8697 
8698     // draw the item
8699     lEntityRenderInfo.Canvas := ADest;
8700     lEntityRenderInfo.DestX := ADestX;
8701     lEntityRenderInfo.DestY := ADestY+lHeight_px;
8702     lEntityRenderInfo.MulX := AMulX;
8703     lEntityRenderInfo.MulY := AMulY;
8704     lEntity.Render(lEntityRenderInfo, ADoDraw);
8705 
8706     // prepare next loop iteration
8707     MergeRenderInfo(lEntityRenderInfo, ARenderInfo);
8708     CurY := CurY + lItemHeight;
8709     lEntity := GetNextEntity();
8710   end;
8711 end;
8712 
8713 { TvRichText }
8714 
8715 constructor TvRichText.Create(APage: TvPage);
8716 begin
8717   inherited Create(APage);
8718 end;
8719 
8720 destructor TvRichText.Destroy;
8721 begin
8722   inherited Destroy;
8723 end;
8724 
TvRichText.AddParagraphnull8725 function TvRichText.AddParagraph: TvParagraph;
8726 begin
8727   Result := TvParagraph.Create(FPage);
8728   AddEntity(Result);
8729 end;
8730 
AddListnull8731 function TvRichText.AddList: TvList;
8732 begin
8733   Result := TvList.Create(FPage);
8734   AddEntity(Result);
8735 end;
8736 
AddTablenull8737 function TvRichText.AddTable: TvTable;
8738 begin
8739   Result := TvTable.Create(FPage);
8740   AddEntity(Result);
8741 end;
8742 
TvRichText.AddEmbeddedVectorialDocnull8743 function TvRichText.AddEmbeddedVectorialDoc: TvEmbeddedVectorialDoc;
8744 begin
8745   Result := TvEmbeddedVectorialDoc.Create(FPage);
8746   AddEntity(Result);
8747 end;
8748 
TvRichText.AddRasterImagenull8749 function TvRichText.AddRasterImage: TvRasterImage;
8750 begin
8751   Result := TvRasterImage.Create(FPage);
8752   AddEntity(Result);
8753 end;
8754 
isnull8755 // this function is for descendents to override with a different behavior such as TvTableCell
8756 procedure TvRichText.GetEffectiveCellSpacing(out ATopSpacing, ALeftSpacing, ARightSpacing, ABottomSpacing: Double);
8757 begin
8758   ATopSpacing := SpacingTop;
8759   ALeftSpacing := SpacingLeft;
8760   ARightSpacing := SpacingRight;
8761   ABottomSpacing := SpacingBottom;
8762 end;
8763 
CalculateCellHeight_ForWidthnull8764 function TvRichText.CalculateCellHeight_ForWidth(constref ARenderInfo: TvRenderInfo; AWidth: Double): Double;
8765 var
8766   lCurHeight: Double = 0.0;
8767   lLeft, lTop, lRight, lBottom, lSpacingTop, lSpacingBottom, lTmp: Double;
8768   lEntity: TvEntity;
8769   //lParagraph: TvParagraph absolute lEntity;
8770 begin
8771   Result := 0;
8772   lEntity := GetFirstEntity();
8773   while lEntity <> nil do
8774   begin
8775     lEntity.X := X;
8776     lEntity.Y := Y + Result;
8777     lEntity.CalculateBoundingBox(ARenderInfo, lLeft, lTop, lRight, lBottom);
8778     Result := Result + (lBottom - lTop);
8779 
8780     lEntity := GetNextEntity();
8781   end;
8782 
8783   GetEffectiveCellSpacing(lTmp, lSpacingTop, lTmp, lSpacingBottom);
8784   Result := Result + lSpacingTop + lSpacingBottom;
8785 end;
8786 
TvRichText.CalculateMaxNeededWidthnull8787 function TvRichText.CalculateMaxNeededWidth(constref ARenderInfo: TvRenderInfo): Double;
8788 var
8789   lLeft, lTop, lRight, lBottom: Double;
8790   lEntity: TvEntity;
8791   //lParagraph: TvParagraph absolute lEntity;
8792 begin
8793   Result := 0;
8794 
8795   // if the width is not yet known, calculate it
8796   if Width <= 0 then
8797   begin
8798     lEntity := GetFirstEntity();
8799     while lEntity <> nil do
8800     begin
8801       lEntity.X := X;
8802       lEntity.Y := Y + Result;
8803       lEntity.CalculateBoundingBox(ARenderInfo, lLeft, lTop, lRight, lBottom);
8804       Result := Max(Result, (lRight - lLeft));
8805 
8806       lEntity := GetNextEntity();
8807     end;
8808   end;
8809 
8810   Result := Result + SpacingLeft + SpacingRight;
8811 end;
8812 
TryToSelectnull8813 function TvRichText.TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult;
8814 begin
8815   Result:=inherited TryToSelect(APos, ASubpart, ASnapFlexibility);
8816 end;
8817 
8818 procedure TvRichText.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
8819 var
8820   lCurHeight: Double = 0.0;
8821   lLeft, lTop, lRight, lBottom: Double;
8822   lHeight_px: Integer;
8823   lEntity: TvEntity;
8824   //lParagraph: TvParagraph absolute lEntity;
8825   lEntityRenderInfo: TvRenderInfo;
8826 begin
8827   InitializeRenderInfo(ARenderInfo, Self);
8828 
8829   // Don't call inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
8830   lEntity := GetFirstEntity();
8831   while lEntity <> nil do
8832   begin
8833     lEntity.X := X;
8834     lEntity.Y := Y + lCurHeight;
8835     lHeight_px := lEntity.GetEntityFeatures(ARenderInfo).DrawsUpwardHeightAdjustment;
8836     CopyAndInitDocumentRenderInfo(lEntityRenderInfo, ARenderInfo);
8837     lEntityRenderInfo.Canvas := ARenderInfo.Canvas;
8838     lEntityRenderInfo.DestX := ARenderInfo.DestX;
8839     lEntityRenderInfo.DestY := ARenderInfo.DestY + lHeight_px;
8840     lEntityRenderInfo.Canvas := ARenderInfo.Canvas;
8841     lEntityRenderInfo.Canvas := ARenderInfo.Canvas;
8842     lEntity.Render(lEntityRenderInfo, ADoDraw);
8843     lEntity.CalculateBoundingBox(ARenderInfo, lLeft, lTop, lRight, lBottom);
8844     lCurHeight := lCurHeight + (lBottom - lTop);
8845 
8846     lEntity := GetNextEntity();
8847     MergeRenderInfo(lEntityRenderInfo, ARenderInfo);
8848   end;
8849 end;
8850 
GenerateDebugTreenull8851 function TvRichText.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
8852   APageItem: Pointer): Pointer;
8853 begin
8854   Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
8855 end;
8856 
8857 { TvPage }
8858 
8859 procedure TvPage.InitializeRenderInfo(out ARenderInfo: TvRenderInfo;
8860   ACanvas: TFPCustomCanvas; AEntity: TvEntity);
8861 begin
8862   FillChar(ARenderInfo, SizeOf(TvRenderInfo), #0);
8863   TvEntity.InitializeRenderInfo(ARenderInfo, AEntity, True);
8864   ARenderInfo.Canvas := ACanvas;
8865   ARenderInfo.Page := Self;
8866   ARenderInfo.Renderer := FOwner.FRenderer;
8867 end;
8868 
8869 constructor TvPage.Create(AOwner: TvVectorialDocument);
8870 begin
8871   inherited Create;
8872   FOwner := AOwner;
8873   AdjustPenColorToBackground := true;
8874   System.FillChar(RenderInfo, SizeOf(RenderInfo), #0);
8875   TvEntity.InitializeRenderInfo(RenderInfo, nil, True);
8876 end;
8877 
8878 destructor TvPage.Destroy;
8879 begin
8880   TvEntity.FinalizeRenderInfo(RenderInfo);
8881   inherited Destroy;
8882 end;
8883 
8884 procedure TvPage.Assign(ASource: TvPage);
8885 begin
8886 
8887 end;
8888 
8889 procedure TvPage.SetPageFormat(AFormat: TvPageFormat);
8890 begin
8891   case AFormat of
8892   vpA4:
8893   begin
8894     Width := 210;
8895     Height := 297;
8896   end;
8897   else
8898     Width := 210;
8899     Height := 297;
8900   end;
8901 end;
8902 
8903 procedure TvPage.CalculateDocumentSize;
8904 var
8905   i: Integer;
8906   lCurEntity: TvEntity;
8907   lLeft, lTop, lRight, lBottom: Double;
8908   lBmp: TBitmap;
8909   lRenderInfo: TvRenderInfo;
8910 begin
8911   MinX := 0;
8912   MinY := 0;
8913   MinZ := 0;
8914   MaxX := 0;
8915   MaxY := 0;
8916   MaxZ := 0;
8917   lBmp := TBitmap.Create;
8918   for i := 0 to GetEntitiesCount() -1 do
8919   begin
8920     lCurEntity := GetEntity(i);
8921     lRenderInfo.Canvas := lBmp.Canvas;
8922     lCurEntity.CalculateBoundingBox(lRenderInfo, lLeft, lTop, lRight, lBottom);
8923     MinX := Min(MinX, lLeft);
8924     MinY := Min(MinY, lTop);
8925     MaxX := Max(MaxX, lRight);
8926     MaxY := Max(MaxY, lBottom);
8927   end;
8928   lBmp.Free;
8929   Width := MaxX - MinX;
8930   Height := MaxY - MinY;
8931 end;
8932 
8933 procedure TvPage.AutoFit(ADest: TFPCustomCanvas; AWidth, AHeight, ARenderHeight: Integer;
8934   out ADeltaX, ADeltaY: Integer; out AZoom: Double);
8935 var
8936   lCurEntity: TvEntity;
8937   lLeft, lTop, lWidth, lHeight: Integer;
8938   lMinX, lMinY, lMaxX, lMaxY, lNaturalHeightDiff: Integer;
8939   lZoomFitX, lZoomFitY, lNaturalMulY: Double;
8940 
8941   function CalculateAllEntitySizes(): Boolean;
8942   var
8943     i: Integer;
8944     lRenderInfo: TvRenderInfo;
8945   begin
8946     Result := True;
8947 
8948     lMinX := High(Integer);
8949     lMinY := High(Integer);
8950     lMaxX := Low(Integer);
8951     lMaxY := Low(Integer);
8952 
8953     if Self is TvVectorialPage then
8954     begin
8955       for i := 0 to GetEntitiesCount() - 1 do
8956       begin
8957         lCurEntity := TvEntity(GetEntity(i));
8958         InitializeRenderInfo(lRenderInfo, ADest, lCurEntity);
8959         if lCurEntity.CalculateSizeInCanvas(lRenderInfo, ARenderHeight, AZoom, lLeft, lTop, lWidth, lHeight) then
8960         begin
8961           lMinX := Min(lMinX, lLeft);
8962           lMinY := Min(lMinY, lTop);
8963           lMaxX := Max(lMaxX, lLeft + lWidth);
8964           lMaxY := Max(lMaxY, lTop  + lHeight);
8965         end;
8966         {$ifdef FPVECTORIAL_AUTOFIT_DEBUG}
8967         AutoFitDebug.Add(Format('[%s] MinX=%d MinY=%d MaxX=%d MaxY=%D', [lCurEntity.ClassName, lMinX, lMinY, lMaxX, lMaxY]));
8968         {$endif}
8969       end;
8970 
8971       lMinX := Min(lMinX, lLeft);
8972       lMinY := Min(lMinY, lTop);
8973       lMaxX := Max(lMaxX, lLeft + lWidth);
8974       lMaxY := Max(lMaxY, lTop  + lHeight);
8975     end
8976     else
8977     begin
8978       Render(ADest, 0, 0, AZoom, AZoom * lNaturalMulY, False);
8979       lMinX := RenderInfo.EntityCanvasMinXY.X;
8980       lMinY := RenderInfo.EntityCanvasMinXY.Y;
8981       lMaxX := RenderInfo.EntityCanvasMaxXY.X;
8982       lMaxY := RenderInfo.EntityCanvasMaxXY.Y;
8983     end;
8984 
8985     if (lMinX = High(Integer)) or (lMinY = High(Integer)) or
8986        (lMaxX = Low(Integer)) or(lMaxY = Low(Integer)) then
8987        Exit(False);
8988 
8989     lWidth := lMaxX - lMinX;
8990     lHeight := lMaxY - lMinY;
8991     if (lWidth = 0) or (lHeight = 0) then Exit(False);
8992   end;
8993 
8994 begin
8995   {$ifdef FPVECTORIAL_AUTOFIT_DEBUG}
8996   AutoFitDebug := TStringList.Create;
8997   try
8998   {$endif}
8999   ADeltaX := 0;
9000   ADeltaY := 0;
9001   GetNaturalRenderPos(lNaturalHeightDiff, lNaturalMulY);
9002 
9003   // First Calculate the zoom
9004 
9005   AZoom := 1;
9006   if not CalculateAllEntitySizes() then Exit;
9007 
9008   lZoomFitX := AWidth / lWidth;
9009   lZoomFitY := AHeight / lHeight;
9010   AZoom := Min(lZoomFitX, lZoomFitY) * 0.9;
9011 
9012   // Now DeltaX, DeltaY
9013 
9014   if not CalculateAllEntitySizes() then Exit;
9015   ADeltaX := Round(-1 * lMinX) + AWidth div 2 - lWidth div 2;
9016   ADeltaY := Round(-1 * lMinY) + (AHeight div 2 - lHeight div 2);
9017 
9018   {$ifdef FPVECTORIAL_RENDERINFO_VISUALDEBUG}
9019   ADest.Brush.Style := bsClear;
9020   ADest.Pen.FPColor := colRed;
9021   ADest.Pen.Style := psSolid;
9022   ADest.Rectangle(lMinX+ADeltaX, lMinY+ADeltaY, lMaxX+ADeltaX, lMaxY+ADeltaY);
9023   {$endif}
9024 
9025   {$ifdef FPVECTORIAL_AUTOFIT_DEBUG}
9026   finally
9027     {$ifdef Windows}
9028     AutoFitDebug.SaveToFile('C:\Programas\autofit.txt');
9029     {$else}
9030     AutoFitDebug.SaveToFile('/Users/felipe/autofit.txt');
9031     {$endif}
9032     AutoFitDebug.Free;
9033     AutoFitDebug := nil;
9034   end;
9035   {$endif}
9036 end;
9037 
9038 procedure TvPage.SetNaturalRenderPos(AUseTopLeftCoords: Boolean);
9039 begin
9040   FUseTopLeftCoordinates := AUseTopLeftCoords;
9041 end;
9042 
HasNaturalRenderPosnull9043 function TvPage.HasNaturalRenderPos: Boolean;
9044 begin
9045   Result := FUseTopLeftCoordinates;
9046 end;
9047 
GetTopLeftCoords_Adjustmentnull9048 function TvPage.GetTopLeftCoords_Adjustment: Double;
9049 begin
9050   if UseTopLeftCoordinates then
9051     Result := 1
9052   else
9053     Result := -1;
9054 end;
9055 
9056 
9057 { TvVectorialPage }
9058 
9059 procedure TvVectorialPage.ClearTmpPath;
9060 begin
9061   FTmpPath.Points := nil;
9062   FTmpPath.PointsEnd := nil;
9063   FTmpPath.Len := 0;
9064   FTmpPath.Brush.Color := colBlue;
9065   FTmpPath.Brush.Style := bsClear;
9066   FTmpPath.Pen.Color := colBlack;
9067   FTmpPath.Pen.Style := psSolid;
9068   FTmpPath.Pen.Width := 1;
9069 end;
9070 
9071 procedure TvVectorialPage.AppendSegmentToTmpPath(ASegment: TPathSegment);
9072 begin
9073   FTmpPath.AppendSegment(ASegment);
9074 end;
9075 
9076 procedure TvVectorialPage.CallbackDeleteEntity(data, arg: pointer);
9077 begin
9078   if (data <> nil) then
9079     TvEntity(data).Free;
9080 end;
9081 
9082 constructor TvVectorialPage.Create(AOwner: TvVectorialDocument);
9083 begin
9084   inherited Create(AOwner);
9085 
9086   FEntities := TFPList.Create;
9087   FTmpPath := TPath.Create(Self);
9088   Owner := AOwner;
9089   Clear();
9090   BackgroundColor := colWhite;
9091   RenderInfo.BackgroundColor := colWhite;
9092 end;
9093 
9094 destructor TvVectorialPage.Destroy;
9095 begin
9096   Clear;
9097 
9098   if FTmpPath <> nil then
9099   begin
9100     FTmpPath.Free;
9101     FTmpPath := nil;
9102   end;
9103 
9104   FEntities.Free;
9105   FEntities := nil;
9106 
9107   inherited Destroy;
9108 end;
9109 
9110 procedure TvVectorialPage.Assign(ASource: TvPage);
9111 var
9112   i: Integer;
9113   AVecSource: TvVectorialPage absolute ASource;
9114 begin
9115   if not (ASource is TvVectorialPage) then Exit;
9116   Clear;
9117 
9118   for i := 0 to AVecSource.GetEntitiesCount - 1 do
9119     Self.AddEntity(AVecSource.GetEntity(i));
9120 end;
9121 
GetEntitynull9122 function TvVectorialPage.GetEntity(ANum: Cardinal): TvEntity;
9123 begin
9124   if ANum >= FEntities.Count then raise Exception.Create('TvVectorialDocument.GetEntity: Entity number out of bounds');
9125 
9126   Result := TvEntity(FEntities.Items[ANum]);
9127 
9128   if Result = nil then raise Exception.Create(Format('TvVectorialDocument.GetEntity: Invalid Entity number ANum=%d', [ANum]));
9129 end;
9130 
GetEntitiesCountnull9131 function TvVectorialPage.GetEntitiesCount: Integer;
9132 begin
9133   Result := FEntities.Count;
9134 end;
9135 
GetLastEntitynull9136 function TvVectorialPage.GetLastEntity(): TvEntity;
9137 begin
9138   Result:=TvEntity(FEntities.Last);
9139 end;
9140 
GetEntityIndexnull9141 function TvVectorialPage.GetEntityIndex(AEntity: TvEntity): Integer;
9142 var
9143   i: Integer;
9144 begin
9145   Result := -1;
9146   for i := 0 to GetEntitiesCount()-1 do
9147     if TvEntity(FEntities.Items[i]) = AEntity then Exit(i);
9148 end;
9149 
FindAndSelectEntitynull9150 function TvVectorialPage.FindAndSelectEntity(Pos: TPoint): TvFindEntityResult;
9151 var
9152   lEntity: TvEntity;
9153   i: Integer;
9154   lSubpart: Cardinal;
9155 begin
9156   Result := vfrNotFound;
9157 
9158   for i := 0 to GetEntitiesCount() - 1 do
9159   begin
9160     lEntity := GetEntity(i);
9161 
9162     Result := lEntity.TryToSelect(Pos, lSubpart);
9163 
9164     if Result <> vfrNotFound then
9165     begin
9166       Owner.SelectedElement := lEntity;
9167       Exit;
9168     end;
9169   end;
9170 end;
9171 
FindEntityWithNameAndTypenull9172 function TvVectorialPage.FindEntityWithNameAndType(AName: string;
9173   AType: TvEntityClass; ARecursively: Boolean): TvEntity;
9174 var
9175   i: Integer;
9176   lCurEntity: TvEntity;
9177   lCurName: String;
9178 begin
9179   Result := nil;
9180   for i := 0 to GetEntitiesCount()-1 do
9181   begin
9182     lCurEntity := GetEntity(i);
9183 
9184     if (lCurEntity is TvNamedEntity) then
9185       lCurName := TvNamedEntity(lCurEntity).Name
9186     else
9187       lCurName := '';
9188 
9189     if (lCurEntity is AType) and
9190       (lCurEntity is TvNamedEntity) and (lCurName = AName) then
9191     begin
9192       Result := lCurEntity;
9193       Exit;
9194     end;
9195 
9196     if ARecursively and (lCurEntity is TvEntityWithSubEntities) then
9197     begin
9198       Result := TvEntityWithSubEntities(lCurEntity).FindEntityWithNameAndType(AName, AType, True);
9199       if Result <> nil then Exit;
9200     end;
9201   end;
9202 end;
9203 
9204 procedure TvVectorialPage.Clear;
9205 begin
9206   FEntities.ForEachCall(@CallbackDeleteEntity, nil);
9207   FEntities.Clear();
9208   ClearTmpPath();
9209   ClearLayerSelection();
9210 end;
9211 
9212 {@@
9213   Returns if the entity was really deleted or false if there is no entity with this index
9214 }
DeleteEntitynull9215 function TvVectorialPage.DeleteEntity(AIndex: Cardinal): Boolean;
9216 var
9217   lEntity: TvEntity;
9218 begin
9219   Result := False;
9220   if AIndex >= GetEntitiesCount() then Exit;;
9221   lEntity := GetEntity(AIndex);
9222   if lEntity = nil then Exit;
9223   FEntities.Delete(AIndex);
9224   lEntity.Free;
9225   Result := True;
9226 end;
9227 
RemoveEntitynull9228 function TvVectorialPage.RemoveEntity(AEntity: TvEntity; AFreeAfterRemove: Boolean = True): Boolean;
9229 begin
9230   Result := False;
9231   if AEntity = nil then Exit;
9232   FEntities.Remove(AEntity);
9233   if AFreeAfterRemove then AEntity.Free;
9234   Result := True;
9235 end;
9236 
9237 {@@
9238   Adds an entity to the document and returns it's current index
9239 }
TvVectorialPage.AddEntitynull9240 function TvVectorialPage.AddEntity(AEntity: TvEntity): Integer;
9241 begin
9242   AEntity.SetPage(Self);
9243   if FCurrentLayer = nil then
9244   begin
9245     Result := FEntities.Count;
9246     //AEntity.Parent := nil;
9247     FEntities.Add(Pointer(AEntity));
9248   end
9249   // If a layer is selected as current, add elements to it instead
9250   else
9251   begin
9252     Result := FCurrentLayer.GetSubpartCount();
9253     //AEntity.Parent := FCurrentLayer;
9254     FCurrentLayer.AddEntity(AEntity);
9255   end;
9256 end;
9257 
AddPathCopyMemnull9258 function TvVectorialPage.AddPathCopyMem(APath: TPath; AOnlyCreate: Boolean = False): TPath;
9259 var
9260   lPath: TPath;
9261   //Len: Integer;
9262 begin
9263   lPath := TPath.Create(Self);
9264   lPath.Assign(APath);
9265   Result := lPath;
9266   if not AOnlyCreate then AddEntity(lPath);
9267   //WriteLn(':>TvVectorialDocument.AddPath 1 Len = ', Len);
9268 end;
9269 
9270 {@@
9271   Starts writing a Path in multiple steps.
9272   Should be followed by zero or more calls to AddPointToPath
9273   and by a call to EndPath to effectively add the data.
9274 
9275   @see    EndPath, AddPointToPath
9276 }
9277 procedure TvVectorialPage.StartPath(AX, AY: Double);
9278 var
9279   segment: T2DSegment;
9280 begin
9281   ClearTmpPath();
9282 
9283   FTmpPath.Len := 1;
9284   segment := T2DSegment.Create;
9285   segment.SegmentType := stMoveTo;
9286   segment.X := AX;
9287   segment.Y := AY;
9288 
9289   FTmpPath.Points := segment;
9290   FTmpPath.PointsEnd := segment;
9291 end;
9292 
9293 procedure TvVectorialPage.StartPath;
9294 begin
9295   ClearTmpPath();
9296 end;
9297 
9298 procedure TvVectorialPage.AddMoveToPath(AX, AY: Double);
9299 var
9300   segment: T2DSegment;
9301 begin
9302   segment := T2DSegment.Create;
9303   segment.SegmentType := stMoveTo;
9304   segment.X := AX;
9305   segment.Y := AY;
9306 
9307   AppendSegmentToTmpPath(segment);
9308 end;
9309 
9310 {@@
9311   Adds one more point to the end of a Path being
9312   writing in multiple steps.
9313 
9314   Does nothing if not called between StartPath and EndPath.
9315 
9316   Can be called multiple times to add multiple points.
9317 
9318   @see    StartPath, EndPath
9319 }
9320 procedure TvVectorialPage.AddLineToPath(AX, AY: Double);
9321 var
9322   segment: T2DSegment;
9323 begin
9324   segment := T2DSegment.Create;
9325   segment.SegmentType := st2DLine;
9326   segment.X := AX;
9327   segment.Y := AY;
9328 
9329   AppendSegmentToTmpPath(segment);
9330 end;
9331 
9332 procedure TvVectorialPage.AddLineToPath(AX, AY: Double; AColor: TFPColor);
9333 var
9334   segment: T2DSegmentWithPen;
9335 begin
9336   segment := T2DSegmentWithPen.Create;
9337   segment.SegmentType := st2DLineWithPen;
9338   segment.X := AX;
9339   segment.Y := AY;
9340   segment.Pen.Color := AColor;
9341 
9342   AppendSegmentToTmpPath(segment);
9343 end;
9344 
9345 procedure TvVectorialPage.AddLineToPath(AX, AY, AZ: Double);
9346 var
9347   segment: T3DSegment;
9348 begin
9349   segment := T3DSegment.Create;
9350   segment.SegmentType := st3DLine;
9351   segment.X := AX;
9352   segment.Y := AY;
9353   segment.Z := AZ;
9354 
9355   AppendSegmentToTmpPath(segment);
9356 end;
9357 
9358 {@@
9359   Gets the current Pen Pos in the temporary path
9360 }
9361 procedure TvVectorialPage.GetCurrentPathPenPos(var AX, AY: Double);
9362 begin
9363   // Check if we are the first segment in the tmp path
9364   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');
9365 
9366   AX := T2DSegment(FTmpPath.PointsEnd).X;
9367   AY := T2DSegment(FTmpPath.PointsEnd).Y;
9368 end;
9369 
9370 procedure TvVectorialPage.GetTmpPathStartPos(var AX, AY: Double);
9371 begin
9372   AX := 0;
9373   AY := 0;
9374   if (FTmpPath = nil) or (FTmpPath.GetSubpartCount() <= 0) or (FTmpPath.Points = nil) then Exit;
9375   if FTmpPath.Points is T2DSegment then
9376   begin
9377     AX := T2DSegment(FTmpPath.Points).X;
9378     AY := T2DSegment(FTmpPath.Points).Y;
9379   end;
9380 end;
9381 
9382 {@@
9383   Adds a bezier element to the path. It starts where the previous element ended
9384   and it goes throw the control points [AX1, AY1] and [AX2, AY2] and ends
9385   in [AX3, AY3].
9386 }
9387 procedure TvVectorialPage.AddBezierToPath(AX1, AY1, AX2, AY2, AX3, AY3: Double);
9388 var
9389   segment: T2DBezierSegment;
9390 begin
9391   segment := T2DBezierSegment.Create;
9392   segment.SegmentType := st2DBezier;
9393   segment.X := AX3;
9394   segment.Y := AY3;
9395   segment.X2 := AX1;
9396   segment.Y2 := AY1;
9397   segment.X3 := AX2;
9398   segment.Y3 := AY2;
9399 
9400   AppendSegmentToTmpPath(segment);
9401 end;
9402 
9403 procedure TvVectorialPage.AddBezierToPath(AX1, AY1, AZ1, AX2, AY2, AZ2, AX3, AY3, AZ3: Double);
9404 var
9405   segment: T3DBezierSegment;
9406 begin
9407   segment := T3DBezierSegment.Create;
9408   segment.SegmentType := st3DBezier;
9409   segment.X := AX3;
9410   segment.Y := AY3;
9411   segment.Z := AZ3;
9412   segment.X2 := AX1;
9413   segment.Y2 := AY1;
9414   segment.Z2 := AZ1;
9415   segment.X3 := AX2;
9416   segment.Y3 := AY2;
9417   segment.Z3 := AZ2;
9418 
9419   AppendSegmentToTmpPath(segment);
9420 end;
9421 
9422 procedure TvVectorialPage.AddEllipticalArcToPath(ARadX, ARadY, AXAxisRotation,
9423   ADestX, ADestY: Double; ALeftmostEllipse, AClockwiseArcFlag: Boolean);
9424 var
9425   segment: T2DEllipticalArcSegment;
9426 begin
9427   segment := T2DEllipticalArcSegment.Create;
9428   segment.SegmentType := st2DEllipticalArc;
9429   segment.X := ADestX;
9430   segment.Y := ADestY;
9431   segment.RX := ARadX;
9432   segment.RY := ARadY;
9433   segment.XRotation := AXAxisRotation;
9434   segment.LeftmostEllipse := ALeftmostEllipse;
9435   segment.ClockwiseArcFlag := AClockwiseArcFlag;
9436 
9437   AppendSegmentToTmpPath(segment);
9438 end;
9439 
9440 procedure TvVectorialPage.AddEllipticalArcWithCenterToPath(ARadX, ARadY,
9441   AXAxisRotation, ADestX, ADestY, ACenterX, ACenterY: Double;
9442   AClockwiseArcFlag: Boolean);
9443 var
9444   segment: T2DEllipticalArcSegment;
9445 begin
9446   segment := T2DEllipticalArcSegment.Create;
9447   segment.SegmentType := st2DEllipticalArc;
9448   segment.X := ADestX;
9449   segment.Y := ADestY;
9450   segment.RX := ARadX;
9451   segment.RY := ARadY;
9452   segment.XRotation := AXAxisRotation;
9453   segment.CX := ACenterX;
9454   segment.CY := ACenterY;
9455   segment.ClockwiseArcFlag := AClockwiseArcFlag;
9456   segment.CenterSetByUser := true;
9457 
9458   AppendSegmentToTmpPath(segment);
9459 end;
9460 
9461 procedure TvVectorialPage.SetBrushColor(AColor: TFPColor);
9462 begin
9463   FTmPPath.Brush.Color := AColor;
9464 end;
9465 
9466 procedure TvVectorialPage.SetBrushStyle(AStyle: TFPBrushStyle);
9467 begin
9468   FTmPPath.Brush.Style := AStyle;
9469 end;
9470 
9471 procedure TvVectorialPage.SetPenColor(AColor: TFPColor);
9472 begin
9473   FTmPPath.Pen.Color := AColor;
9474 end;
9475 
9476 procedure TvVectorialPage.SetPenStyle(AStyle: TFPPenStyle);
9477 begin
9478   FTmPPath.Pen.Style := AStyle;
9479 end;
9480 
9481 procedure TvVectorialPage.SetPenWidth(AWidth: Integer);
9482 begin
9483   FTmPPath.Pen.Width := AWidth;
9484 end;
9485 
9486 procedure TvVectorialPage.SetClipPath(AClipPath: TPath; AClipMode: TvClipMode);
9487 begin
9488   FTmPPath.ClipPath := AClipPath;
9489   FTmPPath.ClipMode := AClipMode;
9490 end;
9491 
9492 {@@
9493   Finishes writing a Path, which was created in multiple
9494   steps using StartPath and AddPointToPath,
9495   to the document.
9496 
9497   Does nothing if there wasn't a previous correspondent call to
9498   StartPath.
9499 
9500   @see    StartPath, AddPointToPath
9501 }
TvVectorialPage.EndPathnull9502 function  TvVectorialPage.EndPath(AOnlyCreate: Boolean = False): TPath;
9503 begin
9504   if FTmpPath.Len = 0 then Exit;
9505   Result := AddPathCopyMem(FTmpPath, AOnlyCreate);
9506   Result.FPage := self;
9507   ClearTmpPath();
9508 end;
9509 
TvVectorialPage.AddTextnull9510 function TvVectorialPage.AddText(AX, AY, AZ: Double; FontName: string;
9511   FontSize: integer; AText: utf8string; AOnlyCreate: Boolean = False): TvText;
9512 var
9513   lText: TvText;
9514 begin
9515   lText := TvText.Create(Self);
9516   lText.Value.Text := AText;
9517   lText.X := AX;
9518   lText.Y := AY;
9519   lText.Z := AZ;
9520   lText.Font.Name := FontName;
9521   lText.Font.Size := FontSize;
9522   if not AOnlyCreate then AddEntity(lText);
9523   Result := lText;
9524 end;
9525 
TvVectorialPage.AddTextnull9526 function TvVectorialPage.AddText(AX, AY: Double; AStr: utf8string; AOnlyCreate: Boolean = False): TvText;
9527 begin
9528   Result := AddText(AX, AY, 0, '', 10, AStr, AOnlyCreate);
9529 end;
9530 
TvVectorialPage.AddTextnull9531 function TvVectorialPage.AddText(AX, AY, AZ: Double; AStr: utf8string; AOnlyCreate: Boolean = False): TvText;
9532 begin
9533   Result := AddText(AX, AY, AZ, '', 10, AStr, AOnlyCreate);
9534 end;
9535 
TvVectorialPage.AddCirclenull9536 function TvVectorialPage.AddCircle(ACenterX, ACenterY, ARadius: Double; AOnlyCreate: Boolean = False): TvCircle;
9537 var
9538   lCircle: TvCircle;
9539 begin
9540   lCircle := TvCircle.Create(Self);
9541   lCircle.X := ACenterX;
9542   lCircle.Y := ACenterY;
9543   lCircle.Radius := ARadius;
9544   Result := lCircle;
9545   if not AOnlyCreate then AddEntity(lCircle);
9546 end;
9547 
AddCircularArcnull9548 function TvVectorialPage.AddCircularArc(ACenterX, ACenterY, ARadius,
9549   AStartAngle, AEndAngle: Double; AColor: TFPColor; AOnlyCreate: Boolean = False): TvCircularArc;
9550 var
9551   lCircularArc: TvCircularArc;
9552 begin
9553   lCircularArc := TvCircularArc.Create(Self);
9554   lCircularArc.X := ACenterX;
9555   lCircularArc.Y := ACenterY;
9556   lCircularArc.Radius := ARadius;
9557   lCircularArc.StartAngle := AStartAngle;
9558   lCircularArc.EndAngle := AEndAngle;
9559   lCircularArc.Pen.Color := AColor;
9560   Result := lCircularArc;
9561   if not AOnlyCreate then AddEntity(lCircularArc);
9562 end;
9563 
TvVectorialPage.AddEllipsenull9564 function TvVectorialPage.AddEllipse(CenterX, CenterY, HorzHalfAxis,
9565   VertHalfAxis, Angle: Double; AOnlyCreate: Boolean = False): TvEllipse;
9566 var
9567   lEllipse: TvEllipse;
9568 begin
9569   lEllipse := TvEllipse.Create(Self);
9570   lEllipse.X := CenterX;
9571   lEllipse.Y := CenterY;
9572   lEllipse.HorzHalfAxis := HorzHalfAxis;
9573   lEllipse.VertHalfAxis := VertHalfAxis;
9574   lEllipse.Angle := Angle;
9575   Result := lEllipse;
9576   if not AOnlyCreate then AddEntity(lEllipse);
9577 end;
9578 
TvVectorialPage.AddBlocknull9579 function TvVectorialPage.AddBlock(AName: string; AX, AY, AZ: Double): TvBlock;
9580 var
9581   lBlock: TvBlock;
9582 begin
9583   lBlock := TvBlock.Create(Self);
9584   lBlock.X := AX;
9585   lBlock.Y := AY;
9586   lBlock.Name := AName;
9587   AddEntity(lBlock);
9588   Result := lBlock;
9589 end;
9590 
AddInsertnull9591 function TvVectorialPage.AddInsert(AX, AY, AZ: Double; AInsertEntity: TvEntity): TvInsert;
9592 var
9593   lInsert: TvInsert;
9594 begin
9595   lInsert := TvInsert.Create(Self);
9596   lInsert.X := AX;
9597   lInsert.Y := AY;
9598   lInsert.InsertEntity := AInsertEntity;
9599   AddEntity(lInsert);
9600   Result := lInsert;
9601 end;
9602 
TvVectorialPage.AddLayernull9603 function TvVectorialPage.AddLayer(AName: string): TvLayer;
9604 begin
9605   Result := TvLayer.Create(Self);
9606   Result.Name := AName;
9607   AddEntity(Result);
9608 end;
9609 
TvVectorialPage.AddLayerAndSetAsCurrentnull9610 function TvVectorialPage.AddLayerAndSetAsCurrent(AName: string): TvLayer;
9611 begin
9612   Result := AddLayer(AName);
9613   FCurrentLayer := Result;
9614 end;
9615 
9616 procedure TvVectorialPage.ClearLayerSelection;
9617 begin
9618   FCurrentLayer := nil;
9619 end;
9620 
TvVectorialPage.SetCurrentLayernull9621 function TvVectorialPage.SetCurrentLayer(ALayer: TvEntityWithSubEntities): Boolean;
9622 begin
9623   Result := True;
9624   FCurrentLayer := ALayer;
9625 end;
9626 
GetCurrentLayernull9627 function TvVectorialPage.GetCurrentLayer: TvEntityWithSubEntities;
9628 begin
9629   Result := FCurrentLayer;
9630 end;
9631 
9632 
AddAlignedDimensionnull9633 function TvVectorialPage.AddAlignedDimension(BaseLeft, BaseRight, DimLeft,
9634   DimRight: T3DPoint; AOnlyCreate: Boolean = False): TvAlignedDimension;
9635 var
9636   lDim: TvAlignedDimension;
9637 begin
9638   lDim := TvAlignedDimension.Create(Self);
9639   lDim.BaseLeft := BaseLeft;
9640   lDim.BaseRight := BaseRight;
9641   lDim.DimensionLeft := DimLeft;
9642   lDim.DimensionRight := DimRight;
9643   Result := lDim;
9644   if not AOnlyCreate then AddEntity(lDim);
9645 end;
9646 
TvVectorialPage.AddRadialDimensionnull9647 function TvVectorialPage.AddRadialDimension(AIsDiameter: Boolean; ACenter,
9648   ADimLeft, ADimRight: T3DPoint; AOnlyCreate: Boolean = False): TvRadialDimension;
9649 var
9650   lDim: TvRadialDimension;
9651 begin
9652   lDim := TvRadialDimension.Create(Self);
9653   lDim.IsDiameter := AIsDiameter;
9654   lDim.Center := ACenter;
9655   lDim.DimensionLeft := ADimLeft;
9656   lDim.DimensionRight := ADimRight;
9657   Result := lDim;
9658   if not AOnlyCreate then AddEntity(lDim);
9659 end;
9660 
TvVectorialPage.AddArcDimensionnull9661 function TvVectorialPage.AddArcDimension(AArcValue, AArcRadius: Double; ABaseLeft, ABaseRight, ADimLeft, ADimRight, ATextPos: T3DPoint; AOnlyCreate: Boolean): TvArcDimension;
9662 var
9663   lDim: TvArcDimension;
9664 begin
9665   lDim := TvArcDimension.Create(Self);
9666   lDim.BaseLeft := ABaseLeft;
9667   lDim.BaseRight := ABaseRight;
9668   lDim.DimensionLeft := ADimLeft;
9669   lDim.DimensionRight := ADimRight;
9670   lDim.ArcRadius := AArcRadius;
9671   lDim.ArcValue := AArcValue;
9672   lDim.TextPos := ATextPos;
9673   Result := lDim;
9674   if not AOnlyCreate then AddEntity(lDim);
9675 end;
9676 
AddPointnull9677 function TvVectorialPage.AddPoint(AX, AY, AZ: Double): TvPoint;
9678 var
9679   lPoint: TvPoint;
9680 begin
9681   lPoint := TvPoint.Create(Self);
9682   lPoint.X := AX;
9683   lPoint.Y := AY;
9684   lPoint.Z := AZ;
9685   AddEntity(lPoint);
9686   Result := lPoint;
9687 end;
9688 
9689 procedure TvVectorialPage.PositionEntitySubparts(constref
9690   ARenderInfo: TvRenderInfo; ABaseX, ABaseY: Double);
9691 var
9692   i: Integer;
9693 begin
9694   for i := 0 to GetEntitiesCount()-1 do
9695     GetEntity(i).PositionSubparts(ARenderInfo, ABaseX, ABaseY);
9696 end;
9697 
9698 procedure TvVectorialPage.DrawBackground(ADest: TFPCustomCanvas);
9699 begin
9700   ADest.Pen.Style := psClear;
9701   ADest.Brush.Style := bsSolid;
9702   ADest.Brush.FPColor := BackgroundColor;
9703   ADest.FillRect(0, 0, ADest.Width, ADest.Height);
9704   ADest.Pen.Style := psSolid;
9705 end;
9706 
9707 procedure TvVectorialPage.RenderPageBorder(ADest: TFPCustomCanvas;
9708   ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double);
9709 
CoordToCanvasXnull9710   function CoordToCanvasX(ACoord: Double): Integer;
9711   begin
9712     Result := Round(ADestX + AmulX * ACoord);
9713   end;
9714 
CoordToCanvasYnull9715   function CoordToCanvasY(ACoord: Double): Integer;
9716   begin
9717     Result := Round(ADestY + AmulY * ACoord);
9718   end;
9719 
9720 var
9721   lLeft, lTop, lRight, lBottom: Integer;
9722 begin
9723   // Fix the min/max values
9724   if MinX = MaxX then MaxX := MinX + Width;
9725   if MinY = MaxY then MaxY := MinY + Height;
9726 
9727   lLeft := CoordToCanvasX(MinX);
9728   lTop := CoordToCanvasY(MaxY);
9729   lRight := CoordToCanvasX(MaxX);
9730   lBottom := CoordToCanvasY(MinY);
9731 
9732   ADest.Brush.Style := bsClear;
9733   ADest.Pen.FPColor := colBlack;
9734   ADest.Pen.Style := psSolid;
9735   ADest.Pen.Width := 1;
9736   ADest.Rectangle(lLeft, lTop, lRight, lBottom);
9737 end;
9738 
9739 {@@
9740   This function draws a FPVectorial vectorial page to a TFPCustomCanvas
9741   descendent, such as TCanvas from the LCL.
9742 
9743   Be careful that by default this routine does not execute coordinate transformations,
9744   and that FPVectorial works with a start point in the bottom-left corner, with
9745   the X growing to the right and the Y growing to the top. This will result in
9746   an image in TFPCustomCanvas mirrored in the Y axis in relation with the document
9747   as seen in a PDF viewer, for example. This can be easily changed with the
9748   provided parameters. To have the standard view of an image viewer one could
9749   use this function like this:
9750 
9751   ASource.Render(ADest, 0, ASource.Height, 1.0, -1.0);
9752 
9753   Set ADoDraw to falses in order to just get the bounding box of all entities
9754   on the page in RenderInfo.EnitityCanvasMinXY/EntityCanvasMaxXY.
9755 }
9756 procedure TvVectorialPage.Render(ADest: TFPCustomCanvas;
9757   ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double;
9758   ADoDraw: Boolean = true);
9759 var
9760   i: Integer;
9761   CurEntity: TvEntity;
9762   rinfo: TvRenderInfo;
9763 begin
9764   {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
9765   WriteLn(':>DrawFPVectorialToCanvas');
9766   {$endif}
9767 
9768   InitializeRenderInfo(RenderInfo, ADest, nil);
9769   InitializeRenderInfo(rInfo, ADest, nil);
9770   TvEntity.CopyAndInitDocumentRenderInfo(rInfo, RenderInfo, False, False);
9771   if Assigned(FOwner.FRenderer) then FOwner.FRenderer.BeginRender(RenderInfo, ADoDraw);
9772 
9773   for i := 0 to GetEntitiesCount - 1 do
9774   begin
9775     {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
9776     Write(Format('[Path] ID=%d', [i]));
9777     {$endif}
9778 
9779     CurEntity := GetEntity(i);
9780 
9781     RenderInfo.BackgroundColor := BackgroundColor;
9782     RenderInfo.AdjustPenColorToBackground := AdjustPenColorToBackground;
9783     RenderInfo.DestX := ADestX;
9784     RenderInfo.DestY := ADestY;
9785     RenderInfo.MulX := AMulX;
9786     RenderInfo.MulY := AMulY;
9787 
9788     CurEntity.Render(RenderInfo, ADoDraw);
9789 
9790     if i = 0 then
9791       rInfo := RenderInfo
9792     else
9793     begin
9794       rInfo.EntityCanvasMinXY.X := Min(rInfo.EntityCanvasMinXY.X, RenderInfo.EntityCanvasMinXY.X);
9795       rInfo.EntityCanvasMinXY.Y := Min(rInfo.EntityCanvasMinXY.Y, RenderInfo.EntityCanvasMinXY.Y);
9796       rInfo.EntityCanvasMaxXY.X := Max(rInfo.EntityCanvasMaxXY.X, RenderInfo.EntityCanvasMaxXY.X);
9797       rInfo.EntityCanvasMaxXY.Y := Max(rInfo.EntityCanvasMaxXY.Y, RenderInfo.EntityCanvasMaxXY.Y);
9798     end;
9799   end;
9800 
9801   if Assigned(FOwner.FRenderer) then FOwner.FRenderer.EndRender(RenderInfo, ADoDraw);
9802   TvEntity.CopyAndInitDocumentRenderInfo(RenderInfo, rInfo, True, False);
9803 
9804   {$ifdef FPVECTORIAL_RENDERINFO_VISUALDEBUG}
9805   ADest.Brush.Style := bsClear;
9806   ADest.Pen.FPColor := colRed;
9807   ADest.Rectangle(rInfo.EntityCanvasMinXY.X, RenderInfo.EntityCanvasMinXY.Y,
9808     rInfo.EntityCanvasMaxXY.X, rInfo.EntityCanvasMaxXY.Y);
9809   {$endif}
9810   {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
9811   WriteLn(':<DrawFPVectorialToCanvas');
9812   {$endif}
9813 end;
9814 
9815 procedure TvVectorialPage.GetNaturalRenderPos(var APageHeight: Integer; out AMulY: Double);
9816 begin
9817   if FUseTopLeftCoordinates then
9818   begin
9819     APageHeight := 0;
9820     AMulY := 1.0;
9821   end
9822   else
9823   begin
9824     AMulY := -1.0;
9825   end;
9826 end;
9827 
9828 procedure TvVectorialPage.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
9829   APageItem: Pointer);
9830 var
9831   lCurEntity: TvEntity;
9832   i: Integer;
9833 begin
9834   for i := 0 to FEntities.Count - 1 do
9835   begin
9836     lCurEntity := TvEntity(FEntities.Items[i]);
9837     lCurEntity.GenerateDebugTree(ADestRoutine, APageItem);
9838   end;
9839 end;
9840 
9841 { TvTextPageSequence }
9842 
9843 constructor TvTextPageSequence.Create(AOwner: TvVectorialDocument);
9844 begin
9845   inherited Create(AOwner);
9846 
9847   FUseTopLeftCoordinates := True;
9848   Footer := TvRichText.Create(Self);
9849   Header := TvRichText.Create(Self);
9850   MainText := TvRichText.Create(Self);
9851 end;
9852 
9853 destructor TvTextPageSequence.Destroy;
9854 begin
9855   Footer.Free;
9856   Header.Free;
9857   MainText.Free;
9858 
9859   inherited Destroy;
9860 end;
9861 
9862 procedure TvTextPageSequence.Assign(ASource: TvPage);
9863 begin
9864   inherited Assign(ASource);
9865 end;
9866 
TvTextPageSequence.GetEntitynull9867 function TvTextPageSequence.GetEntity(ANum: Cardinal): TvEntity;
9868 begin
9869   Result := MainText.GetEntity(ANum);
9870 end;
9871 
GetEntitiesCountnull9872 function TvTextPageSequence.GetEntitiesCount: Integer;
9873 begin
9874   Result := MainText.GetEntitiesCount();
9875 end;
9876 
TvTextPageSequence.GetLastEntitynull9877 function TvTextPageSequence.GetLastEntity: TvEntity;
9878 begin
9879   Result := MainText.GetEntity(MainText.GetEntitiesCount()-1);
9880 end;
9881 
GetEntityIndexnull9882 function TvTextPageSequence.GetEntityIndex(AEntity: TvEntity): Integer;
9883 begin
9884   Result := MainText.GetEntityIndex(AEntity);
9885 end;
9886 
FindAndSelectEntitynull9887 function TvTextPageSequence.FindAndSelectEntity(Pos: TPoint
9888   ): TvFindEntityResult;
9889 begin
9890 
9891 end;
9892 
FindEntityWithNameAndTypenull9893 function TvTextPageSequence.FindEntityWithNameAndType(AName: string;
9894   AType: TvEntityClass; ARecursively: Boolean): TvEntity;
9895 begin
9896 
9897 end;
9898 
9899 procedure TvTextPageSequence.Clear;
9900 begin
9901   MainText.Clear;
9902 end;
9903 
TvTextPageSequence.DeleteEntitynull9904 function TvTextPageSequence.DeleteEntity(AIndex: Cardinal): Boolean;
9905 begin
9906   Result := MainText.DeleteEntity(AIndex);
9907 end;
9908 
TvTextPageSequence.RemoveEntitynull9909 function TvTextPageSequence.RemoveEntity(AEntity: TvEntity;
9910   AFreeAfterRemove: Boolean): Boolean;
9911 begin
9912   Result := True;
9913   MainText.Clear;
9914 end;
9915 
AddEntitynull9916 function TvTextPageSequence.AddEntity(AEntity: TvEntity): Integer;
9917 begin
9918   AEntity.SetPage(Self);
9919   Result := MainText.AddEntity(AEntity);
9920 end;
9921 
TvTextPageSequence.AddParagraphnull9922 function TvTextPageSequence.AddParagraph: TvParagraph;
9923 begin
9924   Result := MainText.AddParagraph();
9925 end;
9926 
AddListnull9927 function TvTextPageSequence.AddList: TvList;
9928 begin
9929   Result := MainText.AddList();
9930 end;
9931 
AddTablenull9932 function TvTextPageSequence.AddTable: TvTable;
9933 begin
9934   Result := MainText.AddTable;
9935 end;
9936 
TvTextPageSequence.AddEmbeddedVectorialDocnull9937 function TvTextPageSequence.AddEmbeddedVectorialDoc: TvEmbeddedVectorialDoc;
9938 begin
9939   Result := MainText.AddEmbeddedVectorialDoc;
9940 end;
9941 
9942 procedure TvTextPageSequence.DrawBackground(ADest: TFPCustomCanvas);
9943 begin
9944 
9945 end;
9946 
9947 procedure TvTextPageSequence.RenderPageBorder(ADest: TFPCustomCanvas;
9948   ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double);
9949 begin
9950 
9951 end;
9952 
9953 procedure TvTextPageSequence.Render(ADest: TFPCustomCanvas; ADestX: Integer;
9954   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean = true);
9955 
CoordToCanvasXnull9956   function CoordToCanvasX(ACoord: Double): Integer;
9957   begin
9958     Result := Round(ADestX + AmulX * ACoord);
9959   end;
9960 
CoordToCanvasYnull9961   function CoordToCanvasY(ACoord: Double): Integer;
9962   begin
9963     Result := Round(ADestY + AmulY * ACoord);
9964   end;
9965 
9966 var
9967   i: Integer;
9968   CurEntity: TvEntity;
9969   CurY_px: Integer = 0;
9970   lHeight_px: Integer;
9971   lBoundsLeft, lBoundsTop, lBoundsRight, lBoundsBottom: Double;
9972   lSumRenderInfo: TvRenderInfo;
9973 begin
9974   {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
9975   WriteLn(':>TvTextPageSequence.Render');
9976   {$endif}
9977   CurY_px := ADestY;
9978   InitializeRenderInfo(RenderInfo, ADest, nil);
9979   TvEntity.CopyAndInitDocumentRenderInfo(lSumRenderInfo, RenderInfo);
9980 
9981   for i := 0 to GetEntitiesCount - 1 do
9982   begin
9983     {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
9984     Write(Format('[Path] ID=%d', [i]));
9985     {$endif}
9986 
9987     CurEntity := GetEntity(i);
9988 
9989     CurEntity.X := 0;
9990     CurEntity.Y := 0;
9991     lHeight_px := CurEntity.GetEntityFeatures(lSumRenderInfo).TotalHeight;
9992     RenderInfo.BackgroundColor := BackgroundColor;
9993     RenderInfo.DestX := ADestX;
9994     RenderInfo.DestY := CurY_px + lHeight_px;
9995     RenderInfo.MulX := AMulX;
9996     RenderInfo.MulY := AMulY;
9997     CurEntity.Render(RenderInfo, ADoDraw);
9998     // Store the old position in X/Y but don't use it, we use this to debug out the position
9999     CurEntity.X := ADestX;
10000     CurEntity.Y := CurY_px;
10001     lHeight_px := Abs(RenderInfo.EntityCanvasMaxXY.Y - RenderInfo.EntityCanvasMinXY.Y);
10002     CurY_px := CurY_px + lHeight_px;
10003 
10004     TvEntity.CalcEntityCanvasMinMaxXY_With2Points(lSumRenderInfo,
10005       RenderInfo.EntityCanvasMinXY.X, RenderInfo.EntityCanvasMinXY.Y,
10006       RenderInfo.EntityCanvasMaxXY.X, RenderInfo.EntityCanvasMaxXY.Y);
10007   end;
10008 
10009   TvEntity.CopyAndInitDocumentRenderInfo(RenderInfo, lSumRenderInfo, True);
10010 
10011   {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
10012   WriteLn(':<TvTextPageSequence.Render');
10013   {$endif}
10014 end;
10015 
10016 procedure TvTextPageSequence.GetNaturalRenderPos(var APageHeight: Integer; out AMulY: Double);
10017 begin
10018   APageHeight := 0;
10019   AMulY := 1.0;
10020 end;
10021 
10022 procedure TvTextPageSequence.GenerateDebugTree(
10023   ADestRoutine: TvDebugAddItemProc; APageItem: Pointer);
10024 var
10025   lCurEntity: TvEntity;
10026   i: Integer;
10027 begin
10028   for i := 0 to MainText.GetEntitiesCount() - 1 do
10029   begin
10030     lCurEntity := MainText.GetEntity(i);
10031     lCurEntity.GenerateDebugTree(ADestRoutine, APageItem);
10032   end;
10033 end;
10034 
10035 (*
AddImagenull10036 function TvTextPageSequence.AddImage: TvImage;
10037 begin
10038   Result := MainText.AddImage;
10039 end;
10040 *)
10041 { TvVectorialDocument }
10042 
10043 {@@
10044   Constructor.
10045 }
10046 constructor TvVectorialDocument.Create;
10047 begin
10048   inherited Create;
10049 
10050   FPages := TFPList.Create;
10051   FCurrentPageIndex := -1;
10052   FStyles := TFPList.Create;
10053   FListStyles := TFPList.Create;
10054   if gDefaultRenderer <> nil then
10055     FRenderer := gDefaultRenderer.Create;
10056 end;
10057 
10058 {@@
10059   Destructor.
10060 }
10061 destructor TvVectorialDocument.Destroy;
10062 begin
10063   Clear();
10064 
10065   FPages.Free;
10066   FPages := nil;
10067   FStyles.Free;
10068   FStyles := nil;
10069   FListStyles.Free;
10070   FListStyles := nil;
10071 
10072   ClearRenderer();
10073 
10074   inherited Destroy;
10075 end;
10076 
10077 procedure TvVectorialDocument.Assign(ASource: TvVectorialDocument);
10078 //var
10079 //  i: Integer;
10080 begin
10081 //  Clear;
10082 //
10083 //  for i := 0 to ASource.GetEntitiesCount - 1 do
10084 //    Self.AddEntity(ASource.GetEntity(i));
10085 end;
10086 
10087 procedure TvVectorialDocument.AssignTo(ADest: TvVectorialDocument);
10088 begin
10089   ADest.Assign(Self);
10090 end;
10091 
10092 {@@
10093   Convenience method which creates the correct
10094   writer object for a given vector graphics document format.
10095 }
CreateVectorialWriternull10096 function TvVectorialDocument.CreateVectorialWriter(AFormat: TvVectorialFormat): TvCustomVectorialWriter;
10097 var
10098   i: Integer;
10099 begin
10100   Result := nil;
10101 
10102   for i := 0 to Length(GvVectorialFormats) - 1 do
10103     if GvVectorialFormats[i].Format = AFormat then
10104     begin
10105       if GvVectorialFormats[i].WriterClass <> nil then
10106         Result := GvVectorialFormats[i].WriterClass.Create;
10107 
10108       Break;
10109     end;
10110 
10111   if Result = nil then raise Exception.Create('Unsupported vector graphics format.');
10112 end;
10113 
10114 {@@
10115   Convenience method which creates the correct
10116   reader object for a given vector graphics document format.
10117 }
CreateVectorialReadernull10118 function TvVectorialDocument.CreateVectorialReader(AFormat: TvVectorialFormat): TvCustomVectorialReader;
10119 var
10120   i: Integer;
10121 begin
10122   Result := nil;
10123 
10124   for i := 0 to Length(GvVectorialFormats) - 1 do
10125     if GvVectorialFormats[i].Format = AFormat then
10126     begin
10127       if GvVectorialFormats[i].ReaderClass <> nil then
10128         Result := GvVectorialFormats[i].ReaderClass.Create;
10129 
10130       Break;
10131     end;
10132 
10133   if Result = nil then raise Exception.Create('Unsupported vector graphics format.');
10134 end;
10135 
10136 {@@
10137   Writes the document to a file.
10138 
10139   If the file doesn't exist, it will be created.
10140 }
10141 procedure TvVectorialDocument.WriteToFile(AFileName: string; AFormat: TvVectorialFormat);
10142 var
10143   AWriter: TvCustomVectorialWriter;
10144 begin
10145   AWriter := CreateVectorialWriter(AFormat);
10146 
10147   try
10148     AWriter.WriteToFile(AFileName, Self);
10149   finally
10150     AWriter.Free;
10151   end;
10152 end;
10153 
10154 procedure TvVectorialDocument.WriteToFile(AFileName: string);
10155 var
10156   lFormat: TvVectorialFormat;
10157 begin
10158   lFormat := GetFormatFromExtension(AFileName);
10159   WriteToFile(AFileName, lFormat);
10160 end;
10161 
10162 {@@
10163   Writes the document to a stream
10164 }
10165 procedure TvVectorialDocument.WriteToStream(AStream: TStream; AFormat: TvVectorialFormat);
10166 var
10167   AWriter: TvCustomVectorialWriter;
10168 begin
10169   AWriter := CreateVectorialWriter(AFormat);
10170 
10171   try
10172     AWriter.WriteToStream(AStream, Self);
10173   finally
10174     AWriter.Free;
10175   end;
10176 end;
10177 
10178 procedure TvVectorialDocument.WriteToStrings(AStrings: TStrings;
10179   AFormat: TvVectorialFormat);
10180 var
10181   AWriter: TvCustomVectorialWriter;
10182 begin
10183   AWriter := CreateVectorialWriter(AFormat);
10184 
10185   try
10186     AWriter.WriteToStrings(AStrings, Self);
10187   finally
10188     AWriter.Free;
10189   end;
10190 end;
10191 
10192 {@@
10193   Reads the document from a file.
10194 
10195   Any current contents in this object will be removed.
10196 }
10197 procedure TvVectorialDocument.ReadFromFile(AFileName: string;
10198   AFormat: TvVectorialFormat);
10199 var
10200   AReader: TvCustomVectorialReader;
10201 begin
10202   Self.Clear;
10203 
10204   AReader := CreateVectorialReader(AFormat);
10205   try
10206     AReader.Settings := ReaderSettings;
10207     AReader.ReadFromFile(AFileName, Self);
10208   finally
10209     AReader.Free;
10210   end;
10211 end;
10212 
10213 {@@
10214   Reads the document from a file.  A variant that auto-detects the format from the extension and other factors.
10215 }
10216 procedure TvVectorialDocument.ReadFromFile(AFileName: string);
10217 var
10218   lFormat: TvVectorialFormat;
10219 begin
10220   lFormat := GetFormatFromExtension(AFileName);
10221   ReadFromFile(AFileName, lFormat);
10222 end;
10223 
10224 {@@
10225   Reads the document from a stream.
10226 
10227   Any current contents in this object will be removed.
10228 }
10229 procedure TvVectorialDocument.ReadFromStream(AStream: TStream;
10230   AFormat: TvVectorialFormat);
10231 var
10232   AReader: TvCustomVectorialReader;
10233 begin
10234   Self.Clear;
10235 
10236   AReader := CreateVectorialReader(AFormat);
10237   try
10238     AReader.Settings := ReaderSettings;
10239     AReader.ReadFromStream(AStream, Self);
10240   finally
10241     AReader.Free;
10242   end;
10243 end;
10244 
10245 procedure TvVectorialDocument.ReadFromStrings(AStrings: TStrings;
10246   AFormat: TvVectorialFormat);
10247 var
10248   AReader: TvCustomVectorialReader;
10249 begin
10250   Self.Clear;
10251 
10252   AReader := CreateVectorialReader(AFormat);
10253   try
10254     AReader.Settings := ReaderSettings;
10255     AReader.ReadFromStrings(AStrings, Self);
10256   finally
10257     AReader.Free;
10258   end;
10259 end;
10260 
10261 procedure TvVectorialDocument.ReadFromXML(ADoc: TXMLDocument; AFormat: TvVectorialFormat);
10262 var
10263   AReader: TvCustomVectorialReader;
10264 begin
10265   Self.Clear;
10266 
10267   AReader := CreateVectorialReader(AFormat);
10268   try
10269     AReader.ReadFromXML(ADoc, Self);
10270   finally
10271     AReader.Free;
10272   end;
10273 end;
10274 
TvVectorialDocument.GetFormatFromExtensionnull10275 class function TvVectorialDocument.GetFormatFromExtension(AFileName: string;
10276   ARaiseException: Boolean = True): TvVectorialFormat;
10277 var
10278   lExt: string;
10279 begin
10280   lExt := ExtractFileExt(AFileName);
10281   if AnsiCompareText(lExt, STR_PDF_EXTENSION) = 0 then Result := vfPDF
10282   else if AnsiCompareText(lExt, STR_POSTSCRIPT_EXTENSION) = 0 then Result := vfPostScript
10283   else if AnsiCompareText(lExt, STR_SVG_EXTENSION) = 0 then Result := vfSVG
10284   else if AnsiCompareText(lExt, STR_SVGZ_EXTENSION) = 0 then Result := vfSVGZ
10285   else if AnsiCompareText(lExt, STR_CORELDRAW_EXTENSION) = 0 then Result := vfCorelDrawCDR
10286   else if AnsiCompareText(lExt, STR_WINMETAFILE_EXTENSION) = 0 then Result := vfWindowsMetafileWMF
10287   else if AnsiCompareText(lExt, STR_AUTOCAD_EXCHANGE_EXTENSION) = 0 then Result := vfDXF
10288   else if AnsiCompareText(lExt, STR_ENCAPSULATEDPOSTSCRIPT_EXTENSION) = 0 then Result := vfEncapsulatedPostScript
10289   else if AnsiCompareText(lExt, STR_LAS_EXTENSION) = 0 then Result := vfLAS
10290   else if AnsiCompareText(lExt, STR_LAZ_EXTENSION) = 0 then Result := vfLAZ
10291   else if AnsiCompareText(lExt, STR_RAW_EXTENSION) = 0 then Result := vfRAW
10292   else if AnsiCompareText(lExt, STR_MATHML_EXTENSION) = 0 then Result := vfMathML
10293   else if AnsiCompareText(lExt, STR_ODG_EXTENSION) = 0 then Result := vfODG
10294   else if AnsiCompareText(lExt, STR_DOCX_EXTENSION) = 0 then Result := vfDOCX
10295   else if AnsiCompareText(lExt, STR_HTML_EXTENSION) = 0 then Result := vfHTML
10296   else if ARaiseException then
10297     raise Exception.Create('TvVectorialDocument.GetFormatFromExtension: The extension (' + lExt + ') doesn''t match any supported formats.')
10298   else
10299     Result := vfUnknown;
10300 end;
10301 
TvVectorialDocument.GetDetailedFileFormatnull10302 function  TvVectorialDocument.GetDetailedFileFormat(): string;
10303 begin
10304 
10305 end;
10306 
10307 procedure TvVectorialDocument.GuessDocumentSize();
10308 var
10309   i, j: Integer;
10310   lEntity: TvEntity;
10311   lLeft, lTop, lRight, lBottom: Double;
10312   CurPage: TvPage;
10313   lRenderInfo: TvRenderInfo;
10314 begin
10315   lLeft := 0;
10316   lTop := 0;
10317   lRight := 0;
10318   lBottom := 0;
10319 
10320   for j := 0 to GetPageCount()-1 do
10321   begin
10322     CurPage := GetPage(j);
10323     for i := 0 to CurPage.GetEntitiesCount() - 1 do
10324     begin
10325       lEntity := CurPage.GetEntity(I);
10326       TvEntity.InitializeRenderInfo(lRenderInfo, nil);
10327       lEntity.ExpandBoundingBox(lRenderInfo, lLeft, lTop, lRight, lBottom);
10328     end;
10329   end;
10330 
10331   Width := lRight - lLeft;
10332   Height := lBottom - lTop;
10333 end;
10334 
10335 procedure TvVectorialDocument.GuessGoodZoomLevel(AScreenSize: Integer);
10336 begin
10337   If Height<>0 Then
10338     ZoomLevel := AScreenSize / Height;
10339 end;
10340 
TvVectorialDocument.GetPagenull10341 function TvVectorialDocument.GetPage(AIndex: Integer): TvPage;
10342 begin
10343   Result := TvPage(FPages.Items[AIndex]);
10344 end;
10345 
GetPageIndexnull10346 function TvVectorialDocument.GetPageIndex(APage: TvPage): Integer;
10347 var
10348   i: Integer;
10349 begin
10350   Result := -1;
10351   for i := 0 to FPages.Count-1 do
10352     if TvPage(FPages.Items[i]) = APage then Exit(i);
10353 end;
10354 
GetPageAsVectorialnull10355 function TvVectorialDocument.GetPageAsVectorial(AIndex: Integer): TvVectorialPage;
10356 var
10357   lPage: TvPage;
10358 begin
10359   lPage := GetPage(AIndex);
10360   if lPage is TvVectorialPage then
10361     Result := TvVectorialPage(lPage)
10362   else
10363     Result := nil;
10364 end;
10365 
GetPageAsTextnull10366 function TvVectorialDocument.GetPageAsText(AIndex: Integer): TvTextPageSequence;
10367 var
10368   lPage: TvPage;
10369 begin
10370   lPage := GetPage(AIndex);
10371   if lPage is TvTextPageSequence then
10372     Result := TvTextPageSequence(lPage)
10373   else
10374     Result := nil;
10375 end;
10376 
GetPageCountnull10377 function TvVectorialDocument.GetPageCount: Integer;
10378 begin
10379   Result := FPages.Count;
10380 end;
10381 
GetCurrentPagenull10382 function TvVectorialDocument.GetCurrentPage: TvPage;
10383 begin
10384   if FCurrentPageIndex >= 0 then
10385     Result := GetPage(FCurrentPageIndex)
10386   else
10387     Result := nil;
10388 end;
10389 
TvVectorialDocument.GetCurrentPageAsVectorialnull10390 function TvVectorialDocument.GetCurrentPageAsVectorial: TvVectorialPage;
10391 var
10392   lCurPage: TvPage;
10393 begin
10394   lCurPage := GetCurrentPage();
10395   if lCurPage is TvVectorialPage then
10396     Result := TvVectorialPage(lCurPage)
10397   else
10398     Result := nil
10399 end;
10400 
10401 procedure TvVectorialDocument.SetCurrentPage(AIndex: Integer);
10402 begin
10403   FCurrentPageIndex := AIndex;
10404 end;
10405 
10406 procedure TvVectorialDocument.SetDefaultPageFormat(AFormat: TvPageFormat);
10407 begin
10408   case AFormat of
10409   vpA4:
10410   begin
10411     Width := 210;
10412     Height := 297;
10413   end;
10414   else
10415     Width := 210;
10416     Height := 297;
10417   end;
10418 end;
10419 
AddPagenull10420 function TvVectorialDocument.AddPage(AUseTopLeftCoords: Boolean = False): TvVectorialPage;
10421 begin
10422   Result := TvVectorialPage.Create(Self);
10423   Result.Width := Width;
10424   Result.Height := Height;
10425   Result.SetNaturalRenderPos(AUseTopLeftCoords);
10426   FPages.Add(Result);
10427   if FCurrentPageIndex < 0 then FCurrentPageIndex := FPages.Count-1;
10428 end;
10429 
AddTextPageSequencenull10430 function TvVectorialDocument.AddTextPageSequence: TvTextPageSequence;
10431 begin
10432   Result := TvTextPageSequence.Create(Self);
10433   Result.Width := Width;
10434   Result.Height := Height;
10435   FPages.Add(Result);
10436   if FCurrentPageIndex < 0 then FCurrentPageIndex := FPages.Count-1;
10437 end;
10438 
TvVectorialDocument.AddStylenull10439 function TvVectorialDocument.AddStyle: TvStyle;
10440 begin
10441   Result := TvStyle.Create;
10442   FStyles.Add(Result);
10443 end;
10444 
TvVectorialDocument.AddListStylenull10445 function TvVectorialDocument.AddListStyle: TvListStyle;
10446 begin
10447   Result := TvListStyle.Create;
10448   FListStyles.Add(Result);
10449 end;
10450 
10451 procedure TvVectorialDocument.AddStandardTextDocumentStyles(AFormat: TvVectorialFormat);
10452 var
10453   lTextBody, lBaseHeading, lCurStyle: TvStyle;
10454   lCurListStyle : TvListStyle;
10455   i: Integer;
10456   lCurListLevelStyle: TvListLevelStyle;
10457 begin
10458   lTextBody := AddStyle();
10459   lTextBody.Name := 'Text Body';
10460   lTextBody.Kind := vskTextBody;
10461   lTextBody.Font.Size := 12;
10462   lTextBody.Font.Name := 'Times New Roman';
10463   lTextBody.Brush.Style := bsClear;
10464   lTextBody.Alignment := vsaJustifed;
10465   lTextBody.MarginTop := 0;
10466   lTextBody.MarginBottom := 2.12;
10467   lTextBody.SetElements := [spbfFontSize, spbfFontName, spbfAlignment,
10468     sseMarginTop, sseMarginBottom, spbfBrushStyle];
10469   StyleTextBody := lTextBody;
10470 
10471   // Headings
10472   lBaseHeading := AddStyle();
10473   lBaseHeading.Name := 'Heading';
10474   lBaseHeading.Kind := vskHeading;
10475   lBaseHeading.Font.Size := 14;
10476   lBaseHeading.Font.Name := 'Arial';
10477   lBaseHeading.Brush.Style := bsClear;
10478   lBaseHeading.MarginTop := 4.23;
10479   lBaseHeading.MarginBottom := 2.12;
10480   lBaseHeading.SetElements := [spbfFontSize, spbfFontName, sseMarginTop, sseMarginBottom];
10481 
10482   lCurStyle := AddStyle();
10483   lCurStyle.Name := 'Heading 1';
10484   lCurStyle.Parent := lBaseHeading;
10485   lCurStyle.HeadingLevel := 1;
10486   lCurStyle.Font.Bold := True;
10487   case AFormat of
10488     vfHTML: lCurStyle.Font.Size := 20;
10489   else
10490     lCurStyle.Font.Size := Round(1.15 * lBaseHeading.Font.Size);
10491   end;
10492   lCurStyle.Brush.Style := bsClear;
10493   lCurStyle.SetElements := [spbfFontSize, spbfFontBold];
10494   StyleHeading1 := lCurStyle;
10495 
10496   lCurStyle := AddStyle();
10497   lCurStyle.Name := 'Heading 2';
10498   lCurStyle.Parent := lBaseHeading;
10499   lCurStyle.HeadingLevel := 2;
10500   lCurStyle.Font.Bold := True;
10501   case AFormat of
10502     vfHTML: lCurStyle.Font.Size := 16;
10503   else
10504     lCurStyle.Font.Size := 14;
10505     lCurStyle.Font.Italic := True;
10506   end;
10507   lCurStyle.Brush.Style := bsClear;
10508   lCurStyle.SetElements := [spbfFontSize, spbfFontBold, spbfFontItalic];
10509   StyleHeading2 := lCurStyle;
10510 
10511   lCurStyle := AddStyle();
10512   lCurStyle.Name := 'Heading 3';
10513   lCurStyle.Parent := lBaseHeading;
10514   lCurStyle.HeadingLevel := 3;
10515   lCurStyle.Font.Bold := True;
10516   lCurStyle.Font.Size := 14;
10517   lCurStyle.Brush.Style := bsClear;
10518   lCurStyle.SetElements := [spbfFontSize, spbfFontName, spbfFontBold];
10519   StyleHeading3 := lCurStyle;
10520 
10521   lCurStyle := AddStyle();
10522   lCurStyle.Name := 'Heading 4';
10523   lCurStyle.Parent := lBaseHeading;
10524   lCurStyle.HeadingLevel := 4;
10525   lCurStyle.Font.Size := 12;
10526   lCurStyle.Font.Bold := True;
10527   lCurStyle.Brush.Style := bsClear;
10528   lCurStyle.SetElements := [spbfFontSize, spbfFontName, spbfFontBold];
10529   StyleHeading4 := lCurStyle;
10530 
10531   lCurStyle := AddStyle();
10532   lCurStyle.Name := 'Heading 5';
10533   lCurStyle.Parent := lBaseHeading;
10534   lCurStyle.HeadingLevel := 5;
10535   lCurStyle.Font.Size := 10;
10536   lCurStyle.Font.Bold := True;
10537   lCurStyle.Brush.Style := bsClear;
10538   lCurStyle.SetElements := [spbfFontSize, spbfFontName, spbfFontBold];
10539   StyleHeading5 := lCurStyle;
10540 
10541   lCurStyle := AddStyle();
10542   lCurStyle.Name := 'Heading 6';
10543   lCurStyle.Parent := lBaseHeading;
10544   lCurStyle.HeadingLevel := 6;
10545   lCurStyle.Font.Size := 8;
10546   lCurStyle.Font.Bold := True;
10547   lCurStyle.Brush.Style := bsClear;
10548   lCurStyle.SetElements := [spbfFontSize, spbfFontName, spbfFontBold];
10549   StyleHeading6 := lCurStyle;
10550 
10551   // ---------------------------------
10552   // Centralized paragraph styles
10553   // ---------------------------------
10554 
10555   StyleTextBodyCentralized := AddStyle();
10556   StyleTextBodyCentralized.ApplyOver(StyleTextBody);
10557   StyleTextBodyCentralized.Name := 'Text Body Centered';
10558   StyleTextBodyCentralized.Alignment := vsaCenter;
10559   StyleTextBodyCentralized.SetElements := StyleTextBodyCentralized.SetElements + [spbfAlignment];
10560 
10561   StyleTextBodyBold := AddStyle();
10562   StyleTextBodyBold.ApplyOver(StyleTextBody);
10563   StyleTextBodyBold.Name := 'Text Body Bold';
10564   StyleTextBodyBold.Font.Bold := True;
10565   StyleTextBodyBold.SetElements := StyleTextBodyCentralized.SetElements + [spbfFontBold];
10566 
10567   StyleHeading1Centralized := AddStyle();
10568   StyleHeading1Centralized.ApplyOver(StyleHeading1);
10569   StyleHeading1Centralized.Name := 'Heading 1 Centered';
10570   StyleHeading1Centralized.Alignment := vsaCenter;
10571   StyleHeading1Centralized.SetElements := StyleHeading1Centralized.SetElements + [spbfAlignment];
10572 
10573   StyleHeading2Centralized := AddStyle();
10574   StyleHeading2Centralized.ApplyOver(StyleHeading2);
10575   StyleHeading2Centralized.Name := 'Heading 2 Centered';
10576   StyleHeading2Centralized.Alignment := vsaCenter;
10577   StyleHeading2Centralized.SetElements := StyleHeading2Centralized.SetElements + [spbfAlignment];
10578 
10579   StyleHeading3Centralized := AddStyle();
10580   StyleHeading3Centralized.ApplyOver(StyleHeading3);
10581   StyleHeading3Centralized.Name := 'Heading 3 Centered';
10582   StyleHeading3Centralized.Alignment := vsaCenter;
10583   StyleHeading3Centralized.SetElements := StyleHeading3Centralized.SetElements + [spbfAlignment];
10584 
10585   // ---------------------------------
10586   // Bullet List Items
10587   // ---------------------------------
10588 
10589   lCurListStyle := AddListStyle();
10590   lCurListStyle.Name := 'Bullet List Style';
10591   StyleBulletList := lCurListStyle;
10592 
10593   for i := 0 To NUM_MAX_LISTSTYLES-1 Do
10594   begin
10595     lCurListLevelStyle := StyleBulletList.AddListLevelStyle;
10596     lCurListLevelStyle.Kind := vlskBullet;
10597     lCurListLevelStyle.Level := i;
10598 
10599     // Bullet is positioned at MarginLeft - HangingIndent
10600     lCurListLevelStyle.MarginLeft := 16.35*(i + 1);
10601     lCurListLevelStyle.HangingIndent := 6.35;
10602   end;
10603 
10604   lCurListStyle := AddListStyle();
10605   lCurListStyle.Name := 'Numbered List Style';
10606   StyleNumberList := lCurListStyle;
10607 
10608   for i := 0 To NUM_MAX_LISTSTYLES-1 Do
10609   begin
10610     lCurListLevelStyle := StyleNumberList.AddListLevelStyle;
10611     lCurListLevelStyle.Kind := vlskNumeric;
10612     lCurListLevelStyle.NumberFormat := vnfDecimal;
10613     lCurListLevelStyle.Level := i;
10614 
10615     lCurListLevelStyle.Prefix := '';
10616     lCurListLevelStyle.Suffix := '.';
10617     lCurListLevelStyle.DisplayLevels := True;  // 1.1.1.1.
10618     lCurListLevelStyle.LeaderFontName := 'Arial';
10619 
10620     // For MS Word
10621     // Bullet is positioned at MarginLeft - HangingIndent
10622     lCurListLevelStyle.MarginLeft := 16.35*(i + 1);
10623     lCurListLevelStyle.HangingIndent := 6.35 + 3*i;
10624   end;
10625 
10626   // ---------------------------------
10627   // Text Span Items
10628   // ---------------------------------
10629   StyleTextSpanBold := AddStyle();
10630   StyleTextSpanBold.Kind := vskTextSpan; // This implies this style should not be applied to Paragraphs
10631   StyleTextSpanBold.Name := 'Bold';
10632   StyleTextSpanBold.Font.Bold := True;
10633   StyleTextSpanBold.Brush.Style := bsClear;
10634   StyleTextSpanBold.SetElements := StyleTextSpanBold.SetElements + [spbfFontBold];
10635 
10636   StyleTextSpanItalic := AddStyle();
10637   StyleTextSpanItalic.Kind := vskTextSpan; // This implies this style should not be applied to Paragraphs
10638   StyleTextSpanItalic.Name := 'Italic';
10639   StyleTextSpanItalic.Font.Italic := True;
10640   StyleTextSpanItalic.Brush.Style := bsClear;
10641   StyleTextSpanItalic.SetElements := StyleTextSpanItalic.SetElements + [spbfFontItalic];
10642 
10643   StyleTextSpanUnderline := AddStyle();
10644   StyleTextSpanUnderline.Kind := vskTextSpan; // This implies this style should not be applied to Paragraphs
10645   StyleTextSpanUnderline.Name := 'Underline';
10646   StyleTextSpanUnderline.Font.Underline := True;
10647   StyleTextSpanUnderline.Brush.Style := bsClear;
10648   StyleTextSpanUnderline.SetElements := StyleTextSpanUnderline.SetElements + [spbfFontUnderline];
10649 end;
10650 
TvVectorialDocument.GetStyleCountnull10651 function TvVectorialDocument.GetStyleCount: Integer;
10652 begin
10653   Result := FStyles.Count;
10654 end;
10655 
TvVectorialDocument.GetStylenull10656 function TvVectorialDocument.GetStyle(AIndex: Integer): TvStyle;
10657 begin
10658   Result := TvStyle(FStyles.Items[AIndex]);
10659 end;
10660 
TvVectorialDocument.FindStyleIndexnull10661 function TvVectorialDocument.FindStyleIndex(AStyle: TvStyle): Integer;
10662 var
10663   i: Integer;
10664 begin
10665   Result := -1;
10666   for i := 0 to GetStyleCount()-1 do
10667     if GetStyle(i) = AStyle then Exit(i);
10668 end;
10669 
TvVectorialDocument.GetListStyleCountnull10670 function TvVectorialDocument.GetListStyleCount: Integer;
10671 begin
10672   Result := FListStyles.Count;
10673 end;
10674 
GetListStylenull10675 function TvVectorialDocument.GetListStyle(AIndex: Integer): TvListStyle;
10676 begin
10677   Result := TvListStyle(FListStyles.Items[AIndex]);
10678 end;
10679 
FindListStyleIndexnull10680 function TvVectorialDocument.FindListStyleIndex(AListStyle: TvListStyle): Integer;
10681 var
10682   i: Integer;
10683 begin
10684   Result := -1;
10685   for i := 0 to GetListStyleCount()-1 do
10686     if GetListStyle(i) = AListStyle then Exit(i);
10687 end;
10688 
10689 
10690 {@@
10691   Clears all data in the document
10692 }
10693 // GM: Release memory for each page
10694 procedure TvVectorialDocument.Clear;
10695 var
10696   i: integer;
10697   p: TvPage;
10698 begin
10699   for i:=0 to FStyles.Count-1 do
10700     TvStyle(FStyles[i]).Free;
10701   FStyles.Clear;
10702 
10703   for i:=0 to FListStyles.Count-1 do
10704     TvListStyle(FListStyles[i]).Free;
10705   FListStyles.Clear;
10706 
10707   for i:=FPages.Count-1 downto 0 do
10708   begin
10709     p := TvPage(FPages[i]);
10710     p.Clear;
10711     FreeAndNil(p);
10712   end;
10713   FPages.Clear;
10714   FCurrentPageIndex:=-1;
10715 end;
10716 
GetRenderernull10717 function TvVectorialDocument.GetRenderer: TvRenderer;
10718 begin
10719   Result := FRenderer;
10720 end;
10721 
10722 procedure TvVectorialDocument.SetRenderer(ARenderer: TvRenderer);
10723 begin
10724   ClearRenderer();
10725   FRenderer := ARenderer;
10726 end;
10727 
10728 procedure TvVectorialDocument.ClearRenderer;
10729 begin
10730   if FRenderer <> nil then FreeAndNil(FRenderer);
10731 end;
10732 
10733 procedure TvVectorialDocument.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer);
10734 var
10735   i, lTmpInt: integer;
10736   p: TvPage;
10737   lPageItem: Pointer;
10738   lDebugStr: string;
10739   lTmpY: Double;
10740 begin
10741   for i:=0 to FPages.Count-1 do
10742   begin
10743     p := TvPage(FPages[i]);
10744 
10745     lDebugStr := 'Origin=';
10746     p.GetNaturalRenderPos(lTmpInt, lTmpY);
10747     if lTmpY > 0 then
10748       lDebugStr += 'top-left'
10749     else
10750       lDebugStr += 'bottom-left';
10751 
10752 
10753     lPageItem := ADestRoutine(Format('Page %d : %s %s Width=%f Height=%f MinX=%f MaxX=%f MinY=%f MaxY=%f',
10754       [i, p.ClassName, lDebugStr, p.Width, p.Height, p.MinX, p.MaxX, p.MinY, p.MaxY]), APageItem);
10755     p.GenerateDebugTree(ADestRoutine, lPageItem);
10756   end;
10757 end;
10758 
10759 { TvCustomVectorialReader }
10760 
TvCustomVectorialReader.GetTextContentsFromNodenull10761 class function TvCustomVectorialReader.GetTextContentsFromNode(ANode: TDOMNode): DOMString;
10762 var
10763   lNodeTextTmp: DOMString;
10764   lContentNode: TDOMNode;
10765 begin
10766   Result := '';
10767 
10768   for lContentNode in ANode.GetEnumeratorAllChildren() do
10769   begin
10770     if lContentNode is TDOMText then
10771       lNodeTextTmp := TDOMText(lContentNode).TextContent
10772     else if lContentNode is TDOMEntityReference then
10773     begin
10774       lNodeTextTmp := UTF8LowerCase(lContentNode.NodeName);
10775       case lNodeTextTmp of
10776       'pi': lNodeTextTmp := 'π';
10777       'invisibletimes': lNodeTextTmp := '';
10778       else
10779         lNodeTextTmp := '';//lContentNode.NodeName;
10780       end;
10781     end
10782     else
10783       lNodeTextTmp := lContentNode.NodeName;
10784 
10785     Result := Result + lNodeTextTmp;
10786   end;
10787 end;
10788 
TvCustomVectorialReader.RemoveLineEndingsAndTrimnull10789 class function TvCustomVectorialReader.RemoveLineEndingsAndTrim(AStr: string): string;
10790 begin
10791   Result := Trim(AStr);
10792   Result := StringReplace(Result, #13, '', [rfReplaceAll]);
10793   Result := StringReplace(Result, #10, '', [rfReplaceAll]);
10794 end;
10795 
10796 constructor TvCustomVectorialReader.Create;
10797 begin
10798   inherited Create;
10799 end;
10800 
10801 procedure TvCustomVectorialReader.ReadFromFile(AFileName: string; AData: TvVectorialDocument);
10802 var
10803   FileStream: TFileStream;
10804 begin
10805   FFilename := AFilename;
10806   FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
10807   try
10808     ReadFromStream(FileStream, AData);
10809   finally
10810     FileStream.Free;
10811   end;
10812 end;
10813 
10814 procedure TvCustomVectorialReader.ReadFromStream(AStream: TStream;
10815   AData: TvVectorialDocument);
10816 var
10817   AStringStream: TStringStream;
10818   AStrings: TStringList;
10819 begin
10820   AStringStream := TStringStream.Create('');
10821   AStrings := TStringList.Create;
10822   try
10823     AStringStream.CopyFrom(AStream, AStream.Size);
10824     AStringStream.Seek(0, soFromBeginning);
10825     AStrings.Text := AStringStream.DataString;
10826     ReadFromStrings(AStrings, AData);
10827   finally
10828     AStringStream.Free;
10829     AStrings.Free;
10830   end;
10831 end;
10832 
10833 procedure TvCustomVectorialReader.ReadFromStrings(AStrings: TStrings;
10834   AData: TvVectorialDocument);
10835 var
10836   AStringStream: TStringStream;
10837 begin
10838   AStringStream := TStringStream.Create('');
10839   try
10840     AStringStream.WriteString(AStrings.Text);
10841     AStringStream.Seek(0, soFromBeginning);
10842     ReadFromStream(AStringStream, AData);
10843   finally
10844     AStringStream.Free;
10845   end;
10846 end;
10847 
10848 procedure TvCustomVectorialReader.ReadFromXML(ADoc: TXMLDocument; AData: TvVectorialDocument);
10849 begin
10850 end;
10851 
10852 { TsCustomSpreadWriter }
10853 
10854 constructor TvCustomVectorialWriter.Create;
10855 begin
10856   inherited Create;
10857 end;
10858 
10859 {@@
10860   Default file writting method.
10861 
10862   Opens the file and calls WriteToStream
10863 
10864   @param  AFileName The output file name.
10865                    If the file already exists it will be replaced.
10866   @param  AData     The Workbook to be saved.
10867 
10868   @see    TsWorkbook
10869 }
10870 procedure TvCustomVectorialWriter.WriteToFile(AFileName: string; AData: TvVectorialDocument);
10871 var
10872   OutputFile: TFileStream;
10873 begin
10874   OutputFile := TFileStream.Create(AFileName, fmCreate or fmOpenWrite);
10875   try
10876     WriteToStream(OutputFile, AData);
10877   finally
10878     OutputFile.Free;
10879   end;
10880 end;
10881 
10882 {@@
10883   The default stream writer just uses WriteToStrings
10884 }
10885 procedure TvCustomVectorialWriter.WriteToStream(AStream: TStream;
10886   AData: TvVectorialDocument);
10887 var
10888   lStringList: TStringList;
10889 begin
10890   lStringList := TStringList.Create;
10891   try
10892     WriteToStrings(lStringList, AData);
10893     lStringList.SaveToStream(AStream);
10894   finally
10895     lStringList.Free;
10896   end;
10897 end;
10898 
10899 procedure TvCustomVectorialWriter.WriteToStrings(AStrings: TStrings;
10900   AData: TvVectorialDocument);
10901 begin
10902 
10903 end;
10904 
10905 finalization
10906 
10907   SetLength(GvVectorialFormats, 0);
10908 
10909 end.
10910 
10911