mirror of
				https://gitlab.com/freepascal.org/lazarus/lazarus.git
				synced 2025-10-31 16:02:33 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			10844 lines
		
	
	
		
			335 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			10844 lines
		
	
	
		
			335 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| {
 | ||
| fpvectorial.pas
 | ||
| 
 | ||
| Vector graphics document
 | ||
| 
 | ||
| License: The same modified LGPL as the Free Pascal RTL
 | ||
|          See the file COPYING.modifiedLGPL for more details
 | ||
| 
 | ||
| AUTHORS: Felipe Monteiro de Carvalho
 | ||
|          Pedro Sol Pegorini L de Lima
 | ||
| }
 | ||
| unit fpvectorial;
 | ||
| 
 | ||
| {$ifdef fpc}
 | ||
|   {$mode objfpc}{$h+}
 | ||
| {$endif}
 | ||
| 
 | ||
| {$define USE_LCL_CANVAS}
 | ||
| {$ifdef USE_LCL_CANVAS}
 | ||
|   {$define USE_CANVAS_CLIP_REGION}
 | ||
|   {.$define DEBUG_CANVAS_CLIP_REGION}
 | ||
| {$endif}
 | ||
| {.$define FPVECTORIAL_DEBUG_DIMENSIONS}
 | ||
| {.$define FPVECTORIAL_TOCANVAS_DEBUG}
 | ||
| {.$define FPVECTORIAL_DEBUG_BLOCKS}
 | ||
| {.$define FPVECTORIAL_AUTOFIT_DEBUG}
 | ||
| {.$define FPVECTORIAL_SUPPORT_LAZARUS_1_6}
 | ||
| // visual debugs
 | ||
| {.$define FPVECTORIAL_TOCANVAS_ELLIPSE_VISUALDEBUG}
 | ||
| {.$define FPVECTORIAL_RENDERINFO_VISUALDEBUG}
 | ||
| 
 | ||
| interface
 | ||
| 
 | ||
| uses
 | ||
|   Classes, SysUtils, Math, TypInfo, contnrs, types,
 | ||
|   // FCL-Image
 | ||
|   fpcanvas, fpimage, fpwritebmp,
 | ||
|   // lazutils
 | ||
|   laz2_dom,
 | ||
|   // LCL
 | ||
|   lazutf8, lazregions
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   , Graphics, LCLIntf, LCLType, intfgraphics, graphtype, interfacebase
 | ||
|   {$endif}
 | ||
|   ;
 | ||
| 
 | ||
| type
 | ||
|   TvVectorialFormat = (
 | ||
|     vfUnknown,
 | ||
|     { Multi-purpose document formats }
 | ||
|     vfPDF, vfSVG, vfSVGZ, vfCorelDrawCDR, vfWindowsMetafileWMF, vfODG,
 | ||
|     { CAD formats }
 | ||
|     vfDXF,
 | ||
|     { Geospatial formats }
 | ||
|     vfLAS, vfLAZ,
 | ||
|     { Printing formats }
 | ||
|     vfPostScript, vfEncapsulatedPostScript,
 | ||
|     { GCode formats }
 | ||
|     vfGCodeAvisoCNCPrototipoV5, vfGCodeAvisoCNCPrototipoV6,
 | ||
|     { Formula formats }
 | ||
|     vfMathML,
 | ||
|     { Text Document formats }
 | ||
|     vfODT, vfDOCX, vfHTML,
 | ||
|     { Raster Image formats }
 | ||
|     vfRAW
 | ||
|     );
 | ||
| 
 | ||
|   TvPageFormat = (vpA4, vpA3, vpA2, vpA1, vpA0);
 | ||
| 
 | ||
|   TvProgressEvent = procedure (APercentage: Byte) of object;
 | ||
| 
 | ||
|   {@@ This routine is called to add an item of caption AStr to an item
 | ||
|     AParent, which is a pointer to another item as returned by a previous call
 | ||
|     of this same proc. If AParent = nil then it should add the item to the
 | ||
|     top of the tree. In all cases this routine should return a pointer to the
 | ||
|     newly created item.
 | ||
|   }
 | ||
|   TvDebugAddItemProc = function (AStr: string; AParent: Pointer): Pointer of object;
 | ||
| 
 | ||
| const
 | ||
|   { Default extensions }
 | ||
|   { Multi-purpose document formats }
 | ||
|   STR_PDF_EXTENSION = '.pdf';
 | ||
|   STR_POSTSCRIPT_EXTENSION = '.ps';
 | ||
|   STR_SVG_EXTENSION = '.svg';
 | ||
|   STR_SVGZ_EXTENSION = '.svgz';
 | ||
|   STR_CORELDRAW_EXTENSION = '.cdr';
 | ||
|   STR_WINMETAFILE_EXTENSION = '.wmf';
 | ||
|   STR_AUTOCAD_EXCHANGE_EXTENSION = '.dxf';
 | ||
|   STR_ENCAPSULATEDPOSTSCRIPT_EXTENSION = '.eps';
 | ||
|   STR_LAS_EXTENSION = '.las';
 | ||
|   STR_LAZ_EXTENSION = '.laz';
 | ||
|   STR_RAW_EXTENSION = '.raw';
 | ||
|   STR_MATHML_EXTENSION = '.mathml';
 | ||
|   STR_ODG_EXTENSION = '.odg';
 | ||
|   STR_ODT_EXTENSION = '.odt';
 | ||
|   STR_DOCX_EXTENSION = '.docx';
 | ||
|   STR_HTML_EXTENSION = '.html';
 | ||
| 
 | ||
|   STR_FPVECTORIAL_TEXT_HEIGHT_SAMPLE = 'Ćą';
 | ||
| 
 | ||
|   NUM_MAX_LISTSTYLES = 8;  // OpenDocument Limit is 10, MS Word Limit is 9
 | ||
| 
 | ||
|   // Convenience constant to convert text size points to mm
 | ||
|   FPV_TEXT_POINT_TO_MM = 0.35278;
 | ||
| 
 | ||
|   TWO_PI = 2.0 * pi;
 | ||
| 
 | ||
| type
 | ||
|   TvCustomVectorialWriter = class;
 | ||
|   TvCustomVectorialReader = class;
 | ||
|   TvPage = class;
 | ||
|   TvVectorialPage = class;
 | ||
|   TvTextPageSequence = class;
 | ||
|   TvEntity = class;
 | ||
|   TPath = class;
 | ||
|   TvVectorialDocument = class;
 | ||
|   TvEmbeddedVectorialDoc = class;
 | ||
| 
 | ||
|   { Coordinates }
 | ||
| 
 | ||
|   T2DPoint = record
 | ||
|     X, Y: Double;
 | ||
|   end;
 | ||
|   P2DPoint = ^T2DPoint;
 | ||
| 
 | ||
|   T3DPoint = record
 | ||
|     X, Y, Z: Double;
 | ||
|   end;
 | ||
|   P3DPoint = ^T3DPoint;
 | ||
| 
 | ||
|   T2DPointsArray = array of T2DPoint;
 | ||
|   T3DPointsArray = array of T3DPoint;
 | ||
|   TPointsArray = array of TPoint;
 | ||
| 
 | ||
|   { Pen, Brush and Font }
 | ||
| 
 | ||
|   TvPen = record
 | ||
|     Color: TFPColor;
 | ||
|     Style: TFPPenStyle;
 | ||
|     Width: Integer;
 | ||
|     Pattern: array of LongWord;
 | ||
|   end;
 | ||
|   PvPen = ^TvPen;
 | ||
| 
 | ||
|   TvBrushKind = (bkSimpleBrush, bkHorizontalGradient, bkVerticalGradient,
 | ||
|     bkOtherLinearGradient, bkRadialGradient);
 | ||
|   TvCoordinateUnit = (vcuDocumentUnit, vcuPercentage);
 | ||
| 
 | ||
|   TvGradientFlag = (gfRelStartX, gfRelStartY, gfRelEndX, gfRelEndY, gfRelToUserSpace);
 | ||
|   TvGradientFlags = set of TvGradientFlag;
 | ||
| 
 | ||
|   TvGradientColor = record
 | ||
|     Color: TFPColor;
 | ||
|     Position: Double;   // 0 ... 1
 | ||
|   end;
 | ||
| 
 | ||
|   TvGradientColors = array of TvGradientColor;
 | ||
| 
 | ||
|   TvBrush = record
 | ||
|     Color: TFPColor;
 | ||
|     Style: TFPBrushStyle;
 | ||
|     Kind: TvBrushKind;
 | ||
|     Image: TFPCustomImage;
 | ||
|     // Gradient filling support
 | ||
|     Gradient_start: T2DPoint; // Start/end point of gradient, in pixels by default,
 | ||
|     Gradient_end: T2DPoint;   // but if gfRel* in flags relative to entity boundary or user space
 | ||
|     Gradient_flags: TvGradientFlags;
 | ||
|     Gradient_cx, Gradient_cy, Gradient_r, Gradient_fx, Gradient_fy: Double;
 | ||
|     Gradient_cx_Unit, Gradient_cy_Unit, Gradient_r_Unit, Gradient_fx_Unit, Gradient_fy_Unit: TvCoordinateUnit;
 | ||
|     Gradient_colors: TvGradientColors;
 | ||
|   end;
 | ||
|   PvBrush = ^TvBrush;
 | ||
| 
 | ||
|   TvFont = record
 | ||
|     Color: TFPColor;
 | ||
|     Size: integer;
 | ||
|     Name: utf8string;
 | ||
|     {@@
 | ||
|       Font orientation is measured in degrees and uses the
 | ||
|       same direction as the LCL TFont.orientation, which is counter-clockwise.
 | ||
|       Zero is the normal, horizontal, orientation, directed to the right.
 | ||
|     }
 | ||
|     Orientation: Double;
 | ||
|     Bold: boolean;
 | ||
|     Italic: boolean;
 | ||
|     Underline: boolean;
 | ||
|     StrikeThrough: boolean;
 | ||
|   end;
 | ||
|   PvFont = ^TvFont;
 | ||
| 
 | ||
|   TvSetStyleElement = (
 | ||
|     // Pen, Brush and Font
 | ||
|     spbfPenColor, spbfPenStyle, spbfPenWidth,
 | ||
|     spbfBrushColor, spbfBrushStyle, spbfBrushGradient, spbfBrushKind,
 | ||
|     spbfFontColor, spbfFontSize, spbfFontName, spbfFontBold, spbfFontItalic,
 | ||
|     spbfFontUnderline, spbfFontStrikeThrough, spbfAlignment,
 | ||
|     // TextAnchor
 | ||
|     spbfTextAnchor,
 | ||
|     // Page style
 | ||
|     sseMarginTop, sseMarginBottom, sseMarginLeft, sseMarginRight
 | ||
|     );
 | ||
| 
 | ||
|   TvSetStyleElements = set of TvSetStyleElement;
 | ||
|   // for backwards compatibility, obsolete
 | ||
|   TvSetPenBrushAndFontElement = TvSetStyleElement;
 | ||
|   TvSetPenBrushAndFontElements = TvSetStyleElements;
 | ||
| 
 | ||
|   TvStyleKind = (
 | ||
|     // Paragraph kinds
 | ||
|     vskTextBody, vskHeading,
 | ||
|     // Text-span kind
 | ||
|     vskTextSpan);
 | ||
| 
 | ||
|   TvStyleAlignment = (vsaLeft, vsaRight, vsaJustifed, vsaCenter);
 | ||
| 
 | ||
|   TvTextAnchor = (vtaStart, vtaMiddle, vtaEnd);
 | ||
| 
 | ||
|   { TvStyle }
 | ||
| 
 | ||
|   TvStyle = class
 | ||
|   protected
 | ||
|     FExtraDebugStr: string;
 | ||
|   public
 | ||
|     Name: string;
 | ||
|     Parent: TvStyle; // Can be nil
 | ||
|     Kind: TvStyleKind;
 | ||
|     Alignment: TvStyleAlignment;
 | ||
|     HeadingLevel: Integer;
 | ||
|     //
 | ||
|     Pen: TvPen;
 | ||
|     Brush: TvBrush;
 | ||
|     Font: TvFont;
 | ||
|     TextAnchor: TvTextAnchor;
 | ||
|     // Page style
 | ||
|     MarginTop, MarginBottom, MarginLeft, MarginRight: Double; // in mm
 | ||
|     SuppressSpacingBetweenSameParagraphs : Boolean;
 | ||
|     //
 | ||
|     SetElements: TvSetStyleElements;
 | ||
|     //
 | ||
|     Constructor Create;
 | ||
| 
 | ||
|     function GetKind: TvStyleKind; // takes care of parenting
 | ||
|     procedure Clear(); virtual;
 | ||
|     procedure CopyFrom(AFrom: TvStyle);
 | ||
|     procedure CopyFromEntity(AEntity: TvEntity);
 | ||
|     procedure ApplyOverFromPen(APen: PvPen; ASetElements: TvSetStyleElements);
 | ||
|     procedure ApplyOverFromBrush(ABrush: PvBrush; ASetElements: TvSetStyleElements);
 | ||
|     procedure ApplyOverFromFont(AFont: PvFont; ASetElements: TvSetStyleElements);
 | ||
|     procedure ApplyOver(AFrom: TvStyle); virtual;
 | ||
|     procedure ApplyIntoEntity(ADest: TvEntity); virtual;
 | ||
|     function CreateStyleCombinedWithParent: TvStyle;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; virtual;
 | ||
|   end;
 | ||
| 
 | ||
|   TvListStyleKind = (vlskBullet, vlskNumeric);
 | ||
| 
 | ||
|   TvNumberFormat = (vnfDecimal,      // 0, 1, 2, 3...
 | ||
|                     vnfLowerLetter,  // a, b, c, d...
 | ||
|                     vnfLowerRoman,   // i, ii, iii, iv....
 | ||
|                     vnfUpperLetter,  // A, B, C, D...
 | ||
|                     vnfUpperRoman);  // I, II, III, IV....
 | ||
|   { TvListLevelStyle }
 | ||
| 
 | ||
|   TvListLevelStyle = Class
 | ||
|     Kind : TvListStyleKind;
 | ||
|     Level : Integer;
 | ||
|     Start : Integer; // For numbered lists only
 | ||
| 
 | ||
|     // Define the "leader", the stuff in front of each list item
 | ||
|     Prefix : String;
 | ||
|     Suffix : String;
 | ||
|     Bullet : String; // Only applies to Kind=vlskBullet
 | ||
|     NumberFormat : TvNumberFormat; // Only applies to Kind=vlskNumeric
 | ||
|     DisplayLevels : Boolean; // Only applies to numbered lists.
 | ||
|                              // If true, style is 1.1.1.1.
 | ||
|                              //     else style is 1.
 | ||
|     LeaderFontName : String; // Not used by odt...
 | ||
| 
 | ||
|     MarginLeft : Double; // mm
 | ||
|     HangingIndent : Double; //mm
 | ||
|     Alignment : TvStyleAlignment;
 | ||
| 
 | ||
|     Constructor Create;
 | ||
|   end;
 | ||
| 
 | ||
|  { TvListStyle }
 | ||
| 
 | ||
|   TvListStyle = class
 | ||
|   private
 | ||
|     ListLevelStyles : TFPList;
 | ||
|   public
 | ||
|     Name : String;
 | ||
| 
 | ||
|     constructor Create;
 | ||
|     destructor Destroy; override;
 | ||
| 
 | ||
|     procedure Clear;
 | ||
|     function AddListLevelStyle : TvListLevelStyle;
 | ||
|     function GetListLevelStyleCount : Integer;
 | ||
|     function GetListLevelStyle(AIndex: Integer): TvListLevelStyle;
 | ||
|   end;
 | ||
| 
 | ||
|   { Polyline segments }
 | ||
| 
 | ||
|   TSegmentType = (
 | ||
|     st2DLine, st2DLineWithPen, st2DBezier,
 | ||
|     st3DLine, st3DBezier, stMoveTo,
 | ||
|     st2DEllipticalArc);
 | ||
| 
 | ||
|   {@@
 | ||
|     The coordinates in fpvectorial are given in millimeters and
 | ||
|     the starting point is in the bottom-left corner of the document.
 | ||
|     The X grows to the right and the Y grows to the top.
 | ||
|   }
 | ||
|   { TPathSegment }
 | ||
| 
 | ||
|   TPathSegment = class
 | ||
|   protected
 | ||
|     FPath: TPath;
 | ||
|   public
 | ||
|     SegmentType: TSegmentType;
 | ||
|     // Fields for linking the list
 | ||
|     Previous: TPathSegment;
 | ||
|     Next: TPathSegment;
 | ||
|     // mathematical methods
 | ||
|     function GetLength(): Double; virtual;
 | ||
|     function GetPointAndTangentForDistance(ADistance: Double; out AX, AY, ATangentAngle: Double): Boolean; virtual; // ATangentAngle in radians
 | ||
|     function GetStartPoint(out APoint: T3DPoint): Boolean;
 | ||
|     // edition methods
 | ||
|     procedure Move(ADeltaX, ADeltaY: Double); virtual;
 | ||
|     procedure Rotate(AAngle: Double; ABase: T3DPoint); virtual; // Angle in radians
 | ||
|     procedure CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double); virtual;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; virtual;
 | ||
|     // rendering
 | ||
|     procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); virtual;
 | ||
|     // helper methods
 | ||
|     function UseTopLeftCoordinates: Boolean;
 | ||
|   end;
 | ||
| 
 | ||
|   {@@
 | ||
|     In a 2D segment, the X and Y coordinates represent usually the
 | ||
|     final point of the segment, being that it starts where the previous
 | ||
|     segment ends. The exception is for the first segment of all, which simply
 | ||
|     holds the starting point for the drawing and should always be of the type
 | ||
|     stMoveTo.
 | ||
|   }
 | ||
| 
 | ||
|   { T2DSegment }
 | ||
| 
 | ||
|   T2DSegment = class(TPathSegment)
 | ||
|   public
 | ||
|     X, Y: Double;
 | ||
|     // mathematical methods
 | ||
|     function GetLength(): Double; override;
 | ||
|     function GetPointAndTangentForDistance(ADistance: Double; out AX, AY, ATangentAngle: Double): Boolean; override;
 | ||
|     // edition methods
 | ||
|     procedure Move(ADeltaX, ADeltaY: Double); override;
 | ||
|     procedure Rotate(AAngle: Double; ABase: T3DPoint); override;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|     // rendering
 | ||
|     procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); override;
 | ||
|   end;
 | ||
| 
 | ||
|   T2DSegmentWithPen = class(T2DSegment)
 | ||
|   public
 | ||
|     Pen: TvPen;
 | ||
|   end;
 | ||
| 
 | ||
|   {@@
 | ||
|     In Bezier segments, we remain using the X and Y coordinates for the ending point.
 | ||
|     The starting point is where the previous segment ended, so that the intermediary
 | ||
|     bezier control points are [X2, Y2] and [X3, Y3].
 | ||
| 
 | ||
|     Equations:
 | ||
| 
 | ||
|     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
 | ||
| 
 | ||
|     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]
 | ||
|   }
 | ||
| 
 | ||
|   { T2DBezierSegment }
 | ||
| 
 | ||
|   T2DBezierSegment = class(T2DSegment)
 | ||
|   public
 | ||
|     X2, Y2: Double;
 | ||
|     X3, Y3: Double;
 | ||
|     // mathematical methods
 | ||
|     function GetLength(): Double; override;
 | ||
|     function GetPointAndTangentForDistance(ADistance: Double; out AX, AY, ATangentAngle: Double): Boolean; override;
 | ||
|     // edition methods
 | ||
|     procedure Move(ADeltaX, ADeltaY: Double); override;
 | ||
|     procedure Rotate(AAngle: Double; ABase: T3DPoint); override;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|     // rendering
 | ||
|     procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); override;
 | ||
|   end;
 | ||
| 
 | ||
|   { T3DSegment }
 | ||
| 
 | ||
|   T3DSegment = class(TPathSegment)
 | ||
|   public
 | ||
|     {@@
 | ||
|       Coordinates of the end of the segment.
 | ||
|       For the first segment, this is the starting point.
 | ||
|     }
 | ||
|     X, Y, Z: Double;
 | ||
|     procedure Move(ADeltaX, ADeltaY: Double); override;
 | ||
|     // rendering
 | ||
|     procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); override;
 | ||
|   end;
 | ||
| 
 | ||
|   { T3DBezierSegment }
 | ||
| 
 | ||
|   T3DBezierSegment = class(T3DSegment)
 | ||
|   public
 | ||
|     X2, Y2, Z2: Double;
 | ||
|     X3, Y3, Z3: Double;
 | ||
|     procedure Move(ADeltaX, ADeltaY: Double); override;
 | ||
|   end;
 | ||
| 
 | ||
|   // Elliptical Arc
 | ||
|   // See http://www.w3.org/TR/SVG/paths.html#PathDataEllipticalArcCommands
 | ||
| 
 | ||
|   { T2DEllipticalArcSegment }
 | ||
| 
 | ||
|   T2DEllipticalArcSegment = class(T2DSegment)
 | ||
|   private
 | ||
|     E1, E2: T3DPoint;
 | ||
|     function AlignedEllipseCenterEquationT1(AParam: Double): Double;
 | ||
|   public
 | ||
|     RX, RY: Double; // RX and RY are the X and Y half axis sizes
 | ||
|     XRotation: Double;  // rotation of x axis, in radians
 | ||
|     LeftmostEllipse, ClockwiseArcFlag: Boolean;
 | ||
|     CX, CY: Double; // Ellipse center
 | ||
|     CenterSetByUser: Boolean; // defines if we should use LeftmostEllipse to calculate the center, or if CX, CY is set directly
 | ||
|     procedure BezierApproximate(var Points: T3dPointsArray);
 | ||
|     procedure PolyApproximate(var Points: T3dPointsArray);
 | ||
|     procedure CalculateCenter;
 | ||
|     procedure CalculateEllipseBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double);
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|     procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); override;
 | ||
|     procedure Move(ADeltaX, ADeltaY: Double); override;
 | ||
|     procedure Rotate(AAngle: Double; ABase: T3DPoint); override;
 | ||
|   end;
 | ||
| 
 | ||
|   TvFindEntityResult = (vfrNotFound, vfrFound, vfrSubpartFound);
 | ||
| 
 | ||
|   TvRenderInfo = record
 | ||
|     // Input to the rendering, provided by the Document or some other
 | ||
|     // top-level entity and propagated down to all sub-entities
 | ||
|     BackgroundColor: TFPColor;
 | ||
|     AdjustPenColorToBackground: Boolean;
 | ||
|     Selected: TvEntity;
 | ||
| 
 | ||
|     // Input to the rendering, other inputs
 | ||
|     ForceRenderBlock: Boolean; // Blocks are usually invisible, but when rendering an insert, their drawing can be forced
 | ||
| 
 | ||
|     // Fields which are output from the rendering process
 | ||
|     EntityCanvasMinXY, EntityCanvasMaxXY: TPoint; // The size utilized in the canvas to draw this entity, in pixels
 | ||
| 
 | ||
|     // errors
 | ||
|     Self: TvEntity;
 | ||
|     Parent: TvEntity;
 | ||
|     Errors: TStrings;
 | ||
|   end;
 | ||
| 
 | ||
|   TvEntityFeatures = record
 | ||
|     DrawsUpwards: Boolean; // TvText, TvEmbeddedVectorialDoc, etc draws upwards, but in the future we might have entities drawing downwards
 | ||
|     DrawsUpwardHeightAdjustment: Integer; // in Canvas pixels
 | ||
|     FirstLineHeight: Integer; // in Canvas pixels
 | ||
|     TotalHeight: Integer; // in Canvas pixels
 | ||
|   end;
 | ||
| 
 | ||
|   { Now all elements }
 | ||
| 
 | ||
|   {@@
 | ||
|     All elements should derive from TvEntity, regardless of whatever properties
 | ||
|     they might contain.
 | ||
|   }
 | ||
| 
 | ||
|   { TvEntity }
 | ||
| 
 | ||
|   TvEntity = class
 | ||
|   public
 | ||
|     //not used currently Parent: TvEntity; // Might be nil if this is placed directly in the page!!!
 | ||
|     X, Y, Z: Double;
 | ||
|     constructor Create(APage: TvPage); virtual;
 | ||
|     procedure Clear; virtual;
 | ||
|     procedure SetPage(APage: TvPage); virtual;
 | ||
|     // in CalculateBoundingBox always remember to treat correctly the case of ADest=nil!!!
 | ||
|     // This cased is utilized to guess the size of a document even before getting a canvas to draw at
 | ||
|     procedure CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double); virtual;
 | ||
|     function CalculateSizeInCanvas(ADest: TFPCustomCanvas; APage: TvPage; APageHeight: Integer; AZoom: Double; out ALeft, ATop, AWidth, AHeight: Integer): Boolean;
 | ||
|     procedure CalculateHeightInCanvas(ADest: TFPCustomCanvas; AMulX, AMulY: Double; out AHeight: Integer);
 | ||
|     // helper functions for CalculateBoundingBox & TvRenderInfo
 | ||
|     procedure ExpandBoundingBox(ADest: TFPCustomCanvas; var ALeft, ATop, ARight, ABottom: Double);
 | ||
|     class procedure CalcEntityCanvasMinMaxXY(var ARenderInfo: TvRenderInfo; APointX, APointY: Integer);
 | ||
|     class procedure CalcEntityCanvasMinMaxXY_With2Points(var ARenderInfo: TvRenderInfo; AX1, AY1, AX2, AY2: Integer);
 | ||
|     procedure MergeRenderInfo(var AFrom, ATo: TvRenderInfo);
 | ||
|     class procedure InitializeRenderInfo(out ARenderInfo: TvRenderInfo; ASelf: TvEntity; ACreateObjs: Boolean = False);
 | ||
|     class procedure FinalizeRenderInfo(var ARenderInfo: TvRenderInfo);
 | ||
|     class procedure CopyAndInitDocumentRenderInfo(out ATo: TvRenderInfo; AFrom: TvRenderInfo; ACopyMinMax: Boolean = False);
 | ||
|     function RenderInfo_GenerateParentTree(ARenderInfo: TvRenderInfo): string;
 | ||
|     function CentralizeY_InHeight(ADest: TFPCustomCanvas; AHeight: Double): Double;
 | ||
|     function  GetHeight(ADest: TFPCustomCanvas): Double;
 | ||
|     function  GetWidth(ADest: TFPCustomCanvas): Double;
 | ||
|     {@@ ASubpart is only valid if this routine returns vfrSubpartFound }
 | ||
|     function GetLineIntersectionPoints(ACoord: Double;
 | ||
|       ACoordIsX: Boolean): TDoubleDynArray; virtual; // get all points where the entity inner area crosses a line
 | ||
|     function TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult; virtual;
 | ||
|     procedure Move(ADeltaX, ADeltaY: Double); virtual;
 | ||
|     procedure MoveSubpart(ADeltaX, ADeltaY: Double; ASubpart: Cardinal); virtual;
 | ||
|     function  GetSubpartCount: Integer; virtual;
 | ||
|     procedure PositionSubparts(ADest: TFPCustomCanvas; ABaseX, ABaseY: Double); virtual;
 | ||
|     procedure Scale(ADeltaScaleX, ADeltaScaleY: Double); virtual;
 | ||
|     procedure Rotate(AAngle: Double; ABase: T3DPoint); virtual; // Angle in radians
 | ||
|     // ADoDraw = False means that no drawing will actually be done, only the size info will be filled in ARenderInfo
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); virtual;
 | ||
|     function AdjustColorToBackground(AColor: TFPColor; ARenderInfo: TvRenderInfo): TFPColor;
 | ||
|     function GetNormalizedPos(APage: TvVectorialPage; ANewMin, ANewMax: Double): T3DPoint;
 | ||
|     function GetEntityFeatures(ADest: TFPCustomCanvas; AMulX, AMulY: Double): TvEntityFeatures; virtual;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; virtual;
 | ||
|     class function GenerateDebugStrForFPColor(AColor: TFPColor): string;
 | ||
|     class function GenerateDebugStrForString(AValue: string): string;
 | ||
|   end;
 | ||
| 
 | ||
|   TvEntityClass = class of TvEntity;
 | ||
| 
 | ||
|   { TvNamedEntity }
 | ||
| 
 | ||
|   TvNamedEntity = class(TvEntity)
 | ||
|   protected
 | ||
|     FExtraDebugStr: string;
 | ||
|     FPage: TvPage;
 | ||
|   public
 | ||
|     Name: string;
 | ||
|     constructor Create(APage: TvPage); override;
 | ||
|     procedure SetPage(APage: TvPage); override;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|   end;
 | ||
| 
 | ||
|   { TvEntityWithPen }
 | ||
| 
 | ||
|   TvEntityWithPen = class(TvNamedEntity)
 | ||
|   protected
 | ||
|     function CreatePath: TPath; virtual;
 | ||
|   public
 | ||
|     {@@ The global Pen for the entire entity. In the case of paths, individual
 | ||
|         elements might be able to override this setting. }
 | ||
|     Pen: TvPen;
 | ||
|     constructor Create(APage: TvPage); override;
 | ||
|     procedure ApplyPenToCanvas(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo); overload;
 | ||
|     procedure ApplyPenToCanvas(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; APen: TvPen); overload;
 | ||
|     procedure AssignPen(APen: TvPen);
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|   end;
 | ||
| 
 | ||
|   { TvEntityWithPenAndBrush }
 | ||
| 
 | ||
|   TvClipMode = (vcmNonzeroWindingRule, vcmEvenOddRule);
 | ||
| 
 | ||
|   TvEntityWithPenAndBrush = class(TvEntityWithPen)
 | ||
|   protected
 | ||
|     procedure CalcGradientVector(out AGradientStart, AGradientEnd: T2dPoint;
 | ||
|       const ARect: TRect; ADestX: Integer = 0; ADestY: Integer = 0;
 | ||
|       AMulX: Double = 1.0; AMulY: Double = 1.0);
 | ||
|     procedure DrawPolygon(ADest: TFPCustomCanvas; var RenderInfo: TvRenderInfo;
 | ||
|       const APoints: TPointsArray; const APolyStarts: TIntegerDynArray; ARect: TRect);
 | ||
|     procedure DrawPolygonBrushLinearGradient(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
 | ||
|       const APoints: TPointsArray;const APolyStarts: TIntegerDynArray;
 | ||
|       ARect: TRect; AGradientStart, AGradientEnd: T2DPoint);
 | ||
|     procedure DrawPolygonBrushRadialGradient(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
 | ||
|       const APoints: TPointsArray; ARect: TRect);
 | ||
|     procedure DrawNativePolygonBrushRadialGradient(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
 | ||
|       const APoints: TPointsArray; ARect: TRect);
 | ||
|     procedure DrawPolygonBorderOnly(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
 | ||
|       const APoints: TPointsArray);
 | ||
|   public
 | ||
|     {@@ The global Brush for the entire entity. In the case of paths, individual
 | ||
|         elements might be able to override this setting. }
 | ||
|     Brush: TvBrush;
 | ||
|     WindingRule: TvClipMode;
 | ||
|     constructor Create(APage: TvPage); override;
 | ||
|     procedure ApplyBrushToCanvas(ADest: TFPCustomCanvas); overload;
 | ||
|     procedure ApplyBrushToCanvas(ADest: TFPCustomCanvas; ABrush: PvBrush); overload;
 | ||
|     procedure AssignBrush(ABrush: PvBrush);
 | ||
|     procedure DrawBrush(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
 | ||
|       ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
 | ||
|     procedure DrawBrushGradient(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
 | ||
|       x1, y1, x2, y2: Integer;
 | ||
|       ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); virtual;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|   end;
 | ||
| 
 | ||
|   { TvEntityWithPenBrushAndFont }
 | ||
| 
 | ||
|   TvEntityWithPenBrushAndFont = class(TvEntityWithPenAndBrush)
 | ||
|   public
 | ||
|     Font: TvFont;
 | ||
|     TextAnchor: TvTextAnchor;
 | ||
|     constructor Create(APage: TvPage); override;
 | ||
|     procedure ApplyFontToCanvas(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; AMulX: Double = 1.0); overload;
 | ||
|     procedure ApplyFontToCanvas(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; AFont: TvFont; AMulX: Double = 1.0); overload;
 | ||
|     procedure AssignFont(AFont: TvFont);
 | ||
|     procedure Rotate(AAngle: Double; ABase: T3DPoint); override; // Angle in radians
 | ||
|     procedure Scale(ADeltaScaleX, ADeltaScaleY: Double); override;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|   end;
 | ||
| 
 | ||
|   { TvEntityWithStyle }
 | ||
| 
 | ||
|   TvEntityWithStyle = class(TvEntityWithPenBrushAndFont)
 | ||
|   public
 | ||
|     Style: TvStyle; // can be nil!
 | ||
|     constructor Create(APage: TvPage); override;
 | ||
|     destructor Destroy; override;
 | ||
|     function GetCombinedStyle(AParent: TvEntityWithStyle): TvStyle;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|   end;
 | ||
| 
 | ||
|   TPath = class(TvEntityWithPenAndBrush)
 | ||
|   private
 | ||
|     // Used to speed up sequencial access in MoveSubpart
 | ||
|     FCurMoveSubPartIndex: Integer;
 | ||
|     FCurMoveSubPartSegment: TPathSegment;
 | ||
|     //
 | ||
|   protected
 | ||
|     FPolyPoints: TPointsArray;
 | ||
|     FPolyStarts: TIntegerDynArray;
 | ||
|   public
 | ||
|     Len: Integer;
 | ||
|     Points: TPathSegment;   // Beginning of the double-linked list
 | ||
|     PointsEnd: TPathSegment;// End of the double-linked list
 | ||
|     CurPoint: TPathSegment; // Used in PrepareForSequentialReading and Next
 | ||
|     CurWalkDistanceInCurSegment: Double;// Used in PrepareForWalking and NextWalk
 | ||
|     ClipPath: TPath;
 | ||
|     ClipMode: TvClipMode;
 | ||
|     constructor Create(APage: TvPage); override;
 | ||
|     destructor Destroy; override;
 | ||
|     procedure Clear; override;
 | ||
|     procedure Assign(ASource: TPath);
 | ||
|     procedure PrepareForSequentialReading;
 | ||
|     procedure PrepareForWalking;
 | ||
|     function Next(): TPathSegment;
 | ||
|     function NextWalk(ADistance: Double; out AX, AY, ATangentAngle: Double): Boolean;
 | ||
|     procedure CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double); override;
 | ||
|     procedure AppendSegment(ASegment: TPathSegment);
 | ||
|     procedure AppendMoveToSegment(AX, AY: Double);
 | ||
|     procedure AppendLineToSegment(AX, AY: Double);
 | ||
|     procedure AppendEllipticalArc(ARadX, ARadY, AXAxisRotation, ADestX, ADestY: Double; ALeftmostEllipse, AClockwiseArcFlag: Boolean); // See http://www.w3.org/TR/SVG/paths.html#PathDataEllipticalArcCommands
 | ||
|     procedure AppendEllipticalArcWithCenter(ARadX, ARadY, AXAxisRotation, ADestX, ADestY, ACenterX, ACenterY: Double; AClockwiseArcFlag: Boolean); // See http://www.w3.org/TR/SVG/paths.html#PathDataEllipticalArcCommands
 | ||
|     function GetLineIntersectionPoints(ACoord: Double; ACoordIsX: Boolean): TDoubleDynArray; override;
 | ||
|     procedure Move(ADeltaX, ADeltaY: Double); override;
 | ||
|     procedure MoveSubpart(ADeltaX, ADeltaY: Double; ASubpart: Cardinal); override;
 | ||
|     function  MoveToSubpart(ASubpart: Cardinal): TPathSegment;
 | ||
|     function  GetSubpartCount: Integer; override;
 | ||
|     procedure Rotate(AAngle: Double; ABase: T3DPoint); override; // Angle in radians
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     procedure RenderInternalPolygon(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|   end;
 | ||
| 
 | ||
|   {@@
 | ||
|     TvText represents a text entity.
 | ||
| 
 | ||
|     The text starts in X, Y and grows upwards, towards a bigger Y (fpvectorial coordinates)
 | ||
|     or smaller Y (LCL coordinates).
 | ||
|     It has the opposite direction of text in the LCL TCanvas.
 | ||
|   }
 | ||
| 
 | ||
| 
 | ||
|   { TvText }
 | ||
| 
 | ||
|   TvText = class(TvEntityWithStyle)
 | ||
|   private
 | ||
|     function GetTextMetric_Descender_px(ADest: TFPCustomCanvas; AMulX: Double = 1.0): Integer;
 | ||
|   public
 | ||
|     Value: TStringList;
 | ||
|     Render_NextText_X: Integer;
 | ||
|     Render_Use_NextText_X: Boolean;
 | ||
|     constructor Create(APage: TvPage); override;
 | ||
|     destructor Destroy; override;
 | ||
|     function TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult; override;
 | ||
|     procedure CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double); override;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     function GetEntityFeatures(ADest: TFPCustomCanvas; AMulX, AMulY: Double): TvEntityFeatures; override;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|   end;
 | ||
| 
 | ||
|   { TvCurvedText }
 | ||
| 
 | ||
|   // TvCurvedText supports only one line
 | ||
|   TvCurvedText = class(TvText)
 | ||
|   public
 | ||
|     Path: TPath;
 | ||
|     //constructor Create(APage: TvPage); override;
 | ||
|     //destructor Destroy; override;
 | ||
|     //function TryToSelect(APos: TPoint; var ASubpart: Cardinal): TvFindEntityResult; override;
 | ||
|     //procedure CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double); override;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     //function GetEntityFeatures: TvEntityFeatures; override;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|   end;
 | ||
| 
 | ||
|   TvFieldKind = (vfkNumPages, vfkPage, vfkAuthor, vfkDateCreated, vfkDate);
 | ||
| 
 | ||
|   { TvField }
 | ||
| 
 | ||
|   TvField = Class(TvEntityWithStyle)
 | ||
|   public
 | ||
|     Kind : TvFieldKind;
 | ||
| 
 | ||
|     DateFormat : String;            // Only for Kind in (vfkDateCreated, vfkDate)
 | ||
|                                     // Date Format is similar to MS Specification
 | ||
|     NumberFormat : TvNumberFormat;  // Only for Kind in (vfkNumPages, vfkPage)
 | ||
| 
 | ||
|     constructor Create(APage : TvPage); override;
 | ||
|   end;
 | ||
| 
 | ||
|   {@@
 | ||
|   }
 | ||
| 
 | ||
|   { TvCircle }
 | ||
| 
 | ||
|   TvCircle = class(TvEntityWithPenAndBrush)
 | ||
|   protected
 | ||
|     function CreatePath: TPath; override;
 | ||
|   public
 | ||
|     Radius: Double;
 | ||
|     procedure CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double); override;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     procedure Rotate(AAngle: Double; ABase: T3DPoint); override; // Angle in radians
 | ||
|   end;
 | ||
| 
 | ||
|   {@@
 | ||
|   }
 | ||
| 
 | ||
|   { TvCircularArc }
 | ||
| 
 | ||
|   TvCircularArc = class(TvEntityWithPenAndBrush)
 | ||
|   public
 | ||
|     Radius: Double;
 | ||
|     {@@ The Angle is measured in degrees in relation to the positive X axis }
 | ||
|     StartAngle, EndAngle: Double;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|   end;
 | ||
| 
 | ||
|   {@@
 | ||
|   }
 | ||
| 
 | ||
|   { TvEllipse }
 | ||
| 
 | ||
|   TvEllipse = class(TvEntityWithPenAndBrush)
 | ||
|   protected
 | ||
|     function CreatePath: TPath; override;
 | ||
|   public
 | ||
|     // Mandatory fields
 | ||
|     HorzHalfAxis: Double; // This half-axis is the horizontal one when Angle=0
 | ||
|     VertHalfAxis: Double; // This half-axis is the vertical one when Angle=0
 | ||
|     {@@ The Angle is measured in radians in relation to the positive X axis }
 | ||
|     Angle: Double;
 | ||
|     function GetLineIntersectionPoints(ACoord: Double; ACoordIsX: Boolean): TDoubleDynArray; override;
 | ||
|     function TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult; override;
 | ||
|     procedure CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double); override;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     procedure Rotate(AAngle: Double; ABase: T3DPoint); override; // Angle in radians
 | ||
|   end;
 | ||
| 
 | ||
|   { TvRectangle }
 | ||
|   { The point (X,Y) refers to the left/top corner of the rectangle! }
 | ||
| 
 | ||
|   TvRectangle = class(TvEntityWithPenBrushAndFont)
 | ||
|   protected
 | ||
|     function CreatePath: TPath; override;
 | ||
|   public
 | ||
|     // A text displayed in the center of the square, usually empty
 | ||
|     Text: string;
 | ||
|     // Mandatory fields
 | ||
|     CX, CY, CZ: Double;  // CX = width, CY = height, CZ = depth
 | ||
|     // Corner rounding, zero indicates no rounding
 | ||
|     RX, RY: Double;
 | ||
|     // The Angle is measured in radians relative to the positive X axis.
 | ||
|     // Center of rotation is (X,Y).
 | ||
|     Angle: Double;
 | ||
|     procedure CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double); override;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     procedure Rotate(AAngle: Double; ABase: T3DPoint); override; // Angle in radians
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|   end;
 | ||
| 
 | ||
|   { TvPolygon }
 | ||
| 
 | ||
|   TvPolygon = class(TvEntityWithPenBrushAndFont)
 | ||
|   public
 | ||
|     // A text displayed in the center of the square, usually empty
 | ||
|     Text: string;
 | ||
|     // All points of the polygon
 | ||
|     Points: array of T3DPoint;
 | ||
|     procedure CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double); override;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|   end;
 | ||
| 
 | ||
|   {@@
 | ||
|    DimensionLeft ---text--- DimensionRight
 | ||
|                  |        |
 | ||
|                  |        | BaseRight
 | ||
|                  |
 | ||
|                  | BaseLeft
 | ||
|   }
 | ||
| 
 | ||
|   { TvAlignedDimension }
 | ||
| 
 | ||
|   TvAlignedDimension = class(TvEntityWithPen)
 | ||
|   public
 | ||
|     // Mandatory fields
 | ||
|     BaseLeft, BaseRight, DimensionLeft, DimensionRight: T3DPoint;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|   end;
 | ||
| 
 | ||
|   {@@
 | ||
| 
 | ||
|   }
 | ||
| 
 | ||
|   { TvRadialDimension }
 | ||
| 
 | ||
|   TvRadialDimension = class(TvEntityWithPen)
 | ||
|   public
 | ||
|     // Mandatory fields
 | ||
|     IsDiameter: Boolean; // If false, it is a radius, if true, it is a diameter
 | ||
|     Center, DimensionLeft, DimensionRight: T3DPoint; // Diameter uses both, Radius uses only DImensionLeft
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|   end;
 | ||
| 
 | ||
|   { TvArcDimension }
 | ||
| 
 | ||
|   TvArcDimension = class(TvEntityWithPen)
 | ||
|   private
 | ||
|     // Calculated fields
 | ||
|     AngleBase, ArcLeft, ArcRight: T3DPoint;
 | ||
|     al, bl, ar, br, AngleLeft, AngleRight: Double;
 | ||
|   public
 | ||
|     // Mandatory fields
 | ||
|     ArcValue, ArcRadius: Double; // ArcValue is in degrees
 | ||
|     TextPos, BaseLeft, BaseRight, DimensionLeft, DimensionRight: T3DPoint;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     procedure CalculateExtraArcInfo;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|   end;
 | ||
| 
 | ||
|   {@@
 | ||
|    Vectorial images can contain raster images inside them and this entity
 | ||
|    represents this.
 | ||
| 
 | ||
|    If the Width and Height differ from the same data in the image, then
 | ||
|    the raster image will be stretched.
 | ||
| 
 | ||
|    X,Y represents the top-left corner of the image
 | ||
| 
 | ||
|    Note that TFPCustomImage does not implement a storage, so the property
 | ||
|    RasterImage should be filled with either a FPImage.TFPMemoryImage or with
 | ||
|    a TLazIntfImage. The property RasterImage might be nil.
 | ||
|   }
 | ||
| 
 | ||
|   { TvRasterImage }
 | ||
| 
 | ||
|   TvRasterImage = class(TvNamedEntity)
 | ||
|   public
 | ||
|     RasterImage: TFPCustomImage;
 | ||
|     Width, Height: Double;
 | ||
|     AltText: string;
 | ||
|     destructor Destroy; override;
 | ||
|     procedure CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double); override;
 | ||
|     procedure CreateRGB888Image(AWidth, AHeight: Cardinal);
 | ||
|     procedure CreateImageFromFile(AFilename: string);
 | ||
|     procedure CreateImageFromStream(AStream: TStream; Handler:TFPCustomImageReader);
 | ||
|     procedure InitializeWithConvertionOf3DPointsToHeightMap(APage: TvVectorialPage; AWidth, AHeight: Integer);
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|   end;
 | ||
| 
 | ||
|   { TvPoint }
 | ||
| 
 | ||
|   // Keep TvPoint as small as possible in memory foot-print for LAS support
 | ||
|   TvPoint = class(TvEntity)
 | ||
|   public
 | ||
|     Pen: TvPen;
 | ||
|     {constructor Create; override;
 | ||
|     procedure ApplyPenToCanvas(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo);
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;}
 | ||
|   end;
 | ||
| 
 | ||
|   { TvArrow }
 | ||
| 
 | ||
|   //
 | ||
|   // The arrow look like this:
 | ||
|   //
 | ||
|   // A<------|B
 | ||
|   //         |
 | ||
|   //         |C
 | ||
|   //
 | ||
|   // A -> X,Y,Z
 | ||
|   // B -> Base
 | ||
|   // C -> ExtraLineBase, which exists if HasExtraLine=True
 | ||
| 
 | ||
|   TvArrow = class(TvEntityWithPenAndBrush)
 | ||
|   public
 | ||
|     Base: T3DPoint;
 | ||
|     HasExtraLine: Boolean;
 | ||
|     ExtraLineBase: T3DPoint;
 | ||
|     ArrowLength: Double;
 | ||
|     ArrowBaseLength: Double;
 | ||
|     procedure CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double); override;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|   end;
 | ||
| 
 | ||
|   {@@
 | ||
|     The elements bellow describe a formula
 | ||
| 
 | ||
|     The main element of a formula is TvFormula which contains a horizontal list of
 | ||
|     the elements of the formula. Those can then have sub-elements
 | ||
| 
 | ||
|     The formula starts in X, Y and grows downwards, towards a smaller Y
 | ||
|   }
 | ||
| 
 | ||
|   TvFormula = class;
 | ||
| 
 | ||
|   TvFormulaElementKind = (
 | ||
|     // Basic symbols
 | ||
|     fekVariable,  // Text is the text of the variable
 | ||
|     fekEqual,     // = symbol
 | ||
|     fekSubtraction, // - symbol
 | ||
|     fekMultiplication, // either a point . or a small x
 | ||
|     fekSum,       // + symbol
 | ||
|     fekPlusMinus, // The +/- symbol
 | ||
|     fekLessThan, // The < symbol
 | ||
|     fekLessOrEqualThan, // The <= symbol
 | ||
|     fekGreaterThan, // The > symbol
 | ||
|     fekGreaterOrEqualThan, // The >= symbol
 | ||
|     fekHorizontalLine,
 | ||
|     // More complex elements, utilized for graphical representation of formula
 | ||
|     fekFraction,  // a division with Formula on the top and AdjacentFormula in the bottom
 | ||
|     fekRoot,      // A root. For example sqrt(something). Number gives the root, usually 2, and inside it goes a Formula
 | ||
|     fekPower,     // A Formula elevated to a AdjacentFormula, example: 2^5
 | ||
|     fekSubscript, // A Formula with a subscripted element AdjacentFormula, example: Xi
 | ||
|     fekSummation, // Sum of a variable given by Text set by Formula in the bottom and going up to AdjacentFormula in the top
 | ||
|     fekFormula,   // A formula, stored in Formula
 | ||
|     // Elements utilized for formulas for infix to RPN converion, not utilized for graphical representations
 | ||
|     fekParentesesOpen,
 | ||
|     freParentesesClose
 | ||
|     );
 | ||
| 
 | ||
|   { TvFormulaElement }
 | ||
| 
 | ||
|   TvFormulaElement = class
 | ||
|   public
 | ||
|     Kind: TvFormulaElementKind;
 | ||
|     Text: string;
 | ||
|     Number: Double;
 | ||
|     Formula: TvFormula;
 | ||
|     AdjacentFormula: TvFormula;
 | ||
|   public
 | ||
|     Top, Left, Width, Height: Double;
 | ||
|     function CalculateHeight(ADest: TFPCustomCanvas): Double; // in millimeters
 | ||
|     function CalculateWidth(ADest: TFPCustomCanvas): Double; // in millimeters
 | ||
|     function AsText: string;
 | ||
|     procedure PositionSubparts(ADest: TFPCustomCanvas; ABaseX, ABaseY: Double);
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); virtual;
 | ||
|     procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer); virtual;
 | ||
|     class function GetPrecedenceFromKind(AKind: TvFormulaElementKind): Byte; // 0 is the smallest precedence
 | ||
|     class function IsLeftAssociativeFromKind(AKind: TvFormulaElementKind): Boolean;
 | ||
|   end;
 | ||
| 
 | ||
|   { TvFormula }
 | ||
| 
 | ||
|   TvFormula = class(TvEntityWithPenBrushAndFont)
 | ||
|   private
 | ||
|     FCurIndex: Integer;
 | ||
|     procedure CallbackDeleteElement(data,arg:pointer);
 | ||
|   protected
 | ||
|     FElements: TFPList; // of TvFormulaElement
 | ||
|     SpacingBetweenElementsX, SpacingBetweenElementsY: Integer;
 | ||
|   public
 | ||
|     Top, Left, Width, Height: Double;
 | ||
|     constructor Create(APage: TvPage); override;
 | ||
|     destructor Destroy; override;
 | ||
|     //
 | ||
|     function GetFirstElement: TvFormulaElement;
 | ||
|     function GetNextElement: TvFormulaElement;
 | ||
|     procedure AddElement(AElement: TvFormulaElement);
 | ||
|     function  AddElementWithKind(AKind: TvFormulaElementKind): TvFormulaElement;
 | ||
|     function  AddElementWithKindAndText(AKind: TvFormulaElementKind; AText: string): TvFormulaElement;
 | ||
|     procedure AddItemsByConvertingInfixToRPN(AInfix: TFPList {of TvFormulaElement});
 | ||
|     procedure AddItemsByConvertingInfixStringToRPN(AStr: string);
 | ||
|     procedure TokenizeInfixString(AStr: string; AOutput: TFPList);
 | ||
|     function  CalculateRPNFormulaValue: Double;
 | ||
|     procedure Clear; override;
 | ||
|     //
 | ||
|     function CalculateHeight(ADest: TFPCustomCanvas): Double; virtual; // in millimeters
 | ||
|     function CalculateWidth(ADest: TFPCustomCanvas): Double; virtual; // in millimeters
 | ||
|     procedure PositionSubparts(ADest: TFPCustomCanvas; ABaseX, ABaseY: Double); override;
 | ||
|     procedure CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double); override;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|   end;
 | ||
| 
 | ||
|   { TvVerticalFormulaStack }
 | ||
| 
 | ||
|   TvVerticalFormulaStack = class(TvFormula)
 | ||
|   public
 | ||
|     function CalculateHeight(ADest: TFPCustomCanvas): Double; override; // in millimeters
 | ||
|     function CalculateWidth(ADest: TFPCustomCanvas): Double; override; // in millimeters
 | ||
|     procedure PositionSubparts(ADest: TFPCustomCanvas; ABaseX, ABaseY: Double); override;
 | ||
|     procedure CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double); override;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     //function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|   end;
 | ||
| 
 | ||
|   {@@
 | ||
|     A EntityWithSubEntities may have Pen, Brush and/or Font data associated with it, but it is disabled by default
 | ||
|     This data can be active recursively in all children of the group if set in the field
 | ||
|     SetPenBrushAndFontElements
 | ||
|   }
 | ||
| 
 | ||
|   { TvEntityWithSubEntities }
 | ||
| 
 | ||
|   TvEntityWithSubEntities = class(TvEntityWithStyle)
 | ||
|   private
 | ||
|     FCurIndex: Integer;
 | ||
|     procedure CallbackDeleteElement(data,arg:pointer);
 | ||
|   protected
 | ||
|     FElements: TFPList; // of TvEntity
 | ||
|   public
 | ||
|     SetPenBrushAndFontElements: TvSetPenBrushAndFontElements;// This is not currently implemented!
 | ||
|     constructor Create(APage: TvPage); override;
 | ||
|     destructor Destroy; override;
 | ||
|     //
 | ||
|     function GetFirstEntity: TvEntity;
 | ||
|     function GetNextEntity: TvEntity;
 | ||
|     function GetEntitiesCount: Integer;
 | ||
|     function GetEntity(AIndex: Integer): TvEntity;
 | ||
|     function AddEntity(AEntity: TvEntity): Integer;
 | ||
|     function GetEntityIndex(AEntity : TvEntity) : Integer;
 | ||
|     function  DeleteEntity(AIndex: Cardinal): Boolean;
 | ||
|     function  RemoveEntity(AEntity: TvEntity; AFreeAfterRemove: Boolean = True): Boolean;
 | ||
|     procedure Rotate(AAngle: Double; ABase: T3DPoint); override;
 | ||
|     procedure Clear; override;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|     function FindEntityWithReference(AEntity: TvEntity): Integer;
 | ||
|     function FindEntityWithNameAndType(AName: string; AType: TvEntityClass {= TvEntity}; ARecursively: Boolean = False): TvEntity;
 | ||
|   end;
 | ||
| 
 | ||
|   {@@
 | ||
|     A block is a group of other elements. It is not rendered directly into the drawing,
 | ||
|     but instead is rendered via another item, called TvInsert
 | ||
|   }
 | ||
| 
 | ||
|   { TvBlock }
 | ||
| 
 | ||
|   TvBlock = class(TvEntityWithSubEntities)
 | ||
|   public
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|   end;
 | ||
| 
 | ||
|   {@@
 | ||
|     A "Insert" inserts a copy of any other element in the specified position.
 | ||
|     Usually TvBlock entities are inserted, but any entity can be inserted.
 | ||
|   }
 | ||
| 
 | ||
|   { TvInsert }
 | ||
| 
 | ||
|   TvInsert = class(TvEntityWithStyle) // instead of TvNamedEntity so that it can pass its own style info to the InsertEntity
 | ||
|   public
 | ||
|     InsertEntity: TvEntity; // The entity to be inserted
 | ||
|     RotationAngle: Double; // in angles, normal is zero
 | ||
|     SetElements: TvSetStyleElements; // Defines which of Pen, Brush and Font will be applied to InsertEntity
 | ||
|     constructor Create(APage: TvPage); override;
 | ||
|     destructor Destroy; override;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|   end;
 | ||
| 
 | ||
|   {@@
 | ||
|     Layers are groups of elements.
 | ||
|     Layers are similar to blocks and the diference is that the layer draws
 | ||
|     its contents, while the block doesnt, and it cannot be pasted with an TvInsert.
 | ||
|   }
 | ||
| 
 | ||
|   { TvLayer }
 | ||
| 
 | ||
|   TvLayer = class(TvEntityWithSubEntities)
 | ||
|   public
 | ||
|   end;
 | ||
| 
 | ||
|   {@@
 | ||
|     TvParagraph represents a sequence of elements ordered as characters
 | ||
|     in a paragraph.
 | ||
|     The elements might be richly formatted text, but also images.
 | ||
| 
 | ||
|     The basic element to build the sequence is TvText. Note that the X, Y positions
 | ||
|     of elements will be all adjusted to fit the TvParagraph area
 | ||
|   }
 | ||
| 
 | ||
|   TvRichTextAutoExpand = (rtaeNone, etaeWidth, etaeHeight);
 | ||
| 
 | ||
|   { TvParagraph }
 | ||
| 
 | ||
|   TvParagraph = class(TvEntityWithSubEntities)
 | ||
|   public
 | ||
|     Width, Height: Double;
 | ||
|     AutoExpand: TvRichTextAutoExpand;
 | ||
|     ListStyle : TvListStyle; // For Bulleted or Numbered Lists...
 | ||
|     YPos_NeedsAdjustment_DelFirstLineBodyHeight: Boolean; // SVG coordinates for text are cumbersome, we need this
 | ||
|     constructor Create(APage: TvPage); override;
 | ||
|     destructor Destroy; override;
 | ||
|     function AddText(AText: string): TvText;
 | ||
|     function AddCurvedText(AText: string): TvCurvedText;
 | ||
|     function AddField(AKind : TvFieldKind): TvField;
 | ||
|     function AddRasterImage: TvRasterImage;
 | ||
|     function AddEmbeddedVectorialDoc: TvEmbeddedVectorialDoc;
 | ||
|     procedure CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double); override;
 | ||
|     function TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult; override;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|   end;
 | ||
| 
 | ||
|   {@@
 | ||
|     TvList represents a list of bulleted texts, like:
 | ||
| 
 | ||
|     * First level
 | ||
|       - Second level
 | ||
|     * First level again
 | ||
| 
 | ||
|     The basic element to build the sequence is TvParagraph
 | ||
|   }
 | ||
| 
 | ||
|   { TvList }
 | ||
| 
 | ||
|   TvList = class(TvEntityWithSubEntities)
 | ||
|   public
 | ||
|     Parent : TvList;
 | ||
|     ListStyle : TvListStyle;
 | ||
| 
 | ||
|     constructor Create(APage: TvPage); override;  // MJT 31/08 added override;
 | ||
|     destructor Destroy; override;
 | ||
|     // helper function to add the most often used sub-entities
 | ||
|     function AddParagraph(ASimpleText: string): TvParagraph;
 | ||
|     function AddList: TvList;
 | ||
|     // other helper functions
 | ||
|     function GetLevel: Integer;
 | ||
|     function GetBulletSize: Double;
 | ||
|     procedure DrawBullet(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
 | ||
|       ALevel: Integer; AX, AY: Double; ADestX: Integer = 0; ADestY: Integer = 0;
 | ||
|       AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True);
 | ||
|     // overrides
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     //function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;}
 | ||
|   end;
 | ||
| 
 | ||
|   {@@
 | ||
|     TvRichText represents a sequence of text paragraphs.
 | ||
| 
 | ||
|     The basic element to build the sequence is TvParagraph. Note that the X, Y positions
 | ||
|     of elements will be all adjusted to fit the TvRichText area
 | ||
|   }
 | ||
| 
 | ||
|   // Forward reference as Table Cells are TvRichText which in turn
 | ||
|   // can also contain tables...
 | ||
|   TvTable = class;
 | ||
|   TvTableRow = class;
 | ||
| (*
 | ||
|   TvImage = Class;
 | ||
| *)
 | ||
|   { TvRichText }
 | ||
| 
 | ||
|   TvRichText = class(TvEntityWithSubEntities)
 | ||
|   public
 | ||
|     Width, Height: Double;
 | ||
|     SpacingLeft, SpacingRight, SpacingTop, SpacingBottom: Double; // space around each side
 | ||
|     AutoExpand: TvRichTextAutoExpand;
 | ||
|     constructor Create(APage: TvPage); override;
 | ||
|     destructor Destroy; override;
 | ||
|     // Data writing methods
 | ||
|     function AddParagraph: TvParagraph;
 | ||
|     function AddList: TvList;
 | ||
|     function AddTable: TvTable;
 | ||
|     function AddEmbeddedVectorialDoc: TvEmbeddedVectorialDoc;
 | ||
|     function AddRasterImage: TvRasterImage;
 | ||
|     // Functions for rendering and calculating sizes
 | ||
|     procedure GetEffectiveCellSpacing(out ATopSpacing, ALeftSpacing, ARightSpacing, ABottomSpacing: Double); virtual;
 | ||
|     function CalculateCellHeight_ForWidth(ADest: TFPCustomCanvas; AWidth: Double): Double; virtual;
 | ||
|     function CalculateMaxNeededWidth(ADest: TFPCustomCanvas): Double; virtual;
 | ||
|     function TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult; override;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|   end;
 | ||
| 
 | ||
|   (*  Support for Adding Tables to the document
 | ||
|       Each Cell is a TvRichText to allow full formatted text contents
 | ||
|   *)
 | ||
| 
 | ||
|   TvUnits = (dimMillimeter, dimPercent, dimPoint);
 | ||
| 
 | ||
|   TvDimension = record
 | ||
|     Value : Double;
 | ||
|     Units : TvUnits;
 | ||
|   end;
 | ||
| 
 | ||
|   // Use tbtDefault if you don't want the Border settings to be written out
 | ||
|   TvTableBorderType = (tbtSingle, tbtDashed, tbtDouble, tbtNone, tbtDefault);
 | ||
| 
 | ||
|   TvTableBorder = record
 | ||
|     LineType : TvTableBorderType;
 | ||
|     Spacing : Double; // mm, default 0
 | ||
|     Color : TFPColor; // Ignored if (0, 0, 0, 0)
 | ||
|     Width : Double;   // mm, default 0.  Should really be in point for fine control
 | ||
|   end;
 | ||
| 
 | ||
|   // Can be applied to Tables AND Cells
 | ||
|   TvTableBorders = record
 | ||
|     Left : TvTableBorder;
 | ||
|     Right : TvTableBorder;
 | ||
|     Top : TvTableBorder;
 | ||
|     Bottom : TvTableBorder;
 | ||
|     InsideHoriz : TvTableBorder;  //  InsideXXX not normally applied to cells
 | ||
|     InsideVert : TvTableBorder;   //    (MS Word Table Styles has an exception)
 | ||
|   end;
 | ||
| 
 | ||
|   { TvTableCell }
 | ||
| 
 | ||
|   TvVerticalAlignment = (vaTop, vaBottom, vaCenter, cvaBoth);
 | ||
|   // Horizontal alignment taken from Paragraph Style
 | ||
| 
 | ||
|   TvTableCell = Class(TvRichText)
 | ||
|   public
 | ||
|     // MJT to Felipe:  It may be that Borders can be
 | ||
|     // added to TvRichText if odt supports paragraph
 | ||
|     // borders, in which case we can refactor a little and
 | ||
|     // rename TvTableBorders
 | ||
|     Row: TvTableRow;
 | ||
|     Borders: TvTableBorders;                  // Defaults to be ignored (tbtDefault)
 | ||
|     PreferredWidth: TvDimension;              // Optional
 | ||
|     VerticalAlignment: TvVerticalAlignment;   // Defaults to vaTop
 | ||
|     BackgroundColor: TFPColor;                // Optional
 | ||
|     BackgroundColorValid: Boolean;
 | ||
|     SpannedCols: Integer;                     // For merging horiz cells.  Default 1.
 | ||
|                                               // See diagram above TvTable Class
 | ||
|     SpacingDataValid: Boolean;                // TvRichText defines spacing, SpacingTop, SpacingLeft, etc
 | ||
|                                               // if SpacingDataValid is false use Row.Table.CallSpacing
 | ||
|                                               // instead. Units for SpacingTop, etc, in mm. Spacing is the
 | ||
|                                               // empty area around Cells (but inside them) without content.
 | ||
| 
 | ||
|     constructor Create(APage: TvPage); override;
 | ||
|     function GetEffectiveBorder(): TvTableBorders;
 | ||
|     procedure GetEffectiveCellSpacing(out ATopSpacing, ALeftSpacing, ARightSpacing, ABottomSpacing: Double); override;
 | ||
|     class procedure DrawBorder(ABorder: TvTableBorders;
 | ||
|       AX, AY, AWidth, AHeight: double;
 | ||
|       ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|     class function GenerateDebugStrForBorders(ABorders: TvTableBorders): string;
 | ||
|   end;
 | ||
| 
 | ||
|   { TvTableRow }
 | ||
| 
 | ||
|   TvTableRow = Class(TvNamedEntity)
 | ||
|   private
 | ||
|     Cells: TFPList; // of TvTableCell
 | ||
|   Public
 | ||
|     Table: TvTable;                // Link to the parent table
 | ||
|     Height: Double;                // Units mm.  Use 0 for default height
 | ||
|     Header: Boolean;               // Repeat row across pages
 | ||
|     AllowSplitAcrossPage : Boolean;// Can this Row split across multiple pages?
 | ||
|     BackgroundColor: TFPColor;     // Optional
 | ||
|     BackgroundColorValid: Boolean;
 | ||
|     // row spacing data in mm, necessary for docx among other formats
 | ||
|     CellSpacing: Double;
 | ||
|     SpacingDataValid: Boolean;
 | ||
| 
 | ||
|     constructor create(APage : TvPage); override;
 | ||
|     destructor destroy; override;
 | ||
| 
 | ||
|     function AddCell: TvTableCell;
 | ||
|     function GetCellCount: Integer;
 | ||
|     function GetCell(AIndex: Integer): TvTableCell;
 | ||
|     function GetCellColNr(ACell: TvTableCell): Integer;
 | ||
|     function CalculateMaxCellSpacing_Y(): Double;
 | ||
|     //
 | ||
|     procedure CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double); override;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|   end;
 | ||
| 
 | ||
|   (*
 | ||
|       Note on the grid used for the table
 | ||
| 
 | ||
|       For the table shown below, three ColWidths must be defined.
 | ||
| 
 | ||
|       First row should only have 2 cells. First cell spans 2 columns.
 | ||
|       Second row should only have 2 cells. Second cell spans 2 columns.
 | ||
|       Third row should have 3 cells.  Each cell only spans 1 column (default)
 | ||
| 
 | ||
|    X,Y +-----+------+---------+
 | ||
|        |            |         |
 | ||
|        +-----+----------------+
 | ||
|        |     |                |
 | ||
|        +-----+------+---------+
 | ||
|        |     |      |         |
 | ||
|        +-----+------+---------+
 | ||
| 
 | ||
|        The table draws at X,Y and downwards
 | ||
|   *)
 | ||
| 
 | ||
|   // TvTable.Style should be a Table Style, not a Paragraph Style
 | ||
|   // and is optional.
 | ||
|   TvTable = class(TvEntityWithStyle)
 | ||
|   private
 | ||
|     Rows: TFPList;
 | ||
|     ColWidthsInMM: array of Double;   // calculated during Render
 | ||
|     TableWidth, TableHeight: Double;  // in mm; calculated during Render
 | ||
|     procedure CalculateColWidths(ADest: TFPCustomCanvas);
 | ||
|     procedure CalculateRowHeights(ADest: TFPCustomCanvas);
 | ||
|   public
 | ||
|     ColWidths: array of Double;       // Can be left empty for simple tables
 | ||
|                                       // MUST be fully defined for merging cells
 | ||
|     ColWidthsUnits : TvUnits;         // Cannot mix ColWidth Units.
 | ||
|     Borders : TvTableBorders;         // Defaults: single/black/inside and out
 | ||
|     PreferredWidth : TvDimension;     // Optional. Units mm.
 | ||
|     SpacingBetweenCells: Double;      // Units mm. Gap between Cells.
 | ||
|     CellSpacingLeft, CellSpacingRight, CellSpacingTop,
 | ||
|       CellSpacingBottom: Double;      // space around each side of cells, in mm
 | ||
|     BackgroundColor : TFPColor;       // Optional.
 | ||
| 
 | ||
|     constructor create(APage : TvPage); override;
 | ||
|     destructor destroy; override;
 | ||
| 
 | ||
|     function AddRow: TvTableRow;
 | ||
|     function GetRowCount : Integer;
 | ||
|     function GetRow(AIndex: Integer) : TvTableRow;
 | ||
|     //
 | ||
|     function AddColWidth(AValue : Double) : Integer;
 | ||
|     function GetColCount(): Integer;
 | ||
|     //
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|   end;
 | ||
| 
 | ||
|   { TvEmbeddedVectorialDoc }
 | ||
| 
 | ||
|   TvEmbeddedVectorialDoc = class(TvEntity)
 | ||
|   private
 | ||
|     FWidth, FHeight: Double;
 | ||
|   public
 | ||
|     Document: TvVectorialDocument;
 | ||
|     constructor create(APage : TvPage); override;
 | ||
|     destructor destroy; override;
 | ||
|     procedure UpdateDocumentSize();
 | ||
|     function GetWidth: Double;
 | ||
|     function GetHeight: Double;
 | ||
|     procedure SetWidth(AValue: Double);
 | ||
|     procedure SetHeight(AValue: Double);
 | ||
|     procedure CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double); override;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
 | ||
|     function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
 | ||
|   end;
 | ||
| 
 | ||
|   TvVectorialReaderFlag = (vrfSVG_UseBottomLeftCoords, vrfWMF_UseBottomLeftCoords);
 | ||
|   TvVectorialReaderFlags = set of TvVectorialReaderFlag;
 | ||
| 
 | ||
|   TvVectorialReaderSettings = record
 | ||
|     VecReaderFlags: TvVectorialReaderFlags;
 | ||
|     HelperToolPath: string;
 | ||
|   end;
 | ||
| 
 | ||
|   { TvVectorialDocument }
 | ||
| 
 | ||
|   TvVectorialDocument = class
 | ||
|   private
 | ||
|     FOnProgress: TvProgressEvent;
 | ||
|     FPages: TFPList;
 | ||
|     FStyles: TFPList;
 | ||
|     FListStyles: TFPList;
 | ||
|     FCurrentPageIndex: Integer;
 | ||
|     function CreateVectorialWriter(AFormat: TvVectorialFormat): TvCustomVectorialWriter;
 | ||
|     function CreateVectorialReader(AFormat: TvVectorialFormat): TvCustomVectorialReader;
 | ||
|   public
 | ||
|     Width, Height: Double; // in millimeters
 | ||
|     Name: string;
 | ||
|     Encoding: string; // The encoding on which to save the file, if empty UTF-8 will be utilized. This value is filled when reading
 | ||
|     ForcedEncodingOnRead: string; // if empty, no encoding will be forced when reading, but it can be set to a LazUtils compatible value
 | ||
|     // User-Interface information
 | ||
|     ZoomLevel: Double; // 1 = 100%
 | ||
|     { Selection fields }
 | ||
|     SelectedElement: TvEntity;
 | ||
|     // List of common styles, for conveniently finding them
 | ||
|     StyleTextBody, StyleHeading1, StyleHeading2, StyleHeading3,
 | ||
|       StyleHeading4, StyleHeading5, StyleHeading6: TvStyle;
 | ||
|     StyleTextBodyCentralized, StyleTextBodyBold: TvStyle; // text body modifications
 | ||
|     StyleHeading1Centralized, StyleHeading2Centralized, StyleHeading3Centralized: TvStyle; // heading modifications
 | ||
|     StyleBulletList, StyleNumberList : TvListStyle;
 | ||
|     StyleTextSpanBold, StyleTextSpanItalic, StyleTextSpanUnderline: TvStyle;
 | ||
|     // Reader properties
 | ||
|     ReaderSettings: TvVectorialReaderSettings;
 | ||
|     { Base methods }
 | ||
|     constructor Create; virtual;
 | ||
|     destructor Destroy; override;
 | ||
|     procedure Assign(ASource: TvVectorialDocument);
 | ||
|     procedure AssignTo(ADest: TvVectorialDocument);
 | ||
|     procedure WriteToFile(AFileName: string; AFormat: TvVectorialFormat); overload;
 | ||
|     procedure WriteToFile(AFileName: string); overload;
 | ||
|     procedure WriteToStream(AStream: TStream; AFormat: TvVectorialFormat);
 | ||
|     procedure WriteToStrings(AStrings: TStrings; AFormat: TvVectorialFormat);
 | ||
|     procedure ReadFromFile(AFileName: string; AFormat: TvVectorialFormat); overload;
 | ||
|     procedure ReadFromFile(AFileName: string); overload;
 | ||
|     procedure ReadFromStream(AStream: TStream; AFormat: TvVectorialFormat);
 | ||
|     procedure ReadFromStrings(AStrings: TStrings; AFormat: TvVectorialFormat);
 | ||
|     procedure ReadFromXML(ADoc: TXMLDocument; AFormat: TvVectorialFormat);
 | ||
|     class function GetFormatFromExtension(AFileName: string; ARaiseException: Boolean = True): TvVectorialFormat;
 | ||
|     function  GetDetailedFileFormat(): string;
 | ||
|     procedure GuessDocumentSize();
 | ||
|     procedure GuessGoodZoomLevel(AScreenSize: Integer = 500);
 | ||
|     { Page methods }
 | ||
|     function GetPage(AIndex: Integer): TvPage;
 | ||
|     function GetPageIndex(APage : TvPage): Integer;
 | ||
|     function GetPageAsVectorial(AIndex: Integer): TvVectorialPage;
 | ||
|     function GetPageAsText(AIndex: Integer): TvTextPageSequence;
 | ||
|     function GetPageCount: Integer;
 | ||
|     function GetCurrentPage: TvPage;
 | ||
|     function GetCurrentPageAsVectorial: TvVectorialPage;
 | ||
|     procedure SetCurrentPage(AIndex: Integer);
 | ||
|     procedure SetDefaultPageFormat(AFormat: TvPageFormat);
 | ||
|     function AddPage(AUseTopLeftCoords: Boolean = False): TvVectorialPage;
 | ||
|     function AddTextPageSequence(): TvTextPageSequence;
 | ||
|     { Style methods }
 | ||
|     function AddStyle(): TvStyle;
 | ||
|     function AddListStyle: TvListStyle;
 | ||
|     procedure AddStandardTextDocumentStyles(AFormat: TvVectorialFormat);
 | ||
|     function GetStyleCount: Integer;
 | ||
|     function GetStyle(AIndex: Integer): TvStyle;
 | ||
|     function FindStyleIndex(AStyle: TvStyle): Integer;
 | ||
|     function GetListStyleCount: Integer;
 | ||
|     function GetListStyle(AIndex: Integer): TvListStyle;
 | ||
|     function FindListStyleIndex(AListStyle: TvListStyle): Integer;
 | ||
|     { Data removing methods }
 | ||
|     procedure Clear; virtual;
 | ||
|     { Debug methods }
 | ||
|     procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer = nil);
 | ||
|     { Events }
 | ||
|     property OnProgress: TvProgressEvent read FOnProgress write FOnprogress;
 | ||
|   end;
 | ||
| 
 | ||
|   { TvPage }
 | ||
| 
 | ||
|   TvPage = class
 | ||
|   protected
 | ||
|     FOwner: TvVectorialDocument;
 | ||
|     FUseTopLeftCoordinates: Boolean;
 | ||
|   public
 | ||
|     // Document size for page-based documents
 | ||
|     Width, Height: Double; // in millimeters, may be 0 to use TvVectorialDocument defaults
 | ||
|     // Document size for other documents
 | ||
|     MinX, MinY, MinZ, MaxX, MaxY, MaxZ: Double;
 | ||
|     // Other basic document information
 | ||
|     BackgroundColor: TFPColor;
 | ||
|     AdjustPenColorToBackground: Boolean;
 | ||
|     RenderInfo: TvRenderInfo; // Prepared by the reader with info on how to draw the page
 | ||
|     { Base methods }
 | ||
|     constructor Create(AOwner: TvVectorialDocument); virtual;
 | ||
|     destructor Destroy; override;
 | ||
|     procedure Assign(ASource: TvPage); virtual;
 | ||
|     procedure SetPageFormat(AFormat: TvPageFormat);
 | ||
|     { Data reading methods }
 | ||
|     procedure CalculateDocumentSize; virtual;
 | ||
|     function  GetEntity(ANum: Cardinal): TvEntity; virtual; abstract;
 | ||
|     function  GetEntitiesCount: Integer; virtual; abstract;
 | ||
|     function  GetLastEntity(): TvEntity; virtual; abstract;
 | ||
|     function  GetEntityIndex(AEntity : TvEntity) : Integer; virtual; abstract;
 | ||
|     function  FindAndSelectEntity(Pos: TPoint): TvFindEntityResult; virtual; abstract;
 | ||
|     function  FindEntityWithNameAndType(AName: string; AType: TvEntityClass {= TvEntity}; ARecursively: Boolean = False): TvEntity; virtual; abstract;
 | ||
|     { Data removing methods }
 | ||
|     procedure Clear; virtual; abstract;
 | ||
|     function  DeleteEntity(AIndex: Cardinal): Boolean; virtual; abstract;
 | ||
|     function  RemoveEntity(AEntity: TvEntity; AFreeAfterRemove: Boolean = True): Boolean; virtual; abstract;
 | ||
|     { Data writing methods }
 | ||
|     function AddEntity(AEntity: TvEntity): Integer; virtual; abstract;
 | ||
|     { Drawing methods }
 | ||
|     procedure DrawBackground(ADest: TFPCustomCanvas); virtual; abstract;
 | ||
|     procedure RenderPageBorder(ADest: TFPCustomCanvas;
 | ||
|       ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); virtual; abstract;
 | ||
|     procedure Render(ADest: TFPCustomCanvas;
 | ||
|       ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0;
 | ||
|       ADoDraw: Boolean = true); virtual; abstract;
 | ||
|     procedure AutoFit(ADest: TFPCustomCanvas; AWidth, AHeight, ARenderHeight: Integer; out ADeltaX, ADeltaY: Integer; out AZoom: Double); virtual;
 | ||
|     procedure GetNaturalRenderPos(var APageHeight: Integer; out AMulY: Double); virtual; abstract;
 | ||
|     procedure SetNaturalRenderPos(AUseTopLeftCoords: Boolean); virtual;
 | ||
|     function HasNaturalRenderPos: Boolean;
 | ||
|     function GetTopLeftCoords_Adjustment(): Double;
 | ||
|     { Debug methods }
 | ||
|     procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer); virtual; abstract;
 | ||
| 
 | ||
|     property UseTopLeftCoordinates: Boolean read FUseTopLeftCoordinates write FUseTopLeftCoordinates;
 | ||
|   end;
 | ||
| 
 | ||
|   { TvVectorialPage }
 | ||
| 
 | ||
|   TvVectorialPage = class(TvPage)
 | ||
|   private
 | ||
|     FEntities: TFPList; // of TvEntity
 | ||
|     FTmpPath: TPath;
 | ||
|     FTmpText: TvText;
 | ||
|     FCurrentLayer: TvEntityWithSubEntities;
 | ||
|     //procedure RemoveCallback(data, arg: pointer);
 | ||
|     procedure ClearTmpPath();
 | ||
|     procedure AppendSegmentToTmpPath(ASegment: TPathSegment);
 | ||
|     procedure CallbackDeleteEntity(data,arg:pointer);
 | ||
|   public
 | ||
|     Owner: TvVectorialDocument;
 | ||
|     { Base methods }
 | ||
|     constructor Create(AOwner: TvVectorialDocument); override;
 | ||
|     destructor Destroy; override;
 | ||
|     procedure Assign(ASource: TvPage); override;
 | ||
|     { Data reading methods }
 | ||
|     function  GetEntity(ANum: Cardinal): TvEntity; override;
 | ||
|     function  GetEntitiesCount: Integer; override;
 | ||
|     function  GetLastEntity(): TvEntity; override;
 | ||
|     function  GetEntityIndex(AEntity : TvEntity) : Integer; override;
 | ||
|     function  FindAndSelectEntity(Pos: TPoint): TvFindEntityResult; override;
 | ||
|     function  FindEntityWithNameAndType(AName: string; AType: TvEntityClass {= TvEntity}; ARecursively: Boolean = False): TvEntity; override;
 | ||
|     { Data removing methods }
 | ||
|     procedure Clear; override;
 | ||
|     function  DeleteEntity(AIndex: Cardinal): Boolean; override;
 | ||
|     function  RemoveEntity(AEntity: TvEntity; AFreeAfterRemove: Boolean = True): Boolean; override;
 | ||
|     { Data writing methods }
 | ||
|     function AddEntity(AEntity: TvEntity): Integer; override;
 | ||
|     function  AddPathCopyMem(APath: TPath; AOnlyCreate: Boolean = False): TPath;
 | ||
|     procedure StartPath(AX, AY: Double); overload;
 | ||
|     procedure StartPath(); overload;
 | ||
|     procedure AddMoveToPath(AX, AY: Double);
 | ||
|     procedure AddLineToPath(AX, AY: Double); overload;
 | ||
|     procedure AddLineToPath(AX, AY: Double; AColor: TFPColor); overload;
 | ||
|     procedure AddLineToPath(AX, AY, AZ: Double); overload;
 | ||
|     procedure GetCurrentPathPenPos(var AX, AY: Double);
 | ||
|     procedure GetTmpPathStartPos(var AX, AY: Double);
 | ||
|     procedure AddBezierToPath(AX1, AY1, AX2, AY2, AX3, AY3: Double); overload;
 | ||
|     procedure AddBezierToPath(AX1, AY1, AZ1, AX2, AY2, AZ2, AX3, AY3, AZ3: Double); overload;
 | ||
|     procedure AddEllipticalArcToPath(ARadX, ARadY, AXAxisRotation, ADestX, ADestY: Double; ALeftmostEllipse, AClockwiseArcFlag: Boolean); // See http://www.w3.org/TR/SVG/paths.html#PathDataEllipticalArcCommands
 | ||
|     procedure AddEllipticalArcWithCenterToPath(ARadX, ARadY, AXAxisRotation, ADestX, ADestY, ACenterX, ACenterY: Double; AClockwiseArcFlag: Boolean);
 | ||
|     procedure SetBrushColor(AColor: TFPColor);
 | ||
|     procedure SetBrushStyle(AStyle: TFPBrushStyle);
 | ||
|     procedure SetPenColor(AColor: TFPColor);
 | ||
|     procedure SetPenStyle(AStyle: TFPPenStyle);
 | ||
|     procedure SetPenWidth(AWidth: Integer);
 | ||
|     procedure SetClipPath(AClipPath: TPath; AClipMode: TvClipMode);
 | ||
|     function  EndPath(AOnlyCreate: Boolean = False): TPath;
 | ||
|     function  AddText(AX, AY, AZ: Double; FontName: string; FontSize: integer; AText: utf8string; AOnlyCreate: Boolean = False): TvText; overload;
 | ||
|     function  AddText(AX, AY: Double; AStr: utf8string; AOnlyCreate: Boolean = False): TvText; overload;
 | ||
|     function  AddText(AX, AY, AZ: Double; AStr: utf8string; AOnlyCreate: Boolean = False): TvText; overload;
 | ||
|     function AddCircle(ACenterX, ACenterY, ARadius: Double; AOnlyCreate: Boolean = False): TvCircle;
 | ||
|     function AddCircularArc(ACenterX, ACenterY, ARadius, AStartAngle, AEndAngle: Double; AColor: TFPColor; AOnlyCreate: Boolean = False): TvCircularArc;
 | ||
|     function AddEllipse(CenterX, CenterY, HorzHalfAxis, VertHalfAxis, Angle: Double; AOnlyCreate: Boolean = False): TvEllipse;
 | ||
|     function AddBlock(AName: string; AX, AY, AZ: Double): TvBlock;
 | ||
|     function AddInsert(AX, AY, AZ: Double; AInsertEntity: TvEntity): TvInsert;
 | ||
|     // Layers
 | ||
|     function AddLayer(AName: string): TvLayer;
 | ||
|     function AddLayerAndSetAsCurrent(AName: string): TvLayer;
 | ||
|     procedure ClearLayerSelection();
 | ||
|     function SetCurrentLayer(ALayer: TvEntityWithSubEntities): Boolean;
 | ||
|     function GetCurrentLayer: TvEntityWithSubEntities;
 | ||
|     // Dimensions
 | ||
|     function AddAlignedDimension(BaseLeft, BaseRight, DimLeft, DimRight: T3DPoint; AOnlyCreate: Boolean = False): TvAlignedDimension;
 | ||
|     function AddRadialDimension(AIsDiameter: Boolean; ACenter, ADimLeft, ADimRight: T3DPoint; AOnlyCreate: Boolean = False): TvRadialDimension;
 | ||
|     function AddArcDimension(AArcValue, AArcRadius: Double; ABaseLeft, ABaseRight, ADimLeft, ADimRight, ATextPos: T3DPoint; AOnlyCreate: Boolean): TvArcDimension;
 | ||
|     //
 | ||
|     function AddPoint(AX, AY, AZ: Double): TvPoint;
 | ||
|     { Drawing methods }
 | ||
|     procedure PositionEntitySubparts(ADest: TFPCustomCanvas; ABaseX, ABaseY: Double);
 | ||
|     procedure DrawBackground(ADest: TFPCustomCanvas); override;
 | ||
|     procedure RenderPageBorder(ADest: TFPCustomCanvas;
 | ||
|       ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; ADestX: Integer = 0; ADestY: Integer = 0;
 | ||
|       AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = true); override;
 | ||
|     procedure GetNaturalRenderPos(var APageHeight: Integer; out AMulY: Double); override;
 | ||
|     { Debug methods }
 | ||
|     procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer); override;
 | ||
|     //
 | ||
|     property Entities[AIndex: Cardinal]: TvEntity read GetEntity;
 | ||
|   end;
 | ||
| 
 | ||
|   { TvTextPageSequence }
 | ||
| 
 | ||
|   {@@ Represents a sequence of text pages up to a page break }
 | ||
| 
 | ||
|   TvTextPageSequence = class(TvPage)
 | ||
|   public
 | ||
|     Footer, Header: TvRichText;
 | ||
|     MainText: TvRichText;
 | ||
|     { Base methods }
 | ||
|     constructor Create(AOwner: TvVectorialDocument); override;
 | ||
|     destructor Destroy; override;
 | ||
|     procedure Assign(ASource: TvPage); override;
 | ||
|     { Data reading methods }
 | ||
|     function  GetEntity(ANum: Cardinal): TvEntity; override;
 | ||
|     function  GetEntitiesCount: Integer; override;
 | ||
|     function  GetLastEntity(): TvEntity; override;
 | ||
|     function  GetEntityIndex(AEntity : TvEntity) : Integer; override;
 | ||
|     function  FindAndSelectEntity(Pos: TPoint): TvFindEntityResult; override;
 | ||
|     function  FindEntityWithNameAndType(AName: string; AType: TvEntityClass {= TvEntity}; ARecursively: Boolean = False): TvEntity; override;
 | ||
|     { Data removing methods }
 | ||
|     procedure Clear; override;
 | ||
|     function  DeleteEntity(AIndex: Cardinal): Boolean; override;
 | ||
|     function  RemoveEntity(AEntity: TvEntity; AFreeAfterRemove: Boolean = True): Boolean; override;
 | ||
|     { Data writing methods }
 | ||
|     function AddEntity(AEntity: TvEntity): Integer; override;
 | ||
|     { Data writing methods }
 | ||
|     function AddParagraph: TvParagraph;
 | ||
|     function AddList: TvList;
 | ||
|     function AddTable: TvTable;
 | ||
|     function AddEmbeddedVectorialDoc: TvEmbeddedVectorialDoc;
 | ||
|     //function AddImage: TvImage;
 | ||
|     { Drawing methods }
 | ||
|     procedure DrawBackground(ADest: TFPCustomCanvas); override;
 | ||
|     procedure RenderPageBorder(ADest: TFPCustomCanvas;
 | ||
|       ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
 | ||
|     procedure Render(ADest: TFPCustomCanvas; ADestX: Integer = 0; ADestY: Integer = 0;
 | ||
|       AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = true); override;
 | ||
|     procedure GetNaturalRenderPos(var APageHeight: Integer; out AMulY: Double); override;
 | ||
|     { Debug methods }
 | ||
|     procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer); override;
 | ||
|   end;
 | ||
| 
 | ||
|   {@@ TvVectorialReader class reference type }
 | ||
| 
 | ||
|   TvVectorialReaderClass = class of TvCustomVectorialReader;
 | ||
| 
 | ||
|   { TvCustomVectorialReader }
 | ||
| 
 | ||
|   TvCustomVectorialReader = class
 | ||
|   protected
 | ||
|     FFilename: string;
 | ||
|     class function GetTextContentsFromNode(ANode: TDOMNode): DOMString;
 | ||
|     class function RemoveLineEndingsAndTrim(AStr: string): string;
 | ||
|   public
 | ||
|     Settings: TvVectorialReaderSettings;
 | ||
|     { General reading methods }
 | ||
|     constructor Create; virtual;
 | ||
|     procedure ReadFromFile(AFileName: string; AData: TvVectorialDocument); virtual;
 | ||
|     procedure ReadFromStream(AStream: TStream; AData: TvVectorialDocument); virtual;
 | ||
|     procedure ReadFromStrings(AStrings: TStrings; AData: TvVectorialDocument); virtual;
 | ||
|     procedure ReadFromXML(ADoc: TXMLDocument; AData: TvVectorialDocument); virtual;
 | ||
|   end;
 | ||
| 
 | ||
|   {@@ TvVectorialWriter class reference type }
 | ||
| 
 | ||
|   TvVectorialWriterClass = class of TvCustomVectorialWriter;
 | ||
| 
 | ||
|   {@@ TvCustomVectorialWriter }
 | ||
| 
 | ||
|   { TvCustomVectorialWriter }
 | ||
| 
 | ||
|   TvCustomVectorialWriter = class
 | ||
|   public
 | ||
|     { General writing methods }
 | ||
|     constructor Create; virtual;
 | ||
|     procedure WriteToFile(AFileName: string; AData: TvVectorialDocument); virtual;
 | ||
|     procedure WriteToStream(AStream: TStream; AData: TvVectorialDocument); virtual;
 | ||
|     procedure WriteToStrings(AStrings: TStrings; AData: TvVectorialDocument); virtual;
 | ||
|   end;
 | ||
| 
 | ||
|   {@@ List of registered formats }
 | ||
| 
 | ||
|   TvVectorialFormatData = record
 | ||
|     ReaderClass: TvVectorialReaderClass;
 | ||
|     WriterClass: TvVectorialWriterClass;
 | ||
|     ReaderRegistered: Boolean;
 | ||
|     WriterRegistered: Boolean;
 | ||
|     Format: TvVectorialFormat;
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   GvVectorialFormats: array of TvVectorialFormatData;
 | ||
| 
 | ||
| const
 | ||
|   FormulaOperators = [fekSubtraction, fekMultiplication, fekSum, fekFraction, fekRoot, fekPower];
 | ||
| 
 | ||
| procedure RegisterVectorialReader(
 | ||
|   AReaderClass: TvVectorialReaderClass;
 | ||
|   AFormat: TvVectorialFormat);
 | ||
| procedure RegisterVectorialWriter(
 | ||
|   AWriterClass: TvVectorialWriterClass;
 | ||
|   AFormat: TvVectorialFormat);
 | ||
| 
 | ||
| function Make2DPoint(AX, AY: Double): T3DPoint;
 | ||
| function Dimension(AValue : Double; AUnits : TvUnits) : TvDimension;
 | ||
| function ConvertDimensionToMM(ADimension: TvDimension; ATotalSize: Double): Double;
 | ||
| 
 | ||
| implementation
 | ||
| 
 | ||
| uses fpvutils;
 | ||
| 
 | ||
| const
 | ||
|   Str_Error_Nil_Path = ' The program attempted to add a segment before creating a path';
 | ||
|   INVALID_RENDERINFO_CANVAS_XY = Low(Integer);
 | ||
|   Str_Line_Height_Tester = 'Áç';
 | ||
| 
 | ||
| {$ifdef FPVECTORIAL_AUTOFIT_DEBUG}
 | ||
| var
 | ||
|   AutoFitDebug: TStrings = nil;
 | ||
| {$endif}
 | ||
| 
 | ||
| {@@
 | ||
|   Registers a new reader for a format
 | ||
| }
 | ||
| procedure RegisterVectorialReader(
 | ||
|   AReaderClass: TvVectorialReaderClass;
 | ||
|   AFormat: TvVectorialFormat);
 | ||
| var
 | ||
|   i, len: Integer;
 | ||
|   FormatInTheList: Boolean;
 | ||
| begin
 | ||
|   len := Length(GvVectorialFormats);
 | ||
|   FormatInTheList := False;
 | ||
| 
 | ||
|   { First search for the format in the list }
 | ||
|   for i := 0 to len - 1 do
 | ||
|   begin
 | ||
|     if GvVectorialFormats[i].Format = AFormat then
 | ||
|     begin
 | ||
|       //if GvVectorialFormats[i].ReaderRegistered then
 | ||
|        //raise Exception.Create('RegisterVectorialReader: Reader class for format ' {+ AFormat} + ' already registered.');
 | ||
| 
 | ||
|       GvVectorialFormats[i].ReaderRegistered := True;
 | ||
|       GvVectorialFormats[i].ReaderClass := AReaderClass;
 | ||
| 
 | ||
|       FormatInTheList := True;
 | ||
|       Break;
 | ||
|     end;
 | ||
|   end;
 | ||
| 
 | ||
|   { If not already in the list, then add it }
 | ||
|   if not FormatInTheList then
 | ||
|   begin
 | ||
|     SetLength(GvVectorialFormats, len + 1);
 | ||
| 
 | ||
|     GvVectorialFormats[len].ReaderClass := AReaderClass;
 | ||
|     GvVectorialFormats[len].WriterClass := nil;
 | ||
|     GvVectorialFormats[len].ReaderRegistered := True;
 | ||
|     GvVectorialFormats[len].WriterRegistered := False;
 | ||
|     GvVectorialFormats[len].Format := AFormat;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| {@@
 | ||
|   Registers a new writer for a format
 | ||
| }
 | ||
| procedure RegisterVectorialWriter(
 | ||
|   AWriterClass: TvVectorialWriterClass;
 | ||
|   AFormat: TvVectorialFormat);
 | ||
| var
 | ||
|   i, len: Integer;
 | ||
|   FormatInTheList: Boolean;
 | ||
| begin
 | ||
|   len := Length(GvVectorialFormats);
 | ||
|   FormatInTheList := False;
 | ||
| 
 | ||
|   { First search for the format in the list }
 | ||
|   for i := 0 to len - 1 do
 | ||
|   begin
 | ||
|     if GvVectorialFormats[i].Format = AFormat then
 | ||
|     begin
 | ||
|       if GvVectorialFormats[i].WriterRegistered then
 | ||
|        raise Exception.Create('RegisterVectorialWriter: Writer class for format ' + {AFormat +} ' already registered.');
 | ||
| 
 | ||
|       GvVectorialFormats[i].WriterRegistered := True;
 | ||
|       GvVectorialFormats[i].WriterClass := AWriterClass;
 | ||
| 
 | ||
|       FormatInTheList := True;
 | ||
|       Break;
 | ||
|     end;
 | ||
|   end;
 | ||
| 
 | ||
|   { If not already in the list, then add it }
 | ||
|   if not FormatInTheList then
 | ||
|   begin
 | ||
|     SetLength(GvVectorialFormats, len + 1);
 | ||
| 
 | ||
|     GvVectorialFormats[len].ReaderClass := nil;
 | ||
|     GvVectorialFormats[len].WriterClass := AWriterClass;
 | ||
|     GvVectorialFormats[len].ReaderRegistered := False;
 | ||
|     GvVectorialFormats[len].WriterRegistered := True;
 | ||
|     GvVectorialFormats[len].Format := AFormat;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function Make2DPoint(AX, AY: Double): T3DPoint;
 | ||
| begin
 | ||
|   Result.X := AX;
 | ||
|   Result.Y := AY;
 | ||
|   Result.Z := 0;
 | ||
| end;
 | ||
| 
 | ||
| function Dimension(AValue: Double; AUnits: TvUnits): TvDimension;
 | ||
| begin
 | ||
|   Result.Value := AValue;
 | ||
|   Result.Units := AUnits;
 | ||
| end;
 | ||
| 
 | ||
| function ConvertDimensionToMM(ADimension: TvDimension; ATotalSize: Double): Double;
 | ||
| begin
 | ||
|   case ADimension.Units of
 | ||
|   dimMillimeter: Result := ADimension.Value;
 | ||
|   dimPercent:    Result := ATotalSize * ADimension.Value;
 | ||
|   dimPoint:      Result := ADimension.Value; // ToDo
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| { TvStyle }
 | ||
| 
 | ||
| constructor TvStyle.Create;
 | ||
| begin
 | ||
|   // Defaults
 | ||
|   SuppressSpacingBetweenSameParagraphs:=False;
 | ||
| end;
 | ||
| 
 | ||
| function TvStyle.GetKind: TvStyleKind;
 | ||
| begin
 | ||
|   if Parent = nil then Result := Kind
 | ||
|   else Result := Parent.GetKind();
 | ||
| end;
 | ||
| 
 | ||
| procedure TvStyle.Clear;
 | ||
| begin
 | ||
|   Name := '';
 | ||
|   Parent := nil;
 | ||
|   Kind := vskTextBody;
 | ||
|   Alignment := vsaLeft;
 | ||
| 
 | ||
|   //
 | ||
|   {Pen.Color := col;
 | ||
|   Brush := nil;
 | ||
|   Font := nil;}
 | ||
|   SetElements := [];
 | ||
|   //
 | ||
|   MarginTop := 0;
 | ||
|   MarginBottom := 0;
 | ||
|   MarginLeft := 0;
 | ||
|   MarginRight := 0;
 | ||
|   //
 | ||
| end;
 | ||
| 
 | ||
| procedure TvStyle.CopyFrom(AFrom: TvStyle);
 | ||
| begin
 | ||
|   Clear();
 | ||
|   ApplyOver(AFrom);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvStyle.CopyFromEntity(AEntity: TvEntity);
 | ||
| begin
 | ||
| 
 | ||
| end;
 | ||
| 
 | ||
| procedure TvStyle.ApplyOverFromPen(APen: PvPen; ASetElements: TvSetStyleElements);
 | ||
| begin
 | ||
|   if spbfPenColor in ASetElements then
 | ||
|     Pen.Color := APen^.Color;
 | ||
|   if spbfPenStyle in ASetElements then
 | ||
|     Pen.Style := APen^.Style;
 | ||
|   if spbfPenWidth in ASetElements then
 | ||
|     Pen.Width := APen^.Width;
 | ||
| 
 | ||
|   SetElements += ASetElements * [spbfPenColor, spbfPenStyle, spbfPenWidth];
 | ||
| end;
 | ||
| 
 | ||
| procedure TvStyle.ApplyOverFromBrush(ABrush: PvBrush; ASetElements: TvSetStyleElements);
 | ||
| begin
 | ||
|   if spbfBrushColor in ASetElements then
 | ||
|     Brush.Color := ABrush^.Color;
 | ||
|   if spbfBrushStyle in ASetElements then
 | ||
|     Brush.Style := ABrush^.Style;
 | ||
|   {if spbfBrushGradient in ASetElements then
 | ||
|     Brush.Gra := AFrom.Brush.Style;}
 | ||
|   if spbfBrushKind in ASetElements then
 | ||
|     Brush.Kind := ABrush^.Kind;
 | ||
| 
 | ||
|   SetElements += ASetElements * [spbfBrushColor, spbfBrushStyle, spbfBrushGradient, spbfBrushKind];
 | ||
| end;
 | ||
| 
 | ||
| procedure TvStyle.ApplyOverFromFont(AFont: PvFont; ASetElements: TvSetStyleElements);
 | ||
| begin
 | ||
| 
 | ||
| end;
 | ||
| 
 | ||
| procedure TvStyle.ApplyOver(AFrom: TvStyle);
 | ||
| begin
 | ||
|   if AFrom = nil then Exit;
 | ||
| 
 | ||
|   // Pen
 | ||
| 
 | ||
|   ApplyOverFromPen(@AFrom.Pen, AFrom.SetElements);
 | ||
| 
 | ||
|   // Brush
 | ||
| 
 | ||
|   ApplyOverFromBrush(@AFrom.Brush, AFrom.SetElements);
 | ||
| 
 | ||
|   // Font
 | ||
| 
 | ||
|   //ApplyOverFromFont(@AFrom.Font, AFrom.SetElements);
 | ||
|   if spbfFontColor in AFrom.SetElements then
 | ||
|     Font.Color := AFrom.Font.Color;
 | ||
|   if spbfFontSize in AFrom.SetElements then
 | ||
|     Font.Size := AFrom.Font.Size;
 | ||
|   if spbfFontName in AFrom.SetElements then
 | ||
|     Font.Name := AFrom.Font.Name;
 | ||
|   if spbfFontBold in AFrom.SetElements then
 | ||
|     Font.Bold := AFrom.Font.Bold;
 | ||
|   if spbfFontItalic in AFrom.SetElements then
 | ||
|     Font.Italic := AFrom.Font.Italic;
 | ||
|   If spbfFontUnderline in AFrom.SetElements then
 | ||
|     Font.Underline := AFrom.Font.Underline;
 | ||
|   If spbfFontStrikeThrough in AFrom.SetElements then
 | ||
|     Font.StrikeThrough := AFrom.Font.StrikeThrough;
 | ||
|   If spbfAlignment in AFrom.SetElements then
 | ||
|     Alignment := AFrom.Alignment;
 | ||
| 
 | ||
|   // TextAnchor
 | ||
|   if spbfTextAnchor in AFrom.SetElements then
 | ||
|     TextAnchor := AFrom.TextAnchor;
 | ||
| 
 | ||
|   // Style
 | ||
| 
 | ||
|   if sseMarginTop in AFrom.SetElements then
 | ||
|     MarginTop := AFrom.MarginTop;
 | ||
|   If sseMarginBottom in AFrom.SetElements then
 | ||
|     MarginBottom := AFrom.MarginBottom;
 | ||
|   If sseMarginLeft in AFrom.SetElements then
 | ||
|     MarginLeft := AFrom.MarginLeft;
 | ||
|   If sseMarginRight in AFrom.SetElements then
 | ||
|     MarginRight := AFrom.MarginRight;
 | ||
| 
 | ||
|   // Other
 | ||
|   SuppressSpacingBetweenSameParagraphs:=AFrom.SuppressSpacingBetweenSameParagraphs;
 | ||
| 
 | ||
|   SetElements := AFrom.SetElements + SetElements;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvStyle.ApplyIntoEntity(ADest: TvEntity);
 | ||
| var
 | ||
|   lCurEntity: TvEntity;
 | ||
|   ADestWithPen: TvEntityWithPen absolute ADest;
 | ||
|   ADestWithBrush: TvEntityWithPenAndBrush absolute ADest;
 | ||
|   ADestWithFont: TvEntityWithPenBrushAndFont absolute ADest;
 | ||
| begin
 | ||
|   if ADest = nil then Exit;
 | ||
| 
 | ||
|   if ADest is TvEntityWithSubEntities then
 | ||
|   begin
 | ||
|     lCurEntity := (ADest as TvEntityWithSubEntities).GetFirstEntity();
 | ||
|     while lCurEntity <> nil do
 | ||
|     begin
 | ||
|       ApplyIntoEntity(lCurEntity);
 | ||
|       lCurEntity := (ADest as TvEntityWithSubEntities).GetNextEntity();
 | ||
|     end;
 | ||
|     Exit;
 | ||
|   end;
 | ||
| 
 | ||
|   // Pen
 | ||
|   if ADest is TvEntityWithPen then
 | ||
|   begin
 | ||
|     if spbfPenColor in SetElements then
 | ||
|       ADestWithPen.Pen.Color := Pen.Color;
 | ||
|     if spbfPenStyle in SetElements then
 | ||
|       ADestWithPen.Pen.Style := Pen.Style;
 | ||
|     if spbfPenWidth in SetElements then
 | ||
|       ADestWithPen.Pen.Width := Pen.Width;
 | ||
|   end;
 | ||
| 
 | ||
|   // Brush
 | ||
|   if ADest is TvEntityWithPenAndBrush then
 | ||
|   begin
 | ||
|     if spbfBrushColor in SetElements then
 | ||
|       ADestWithBrush.Brush.Color := Brush.Color;
 | ||
|     if spbfBrushStyle in SetElements then
 | ||
|       ADestWithBrush.Brush.Style := Brush.Style;
 | ||
|     {if spbfBrushGradient in SetElements then
 | ||
|       ADestWithBrush.Gra := AFrom.Brush.Style;}
 | ||
|     if spbfBrushKind in SetElements then
 | ||
|       ADestWithBrush.Brush.Kind := Brush.Kind;
 | ||
|   end;
 | ||
| 
 | ||
|   // Font
 | ||
|   if ADest is TvEntityWithPenBrushAndFont then
 | ||
|   begin
 | ||
|     if spbfFontColor in SetElements then
 | ||
|       ADestWithFont.Font.Color := Font.Color;
 | ||
|     if spbfFontSize in SetElements then
 | ||
|       ADestWithFont.Font.Size := Font.Size;
 | ||
|     if spbfFontName in SetElements then
 | ||
|       ADestWithFont.Font.Name := Font.Name;
 | ||
|     if spbfFontBold in SetElements then
 | ||
|       ADestWithFont.Font.Bold := Font.Bold;
 | ||
|     if spbfFontItalic in SetElements then
 | ||
|       ADestWithFont.Font.Italic := Font.Italic;
 | ||
|     If spbfFontUnderline in SetElements then
 | ||
|       ADestWithFont.Font.Underline := Font.Underline;
 | ||
|     If spbfFontStrikeThrough in SetElements then
 | ||
|       ADestWithFont.Font.StrikeThrough := Font.StrikeThrough;
 | ||
|     {If spbfAlignment in SetElements then
 | ||
|       ADestWithFont.Alignment := Alignment; }
 | ||
| 
 | ||
|     // TextAnchor
 | ||
|     if spbfTextAnchor in SetElements then
 | ||
|       ADestWithFont.TextAnchor := TextAnchor;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvStyle.CreateStyleCombinedWithParent: TvStyle;
 | ||
| begin
 | ||
|   Result := TvStyle.Create;
 | ||
|   Result.CopyFrom(Self);
 | ||
|   if Parent <> nil then Result.ApplyOver(Parent);
 | ||
| end;
 | ||
| 
 | ||
| function TvStyle.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   lStr, lParentName: string;
 | ||
| begin
 | ||
|   if Parent <> nil then lParentName := Parent.Name
 | ||
|   else lParentName := '<No Parent>';
 | ||
| 
 | ||
|   lStr := Format('[%s] Name=%s Parent=%s',
 | ||
|     [Self.ClassName, Name, lParentName]);
 | ||
| 
 | ||
|   if spbfPenColor in SetElements then
 | ||
|     lStr := lStr + Format(' Pen.Color=%s', [TvEntity.GenerateDebugStrForFPColor(Pen.Color)]);
 | ||
| {    spbfPenStyle, spbfPenWidth,
 | ||
|     spbfBrushColor, spbfBrushStyle, spbfBrushGradient,}
 | ||
|   if spbfFontColor in SetElements then
 | ||
|     lStr := lStr + Format(' Font.Color=%s', [TvEntity.GenerateDebugStrForFPColor(Pen.Color)]);
 | ||
|   if spbfFontSize in SetElements then
 | ||
|     lStr := lStr + Format(' Font.Size=%d', [Font.Size]);
 | ||
|   if spbfFontName in SetElements then
 | ||
|     lStr := lStr + ' Font.Name=' + Font.Name;
 | ||
|   if spbfFontBold in SetElements then
 | ||
|     if Font.Bold then lStr := lStr + Format(' Font.Bold=%s', [BoolToStr(Font.Bold)]);
 | ||
|   if spbfFontItalic in SetElements then
 | ||
|     if Font.Italic then lStr := lStr + Format(' Font.Bold=%s', [BoolToStr(Font.Italic)]);
 | ||
| {
 | ||
|     spbfFontUnderline, spbfFontStrikeThrough, spbfAlignment,
 | ||
|     // Page style
 | ||
|     sseMarginTop, sseMarginBottom, sseMarginLeft, sseMarginRight
 | ||
|     );
 | ||
|    Font.Size, Font.Name, Font.Orientation,
 | ||
|     BoolToStr(Font.Underline),
 | ||
|     BoolToStr(Font.StrikeThrough),
 | ||
|     GetEnumName(TypeInfo(TvTextAnchor), integer(TextAnchor))}
 | ||
|   lStr := lStr + FExtraDebugStr;
 | ||
|   Result := ADestRoutine(lStr, APageItem);
 | ||
| end;
 | ||
| 
 | ||
| { TvListLevelStyle }
 | ||
| 
 | ||
| constructor TvListLevelStyle.Create;
 | ||
| begin
 | ||
|   Start := 1;
 | ||
|   Bullet := '·';
 | ||
|   LeaderFontName := 'Symbol';
 | ||
|   Alignment := vsaLeft;
 | ||
| end;
 | ||
| 
 | ||
| { TvListStyle }
 | ||
| 
 | ||
| constructor TvListStyle.Create;
 | ||
| begin
 | ||
|   ListLevelStyles:=TFPList.Create;
 | ||
| end;
 | ||
| 
 | ||
| destructor TvListStyle.Destroy;
 | ||
| begin
 | ||
|   Clear;
 | ||
|   ListLevelStyles.Free;
 | ||
|   ListLevelStyles := Nil;
 | ||
| 
 | ||
|   inherited Destroy;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvListStyle.Clear;
 | ||
| var
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   for i := ListLevelStyles.Count-1 downto 0 do
 | ||
|   begin
 | ||
|     TvListLevelStyle(ListLevelStyles[i]).free;
 | ||
|     ListLevelStyles.Delete(i);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvListStyle.AddListLevelStyle: TvListLevelStyle;
 | ||
| begin
 | ||
|   Result := TvListLevelStyle.Create;
 | ||
|   ListLevelStyles.Add(Result);
 | ||
| end;
 | ||
| 
 | ||
| function TvListStyle.GetListLevelStyleCount: Integer;
 | ||
| begin
 | ||
|   Result := ListLevelStyles.Count;
 | ||
| end;
 | ||
| 
 | ||
| function TvListStyle.GetListLevelStyle(AIndex : Integer): TvListLevelStyle;
 | ||
| begin
 | ||
|   Result := TvListLevelStyle(ListLevelStyles[Aindex]);
 | ||
| end;
 | ||
| 
 | ||
| { TvTableCell }
 | ||
| 
 | ||
| constructor TvTableCell.Create(APage: TvPage);
 | ||
| begin
 | ||
|   inherited Create(APage);
 | ||
| 
 | ||
|   Borders.Left.LineType:=tbtDefault;
 | ||
|   Borders.Right.LineType:=tbtDefault;
 | ||
|   Borders.Top.LineType:=tbtDefault;
 | ||
|   Borders.Bottom.LineType:=tbtDefault;
 | ||
|   Borders.InsideHoriz.LineType:=tbtDefault;
 | ||
|   Borders.InsideVert.LineType:=tbtDefault;
 | ||
| 
 | ||
|   SpacingLeft := 2;
 | ||
|   SpacingRight := 2;
 | ||
|   SpacingTop := 2;
 | ||
|   SpacingBottom := 2;
 | ||
| 
 | ||
|   SpannedCols := 1;
 | ||
| end;
 | ||
| 
 | ||
| function TvTableCell.GetEffectiveBorder(): TvTableBorders;
 | ||
| begin
 | ||
|   Result := Borders;
 | ||
|   if (Row <> nil) and (Row.Table <> nil) then
 | ||
|   begin
 | ||
|     if Borders.Left.LineType = tbtDefault then
 | ||
|       Result.Left := Row.Table.Borders.Left;
 | ||
|     if Borders.Right.LineType = tbtDefault then
 | ||
|       Result.Right := Row.Table.Borders.Right;
 | ||
|     if Borders.Top.LineType = tbtDefault then
 | ||
|       Result.Top := Row.Table.Borders.Top;
 | ||
|     if Borders.Bottom.LineType = tbtDefault then
 | ||
|       Result.Bottom := Row.Table.Borders.Bottom;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvTableCell.GetEffectiveCellSpacing(out ATopSpacing, ALeftSpacing, ARightSpacing, ABottomSpacing: Double);
 | ||
| begin
 | ||
|   ATopSpacing := 0;
 | ||
|   ALeftSpacing := 0;
 | ||
|   ARightSpacing := 0;
 | ||
|   ABottomSpacing := 0;
 | ||
|   if SpacingDataValid then
 | ||
|   begin
 | ||
|     ATopSpacing := SpacingTop;
 | ||
|     ALeftSpacing := SpacingLeft;
 | ||
|     ARightSpacing := SpacingRight;
 | ||
|     ABottomSpacing := SpacingBottom;
 | ||
|   end
 | ||
|   else if (Row <> nil) and (Row.SpacingDataValid) then
 | ||
|   begin
 | ||
|     ATopSpacing := Row.CellSpacing;
 | ||
|     ALeftSpacing := Row.CellSpacing;
 | ||
|     ARightSpacing := Row.CellSpacing;
 | ||
|     ABottomSpacing := Row.CellSpacing;
 | ||
|   end
 | ||
|   else if (Row <> nil) and (Row.Table <> nil) then
 | ||
|   begin
 | ||
|     ATopSpacing := Row.Table.CellSpacingLeft;
 | ||
|     ALeftSpacing := Row.Table.CellSpacingTop;
 | ||
|     ARightSpacing := Row.Table.CellSpacingRight;
 | ||
|     ABottomSpacing := Row.Table.CellSpacingBottom;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| class procedure TvTableCell.DrawBorder(ABorder: TvTableBorders;
 | ||
|   AX, AY, AWidth, AHeight: double;
 | ||
|   ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|   ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
 | ||
| 
 | ||
|   function CoordToCanvasX(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestX + AmulX * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CoordToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestY + AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
| begin
 | ||
|   CalcEntityCanvasMinMaxXY(ARenderInfo, CoordToCanvasX(AX), CoordToCanvasY(AY));
 | ||
|   CalcEntityCanvasMinMaxXY(ARenderInfo, CoordToCanvasX(AX), CoordToCanvasY(AY+AHeight));
 | ||
|   ADest.Pen.Style := psSolid;
 | ||
|   ADest.Pen.FPColor := colBlack;
 | ||
|   if ABorder.Left.LineType <> tbtNone then
 | ||
|   begin
 | ||
|     ADest.Pen.Width := Round(ABorder.Left.Width * AMulX);
 | ||
|     ADest.Line(
 | ||
|       CoordToCanvasX(AX),
 | ||
|       CoordToCanvasY(AY),
 | ||
|       CoordToCanvasX(AX),
 | ||
|       CoordToCanvasY(AY+AHeight));
 | ||
|   end;
 | ||
|   if ABorder.Right.LineType <> tbtNone then
 | ||
|   begin
 | ||
|     ADest.Pen.Width := Round(ABorder.Right.Width * AMulX);
 | ||
|     ADest.Line(
 | ||
|       CoordToCanvasX(AX+AWidth),
 | ||
|       CoordToCanvasY(AY),
 | ||
|       CoordToCanvasX(AX+AWidth),
 | ||
|       CoordToCanvasY(AY+AHeight));
 | ||
|   end;
 | ||
|   if ABorder.Top.LineType <> tbtNone then
 | ||
|   begin
 | ||
|     ADest.Pen.Width := Round(ABorder.Top.Width * AMulX);
 | ||
|     ADest.Line(
 | ||
|       CoordToCanvasX(AX),
 | ||
|       CoordToCanvasY(AY),
 | ||
|       CoordToCanvasX(AX+AWidth),
 | ||
|       CoordToCanvasY(AY));
 | ||
|   end;
 | ||
|   if ABorder.Bottom.LineType <> tbtNone then
 | ||
|   begin
 | ||
|     ADest.Pen.Width := Round(ABorder.Bottom.Width * AMulX);
 | ||
|     ADest.Line(
 | ||
|       CoordToCanvasX(AX),
 | ||
|       CoordToCanvasY(AY+AHeight),
 | ||
|       CoordToCanvasX(AX+AWidth),
 | ||
|       CoordToCanvasY(AY+AHeight));
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvTableCell.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|   ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True);
 | ||
| var
 | ||
|   lBorders: TvTableBorders;
 | ||
|   CellWidth, CellHeight, lCellSpacingX, lCellSpacingY, lTmp: Double;
 | ||
|   lColNr: Integer;
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   // draw borders
 | ||
|   if (Row <> nil) and (Row.Table <> nil) and ADoDraw then
 | ||
|   begin
 | ||
|     lBorders := GetEffectiveBorder();
 | ||
|     lColNr := Row.GetCellColNr(Self);
 | ||
| 
 | ||
|     CellWidth := 0;
 | ||
|     for i := lColNr to lColNr+SpannedCols-1 do
 | ||
|     begin
 | ||
|       CellWidth := CellWidth + Row.Table.ColWidthsInMM[i];
 | ||
|     end;
 | ||
|     CellHeight := Row.Height;
 | ||
| 
 | ||
|     TvTableCell.DrawBorder(lBorders, X, Y, CellWidth, CellHeight,
 | ||
|       ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY);
 | ||
|   end;
 | ||
| 
 | ||
|   GetEffectiveCellSpacing(lCellSpacingX, lCellSpacingY, lTmp, lTmp);
 | ||
|   X := X + lCellSpacingX;
 | ||
|   Y := Y + lCellSpacingY;
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|   X := X - lCellSpacingX;
 | ||
|   Y := Y - lCellSpacingY;
 | ||
| end;
 | ||
| 
 | ||
| function TvTableCell.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer;
 | ||
| begin
 | ||
|   FExtraDebugStr := Format(' Borders=%s PreferredWidth=%f VerticalAlignment=%s' +
 | ||
|     ' BackgroundColor=%s SpannedCols=%d',
 | ||
|     [GenerateDebugStrForBorders(Borders),
 | ||
|      PreferredWidth.Value,
 | ||
|      GetEnumName(TypeInfo(TvVerticalAlignment), integer(VerticalAlignment)),
 | ||
|      GenerateDebugStrForFPColor(BackgroundColor), SpannedCols]);
 | ||
| 
 | ||
|   Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
 | ||
| end;
 | ||
| 
 | ||
| class function TvTableCell.GenerateDebugStrForBorders(ABorders: TvTableBorders): string;
 | ||
| begin
 | ||
|   Result := Format('L=%s:%f T=%s:%f R=%s:%f B=%s:%f',
 | ||
|     [GetEnumName(TypeInfo(TvTableBorderType), integer(ABorders.Left.LineType)),
 | ||
|      ABorders.Left.Width,
 | ||
|      GetEnumName(TypeInfo(TvTableBorderType), integer(ABorders.Top.LineType)),
 | ||
|      ABorders.Top.Width,
 | ||
|      GetEnumName(TypeInfo(TvTableBorderType), integer(ABorders.Right.LineType)),
 | ||
|      ABorders.Right.Width,
 | ||
|      GetEnumName(TypeInfo(TvTableBorderType), integer(ABorders.Bottom.LineType)),
 | ||
|      ABorders.Bottom.Width]);
 | ||
| end;
 | ||
| 
 | ||
| { TvTable }
 | ||
| 
 | ||
| // Returns the table width
 | ||
| procedure TvTable.CalculateColWidths(ADest: TFPCustomCanvas);
 | ||
| var
 | ||
|   CurRow: TvTableRow;
 | ||
|   CurCell: TvTableCell;
 | ||
|   lWidth: Double;
 | ||
|   col, row, i: Integer;
 | ||
|   //DebugStr: string;
 | ||
|   OriginalColWidthsInMM: array of Double;
 | ||
|   CurRowTableWidth: Double;
 | ||
| begin
 | ||
|   SetLength(ColWidthsInMM, GetColCount());
 | ||
| 
 | ||
|   // Process predefined widths
 | ||
|   for col := 0 to Length(ColWidthsInMM)-1 do
 | ||
|   begin
 | ||
|     ColWidthsInMM[col] := 0;
 | ||
|     if Length(ColWidths) > col then
 | ||
|       ColWidthsInMM[col] := ConvertDimensionToMM(Dimension(ColWidths[col], ColWidthsUnits), FPage.Width);
 | ||
|   end;
 | ||
| 
 | ||
|   // Process initial value for non-predefined widths
 | ||
|   OriginalColWidthsInMM := Copy(ColWidthsInMM, 0, Length(ColWidthsInMM));
 | ||
|   TableWidth := 0;
 | ||
|   for row := 0 to GetRowCount()-1 do
 | ||
|   begin
 | ||
|     CurRow := GetRow(row);
 | ||
|     CurRowTableWidth := 0;
 | ||
| 
 | ||
|     for col := 0 to CurRow.GetCellCount()-1 do
 | ||
|     begin
 | ||
|       CurCell := CurRow.GetCell(col);
 | ||
|       //DebugStr := ((CurCell.GetFirstEntity() as TvParagraph).GetFirstEntity() as TvText).Value.Text;
 | ||
| 
 | ||
|       // skip cells with span since they are complex
 | ||
|       // skip columns with width pre-set
 | ||
|       if (OriginalColWidthsInMM[col] > 0) then
 | ||
|       begin
 | ||
|         CurRowTableWidth := CurRowTableWidth + ColWidthsInMM[col];
 | ||
|         Continue;
 | ||
|       end;
 | ||
|       if (CurCell.SpannedCols > 1) then
 | ||
|       begin
 | ||
|         CurRowTableWidth := CurRowTableWidth + ColWidthsInMM[col];
 | ||
|         for i := 0 to CurCell.SpannedCols-1 do
 | ||
|           CurRowTableWidth := CurRowTableWidth + ColWidthsInMM[col+i];
 | ||
|         Continue;
 | ||
|       end;
 | ||
| 
 | ||
|       lWidth := CurCell.CalculateMaxNeededWidth(ADest);
 | ||
|       ColWidthsInMM[col] := Max(ColWidthsInMM[col], lWidth);
 | ||
|       CurRowTableWidth := CurRowTableWidth + ColWidthsInMM[col];
 | ||
|     end;
 | ||
| 
 | ||
|     TableWidth := Max(TableWidth, CurRowTableWidth);
 | ||
|   end;
 | ||
| 
 | ||
|   // If it goes over the page width, recalculate with equal sizes (in the future do better)
 | ||
|   if FPage.Width <= 0 then Exit;
 | ||
|   if TableWidth <= FPage.Width then Exit;
 | ||
|   TableWidth := FPage.Width;
 | ||
|   for col := 0 to Length(ColWidthsInMM)-1 do
 | ||
|   begin
 | ||
|     ColWidthsInMM[col] := FPage.Width / GetRowCount();
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvTable.CalculateRowHeights(ADest: TFPCustomCanvas);
 | ||
| var
 | ||
|   col, row: Integer;
 | ||
|   CurRow: TvTableRow;
 | ||
|   CurCell: TvTableCell;
 | ||
|   lCellHeight: Double;
 | ||
| begin
 | ||
|   TableHeight := 0;
 | ||
| 
 | ||
|   for row := 0 to GetRowCount()-1 do
 | ||
|   begin
 | ||
|     CurRow := GetRow(row);
 | ||
|     CurRow.Height := 0;
 | ||
| 
 | ||
|     for col := 0 to CurRow.GetCellCount()-1 do
 | ||
|     begin
 | ||
|       CurCell := CurRow.GetCell(col);
 | ||
|       lCellHeight := CurCell.CalculateCellHeight_ForWidth(ADest, ColWidthsInMM[col]);
 | ||
|       CurRow.Height := Max(CurRow.Height, lCellHeight);
 | ||
|     end;
 | ||
| 
 | ||
|     CurRow.Height := CurRow.Height + CurRow.CalculateMaxCellSpacing_Y();
 | ||
|     TableHeight := TableHeight + SpacingBetweenCells;
 | ||
|     CurRow.Y := TableHeight;
 | ||
|     TableHeight := TableHeight + CurRow.Height;
 | ||
|   end;
 | ||
| 
 | ||
|   TableHeight := TableHeight + SpacingBetweenCells;
 | ||
| end;
 | ||
| 
 | ||
| constructor TvTable.create(APage: TvPage);
 | ||
| begin
 | ||
|   inherited Create(APage);
 | ||
| 
 | ||
|   Rows := TFPList.Create;
 | ||
| 
 | ||
|   Borders.Left.Width := 1;
 | ||
|   Borders.Right.Width := 1;
 | ||
|   Borders.Top.Width := 1;
 | ||
|   Borders.Bottom.Width := 1;
 | ||
|   Borders.InsideHoriz.Width := 1;
 | ||
|   Borders.InsideVert.Width := 1;
 | ||
| end;
 | ||
| 
 | ||
| destructor TvTable.destroy;
 | ||
| var
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   for i := Rows.Count-1 downto 0 do
 | ||
|   begin
 | ||
|     TvTableRow(Rows.Last).Free;
 | ||
|     Rows.Delete(Rows.Count-1);
 | ||
|   end;
 | ||
| 
 | ||
|   Rows.Free;
 | ||
|   Rows := nil;
 | ||
| 
 | ||
|   inherited destroy;
 | ||
| end;
 | ||
| 
 | ||
| function TvTable.AddRow: TvTableRow;
 | ||
| begin
 | ||
|   Result := TvTableRow.create(FPage);
 | ||
|   Result.Table := Self;
 | ||
|   Rows.Add(result);
 | ||
| end;
 | ||
| 
 | ||
| function TvTable.GetRowCount: Integer;
 | ||
| begin
 | ||
|   Result := Rows.Count;
 | ||
| end;
 | ||
| 
 | ||
| function TvTable.GetRow(AIndex: Integer): TvTableRow;
 | ||
| begin
 | ||
|   Result := TvTableRow(Rows[AIndex]);
 | ||
| end;
 | ||
| 
 | ||
| function TvTable.AddColWidth(AValue: Double): Integer;
 | ||
| begin
 | ||
|   SetLength(ColWidths, Length(ColWidths) + 1);
 | ||
|   ColWidths[High(ColWidths)] := AValue;
 | ||
| end;
 | ||
| 
 | ||
| function TvTable.GetColCount(): Integer;
 | ||
| var
 | ||
|   row, col, CurRowColCount: Integer;
 | ||
|   CurRow: TvTableRow;
 | ||
|   CurCell: TvTableCell;
 | ||
| begin
 | ||
|   Result := 0;
 | ||
|   for row := 0 to GetRowCount()-1 do
 | ||
|   begin
 | ||
|     CurRow := GetRow(row);
 | ||
|     CurRowColCount := 0;
 | ||
|     for col := 0 to CurRow.GetCellCount()-1 do
 | ||
|     begin
 | ||
|       CurCell := CurRow.GetCell(col);
 | ||
|       CurRowColCount := CurRowColCount + CurCell.SpannedCols;
 | ||
|     end;
 | ||
| 
 | ||
|     Result := Max(Result, CurRowColCount);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvTable.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
 | ||
|   ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| 
 | ||
|   function CoordToCanvasX(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestX + AmulX * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CoordToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestY + AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function DeltaToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   row: Integer;
 | ||
|   CurRow: TvTableRow;
 | ||
|   lEntityRenderInfo: TvRenderInfo;
 | ||
| begin
 | ||
|   InitializeRenderInfo(ARenderInfo, Self);
 | ||
| 
 | ||
|   // First calculate the column widths and heights
 | ||
|   CalculateColWidths(ADest);
 | ||
| 
 | ||
|   // Now calculate the row heights
 | ||
|   CalculateRowHeights(ADest);
 | ||
| 
 | ||
|   // Draw the table border
 | ||
|   if ADoDraw then
 | ||
|   begin
 | ||
|     TvTableCell.DrawBorder(Borders, X, Y, TableWidth, TableHeight,
 | ||
|       ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY);
 | ||
|   end;
 | ||
| 
 | ||
|   // Now draw the table
 | ||
|   for row := 0 to GetRowCount()-1 do
 | ||
|   begin
 | ||
|     CurRow := GetRow(row);
 | ||
| 
 | ||
|     // changes from pos relative inside table (calculated in CalculateRowHeights) to absolute pos
 | ||
|     CurRow.Y := Y + CurRow.Y;
 | ||
| 
 | ||
|     CopyAndInitDocumentRenderInfo(lEntityRenderInfo, ARenderInfo);
 | ||
|     CurRow.Render(ADest, lEntityRenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|     //MergeRenderInfo(lEntityRenderInfo, ARenderInfo); no need to merge, since TvTableCell.DrawBorder calculates the proper size
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvTable.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   i: Integer;
 | ||
|   lCurRow: TvTableRow;
 | ||
| begin
 | ||
|   Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
 | ||
| 
 | ||
|   // data which goes into a separate item
 | ||
|   FExtraDebugStr := 'ColWidthsInMM=';
 | ||
|   for i := 0 to Length(ColWidthsInMM)-1 do
 | ||
|     FExtraDebugStr := FExtraDebugStr + Format('[%d]=%f ', [i, ColWidthsInMM[i]]);
 | ||
|   ADestRoutine(FExtraDebugStr, Result);
 | ||
| 
 | ||
|   // Add rows
 | ||
|   for i := 0 to GetRowCount()-1 do
 | ||
|   begin
 | ||
|     lCurRow := GetRow(i);
 | ||
|     lCurRow.GenerateDebugTree(ADestRoutine, Result);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| { TvEmbeddedVectorialDoc }
 | ||
| 
 | ||
| constructor TvEmbeddedVectorialDoc.create(APage: TvPage);
 | ||
| begin
 | ||
|   inherited create(APage);
 | ||
|   Document := TvVectorialDocument.Create();
 | ||
|   FWidth := -1;
 | ||
|   FHeight := -1;
 | ||
| end;
 | ||
| 
 | ||
| destructor TvEmbeddedVectorialDoc.destroy;
 | ||
| begin
 | ||
|   Document.Free;
 | ||
|   inherited destroy;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEmbeddedVectorialDoc.UpdateDocumentSize;
 | ||
| begin
 | ||
|   if (Document.Width = 0) or (Document.Height = 0) then
 | ||
|   begin
 | ||
|     Document.GuessDocumentSize();
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvEmbeddedVectorialDoc.GetWidth: Double;
 | ||
| begin
 | ||
|   if FWidth >= 0 then
 | ||
|     Result := FWidth
 | ||
|   else
 | ||
|     Result := Document.Width;
 | ||
| end;
 | ||
| 
 | ||
| function TvEmbeddedVectorialDoc.GetHeight: Double;
 | ||
| begin
 | ||
|   if FHeight >= 0 then
 | ||
|     Result := FHeight
 | ||
|   else
 | ||
|     Result := Document.Height;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEmbeddedVectorialDoc.SetWidth(AValue: Double);
 | ||
| begin
 | ||
|   FWidth := AValue;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEmbeddedVectorialDoc.SetHeight(AValue: Double);
 | ||
| begin
 | ||
|   FHeight := AValue;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEmbeddedVectorialDoc.CalculateBoundingBox(ADest: TFPCustomCanvas;
 | ||
|   out ALeft, ATop, ARight, ABottom: Double);
 | ||
| begin
 | ||
|   UpdateDocumentSize();
 | ||
|   ALeft := X;
 | ||
|   ATop := Y;
 | ||
|   ARight := X + GetWidth();
 | ||
|   ABottom := Y + GetHeight();
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEmbeddedVectorialDoc.Render(ADest: TFPCustomCanvas;
 | ||
|   var ARenderInfo: TvRenderInfo; ADestX: Integer; ADestY: Integer;
 | ||
|   AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| 
 | ||
|   function CoordToCanvasX(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestX + AmulX * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CoordToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestY + AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   lPage: TvPage;
 | ||
|   lX_px, lY_px, lWidth_px, lHeight_px, lPageHeight, lDeltaX, lDeltaY: Integer;
 | ||
|   lMulY, lZoom: Double;
 | ||
| begin
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
| 
 | ||
|   if Document.GetPageCount() = 0 then Exit;
 | ||
| 
 | ||
|   lPage := Document.GetPage(0);
 | ||
|   lPageHeight := Round(lPage.Height);
 | ||
|   lPage.GetNaturalRenderPos(lPageHeight, lMulY);
 | ||
| 
 | ||
|   UpdateDocumentSize();
 | ||
|   lX_px := CoordToCanvasX(X);
 | ||
|   lY_px := CoordToCanvasY(Y);
 | ||
| 
 | ||
|   // Ignore MulX/MulY here so that it doesn't affect AutoFit, this fixes an
 | ||
|   // issue where embeded svg in html was getting out of proportion if the zoom
 | ||
|   // was different than 1.0
 | ||
|   // Calculate the standard zoom (zoom with mulx=1.0)
 | ||
|   lWidth_px := Round(GetWidth());
 | ||
|   lHeight_px := Round(GetHeight());
 | ||
|   lPage.AutoFit(ADest, lWidth_px, lHeight_px, lHeight_px, lDeltaX, lDeltaY, lZoom);
 | ||
|   lZoom := Abs(lZoom);
 | ||
|   lX_px += lDeltaX;
 | ||
|   lY_px += lDeltaY;
 | ||
|   if AmulY * lMulY < 0 then
 | ||
|   begin
 | ||
|     lY_px := lY_px + lHeight_px;
 | ||
|   end;
 | ||
|   // recalculate lWidth_px/height considering now mulx/muly
 | ||
|   lWidth_px := Abs(CoordToCanvasX(GetWidth()));
 | ||
|   lHeight_px := Abs(CoordToCanvasY(GetHeight()));
 | ||
| 
 | ||
|   if ADoDraw then
 | ||
|   begin
 | ||
|     lPage.Render(ADest, lX_px, lY_px, AMulX * lZoom, AMulY * lMulY * lZoom);
 | ||
|     {ADest.Pen.FPColor := colRed;
 | ||
|     ADest.Pen.Style := psSolid;
 | ||
|     ADest.Rectangle(CoordToCanvasX(X), CoordToCanvasY(lY), CoordToCanvasX(X+Width), CoordToCanvasY(lY+Height));
 | ||
|     ADest.Rectangle(lX_px, lY_px, lX_px+100, lY_px+100);}
 | ||
|   end;
 | ||
| 
 | ||
|   if (ARenderInfo.Errors <> nil) and (lPage.RenderInfo.Errors <> nil) then
 | ||
|     ARenderInfo.Errors.AddStrings(lPage.RenderInfo.Errors);
 | ||
|   CalcEntityCanvasMinMaxXY(ARenderInfo, CoordToCanvasX(X), CoordToCanvasY(Y));
 | ||
|   CalcEntityCanvasMinMaxXY(ARenderInfo,
 | ||
|     CoordToCanvasX(X + Document.Width),
 | ||
|     CoordToCanvasY(Y + Document.Height));
 | ||
|   CalcEntityCanvasMinMaxXY(ARenderInfo, lX_px, lY_px);
 | ||
|   CalcEntityCanvasMinMaxXY(ARenderInfo, lX_px+lWidth_px, lY_px+lHeight_px);
 | ||
| end;
 | ||
| 
 | ||
| function TvEmbeddedVectorialDoc.GenerateDebugTree(
 | ||
|   ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer;
 | ||
| begin
 | ||
|   Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
 | ||
|   Document.GenerateDebugTree(ADestRoutine, Result);
 | ||
| end;
 | ||
| 
 | ||
| { TvTableRow }
 | ||
| 
 | ||
| constructor TvTableRow.create(APage: TvPage);
 | ||
| begin
 | ||
|   inherited create(APage);
 | ||
| 
 | ||
|   Cells := TFPList.Create;
 | ||
| 
 | ||
|   Header := False;
 | ||
| end;
 | ||
| 
 | ||
| destructor TvTableRow.destroy;
 | ||
| Var
 | ||
|   i : Integer;
 | ||
| begin
 | ||
|   for i := Cells.Count-1 downto 0 do
 | ||
|   begin
 | ||
|     TvTableCell(Cells.Last).Free;
 | ||
|     Cells.Delete(Cells.Count-1);
 | ||
|   end;
 | ||
| 
 | ||
|   Cells.Free;
 | ||
|   Cells := Nil;
 | ||
| 
 | ||
|   inherited destroy;
 | ||
| end;
 | ||
| 
 | ||
| function TvTableRow.AddCell : TvTableCell;
 | ||
| begin
 | ||
|   Result := TvTableCell.Create(FPage);
 | ||
|   Result.Row := Self;
 | ||
|   Cells.Add(Result);
 | ||
| end;
 | ||
| 
 | ||
| function TvTableRow.GetCellCount: Integer;
 | ||
| begin
 | ||
|   Result := Cells.Count;
 | ||
| end;
 | ||
| 
 | ||
| function TvTableRow.GetCell(AIndex: Integer): TvTableCell;
 | ||
| begin
 | ||
|   Result := TvTableCell(Cells[AIndex]);
 | ||
| end;
 | ||
| 
 | ||
| function TvTableRow.GetCellColNr(ACell: TvTableCell): Integer;
 | ||
| begin
 | ||
|   Result := Cells.IndexOf(Pointer(ACell));
 | ||
| end;
 | ||
| 
 | ||
| function TvTableRow.CalculateMaxCellSpacing_Y(): Double;
 | ||
| Var
 | ||
|   i : Integer;
 | ||
|   CurCell: TvTableCell;
 | ||
|   lTopSpacing, lLeftSpacing, lRightSpacing, lBottomSpacing: Double;
 | ||
| begin
 | ||
|   Result := 0;
 | ||
|   for i := 0 to GetCellCount()-1 do
 | ||
|   begin
 | ||
|     CurCell := GetCell(i);
 | ||
|     CurCell.GetEffectiveCellSpacing(lTopSpacing, lLeftSpacing, lRightSpacing, lBottomSpacing);
 | ||
|     Result := Max(Result, lBottomSpacing+lTopSpacing);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvTableRow.CalculateBoundingBox(ADest: TFPCustomCanvas;
 | ||
|   out ALeft, ATop, ARight, ABottom: Double);
 | ||
| begin
 | ||
|   ALeft := X;
 | ||
|   ATop := Y;
 | ||
|   ARight := X + FPage.Width;
 | ||
|   ABottom := Y + Height;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvTableRow.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|   ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True);
 | ||
| 
 | ||
|   function CoordToCanvasX(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestX + AmulX * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CoordToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestY + AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   CurCell: TvTableCell;
 | ||
|   i: Integer;
 | ||
|   CurX_mm: Double = 0.0;
 | ||
|   lEntityRenderInfo: TvRenderInfo;
 | ||
| begin
 | ||
|   InitializeRenderInfo(ARenderInfo, Self);
 | ||
| 
 | ||
|   for i := 0 to GetCellCount()-1 do
 | ||
|   begin
 | ||
|     CurCell := GetCell(i);
 | ||
|     CurCell.X := CurX_mm;
 | ||
|     CurCell.Y := Y;
 | ||
|     //ADest.Line(CoordToCanvasX(CurX_mm), CoordToCanvasY(Y), CoordToCanvasX(CurX_mm+1), CoordToCanvasY(Y+1));
 | ||
|     CopyAndInitDocumentRenderInfo(lEntityRenderInfo, ARenderInfo);
 | ||
|     CurCell.Render(ADest, lEntityRenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|     if (Table <> nil) then
 | ||
|     begin
 | ||
|       if (Length(Table.ColWidthsInMM) > i) then
 | ||
|         CurX_mm := CurX_mm + Table.ColWidthsInMM[i];
 | ||
|     end;
 | ||
| 
 | ||
|     MergeRenderInfo(lEntityRenderInfo, ARenderInfo);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvTableRow.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   i: Integer;
 | ||
|   lCurCell: TvTableCell;
 | ||
| begin
 | ||
|   FExtraDebugStr := Format(' Height=%f CellSpacing=%f SpacingDataValid=%s',
 | ||
|     [Height, CellSpacing, BoolToStr(SpacingDataValid)]);
 | ||
|   Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
 | ||
| 
 | ||
|   // Add cells
 | ||
|   for i := 0 to GetCellCount()-1 do
 | ||
|   begin
 | ||
|     lCurCell := GetCell(i);
 | ||
|     lCurCell.GenerateDebugTree(ADestRoutine, Result);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| { T2DEllipticalArcSegment }
 | ||
| 
 | ||
| // wp: no longer needed...
 | ||
| function T2DEllipticalArcSegment.AlignedEllipseCenterEquationT1(
 | ||
|   AParam: Double): Double;
 | ||
| var
 | ||
|   lLeftSide, lRightSide, lArg: Double;
 | ||
| begin
 | ||
|   // E1.Y - RY*sin(t1) = E2.Y - RY*sin(arccos((- E1.X + RX*cos(t1) + E2.X)/RX))
 | ||
|   lLeftSide := E1.Y - RY*sin(AParam);
 | ||
|   lArg := (- E1.X + RX*cos(AParam) + E2.X)/RX;
 | ||
|   if (lArg > 1) or (lArg < -1) then Exit($FFFFFFFF);
 | ||
|   lRightSide := E2.Y - RY*sin(arccos(lArg));
 | ||
|   Result := lLeftSide - lRightSide;
 | ||
|   if Result < 0 then Result := -1* Result;
 | ||
| end;
 | ||
| 
 | ||
| procedure T2DEllipticalArcSegment.BezierApproximate(var Points: T3dPointsArray);
 | ||
| var
 | ||
|   P1, P2, P3, P4: T3dPoint;
 | ||
|   startangle, endangle: Double;
 | ||
|   startanglePi2, endanglePi2: Double;
 | ||
|   xstart, ystart: Double;
 | ||
|   nextx, nexty: Double;
 | ||
|   angle: Double;
 | ||
|   n: Integer;
 | ||
| begin
 | ||
|   SetLength(Points, 30);
 | ||
|   n := 0;
 | ||
| 
 | ||
|   xstart := T2DSegment(Previous).X;
 | ||
|   ystart := T2DSegment(Previous).Y;
 | ||
|   startangle := CalcEllipsePointAngle(xstart, ystart, RX, RY, CX, CY, XRotation);
 | ||
|   endangle := CalcEllipsePointAngle(X, Y, RX, RY, CX, CY, XRotation);
 | ||
|   if endangle < 0 then endangle := 2*pi + endangle;
 | ||
| 
 | ||
|   angle := arctan2(-1,1);
 | ||
|   angle := radtodeg(angle);
 | ||
| 
 | ||
|   angle := radtodeg(startangle);
 | ||
|   angle := radtodeg(endangle);
 | ||
| 
 | ||
|   // Since the algorithm for bezier approximation requires that the angle
 | ||
|   // between start and end is at most pi/3 we have to progress in pi/3 steps.
 | ||
|   angle := startangle + pi/3;
 | ||
|   while true do
 | ||
|   begin
 | ||
|     if angle >= endangle then begin
 | ||
|       EllipticalArcToBezier(CX, CY, RX, RY, startAngle, endangle, Points[n], Points[n+1], Points[n+2], Points[n+3]);
 | ||
|       inc(n, 4);
 | ||
|       break;
 | ||
|     end else
 | ||
|       EllipticalArcToBezier(CX, CY, RX, RY, startangle, angle, Points[n], Points[n+1], Points[n+2], Points[n+3]);
 | ||
|     inc(n, 4);
 | ||
|     startangle := angle;
 | ||
|     angle := angle + pi/2;
 | ||
|   end;
 | ||
|   SetLength(Points, n);
 | ||
| end;
 | ||
| 
 | ||
| procedure T2DEllipticalArcSegment.PolyApproximate(var Points: T3dPointsArray);
 | ||
| const
 | ||
|   BUFSIZE = 100;
 | ||
| var
 | ||
|   t, tstart, tend, dt: Double;
 | ||
|   xstart, ystart: Double;
 | ||
|   n: Integer;
 | ||
|   done: Boolean;
 | ||
|   clockwise: Boolean;
 | ||
| begin
 | ||
|   n := 0;
 | ||
|   SetLength(Points, BUFSIZE);
 | ||
| 
 | ||
|   dt := DegToRad(1.0);  // 1-degree increments
 | ||
| 
 | ||
|   xstart := T2DSegment(Previous).X;
 | ||
|   ystart := T2DSegment(Previous).Y;
 | ||
|   tstart := CalcEllipsePointAngle(xstart, ystart, RX, RY, CX, CY, XRotation);
 | ||
|   tend := CalcEllipsePointAngle(X, Y, RX, RY, CX, CY, XRotation);
 | ||
| 
 | ||
|   // Flip clockwise flag in case of top/left coordinates
 | ||
|   clockwise := ClockwiseArcFlag xor UseTopLeftCoordinates;
 | ||
| 
 | ||
|   if clockwise then
 | ||
|   begin
 | ||
|     // clockwise --> angle decreases --> tstart must be > tend
 | ||
|     dt := -dt;
 | ||
|     if tstart < tend then tstart := TWO_PI + tstart;
 | ||
|   end else
 | ||
|   begin
 | ||
|     // counter-clockwise --> angle increases --> tstart must be < tend
 | ||
|     if tend < tstart then tend := TWO_PI + tend;
 | ||
|   end;
 | ||
| 
 | ||
|   done := false;
 | ||
|   t := tstart;
 | ||
|   while not done do begin
 | ||
|     if (clockwise and (t < tend)) or         // angle decreases
 | ||
|        (not clockwise and (t > tend)) then   // angle increases
 | ||
|     begin
 | ||
|       t := tend;
 | ||
|       done := true;
 | ||
|     end;
 | ||
|     if n >= Length(Points) then
 | ||
|       SetLength(Points, Length(Points) + BUFSIZE);
 | ||
|     CalcEllipsePoint(t, RX, RY, CX, CY, XRotation, Points[n].x, Points[n].y);
 | ||
|     inc(n);
 | ||
|     t := t + dt;      // Note: dt is < 0 in clockwise case
 | ||
|   end;
 | ||
|   SetLength(Points, n);
 | ||
| end;
 | ||
| 
 | ||
| procedure T2DEllipticalArcSegment.Move(ADeltaX, ADeltaY: Double);
 | ||
| begin
 | ||
|   inherited Move(ADeltaX, ADeltaY);
 | ||
| 
 | ||
|   E1.X := E1.X + ADeltaX;
 | ||
|   E1.X := E1.Y + ADeltaY;
 | ||
| 
 | ||
|   E2.X := E2.X + ADeltaX;
 | ||
|   E2.X := E2.Y + ADeltaY;
 | ||
| 
 | ||
|   CX := CX + ADeltaX;
 | ||
|   CY := CY + ADeltaY;
 | ||
| end;
 | ||
| 
 | ||
| 
 | ||
| procedure T2DEllipticalArcSegment.Rotate(AAngle: Double; ABase: T3dPoint);
 | ||
| var
 | ||
|   p: T3DPoint;
 | ||
| begin
 | ||
|   inherited Rotate(AAngle, ABase);
 | ||
| 
 | ||
|   p := fpvutils.Rotate3DPointInXY(E1, ABase, AAngle);
 | ||
|   E1.X := p.X;
 | ||
|   E1.Y := p.Y;
 | ||
| 
 | ||
|   p := fpvutils.Rotate3DPointInXY(E2, ABase, AAngle);
 | ||
|   E2.X := p.X;
 | ||
|   E2.Y := p.Y;
 | ||
| 
 | ||
|   p := fpvutils.Rotate3DPointInXY(Make2dPoint(CX, CY), ABase, AAngle);
 | ||
|   CX := p.X;
 | ||
|   CY := p.Y;
 | ||
| end;
 | ||
| 
 | ||
| // wp: no longer needed...
 | ||
| procedure T2DEllipticalArcSegment.CalculateCenter;
 | ||
| var
 | ||
|   XStart, YStart, lT1: Double;
 | ||
|   CX1, CY1, CX2, CY2, LeftMostX, LeftMostY, RightMostX, RightMostY: Double;
 | ||
|   RotatedCenter: T3DPoint;
 | ||
| begin
 | ||
|   if CenterSetByUser then Exit;
 | ||
| 
 | ||
|   // Rotated Ellipse equation:
 | ||
|   // (xcosθ+ysinθ)^2 / RX^2 + (ycosθ−xsinθ)^2 / RY^2 = 1
 | ||
|   //
 | ||
|   // parametrized:
 | ||
|   // x = Cx + RX*cos(t)*cos(phi) - RY*sin(t)*sin(phi)  [1]
 | ||
|   // y = Cy + RY*sin(t)*cos(phi) + RX*cos(t)*sin(phi)  [2]
 | ||
| 
 | ||
|   if Previous = nil then
 | ||
|   begin
 | ||
|     CX := X - RX*Cos(0)*Cos(XRotation) + RY*Sin(0)*Sin(XRotation);
 | ||
|     CY := Y - RY*Sin(0)*Cos(XRotation) - RX*Cos(0)*Sin(XRotation);
 | ||
|     Exit;
 | ||
|   end;
 | ||
| 
 | ||
|   XStart := T2DSegment(Previous).X;
 | ||
|   YStart := T2DSegment(Previous).Y;
 | ||
| 
 | ||
|   //  Solve by rotating everything to align the ellipse to the axises and then rotating back again
 | ||
|   E1 := Rotate3DPointInXY(Make3DPoint(XStart,YStart), Make3DPoint(0,0),-1*XRotation);
 | ||
|   E2 := Rotate3DPointInXY(Make3DPoint(X,Y), Make3DPoint(0,0),-1*XRotation);
 | ||
| 
 | ||
|   // parametrized:
 | ||
|   // CX = E1.X - RX*cos(t1)
 | ||
|   // CY = E1.Y - RY*sin(t1)
 | ||
|   // CX = E2.X - RX*cos(t2)
 | ||
|   // CY = E2.Y - RY*sin(t2)
 | ||
|   //
 | ||
|   // E1.X - RX*cos(t1) = E2.X - RX*cos(t2)
 | ||
|   // E1.Y - RY*sin(t1) = E2.Y - RY*sin(t2)
 | ||
|   //
 | ||
|   // (- E1.X + RX*cos(t1) + E2.X)/RX = cos(t2)
 | ||
|   // arccos((- E1.X + RX*cos(t1) + E2.X)/RX) = t2
 | ||
|   //
 | ||
|   // E1.Y - RY*sin(t1) = E2.Y - RY*sin(arccos((- E1.X + RX*cos(t1) + E2.X)/RX))
 | ||
| 
 | ||
|   // SolveNumerically
 | ||
| 
 | ||
|   lT1 := SolveNumericallyAngle(@AlignedEllipseCenterEquationT1, 0.0001, 20);
 | ||
| 
 | ||
|   CX1 := E1.X - RX*cos(lt1);
 | ||
|   CY1 := E1.Y - RY*sin(lt1);
 | ||
| 
 | ||
|   // Rotate back!
 | ||
|   RotatedCenter := Rotate3DPointInXY(Make3DPoint(CX1,CY1), Make3DPoint(0,0),XRotation);
 | ||
|   CX1 := RotatedCenter.X;
 | ||
|   CY1 := RotatedCenter.Y;
 | ||
| 
 | ||
|   // The other ellipse is symmetrically positioned
 | ||
|   if (CX1 > Xstart) then
 | ||
|     CX2 := X - (CX1-Xstart)
 | ||
|   else
 | ||
|     CX2 := Xstart - (CX1-X);
 | ||
|   //
 | ||
|   if (CY1 > Y) then
 | ||
|     CY2 := Ystart - (CY1-Y)
 | ||
|   else
 | ||
|     CY2 := Y - (CY1-Ystart);
 | ||
| 
 | ||
|   // Achar qual é a da esquerda e qual a da direita
 | ||
|   if CX1 < CX2 then
 | ||
|   begin
 | ||
|     LeftMostX := CX1;
 | ||
|     LeftMostY := CY1;
 | ||
|     RightMostX := CX2;
 | ||
|     RightMostY := CY2;
 | ||
|   end
 | ||
|   else
 | ||
|   begin
 | ||
|     LeftMostX := CX2;
 | ||
|     LeftMostY := CY2;
 | ||
|     RightMostX := CX1;
 | ||
|     RightMostY := CY1;
 | ||
|   end;
 | ||
| 
 | ||
|   if LeftmostEllipse then
 | ||
|   begin
 | ||
|     CX := LeftMostX;
 | ||
|     CY := LeftMostY;
 | ||
|   end
 | ||
|   else
 | ||
|   begin
 | ||
|     CX := RightMostX;
 | ||
|     CY := RightMostY;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure T2DEllipticalArcSegment.CalculateEllipseBoundingBox(ADest: TFPCustomCanvas;
 | ||
|   out ALeft, ATop, ARight, ABottom: Double);
 | ||
| var
 | ||
|   t1, t2, t3: Double;
 | ||
|   x1, x2, x3: Double;
 | ||
|   y1, y2, y3: Double;
 | ||
| begin
 | ||
|   ALeft := 0;
 | ||
|   ATop := 0;
 | ||
|   ARight := 0;
 | ||
|   ABottom := 0;
 | ||
|   if Previous = nil then Exit;
 | ||
| 
 | ||
|   // Alligned Ellipse equation:
 | ||
|   // x^2 / RX^2 + Y^2 / RY^2 = 1
 | ||
|   //
 | ||
|   // Rotated Ellipse equation:
 | ||
|   // (xcosθ+ysinθ)^2 / RX^2 + (ycosθ−xsinθ)^2 / RY^2 = 1
 | ||
|   //
 | ||
|   // parametrized:
 | ||
|   // x = Cx + a*cos(t)*cos(phi) - b*sin(t)*sin(phi)  [1]
 | ||
|   // y = Cy + b*sin(t)*cos(phi) + a*cos(t)*sin(phi)  [2]
 | ||
|   // ...where ellipse has centre (h,k) semimajor axis a and semiminor axis b, and is rotated through angle phi.
 | ||
|   //
 | ||
|   // You can then differentiate and solve for gradient = 0:
 | ||
|   // 0 = dx/dt = -a*sin(t)*cos(phi) - b*cos(t)*sin(phi)
 | ||
|   // => tan(t) = -b*tan(phi)/a   [3]
 | ||
|   // => t = arctan(-b*tan(phi)/a) + n*Pi   [4]
 | ||
|   //
 | ||
|   // And the same for Y
 | ||
|   // 0 = dy/dt = b*cos(t)*cos(phi) - a*sin(t)*sin(phi)
 | ||
|   // a*sin(t)/cos(t) = b*cos(phi)/sin(phi)
 | ||
|   // => tan(t) = b*cotan(phi)/a
 | ||
|   // => t = arctan(b*cotan(phi)/a) + n*Pi   [5]
 | ||
|   //
 | ||
|   // calculate some values of t for n in -1, 0, 1 and see which are the smaller, bigger ones
 | ||
|   // done!
 | ||
| 
 | ||
|   CalculateCenter();
 | ||
| 
 | ||
|   if XRotation = 0 then
 | ||
|   begin
 | ||
|     ALeft := CX-RX;
 | ||
|     ARight := CX+RX;
 | ||
|     ATop := CY+RY;
 | ||
|     ABottom := CY-RY;
 | ||
|   end
 | ||
|   else
 | ||
|   begin
 | ||
|     // Search for the minimum and maximum X
 | ||
|     // There are two solutions in each 2pi range
 | ||
|     t1 := arctan(-RY*tan(XRotation)/RX);
 | ||
|     t2 := arctan(-RY*tan(XRotation)/RX) + pi; //Pi/2;    // why add pi/2 ??
 | ||
| //    t3 := arctan(-RY*tan(XRotation)/RX) + Pi;
 | ||
| 
 | ||
|     x1 := Cx + RX*Cos(t1)*Cos(XRotation)-RY*Sin(t1)*Sin(XRotation);
 | ||
|     x2 := Cx + RX*Cos(t2)*Cos(XRotation)-RY*Sin(t2)*Sin(XRotation);
 | ||
| //    x3 := Cx + RX*Cos(t3)*Cos(XRotation)-RY*Sin(t3)*Sin(XRotation);
 | ||
| 
 | ||
|     ALeft := Min(x1, x2);
 | ||
|   //  ALeft := Min(ALeft, x3);
 | ||
| 
 | ||
|     ARight := Max(x1, x2);
 | ||
|     //ARight := Max(ARight, x3);
 | ||
| 
 | ||
|     // Now the same for Y
 | ||
| 
 | ||
|     t1 := arctan(RY*cotan(XRotation)/RX);
 | ||
|     t2 := arctan(RY*cotan(XRotation)/RX) + pi; //Pi/2;   // why add pi/2 ??
 | ||
| //    t3 := arctan(RY*cotan(XRotation)/RX) + 3*Pi/2;
 | ||
| 
 | ||
|     y1 := CY + RY*Sin(t1)*Cos(XRotation)+RX*Cos(t1)*Sin(XRotation);
 | ||
|     y2 := CY + RY*Sin(t2)*Cos(XRotation)+RX*Cos(t2)*Sin(XRotation);
 | ||
| //    y3 := CY + RY*Sin(t3)*Cos(XRotation)+RX*Cos(t3)*Sin(XRotation);
 | ||
| 
 | ||
|     ATop := Max(y1, y2);
 | ||
|   //  ATop := Max(ATop, y3);
 | ||
| 
 | ||
|     ABottom := Min(y1, y2);
 | ||
| //    ABottom := Min(ABottom, y3);
 | ||
|     {
 | ||
|     ATop := Min(y1, y2);
 | ||
|     ATop := Min(ATop, y3);
 | ||
| 
 | ||
|     ABottom := Max(y1, y2);
 | ||
|     ABottom := Max(ABottom, y3);
 | ||
|     }
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function T2DEllipticalArcSegment.GenerateDebugTree(
 | ||
|   ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   lStr: string;
 | ||
|   lStrLeftmostEllipse, lStrClockwiseArcFlag: string;
 | ||
| begin
 | ||
|   if LeftmostEllipse then lStrLeftmostEllipse := 'true'
 | ||
|   else lStrLeftmostEllipse := 'false';
 | ||
|   if ClockwiseArcFlag then lStrClockwiseArcFlag := 'true'
 | ||
|   else lStrClockwiseArcFlag := 'false';
 | ||
|   lStr := Format('[%s] X=%f Y=%f RX=%f RY=%f LeftmostEllipse=%s ClockwiseArcFlag=%s CX=%f CY=%f',
 | ||
|     [Self.ClassName, X, Y, RX, RY, lStrLeftmostEllipse, lStrClockwiseArcFlag, CX, CY]);
 | ||
|   Result := ADestRoutine(lStr, APageItem);
 | ||
| end;
 | ||
| 
 | ||
| procedure T2DEllipticalArcSegment.AddToPoints(ADestX, ADestY: Integer;
 | ||
|   AMulX, AMulY: Double; var Points: TPointsArray);
 | ||
| var
 | ||
|   pts3D: T3DPointsArray;
 | ||
|   i, n: Integer;
 | ||
| begin
 | ||
|   SetLength(pts3d, 0);
 | ||
|   PolyApproximate(pts3D);
 | ||
|   n := Length(Points);
 | ||
|   SetLength(Points, n + Length(pts3D) - 1);  // we don't need the start point --> -1
 | ||
|   for i:=0 to High(pts3D)-1 do    // i=0 is end point of prev segment -> we can skip it.
 | ||
|   begin
 | ||
|     Points[n].X := CoordToCanvasX(pts3D[i].X, ADestX, AMulX);
 | ||
|     Points[n].Y := CoordToCanvasY(pts3D[i].Y, ADestY, AMulY);
 | ||
|     inc(n);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| { TvVerticalFormulaStack }
 | ||
| 
 | ||
| function TvVerticalFormulaStack.CalculateHeight(ADest: TFPCustomCanvas): Double;
 | ||
| var
 | ||
|   lElement: TvFormulaElement;
 | ||
| begin
 | ||
|   Result := 0;
 | ||
|   lElement := GetFirstElement();
 | ||
|   while lElement <> nil do
 | ||
|   begin
 | ||
|     Result := Result + lElement.CalculateHeight(ADest) + SpacingBetweenElementsY;
 | ||
|     lElement := GetNextElement;
 | ||
|   end;
 | ||
|   // Remove an extra spacing, since it is added even to the last item
 | ||
|   Result := Result - SpacingBetweenElementsY;
 | ||
|   // Cache the result
 | ||
|   Height := Result;
 | ||
| end;
 | ||
| 
 | ||
| function TvVerticalFormulaStack.CalculateWidth(ADest: TFPCustomCanvas): Double;
 | ||
| var
 | ||
|   lElement: TvFormulaElement;
 | ||
| begin
 | ||
|   Result := 0;
 | ||
| 
 | ||
|   lElement := GetFirstElement();
 | ||
|   while lElement <> nil do
 | ||
|   begin
 | ||
|     Result := Max(Result, lElement.CalculateWidth(ADest));
 | ||
|     lElement := GetNextElement;
 | ||
|   end;
 | ||
| 
 | ||
|   // Cache the result
 | ||
|   Width := Result;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVerticalFormulaStack.PositionSubparts(ADest: TFPCustomCanvas;
 | ||
|   ABaseX, ABaseY: Double);
 | ||
| var
 | ||
|   lElement: TvFormulaElement;
 | ||
|   lPosX: Double = 0;
 | ||
|   lPosY: Double = 0;
 | ||
| begin
 | ||
|   CalculateHeight(ADest);
 | ||
|   CalculateWidth(ADest);
 | ||
|   Left := ABaseX;
 | ||
|   Top := ABaseY;
 | ||
| 
 | ||
|   // Then calculate the position of each element
 | ||
|   lElement := GetFirstElement();
 | ||
|   while lElement <> nil do
 | ||
|   begin
 | ||
|     lElement.Left := Left;
 | ||
|     lElement.Top := Top - lPosY;
 | ||
|     lPosY := lPosY + lElement.Height + SpacingBetweenElementsY;
 | ||
| 
 | ||
|     lElement.PositionSubparts(ADest, ABaseX, ABaseY);
 | ||
| 
 | ||
|     lElement := GetNextElement();
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVerticalFormulaStack.CalculateBoundingBox(ADest: TFPCustomCanvas;
 | ||
|   out ALeft, ATop, ARight, ABottom: Double);
 | ||
| begin
 | ||
|   inherited CalculateBoundingBox(ADest, ALeft, ATop, ARight, ABottom);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVerticalFormulaStack.Render(ADest: TFPCustomCanvas;
 | ||
|   var ARenderInfo: TvRenderInfo; ADestX: Integer; ADestY: Integer; AMulX: Double;
 | ||
|   AMulY: Double; ADoDraw: Boolean);
 | ||
| begin
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
| end;
 | ||
| 
 | ||
| { TPathSegment }
 | ||
| 
 | ||
| function TPathSegment.GetLength: Double;
 | ||
| begin
 | ||
|   Result := 0;
 | ||
| end;
 | ||
| 
 | ||
| function TPathSegment.GetPointAndTangentForDistance(ADistance: Double; out AX, AY, ATangentAngle: Double): Boolean;
 | ||
| begin
 | ||
|   Result := False;
 | ||
|   AX := 0;
 | ||
|   AY := 0;
 | ||
|   ATangentAngle := 0;
 | ||
| end;
 | ||
| 
 | ||
| function TPathSegment.GetStartPoint(out APoint: T3DPoint): Boolean;
 | ||
| begin
 | ||
|   Result := False;
 | ||
|   if Previous = nil then Exit;
 | ||
|   if (Previous is T3DSegment) then
 | ||
|   begin
 | ||
|     Result := True;
 | ||
|     APoint.X := T3DSegment(Previous).X;
 | ||
|     APoint.Y := T3DSegment(Previous).Y;
 | ||
|     APoint.Z := T3DSegment(Previous).Z;
 | ||
|     Exit;
 | ||
|   end;
 | ||
|   if (Previous is T2DSegment) then
 | ||
|   begin
 | ||
|     Result := True;
 | ||
|     APoint.X := T2DSegment(Previous).X;
 | ||
|     APoint.Y := T2DSegment(Previous).Y;
 | ||
|     APoint.Z := 0;
 | ||
|     Exit;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TPathSegment.Move(ADeltaX, ADeltaY: Double);
 | ||
| begin
 | ||
| 
 | ||
| end;
 | ||
| 
 | ||
| procedure TPathSegment.Rotate(AAngle: Double; ABase: T3DPoint);
 | ||
| begin
 | ||
| 
 | ||
| end;
 | ||
| 
 | ||
| procedure TPathSegment.CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft,
 | ||
|   ATop, ARight, ABottom: Double);
 | ||
| begin
 | ||
|   ALeft := 0;
 | ||
|   ATop := 0;
 | ||
|   ARight := 0;
 | ||
|   ABottom := 0;
 | ||
| end;
 | ||
| 
 | ||
| function TPathSegment.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   lStr, lTypeStr: string;
 | ||
| begin
 | ||
|   lTypeStr := GetEnumName(TypeInfo(TSegmentType), integer(SegmentType));
 | ||
|   lStr := Format('[%s] Type=%s', [Self.ClassName, lTypeStr]);
 | ||
|   Result := ADestRoutine(lStr, APageItem);
 | ||
| end;
 | ||
| 
 | ||
| procedure TPathSegment.AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double;
 | ||
|   var Points: TPointsArray);
 | ||
| begin
 | ||
|   // Override by descendants
 | ||
| end;
 | ||
| 
 | ||
| function TPathSegment.UseTopLeftCoordinates: Boolean;
 | ||
| begin
 | ||
|   Result := (FPath <> nil) and FPath.FPage.UseTopLeftCoordinates;
 | ||
| end;
 | ||
| 
 | ||
| 
 | ||
| { T2DSegment }
 | ||
| 
 | ||
| function T2DSegment.GetLength: Double;
 | ||
| var
 | ||
|   lStartPoint: T3DPoint;
 | ||
| begin
 | ||
|   Result := 0;
 | ||
|   if not GetStartPoint(lStartPoint) then Exit;
 | ||
|   Result := sqrt(sqr(X - lStartPoint.X) + sqr(Y + lStartPoint.Y));
 | ||
| end;
 | ||
| 
 | ||
| function T2DSegment.GetPointAndTangentForDistance(ADistance: Double; out AX,
 | ||
|   AY, ATangentAngle: Double): Boolean;
 | ||
| var
 | ||
|   lStartPoint: T3DPoint;
 | ||
| begin
 | ||
|   Result:=inherited GetPointAndTangentForDistance(ADistance, AX, AY, ATangentAngle);
 | ||
|   if not GetStartPoint(lStartPoint) then Exit;
 | ||
|   Result := LineEquation_GetPointAndTangentForLength(lStartPoint, Make3DPoint(X, Y), ADistance, AX, AY, ATangentAngle);
 | ||
| end;
 | ||
| 
 | ||
| procedure T2DSegment.Move(ADeltaX, ADeltaY: Double);
 | ||
| begin
 | ||
|   X := X + ADeltaX;
 | ||
|   Y := Y + ADeltaY;
 | ||
| end;
 | ||
| 
 | ||
| procedure T2DSegment.Rotate(AAngle: Double; ABase: T3DPoint);
 | ||
| var
 | ||
|   lRes: T3DPoint;
 | ||
| begin
 | ||
|   inherited Rotate(AAngle, ABase);
 | ||
|   lRes := fpvutils.Rotate3DPointInXY(Make3DPoint(X, Y), ABase, AAngle);
 | ||
|   X := lRes.X;
 | ||
|   Y := lRes.Y;
 | ||
| end;
 | ||
| 
 | ||
| function T2DSegment.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   lStr, lTypeStr: string;
 | ||
| begin
 | ||
|   lTypeStr := GetEnumName(TypeInfo(TSegmentType), integer(SegmentType));
 | ||
|   lStr := Format('[%s] Type=%s X=%f Y=%f', [Self.ClassName, lTypeStr, X, Y]);
 | ||
|   Result := ADestRoutine(lStr, APageItem);
 | ||
| end;
 | ||
| 
 | ||
| procedure T2DSegment.AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double;
 | ||
|   var Points: TPointsArray);
 | ||
| var
 | ||
|   n: Integer;
 | ||
| begin
 | ||
|   n := Length(Points);
 | ||
|   SetLength(Points, n + 1);
 | ||
|   Points[n].X := CoordToCanvasX(Points[n].X, ADestX, AMulX);
 | ||
|   Points[n].Y := CoordToCanvasY(Points[n].Y, ADestY, AMulY);
 | ||
| end;
 | ||
| 
 | ||
| { T2DBezierSegment }
 | ||
| 
 | ||
| function T2DBezierSegment.GetLength: Double;
 | ||
| var
 | ||
|   lStartPoint: T3DPoint;
 | ||
| begin
 | ||
|   Result := 0;
 | ||
|   if not GetStartPoint(lStartPoint) then Exit;
 | ||
|   Result := BezierEquation_GetLength(lStartPoint, Make3DPoint(X2, Y2),
 | ||
|     Make3DPoint(X3, Y3), Make3DPoint(X, Y), 0);
 | ||
| end;
 | ||
| 
 | ||
| function T2DBezierSegment.GetPointAndTangentForDistance(ADistance: Double; out
 | ||
|   AX, AY, ATangentAngle: Double): Boolean;
 | ||
| var
 | ||
|   lStartPoint: T3DPoint;
 | ||
| begin
 | ||
|   Result:=inherited GetPointAndTangentForDistance(ADistance, AX, AY,
 | ||
|     ATangentAngle);
 | ||
|   if not GetStartPoint(lStartPoint) then Exit;
 | ||
|   Result := BezierEquation_GetPointAndTangentForLength(lStartPoint, Make3DPoint(X2, Y2),
 | ||
|     Make3DPoint(X3, Y3), Make3DPoint(X, Y), ADistance, AX, AY, ATangentAngle);
 | ||
| end;
 | ||
| 
 | ||
| procedure T2DBezierSegment.Move(ADeltaX, ADeltaY: Double);
 | ||
| begin
 | ||
|   inherited Move(ADeltaX, ADeltaY);
 | ||
|   X2 := X2 + ADeltaX;
 | ||
|   Y2 := Y2 + ADeltaY;
 | ||
|   X3 := X3 + ADeltaX;
 | ||
|   Y3 := Y3 + ADeltaY;
 | ||
| end;
 | ||
| 
 | ||
| procedure T2DBezierSegment.Rotate(AAngle: Double; ABase: T3dPoint);
 | ||
| var
 | ||
|   p: T3DPoint;
 | ||
| begin
 | ||
|   inherited Rotate(AAngle, ABase);
 | ||
| 
 | ||
|   p := fpvutils.Rotate3DPointInXY(Make3DPoint(X2, Y2), ABase, AAngle);
 | ||
|   X2 := p.X;
 | ||
|   Y2 := p.Y;
 | ||
| 
 | ||
|   p := fpvutils.Rotate3DPointInXY(Make3DPoint(X3, Y3), ABase, AAngle);
 | ||
|   X3 := p.X;
 | ||
|   Y3 := p.Y;
 | ||
| end;
 | ||
| 
 | ||
| function T2DBezierSegment.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   lStr: string;
 | ||
| begin
 | ||
|   lStr := Format('[%s] X=%f Y=%f CX2=%f CY2=%f CX3=%f CY3=%f', [Self.ClassName, X, Y, X2, Y2, X3, Y3]);
 | ||
|   Result := ADestRoutine(lStr, APageItem);
 | ||
| end;
 | ||
| 
 | ||
| procedure T2DBezierSegment.AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double;
 | ||
|   var Points: TPointsArray);
 | ||
| var
 | ||
|   pts: TPointsArray;
 | ||
|   coordX, coordY, coord2X, coord2Y, coord3X, coord3Y, coord4X, coord4Y: Integer;
 | ||
|   i, n: Integer;
 | ||
|   prev: TPoint;
 | ||
| begin
 | ||
|   if not (Previous is T2DSegment) then
 | ||
|     raise Exception.Create('T2DBezierSegment must follow a T2DSegment.');
 | ||
| 
 | ||
|   coordX := CoordToCanvasX(T2DSegment(Previous).X, ADestX, AMulX);  // start pt
 | ||
|   coordY := CoordToCanvasY(T2DSegment(Previous).Y, ADestY, AMulY);
 | ||
|   coord4X := CoordToCanvasX(X, ADestX, AMulX);   // end pt
 | ||
|   coord4Y := CoordToCanvasY(Y, ADestY, AMulY);
 | ||
|   coord2X := CoordToCanvasX(X2, ADestX, AMulX);  // ctrl pt 1
 | ||
|   coord2Y := CoordToCanvasY(Y2, ADestY, AMulY);
 | ||
|   coord3X := CoordToCanvasX(X3, ADestX, AMulX);  // ctrl pt 2
 | ||
|   coord3Y := CoordToCanvasY(Y3, ADestY, AMulY);
 | ||
| 
 | ||
|   SetLength(pts, 0);
 | ||
|   AddBezierToPoints(
 | ||
|     Make3DPoint(coordX, coordY),
 | ||
|     Make3DPoint(coord2X, coord2Y),
 | ||
|     Make3DPoint(coord3X, coord3Y),
 | ||
|     Make3DPoint(coord4X, coord4Y),
 | ||
|     pts);
 | ||
| 
 | ||
|   if Length(pts) = 0 then
 | ||
|     exit;
 | ||
| 
 | ||
|   n := Length(Points);
 | ||
|   prev := Points[n-1];
 | ||
|   SetLength(Points, n + Length(pts));
 | ||
|   for i:=0 to High(pts) do
 | ||
|   begin
 | ||
|     if (pts[i].X = prev.X) and (pts[i].Y = prev.Y) then   // skip subsequent coincident points
 | ||
|       Continue;
 | ||
|     Points[n] := pts[i];
 | ||
|     prev := pts[i];
 | ||
|     inc(n);
 | ||
|   end;
 | ||
|   SetLength(Points, n);
 | ||
| end;
 | ||
| 
 | ||
| { T3DSegment }
 | ||
| 
 | ||
| procedure T3DSegment.Move(ADeltaX, ADeltaY: Double);
 | ||
| begin
 | ||
|   X := X + ADeltaX;
 | ||
|   Y := Y + ADeltaY;
 | ||
| end;
 | ||
| 
 | ||
| { This is preliminary... }
 | ||
| procedure T3DSegment.AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double;
 | ||
|   var Points: TPointsArray);
 | ||
| var
 | ||
|   n: Integer;
 | ||
| begin
 | ||
|   n := Length(Points);
 | ||
|   SetLength(Points, n + 1);
 | ||
|   Points[n].X := CoordToCanvasX(Points[n].X, ADestX, AMulX);
 | ||
|   Points[n].Y := CoordToCanvasY(Points[n].Y, ADestY, AMulY);
 | ||
| end;
 | ||
| 
 | ||
| { T3DBezierSegment }
 | ||
| 
 | ||
| procedure T3DBezierSegment.Move(ADeltaX, ADeltaY: Double);
 | ||
| begin
 | ||
|   inherited Move(ADeltaX, ADeltaY);
 | ||
|   X2 := X2 + ADeltaX;
 | ||
|   Y2 := Y2 + ADeltaY;
 | ||
|   X3 := X3 + ADeltaX;
 | ||
|   Y3 := Y3 + ADeltaY;
 | ||
| end;
 | ||
| 
 | ||
| { TvEntity }
 | ||
| 
 | ||
| constructor TvEntity.Create(APage: TvPage);
 | ||
| begin
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntity.Clear;
 | ||
| begin
 | ||
|   X := 0.0;
 | ||
|   Y := 0.0;
 | ||
|   Z := 0.0;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntity.SetPage(APage: TvPage);
 | ||
| begin
 | ||
| 
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntity.CalculateBoundingBox(ADest: TFPCustomCanvas;
 | ||
|   out ALeft, ATop, ARight, ABottom: Double);
 | ||
| begin
 | ||
|   ALeft := X;
 | ||
|   ATop := Y;
 | ||
|   ARight := X+1;
 | ||
|   ABottom := Y+1;
 | ||
| end;
 | ||
| 
 | ||
| // returns false if the element is invisible
 | ||
| function TvEntity.CalculateSizeInCanvas(ADest: TFPCustomCanvas;
 | ||
|   APage: TvPage; APageHeight: Integer; AZoom: Double;
 | ||
|   out ALeft, ATop, AWidth, AHeight: Integer): Boolean;
 | ||
| var
 | ||
|   lRenderInfo: TvRenderInfo;
 | ||
|   lMulY: Double;
 | ||
| begin
 | ||
|   Result := True;
 | ||
|   InitializeRenderInfo(lRenderInfo, Self);
 | ||
|   APage.GetNaturalRenderPos(APageHeight, lMulY);
 | ||
|   AZoom := Abs(AZoom);
 | ||
|   Render(ADest, lRenderInfo, 0, APageHeight, AZoom, AZoom * lMulY, False);
 | ||
|   ALeft := lRenderInfo.EntityCanvasMinXY.X;
 | ||
|   ATop := lRenderInfo.EntityCanvasMinXY.Y;
 | ||
|   AWidth := lRenderInfo.EntityCanvasMaxXY.X - lRenderInfo.EntityCanvasMinXY.X;
 | ||
|   AHeight := lRenderInfo.EntityCanvasMaxXY.Y - lRenderInfo.EntityCanvasMinXY.Y;
 | ||
|   if (lRenderInfo.EntityCanvasMinXY.X = INVALID_RENDERINFO_CANVAS_XY) or
 | ||
|      (lRenderInfo.EntityCanvasMinXY.Y = INVALID_RENDERINFO_CANVAS_XY) or
 | ||
|      (lRenderInfo.EntityCanvasMaxXY.Y = INVALID_RENDERINFO_CANVAS_XY) or
 | ||
|      (lRenderInfo.EntityCanvasMaxXY.Y = INVALID_RENDERINFO_CANVAS_XY) then
 | ||
|      Result := False;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntity.CalculateHeightInCanvas(ADest: TFPCustomCanvas; AMulX, AMulY: Double; out AHeight: Integer);
 | ||
| var
 | ||
|   lRenderInfo: TvRenderInfo;
 | ||
| begin
 | ||
|   Render(ADest, lRenderInfo, 0, 0, AMulX, AMulY, False);
 | ||
|   AHeight := lRenderInfo.EntityCanvasMaxXY.Y - lRenderInfo.EntityCanvasMinXY.Y;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntity.ExpandBoundingBox(ADest: TFPCustomCanvas; var ALeft, ATop, ARight, ABottom: Double);
 | ||
| var
 | ||
|   lLeft, lTop, lRight, lBottom: Double;
 | ||
| begin
 | ||
|   CalculateBoundingBox(ADest, lLeft, lTop, lRight, lBottom);
 | ||
|   if lLeft < ALeft then ALeft := lLeft;
 | ||
|   if lTop < ATop then ATop := lTop;
 | ||
|   if lRight > ARight then ARight := lRight;
 | ||
|   if lBottom > ABottom then ABottom := lBottom;
 | ||
| end;
 | ||
| 
 | ||
| class procedure TvEntity.CalcEntityCanvasMinMaxXY(
 | ||
|   var ARenderInfo: TvRenderInfo; APointX, APointY: Integer);
 | ||
| begin
 | ||
|   if ARenderInfo.EntityCanvasMinXY.X = INVALID_RENDERINFO_CANVAS_XY then
 | ||
|     ARenderInfo.EntityCanvasMinXY.X := APointX
 | ||
|   else ARenderInfo.EntityCanvasMinXY.X := Min(ARenderInfo.EntityCanvasMinXY.X, APointX);
 | ||
|   if ARenderInfo.EntityCanvasMinXY.Y = INVALID_RENDERINFO_CANVAS_XY then
 | ||
|     ARenderInfo.EntityCanvasMinXY.Y := APointY
 | ||
|   else ARenderInfo.EntityCanvasMinXY.Y := Min(ARenderInfo.EntityCanvasMinXY.Y, APointY);
 | ||
|   if ARenderInfo.EntityCanvasMaxXY.X = INVALID_RENDERINFO_CANVAS_XY then
 | ||
|     ARenderInfo.EntityCanvasMaxXY.X := APointX
 | ||
|   else ARenderInfo.EntityCanvasMaxXY.X := Max(ARenderInfo.EntityCanvasMaxXY.X, APointX);
 | ||
|   if ARenderInfo.EntityCanvasMaxXY.Y = INVALID_RENDERINFO_CANVAS_XY then
 | ||
|     ARenderInfo.EntityCanvasMaxXY.Y := APointY
 | ||
|   else ARenderInfo.EntityCanvasMaxXY.Y := Max(ARenderInfo.EntityCanvasMaxXY.Y, APointY);
 | ||
| end;
 | ||
| 
 | ||
| class procedure TvEntity.CalcEntityCanvasMinMaxXY_With2Points(
 | ||
|   var ARenderInfo: TvRenderInfo; AX1, AY1, AX2, AY2: Integer);
 | ||
| begin
 | ||
|   CalcEntityCanvasMinMaxXY(ARenderInfo, AX1, AY1);
 | ||
|   CalcEntityCanvasMinMaxXY(ARenderInfo, AX2, AY2);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntity.MergeRenderInfo(var AFrom, ATo: TvRenderInfo);
 | ||
| begin
 | ||
|   CalcEntityCanvasMinMaxXY(ATo, AFrom.EntityCanvasMinXY.X, AFrom.EntityCanvasMinXY.Y);
 | ||
|   CalcEntityCanvasMinMaxXY(ATo, AFrom.EntityCanvasMaxXY.X, AFrom.EntityCanvasMaxXY.Y);
 | ||
| end;
 | ||
| 
 | ||
| class procedure TvEntity.InitializeRenderInfo(out ARenderInfo: TvRenderInfo; ASelf: TvEntity; ACreateObjs: Boolean);
 | ||
| begin
 | ||
|   // Don't change these because otherwise we lose the value set by the page
 | ||
|   // See CopyAndInitDocumentRenderInfo
 | ||
|   // ARenderInfo.BackgroundColor := colBlack;
 | ||
|   // ARenderInfo.AdjustPenColorToBackground := True;
 | ||
|   // ARenderInfo.Selected := nil;
 | ||
|   // ATo.Parent := AFrom.Self;
 | ||
| 
 | ||
|   ARenderInfo.EntityCanvasMinXY := Point(INVALID_RENDERINFO_CANVAS_XY, INVALID_RENDERINFO_CANVAS_XY);
 | ||
|   ARenderInfo.EntityCanvasMaxXY := Point(INVALID_RENDERINFO_CANVAS_XY, INVALID_RENDERINFO_CANVAS_XY);
 | ||
|   ARenderInfo.ForceRenderBlock := False;
 | ||
| 
 | ||
|   ARenderInfo.Self := ASelf;
 | ||
|   if ACreateObjs then
 | ||
|     ARenderInfo.Errors := TStringList.Create;
 | ||
| end;
 | ||
| 
 | ||
| class procedure TvEntity.FinalizeRenderInfo(var ARenderInfo: TvRenderInfo);
 | ||
| begin
 | ||
|   if ARenderInfo.Errors <> nil then
 | ||
|     ARenderInfo.Errors.Free;
 | ||
|   ARenderInfo.Errors := nil;
 | ||
| end;
 | ||
| 
 | ||
| class procedure TvEntity.CopyAndInitDocumentRenderInfo(out ATo: TvRenderInfo;
 | ||
|   AFrom: TvRenderInfo; ACopyMinMax: Boolean = False);
 | ||
| begin
 | ||
|   InitializeRenderInfo(ATo, nil);
 | ||
|   ATo.AdjustPenColorToBackground := AFrom.AdjustPenColorToBackground;
 | ||
|   ATo.BackgroundColor := AFrom.BackgroundColor;
 | ||
|   ATo.Selected := AFrom.Selected;
 | ||
|   ATo.Parent := AFrom.Self;
 | ||
|   ATo.Errors := AFrom.Errors;
 | ||
|   if ACopyMinMax then
 | ||
|   begin
 | ||
|     ATo.EntityCanvasMinXY := AFrom.EntityCanvasMinXY;
 | ||
|     ATo.EntityCanvasMaxXY := AFrom.EntityCanvasMaxXY;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvEntity.RenderInfo_GenerateParentTree(ARenderInfo: TvRenderInfo): string;
 | ||
| var
 | ||
|   lCurEntity: TvEntity;
 | ||
| begin
 | ||
|   lCurEntity := Self;
 | ||
|   Result := '';
 | ||
|   while lCurEntity <> nil do
 | ||
|   begin
 | ||
|     if Result <> '' then
 | ||
|       Result := '->' + Result;
 | ||
|     Result := lCurEntity.ClassName + Result;
 | ||
|     if lCurEntity is TvNamedEntity then
 | ||
|       Result := TvNamedEntity(lCurEntity).Name + ':' + Result;
 | ||
|     lCurEntity := ARenderInfo.Parent;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvEntity.CentralizeY_InHeight(ADest: TFPCustomCanvas; AHeight: Double): Double;
 | ||
| var
 | ||
|   lHeight: Double;
 | ||
| begin
 | ||
|   lHeight := GetHeight(ADest);
 | ||
|   Result := Y + Abs(AHeight - lHeight) / 2;
 | ||
| end;
 | ||
| 
 | ||
| function TvEntity.GetHeight(ADest: TFPCustomCanvas): Double;
 | ||
| var
 | ||
|   ALeft, ATop, ARight, ABottom: Double;
 | ||
| begin
 | ||
|   CalculateBoundingBox(ADest, ALeft, ATop, ARight, ABottom);
 | ||
|   Result := Abs(ATop - ABottom);
 | ||
| end;
 | ||
| 
 | ||
| function TvEntity.GetWidth(ADest: TFPCustomCanvas): Double;
 | ||
| var
 | ||
|   ALeft, ATop, ARight, ABottom: Double;
 | ||
| begin
 | ||
|   CalculateBoundingBox(ADest, ALeft, ATop, ARight, ABottom);
 | ||
|   Result := Abs(ALeft - ARight);
 | ||
| end;
 | ||
| 
 | ||
| function TvEntity.GetLineIntersectionPoints(ACoord: Double;
 | ||
|   ACoordIsX: Boolean): TDoubleDynArray;
 | ||
| begin
 | ||
|   SetLength(Result, 0);
 | ||
| end;
 | ||
| 
 | ||
| function TvEntity.TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult;
 | ||
| begin
 | ||
|   Result := vfrNotFound;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntity.Move(ADeltaX, ADeltaY: Double);
 | ||
| begin
 | ||
|   X := X + ADeltaX;
 | ||
|   Y := Y + ADeltaY;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntity.MoveSubpart(ADeltaX, ADeltaY: Double; ASubpart: Cardinal);
 | ||
| begin
 | ||
| 
 | ||
| end;
 | ||
| 
 | ||
| function TvEntity.GetSubpartCount: Integer;
 | ||
| begin
 | ||
|   Result := 0;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntity.PositionSubparts(ADest: TFPCustomCanvas; ABaseX,
 | ||
|   ABaseY: Double);
 | ||
| begin
 | ||
| 
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntity.Scale(ADeltaScaleX, ADeltaScaleY: Double);
 | ||
| begin
 | ||
| 
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntity.Rotate(AAngle: Double; ABase: T3DPoint);
 | ||
| begin
 | ||
| 
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntity.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
 | ||
|   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| begin
 | ||
|   InitializeRenderInfo(ARenderInfo, Self);
 | ||
| end;
 | ||
| 
 | ||
| function TvEntity.AdjustColorToBackground(AColor: TFPColor; ARenderInfo: TvRenderInfo): TFPColor;
 | ||
| begin
 | ||
|   Result := AColor;
 | ||
|   if not ARenderInfo.AdjustPenColorToBackground then Exit;
 | ||
|   // Adjust only if the contranst is really low
 | ||
|   if (Abs(AColor.Red - ARenderInfo.BackgroundColor.Red) <= $100) and
 | ||
|      (Abs(AColor.Green - ARenderInfo.BackgroundColor.Green) <= $100) and
 | ||
|      (Abs(AColor.Blue - ARenderInfo.BackgroundColor.Blue) <= $100) then
 | ||
|   begin
 | ||
|     if (ARenderInfo.BackgroundColor.Red <= $1000) and
 | ||
|        (ARenderInfo.BackgroundColor.Green <= $1000) and
 | ||
|        (ARenderInfo.BackgroundColor.Blue <= $1000) then
 | ||
|       Result := colWhite
 | ||
|     else Result := colBlack;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvEntity.GetNormalizedPos(APage: TvVectorialPage; ANewMin,
 | ||
|   ANewMax: Double): T3DPoint;
 | ||
| begin
 | ||
|   Result.X := (X - APage.MinX) * (ANewMax - ANewMin) / (APage.MaxX - APage.MinX) + ANewMin;
 | ||
|   Result.Y := (Y - APage.MinY) * (ANewMax - ANewMin) / (APage.MaxY - APage.MinY) + ANewMin;
 | ||
|   Result.Z := (Z - APage.MinZ) * (ANewMax - ANewMin) / (APage.MaxZ - APage.MinZ) + ANewMin;
 | ||
| end;
 | ||
| 
 | ||
| function TvEntity.GetEntityFeatures(ADest: TFPCustomCanvas; AMulX, AMulY: Double): TvEntityFeatures;
 | ||
| begin
 | ||
|   Result.DrawsUpwards := False;
 | ||
|   Result.DrawsUpwardHeightAdjustment := 0;
 | ||
|   Result.FirstLineHeight := 0;
 | ||
|   Result.TotalHeight := 0;
 | ||
| end;
 | ||
| 
 | ||
| function TvEntity.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   lStr: string;
 | ||
| begin
 | ||
|   lStr := Format('[%s] X=%f Y=%f', [Self.ClassName, X, Y]);
 | ||
|   Result := ADestRoutine(lStr, APageItem);
 | ||
| end;
 | ||
| 
 | ||
| class function TvEntity.GenerateDebugStrForFPColor(AColor: TFPColor): string;
 | ||
| begin
 | ||
|   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);
 | ||
| end;
 | ||
| 
 | ||
| // modified c-style string quoting
 | ||
| class function TvEntity.GenerateDebugStrForString(AValue: string): string;
 | ||
| begin
 | ||
|   Result := AValue;
 | ||
|   Result := StringReplace(Result, '\', '\\', [rfReplaceAll]);
 | ||
|   Result := StringReplace(Result, #$7, '\a', [rfReplaceAll]);
 | ||
|   Result := StringReplace(Result, #$8, '\b', [rfReplaceAll]);
 | ||
|   Result := StringReplace(Result, #$C, '\f', [rfReplaceAll]);
 | ||
|   Result := StringReplace(Result, #$A, '\n', [rfReplaceAll]);
 | ||
|   Result := StringReplace(Result, #$D, '\r', [rfReplaceAll]);
 | ||
|   Result := StringReplace(Result, #$9, '\t', [rfReplaceAll]);
 | ||
|   Result := StringReplace(Result, #$B, '\v', [rfReplaceAll]);
 | ||
| end;
 | ||
| 
 | ||
| { TvNamedEntity }
 | ||
| 
 | ||
| constructor TvNamedEntity.Create(APage: TvPage);
 | ||
| begin
 | ||
|   inherited Create(APage);
 | ||
|   FPage := APage;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvNamedEntity.SetPage(APage: TvPage);
 | ||
| begin
 | ||
|   FPage := APage;
 | ||
| end;
 | ||
| 
 | ||
| function TvNamedEntity.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   lStr: string;
 | ||
| begin
 | ||
|   lStr := Format('[%s] Name="%s" X=%f Y=%f' + FExtraDebugStr, [Self.ClassName, Name, X, Y]);
 | ||
|   Result := ADestRoutine(lStr, APageItem);
 | ||
| end;
 | ||
| 
 | ||
| { TvEntityWithPen }
 | ||
| 
 | ||
| constructor TvEntityWithPen.Create(APage: TvPage);
 | ||
| begin
 | ||
|   inherited Create(APage);
 | ||
|   Pen.Style := psSolid;
 | ||
|   Pen.Color := colBlack;
 | ||
|   Pen.Width := 1;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithPen.ApplyPenToCanvas(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo);
 | ||
| begin
 | ||
|   ApplyPenToCanvas(ADest, ARenderInfo, Pen);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithPen.ApplyPenToCanvas(ADest: TFPCustomCanvas;
 | ||
|   ARenderInfo: TvRenderInfo; APen: TvPen);
 | ||
| begin
 | ||
|   if ADest = nil then
 | ||
|     exit;
 | ||
|   ADest.Pen.FPColor := AdjustColorToBackground(APen.Color, ARenderInfo);
 | ||
|   ADest.Pen.Width := Max(1, APen.Width);   // wp: why was here "1;//APen.Width;" ???
 | ||
|   ADest.Pen.Style := APen.Style;
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   if (APen.Style = psPattern) then
 | ||
|   begin
 | ||
|     TCanvas(ADest).Pen.SetPattern(APen.Pattern);
 | ||
|     if APen.Width = 1 then TCanvas(ADest).Pen.Cosmetic := false;
 | ||
|   end;
 | ||
|   {$endif}
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithPen.AssignPen(APen: TvPen);
 | ||
| begin
 | ||
|   Pen.Style := APen.Style;
 | ||
|   Pen.Color := APen.Color;
 | ||
|   Pen.Width := APen.Width;
 | ||
| end;
 | ||
| 
 | ||
| function TvEntityWithPen.CreatePath: TPath;
 | ||
| begin
 | ||
|   Result := nil;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithPen.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
 | ||
|   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| begin
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|   ApplyPenToCanvas(ADest, ARenderInfo);
 | ||
| end;
 | ||
| 
 | ||
| { TvEntityWithPenAndBrush }
 | ||
| 
 | ||
| constructor TvEntityWithPenAndBrush.Create(APage: TvPage);
 | ||
| begin
 | ||
|   inherited Create(APage);
 | ||
|   Brush.Style := bsClear;
 | ||
|   Brush.Color := colBlue;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithPenAndBrush.ApplyBrushToCanvas(ADest: TFPCustomCanvas);
 | ||
| begin
 | ||
|   ApplyBrushToCanvas(ADest, @Brush);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithPenAndBrush.ApplyBrushToCanvas(ADest: TFPCustomCanvas;
 | ||
|   ABrush: PvBrush);
 | ||
| begin
 | ||
|   if ADest = nil then
 | ||
|     exit;
 | ||
|   ADest.Brush.FPColor := ABrush^.Color;
 | ||
|   ADest.Brush.Style := ABrush^.Style;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithPenAndBrush.AssignBrush(ABrush: PvBrush);
 | ||
| begin
 | ||
|   Brush := ABrush^;
 | ||
| end;
 | ||
| 
 | ||
| { Calculates the canvas coordinates of the gradient vector (i.e. x,y of start
 | ||
|   and end of gradient.
 | ||
|   ARect is the bounding box of the shape in which the gradient will be painted.
 | ||
|   It must be in canvas coordinates (pixels).
 | ||
|   Note that the gradient vector need not be along the edges of this rectangle. }
 | ||
| procedure TvEntityWithPenAndBrush.CalcGradientVector(
 | ||
|   out AGradientStart, AGradientEnd: T2dPoint; const ARect: TRect;
 | ||
|   ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
 | ||
| begin
 | ||
|   AGradientStart := Point2D(Brush.Gradient_start.X, Brush.Gradient_start.Y);
 | ||
|   AGradientEnd := Point2D(Brush.Gradient_end.X, Brush.Gradient_end.Y);
 | ||
|   if (gfRelToUserSpace in Brush.Gradient_flags) then
 | ||
|   begin
 | ||
|     if (gfRelStartX in Brush.Gradient_flags) then
 | ||
|       AGradientStart.X := AGradientStart.X * FPage.Width;
 | ||
|     if (gfRelStartY in Brush.Gradient_flags) then
 | ||
|       AGradientStart.Y := AGradientStart.Y * FPage.Height;
 | ||
|     if (gfRelEndX in Brush.Gradient_flags) then
 | ||
|       AGradientEnd.X := AGradientEnd.X * FPage.Width;
 | ||
|     if (gfRelEndY in Brush.Gradient_flags) then
 | ||
|       AGradientEnd.Y := AGradientEnd.Y * FPage.Height;
 | ||
|     AGradientStart.X := CoordToCanvasX(AGradientStart.X, ADestX, AMulX);
 | ||
|     AGradientStart.Y := CoordToCanvasY(AGradientStart.Y, ADestY, AMulY);
 | ||
|     AGradientEnd.X := CoordToCanvasX(AGradientEnd.X, ADestX, AMulX);
 | ||
|     AGradientEnd.Y := CoordToCanvasY(AGradientEnd.Y, ADestY, AMulY);
 | ||
|   end else
 | ||
|   begin
 | ||
|     if (gfRelStartX in Brush.Gradient_flags) then
 | ||
|       AGradientStart.X := ARect.Left + AGradientStart.X * (ARect.Right - ARect.Left)
 | ||
|     else
 | ||
|       AGradientStart.X := CoordToCanvasX(AGradientStart.X, ADestX, AMulX);
 | ||
|     if (gfRelStartY in Brush.Gradient_flags) then
 | ||
|       AGradientStart.Y := ARect.Top + AGradientStart.Y * (ARect.Bottom - ARect.Left)
 | ||
|     else
 | ||
|       AGradientStart.Y := CoordToCanvasY(AGradientStart.Y, ADestY, AMulY);
 | ||
|     if (gfRelEndX in Brush.Gradient_flags) then
 | ||
|       AGradientEnd.X := ARect.Left + AGradientEnd.X * (ARect.Right - ARect.Left) else
 | ||
|       AGradientEnd.X := CoordToCanvasX(AGradientEnd.X, ADestX, AMulX);
 | ||
|     if (gfRelEndY in Brush.Gradient_flags) then
 | ||
|       AGradientEnd.Y := ARect.Top + AGradientEnd.Y * (ARect.Bottom - ARect.Top) else
 | ||
|       AGradientEnd.Y := CoordToCanvasY(AGradientEnd.Y, ADestY, AMulY);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| { Fills a polygon with the color of the current brush. The routine can handle
 | ||
|   non-contiguous polygons (holes!) correctly using the ScanLine algorithm and
 | ||
|   the even-odd rule
 | ||
|   http://www.tutorialspoint.com/computer_graphics/polygon_filling_algorithm.htm
 | ||
| 
 | ||
|   The array APoints must be in canvas units.
 | ||
| 
 | ||
|   NOTES:
 | ||
|   - The method only performs a solid fill, i.e. Brush.Style is ignored
 | ||
|   - The method modifies the current pen. }
 | ||
| procedure TvEntityWithPenAndBrush.DrawPolygon(ADest: TFPCustomCanvas;
 | ||
|   var RenderInfo: TvRenderInfo; const APoints: TPointsArray;
 | ||
|   const APolyStarts: TIntegerDynArray; ARect: TRect);
 | ||
| var
 | ||
|   scanlineY, scanLineY1, scanLineY2: Integer;
 | ||
|   lPoints, pts: T2DPointsArray;
 | ||
|   j: Integer;
 | ||
| begin
 | ||
|   if ARect.Top < ARect.Bottom then
 | ||
|   begin
 | ||
|     scanLineY1 := ARect.Top;
 | ||
|     scanLineY2 := ARect.Bottom;
 | ||
|   end else
 | ||
|   begin
 | ||
|     scanLineY1 := ARect.Bottom;
 | ||
|     scanLineY2 := ARect.Top;
 | ||
|   end;
 | ||
| 
 | ||
|   // Prepare points as needed by the GetLinePolygonIntersectionPoints procedure
 | ||
|   SetLength(pts, Length(APoints));
 | ||
|   for j := 0 to High(APoints) do
 | ||
|     pts[j] := Point2D(APoints[j].X, APoints[j].Y);
 | ||
| 
 | ||
|   // Prepare parameters and polygon points
 | ||
|   ADest.Pen.Style := psSolid;
 | ||
|   ADest.Pen.Width := 1;
 | ||
|   ADest.Pen.FPColor := Brush.Color;
 | ||
| 
 | ||
|   // Fill polygon by drawing horizontal line segments
 | ||
|   scanlineY := scanlineY1;
 | ||
|   while (scanlineY <= scanlineY2) do begin
 | ||
|     // Find intersection points of horizontal scan line with polygon
 | ||
|     // with polygon
 | ||
|     lPoints := GetLinePolygonIntersectionPoints(scanlineY, pts, APolyStarts, false);
 | ||
|     if Length(lPoints) < 2 then begin
 | ||
|       inc(scanlineY);
 | ||
|       Continue;
 | ||
|     end;
 | ||
|     // Draw lines between intersection points, skip every second pair
 | ||
|     j := 0;
 | ||
|     while j < High(lPoints) do
 | ||
|     begin
 | ||
|       ADest.Line(round(lPoints[j].X), round(lPoints[j].Y), round(lPoints[j+1].X), round(lPoints[j+1].Y));
 | ||
|       inc(j, 2);
 | ||
|     end;
 | ||
|     // Proceed to next scan line
 | ||
|     inc(scanlineY);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| { Paints the border around the shape. Ignores the brush.
 | ||
|   APoints must be in canvas units. }
 | ||
| procedure TvEntityWithPenAndBrush.DrawPolygonBorderOnly(ADest: TFPCustomCanvas;
 | ||
|   var ARenderInfo: TvRenderInfo; const APoints: TPointsArray);
 | ||
| var
 | ||
|   j: Integer;
 | ||
| begin
 | ||
|   if Pen.Style <> psClear then
 | ||
|   begin
 | ||
|     ApplyPenToCanvas(ADest, ARenderInfo);
 | ||
|     ADest.MoveTo(APoints[0].X, APoints[0].Y);
 | ||
|     for j:=1 to High(APoints) do
 | ||
|       ADest.LineTo(APoints[j].X, APoints[j].Y);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| { Fills the entity with a linear gradient.
 | ||
|   Assumes that the boundary is already in canvas units and is specified by
 | ||
|   polygon APoints.
 | ||
|   NOTE: The method modifies the current pen. }
 | ||
| procedure TvEntityWithPenAndBrush.DrawPolygonBrushLinearGradient(
 | ||
|   ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
 | ||
|   const APoints: TPointsArray;const APolyStarts: TIntegerDynArray;
 | ||
|   ARect: TRect; AGradientStart, AGradientEnd: T2DPoint);
 | ||
| var
 | ||
|   lPoints, pts: T2DPointsArray;
 | ||
|   i, j: Integer;
 | ||
|   pf: Double;          // fraction of path travelled along gradient vector
 | ||
|   px, py: Double;
 | ||
|   phi: Double;
 | ||
|   sinphi, cosphi: float;
 | ||
|   coord, coord1, coord2, dcoord: Double;
 | ||
|   coordIsX: Boolean;
 | ||
|   p1, p2: T2dPoint;
 | ||
|   gv: T2dPoint;        // gradient vector
 | ||
|   gvlen: Double;       // length of gradient vector
 | ||
|   gstart: Double;      // Gradient start point (1-dim)
 | ||
|   dir: Integer;
 | ||
|   lStr: String;
 | ||
| begin
 | ||
|   // Direction of gradient vector. The gradient vector begins at the first
 | ||
|   // color position and ends at the last color position specified in the
 | ||
|   // brush's Gradient_colors.
 | ||
|   gv := Point2D(AGradientEnd.X-AGradientStart.X, AGradientEnd.Y-AGradientStart.Y);
 | ||
|   gvlen := sqrt(sqr(gv.x) + sqr(gv.y));
 | ||
|   if gvlen = 0 then
 | ||
|     exit;
 | ||
| 
 | ||
|   // Find boundary points where the gradient starts and ends. The gradient is
 | ||
|   // always travered from 0% to 100% color fractions.
 | ||
|   p1 := Point2D(
 | ||
|     IfThen(AGradientEnd.x > AGradientStart.x, ARect.Left, ARect.Right),
 | ||
|     IfThen(AGradientEnd.Y > AGradientStart.y, ARect.Top, ARect.Bottom)
 | ||
|   );
 | ||
|   p2 := Point2D(
 | ||
|     IfThen(AGradientEnd.x > AGradientStart.x, ARect.Right, ARect.Left),
 | ||
|     IfThen(AGradientEnd.Y > AGradientStart.y, ARect.Bottom, ARect.Top)
 | ||
|   );
 | ||
| 
 | ||
|   // Prepare parameters and polygon points
 | ||
|   ADest.Pen.Style := psSolid;
 | ||
|   ADest.Pen.Width := 1;
 | ||
| 
 | ||
|   SetLength(pts, Length(APoints));
 | ||
|   case Brush.Kind of
 | ||
|     bkVerticalGradient:
 | ||
|       begin // Run vertically, horizontal lines have same color
 | ||
|         coord1 := p1.y;
 | ||
|         coord2 := p2.y;
 | ||
|         dcoord := IfThen(AGradientEnd.Y > AGradientStart.Y, 1.0, -1.0);
 | ||
|         gstart := coord1;
 | ||
|         dir := round(dcoord);
 | ||
|         for i := 0 to High(APoints) do
 | ||
|           pts[i] := Point2D(APoints[i].X, APoints[i].Y);
 | ||
|         coordIsX := false;
 | ||
|         gstart := coord1;
 | ||
|       end;
 | ||
|     bkHorizontalGradient:
 | ||
|       begin  // Run horizontally, vertical lines have same color
 | ||
|         coord1 := p1.x;
 | ||
|         coord2 := p2.x;
 | ||
|         dcoord := IfThen(AGradientEnd.X > AGradientStart.X, 1.0, -1.0);
 | ||
|         gstart := coord1;
 | ||
|         dir := round(dcoord);
 | ||
|         for i := 0 to High(APoints) do
 | ||
|           pts[i] := Point2D(APoints[i].X, APoints[i].Y);
 | ||
|         coordIsX := true;
 | ||
|       end;
 | ||
|     bkOtherLinearGradient:
 | ||
|       begin  // Run along gradient vector, lines perpendicular to gradient vector
 | ||
|         phi := arctan2(gv.y, gv.x);
 | ||
|         Sincos(phi, sinphi, cosphi);
 | ||
|         coordIsX := (abs(sinphi) <= sin(pi/4));
 | ||
|         if not coordIsX then begin
 | ||
|           phi := -(pi/2 - phi);
 | ||
|           Sincos(phi, sinphi, cosphi);
 | ||
|         end;
 | ||
|         // p1 is the boundary point around which the shape is rotated in order to
 | ||
|         // to get the gradient vector in horizontal or vertical direction for
 | ||
|         // easier finding of intersection points.
 | ||
|         // Projection of vector from GradientStart to p1 onto gradient vector
 | ||
|         coord1 := (((p1.x - AGradientStart.X)*gv.x) + (p1.y - AGradientStart.Y)*gv.y) / gvlen;
 | ||
|         // dto for p2.
 | ||
|         coord2 := (((p2.x - AGradientStart.X)*gv.x) + (p2.y - AGradientStart.Y)*gv.Y) / gvlen;
 | ||
|         // Steps for walking along the gradient vector. Note: too-wide steps
 | ||
|         // could result in painting gaps, but this is avoided by using a
 | ||
|         // 2-pixel wide pen below.
 | ||
|         dcoord := 1.0; // --- some gaps with 1.0 / abs(cosphi);
 | ||
|         gstart := -coord1;
 | ||
|         dir := +1;
 | ||
|         // Rotate polygon point such that gradient axis is parallel to x axis
 | ||
|         // (if angle < 45°) or y axis (if angle > 45°)
 | ||
|         // Rotation center is the projection of the corner of the bounding box
 | ||
|         // onto the gradient vector
 | ||
|         p1 := Point2D(
 | ||
|           AGradientStart.X + coord1 * gv.x / gvlen,
 | ||
|           AGradientStart.Y + coord1 * gv.y / gvlen
 | ||
|         );
 | ||
|         for j := 0 to High(APoints) do
 | ||
|         begin
 | ||
|           px := APoints[j].X - p1.x;
 | ||
|           py := APoints[j].Y - p1.y;
 | ||
|           pts[j] := Point2D(px*cosPhi + py*sinPhi, -px*sinPhi + py*cosPhi);
 | ||
|         end;
 | ||
|         // Begin painting at corner
 | ||
|         coord2 := coord2 - coord1;
 | ||
|         coord1 := 0;
 | ||
|         ADest.Pen.Width := 2;  // make sure that there are no gaps due to rounding errors
 | ||
|       end;
 | ||
|   end;
 | ||
| 
 | ||
|   // Draw gradient
 | ||
|   coord := coord1;
 | ||
|   while ((dcoord > 0) and (coord <= coord2)) or (dcoord < 0) and (coord >= coord2) do
 | ||
|   begin
 | ||
|     // Find intersection points of gradient line (normal to gradient vector)
 | ||
|     // with polygon
 | ||
|     lPoints := GetLinePolygonIntersectionPoints(coord, pts, APolyStarts, coordIsX);
 | ||
|     if Length(lPoints) < 2 then begin
 | ||
|       coord := coord + dcoord;
 | ||
|       Continue;
 | ||
|     end;
 | ||
| 
 | ||
|     // Prepare intersection points for painting
 | ||
|     case Brush.Kind of
 | ||
|       bkVerticalGradient:
 | ||
|         // Add loop variable as mssing y coordinate of intersection points
 | ||
|         for j := 0 to High(lPoints) do lPoints[j].Y := coord;
 | ||
|       bkHorizontalGradient:
 | ||
|         // Add loop variable as mssing x coordinate of intersection points
 | ||
|         for j := 0 to High(lPoints) do lPoints[j].X := coord;
 | ||
|       bkOtherLinearGradient:
 | ||
|         // Rotate back
 | ||
|         for j := 0 to High(lPoints) do
 | ||
|           lPoints[j] := Point2D(
 | ||
|             lPoints[j].X * cosPhi - lPoints[j].Y * sinPhi + p1.x,
 | ||
|             lPoints[j].X * sinPhi + lPoints[j].Y * cosPhi + p1.y
 | ||
|           );
 | ||
|     end;
 | ||
| 
 | ||
|     // Determine color from fraction (pf) of path travelled along gradient vector
 | ||
|     pf := (coord - gstart) * dir / gvlen;
 | ||
|     if Length(Brush.Gradient_colors) > 0 then
 | ||
|     begin
 | ||
|       ADest.Pen.FPColor := GradientColor(Brush.Gradient_colors, pf);
 | ||
|     end
 | ||
|     else
 | ||
|     begin
 | ||
|       lStr := RenderInfo_GenerateParentTree(ARenderInfo);
 | ||
|       if ARenderInfo.Errors <> nil then
 | ||
|         ARenderInfo.Errors.Add(Format('[%s] Empty Brush.Gradient_colors', [lStr]));
 | ||
|       ADest.Pen.FPColor := colBlack;
 | ||
|     end;
 | ||
| 
 | ||
|     // Draw gradient lines between intersection points
 | ||
|     j := 0;
 | ||
|     while j < High(lPoints) do
 | ||
|     begin
 | ||
|       ADest.Line(round(lPoints[j].X), round(lPoints[j].Y), round(lPoints[j+1].X), round(lPoints[j+1].Y));
 | ||
|       inc(j, 2);
 | ||
|     end;
 | ||
| 
 | ||
|     // Proceed to next line
 | ||
|     coord := coord + dcoord;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithPenAndBrush.DrawPolygonBrushRadialGradient(
 | ||
|   ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
 | ||
|   const APoints: TPointsArray; ARect: TRect);
 | ||
| var
 | ||
|   i, j: Integer;
 | ||
|   lx, ly: Integer;
 | ||
|   lDist: Double;
 | ||
|   lGradient_cx_px, lGradient_cy_px, lGradient_r_px, lGradient_fx_px, lGradient_fy_px: Double;
 | ||
|   lWidth, lHeight, lBiggestHalfSide: Integer;
 | ||
|   lBiggestSizeIsY: Boolean;
 | ||
|   lColor: TFPColor;
 | ||
| 
 | ||
|   function Gradient_value_to_px(AValue: Double; AUnit: TvCoordinateUnit; AIsY: Boolean): Integer;
 | ||
|   var
 | ||
|     lSideLen: Integer;
 | ||
|   begin
 | ||
|     Result := 0;
 | ||
|     if AIsY then lSideLen := (ARect.Bottom-ARect.Top)
 | ||
|     else lSideLen := (ARect.Right-ARect.Left);
 | ||
|     case AUnit of
 | ||
|     //vcuDocumentUnit: Result := ;
 | ||
|     vcuPercentage:   Result := Round(lSideLen * AValue);
 | ||
|     end;
 | ||
|   end;
 | ||
| 
 | ||
|   function Distance_To_RadialGradient_Color(ADist: Double): TFPColor;
 | ||
|   var
 | ||
|     k: Integer;
 | ||
|   begin
 | ||
|     Result := colTransparent;
 | ||
|     for k := 0 to Length(Brush.Gradient_colors)-1 do
 | ||
|     begin
 | ||
|       if k = 0 then
 | ||
|       begin
 | ||
|         Result := Brush.Gradient_colors[k].Color;
 | ||
|         Continue;
 | ||
|       end;
 | ||
| 
 | ||
|       if ADist < Brush.Gradient_colors[k].Position then
 | ||
|       begin
 | ||
|         Result := MixColors(
 | ||
|           Brush.Gradient_colors[k-1].Color, Brush.Gradient_colors[k].Color,
 | ||
|           ADist - Brush.Gradient_colors[k-1].Position,
 | ||
|           Brush.Gradient_colors[k].Position - Brush.Gradient_colors[k-1].Position);
 | ||
|         Exit;
 | ||
|       end;
 | ||
|     end;
 | ||
|   end;
 | ||
| 
 | ||
| begin
 | ||
|   lWidth := (ARect.Right-ARect.Left);
 | ||
|   lHeight := (ARect.Bottom-ARect.Top);
 | ||
|   lBiggestSizeIsY := lHeight > lWidth;
 | ||
|   if lBiggestSizeIsY then lBiggestHalfSide := Round(lHeight / 2)
 | ||
|   else lBiggestHalfSide := Round(lWidth / 2);
 | ||
| 
 | ||
|   // Calculate Gradient_X_px
 | ||
|   lGradient_cx_px := Gradient_value_to_px(Brush.Gradient_cx, Brush.Gradient_cx_Unit, False);
 | ||
|   lGradient_cy_px := Gradient_value_to_px(Brush.Gradient_cy, Brush.Gradient_cy_Unit, True);
 | ||
|   lGradient_r_px := Gradient_value_to_px(Brush.Gradient_r, Brush.Gradient_r_Unit, lBiggestSizeIsY);
 | ||
|   lGradient_fx_px := Gradient_value_to_px(Brush.Gradient_fx, Brush.Gradient_fx_Unit, False);
 | ||
|   lGradient_fy_px := Gradient_value_to_px(Brush.Gradient_fy, Brush.Gradient_fy_Unit, True);
 | ||
| 
 | ||
|   // pixel-by-pixel version
 | ||
|   for i := 0 to lWidth-1 do
 | ||
|   begin
 | ||
|     for J := 0 to lHeight-1 do
 | ||
|     begin
 | ||
|       lx := ARect.Left + i;
 | ||
|       ly := ARect.Top + j;
 | ||
|       if not IsPointInPolygon(lx, ly, APoints) then Continue;
 | ||
| 
 | ||
|       lDist := sqrt(sqr(i-lGradient_cx_px)+sqr(j-lGradient_cy_px));
 | ||
|       lDist := lDist / lBiggestHalfSide;
 | ||
|       lDist := Min(Max(0, lDist), 1);
 | ||
|       lColor := Distance_To_RadialGradient_Color(lDist);
 | ||
|       ADest.Colors[lx, ly] := AlphaBlendColor(ADest.Colors[lx, ly], lColor);
 | ||
|     end;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithPenAndBrush.DrawNativePolygonBrushRadialGradient(
 | ||
|   ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
 | ||
|   const APoints: TPointsArray; ARect: TRect);
 | ||
| {$ifndef FPVECTORIAL_SUPPORT_LAZARUS_1_6}
 | ||
| {$ifdef USE_LCL_CANVAS}
 | ||
| var
 | ||
|   lLogRadGrad: TLogRadialGradient;
 | ||
|   lBrush, lOldBrush: HBRUSH;
 | ||
|   i: Integer;
 | ||
| 
 | ||
|   function Gradient_value_to_px(AValue: Double; AUnit: TvCoordinateUnit; AIsY: Boolean): Integer;
 | ||
|   var
 | ||
|     lSideLen: Integer;
 | ||
|   begin
 | ||
|     Result := 0;
 | ||
|     if AIsY then lSideLen := (ARect.Bottom-ARect.Top)
 | ||
|     else lSideLen := (ARect.Right-ARect.Left);
 | ||
|     case AUnit of
 | ||
|     vcuDocumentUnit: Result := Round(AValue);
 | ||
|     vcuPercentage:   Result := Round(lSideLen * AValue);
 | ||
|     end;
 | ||
|   end;
 | ||
| 
 | ||
| {$endif}
 | ||
| {$endif}
 | ||
| begin
 | ||
|   {$ifndef FPVECTORIAL_SUPPORT_LAZARUS_1_6}
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   lLogRadGrad.radCenterX := Gradient_value_to_px(Brush.Gradient_cx, Brush.Gradient_cx_Unit, False);
 | ||
|   lLogRadGrad.radCenterY := Gradient_value_to_px(Brush.Gradient_cy, Brush.Gradient_cy_Unit, False);
 | ||
|   lLogRadGrad.radRadius := Gradient_value_to_px(Brush.Gradient_r, Brush.Gradient_r_Unit, True);
 | ||
|   lLogRadGrad.radFocalX := Gradient_value_to_px(Brush.Gradient_fx, Brush.Gradient_fx_Unit, True);
 | ||
|   lLogRadGrad.radFocalY := Gradient_value_to_px(Brush.Gradient_fy, Brush.Gradient_fy_Unit, False);
 | ||
| 
 | ||
|   SetLength(lLogRadGrad.radStops, Length(Brush.Gradient_colors));
 | ||
|   for i := 0 to Length(Brush.Gradient_colors)-1 do
 | ||
|   begin
 | ||
|     lLogRadGrad.radStops[i].radColorA := Brush.Gradient_colors[i].Color.alpha;
 | ||
|     lLogRadGrad.radStops[i].radColorR := Brush.Gradient_colors[i].Color.red;
 | ||
|     lLogRadGrad.radStops[i].radColorG := Brush.Gradient_colors[i].Color.green;
 | ||
|     lLogRadGrad.radStops[i].radColorB := Brush.Gradient_colors[i].Color.blue;
 | ||
|     lLogRadGrad.radStops[i].radPosition := Brush.Gradient_colors[i].Position;
 | ||
|   end;
 | ||
| 
 | ||
|   lBrush := LCLIntf.CreateBrushWithRadialGradient(lLogRadGrad);
 | ||
|   lOldBrush := TCanvas(ADest).Brush.Handle;
 | ||
|   TCanvas(ADest).Brush.Handle := lBrush;
 | ||
|   TCanvas(ADest).Polygon(APoints);
 | ||
|   TCanvas(ADest).Brush.Handle := lOldBrush;
 | ||
|   {$endif}
 | ||
|   {$endif}
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithPenAndBrush.DrawBrushGradient(ADest: TFPCustomCanvas;
 | ||
|   var ARenderInfo: TvRenderInfo; x1, y1, x2, y2: Integer; ADestX: Integer;
 | ||
|   ADestY: Integer; AMulX: Double; AMulY: Double);
 | ||
| var
 | ||
|   tmpPath: TPath;
 | ||
|   polypoints: TPointsArray;
 | ||
|   polystarts: TIntegerDynArray;
 | ||
|   lRect: TRect;
 | ||
|   gv1, gv2: T2dPoint;
 | ||
|   j: Integer;
 | ||
| begin
 | ||
|   tmpPath := CreatePath;
 | ||
|   if tmpPath = nil then
 | ||
|     exit;
 | ||
|   try
 | ||
|     ConvertPathToPolygons(tmpPath, ADestX, ADestY, AMulX, AMulY, polypoints, polystarts);
 | ||
| 
 | ||
|     // Boundary rect of shape filled with a gradient
 | ||
|     lRect := Rect(x1, y1, x2, y2);
 | ||
|     NormalizeRect(lRect);
 | ||
| 
 | ||
|     case Brush.Kind of
 | ||
|       bkHorizontalGradient,
 | ||
|       bkVerticalGradient,
 | ||
|       bkOtherLinearGradient:
 | ||
|         begin
 | ||
|           // calculate gradient vector
 | ||
|           CalcGradientVector(gv1, gv2, lRect, ADestX, ADestY, AMulX, AMulY);
 | ||
|           // Draw the gradient
 | ||
|           DrawPolygonBrushLinearGradient(ADest, ARenderInfo, polyPoints, polystarts, lRect, gv1, gv2);
 | ||
|         end;
 | ||
|       bkRadialGradient:
 | ||
|        {$ifdef USE_LCL_CANVAS}
 | ||
|         if Widgetset.GetLCLCapability(lcRadialGradientBrush) = LCL_CAPABILITY_YES then
 | ||
|           DrawNativePolygonBrushRadialGradient(ADest, ARenderInfo, polypoints, Bounds(0, 0, 1, 1))
 | ||
|         else
 | ||
|        {$endif}
 | ||
|           DrawPolygonBrushRadialGradient(ADest, ARenderInfo, polypoints, lRect);
 | ||
|     end;
 | ||
| 
 | ||
|     // Paint outline
 | ||
|     DrawPolygonBorderOnly(ADest, ARenderInfo, polyPoints);
 | ||
| 
 | ||
|   finally
 | ||
|     tmpPath.Free;
 | ||
|   end;
 | ||
| end;
 | ||
| (*
 | ||
| { Fills the entity's shape with a gradient.
 | ||
|   Assumes that the boundary is in fpv units and provides parameters (ADestX,
 | ||
|   ADestY, AMulX, AMulY) for conversion to canvas pixels. }
 | ||
| procedure TvEntityWithPenAndBrush.DrawBrushGradient(ADest: TFPCustomCanvas;
 | ||
|   var ARenderInfo: TvRenderInfo; x1, y1, x2, y2: Integer;
 | ||
|   ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double);
 | ||
| 
 | ||
|   function CoordToCanvasX(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestX + AmulX * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CoordToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestY + AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CanvasToCoordY(ACanvas: Integer): Double;
 | ||
|   begin
 | ||
|     Result := (ACanvas - ADestY) / AmulY;
 | ||
|   end;
 | ||
| 
 | ||
|   function CanvasToCoordX(ACanvas: Integer): Double;
 | ||
|   begin
 | ||
|     Result := (ACanvas - ADestX) / AmulX;
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   i, j: Integer;
 | ||
|   lPoints: TDoubleDynArray;
 | ||
|   lCanvasPts: array[0..1] of Integer;
 | ||
|   lColor, lColor1, lColor2: TFPColor;
 | ||
| begin
 | ||
|   if not (Brush.Kind in [bkVerticalGradient, bkHorizontalGradient]) then
 | ||
|     Exit;
 | ||
| 
 | ||
|   lColor1 := Brush.Gradient_colors[1].Color;
 | ||
|   lColor2 := Brush.Gradient_colors[0].Color;
 | ||
|   if Brush.Kind = bkVerticalGradient then
 | ||
|   begin
 | ||
|     for i := y1 to y2 do
 | ||
|     begin
 | ||
|       lPoints := GetLineIntersectionPoints(CanvasToCoordY(i), False);
 | ||
|       if Length(lPoints) < 2 then Continue;
 | ||
|       lColor := MixColors(lColor1, lColor2, i-y1, y2-y1);
 | ||
|       ADest.Pen.FPColor := lColor;
 | ||
|       ADest.Pen.Style := psSolid;
 | ||
|       j := 0;
 | ||
|       while j < Length(lPoints) do
 | ||
|       begin
 | ||
|         lCanvasPts[0] := CoordToCanvasX(lPoints[j]);
 | ||
|         lCanvasPts[1] := CoordToCanvasX(lPoints[j+1]);
 | ||
|         ADest.Line(lCanvasPts[0], i, lCanvasPts[1], i);
 | ||
|         inc(j, 2);
 | ||
|       end;
 | ||
|     end;
 | ||
|   end
 | ||
|   else if Brush.Kind = bkHorizontalGradient then
 | ||
|   begin
 | ||
|     for i := x1 to x2 do
 | ||
|     begin
 | ||
|       lPoints := GetLineIntersectionPoints(CanvasToCoordX(i), True);
 | ||
|       if Length(lPoints) < 2 then Continue;
 | ||
|       lColor := MixColors(lColor1, lColor2, i-x1, x2-x1);
 | ||
|       ADest.Pen.FPColor := lColor;
 | ||
|       ADest.Pen.Style := psSolid;
 | ||
|       j := 0;
 | ||
|       while (j+1 < Length(lPoints)) do
 | ||
|       begin
 | ||
|         lCanvasPts[0] := CoordToCanvasY(lPoints[j]);
 | ||
|         lCanvasPts[1] := CoordToCanvasY(lPoints[j+1]);
 | ||
|         ADest.Line(i, lCanvasPts[0], i, lCanvasPts[1]);
 | ||
|         inc(j , 2);
 | ||
|       end;
 | ||
|     end;
 | ||
|   end;
 | ||
| end;      *)
 | ||
| 
 | ||
| procedure TvEntityWithPenAndBrush.DrawBrush(ADest: TFPCustomCanvas;
 | ||
|   var ARenderInfo: TvRenderInfo; ADestX: Integer; ADestY: Integer;
 | ||
|   AMulX: Double; AMulY: Double);
 | ||
| var
 | ||
|   tmpPath: TPath;
 | ||
|   polypoints: TPointsArray;
 | ||
|   polystarts: TIntegerDynArray;
 | ||
| begin
 | ||
|   tmpPath := CreatePath;
 | ||
|   if tmpPath = nil then
 | ||
|     exit;
 | ||
|   try
 | ||
|     ConvertPathToPolygons(tmpPath, ADestX, ADestY, AMulX, AMulY, polypoints, polystarts);
 | ||
|     ADest.Polygon(polypoints);
 | ||
|   finally
 | ||
|     tmpPath.Free;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithPenAndBrush.Render(ADest: TFPCustomCanvas;
 | ||
|    var ARenderInfo: TvRenderInfo; ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| begin
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|   ApplyBrushToCanvas(ADest);
 | ||
| end;
 | ||
| 
 | ||
| function TvEntityWithPenAndBrush.GenerateDebugTree(
 | ||
|   ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   lStr: string;
 | ||
| begin
 | ||
|   lStr := Format('[%s] Name=%s X=%f Y=%f Pen=[Color=%s Style=%s] Brush=[Color=%s Style=%s Kind=%s] %s',
 | ||
|     [Self.ClassName, Self.Name, X, Y,
 | ||
|     GenerateDebugStrForFPColor(Pen.Color),
 | ||
|     GetEnumName(TypeInfo(TFPPenStyle), integer(Pen.Style)),
 | ||
|     GenerateDebugStrForFPColor(Brush.Color),
 | ||
|     GetEnumName(TypeInfo(TFPBrushStyle), integer(Brush.Style)),
 | ||
|     GetEnumName(TypeInfo(TvBrushKind), integer(Brush.Kind)),
 | ||
|     FExtraDebugStr]);
 | ||
|   Result := ADestRoutine(lStr, APageItem);
 | ||
| end;
 | ||
| 
 | ||
| 
 | ||
| { TvEntityWithPenBrushAndFont }
 | ||
| 
 | ||
| constructor TvEntityWithPenBrushAndFont.Create(APage: TvPage);
 | ||
| begin
 | ||
|   inherited Create(APage);
 | ||
|   Font.Color := colBlack;
 | ||
|   Font.Size := 10;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithPenBrushAndFont.ApplyFontToCanvas(ADest: TFPCustomCanvas;
 | ||
|   ARenderInfo: TvRenderInfo; AMulX: Double = 1.0);
 | ||
| begin
 | ||
|   ApplyFontToCanvas(ADest, ARenderInfo, Font, AMulX);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithPenBrushAndFont.ApplyFontToCanvas(ADest: TFPCustomCanvas;
 | ||
|   ARenderInfo: TvRenderInfo; AFont: TvFont; AMulX: Double);
 | ||
| var
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   ALCLDest: TCanvas absolute ADest;
 | ||
|   {$endif}
 | ||
|   lFPColor: TFPColor;
 | ||
| begin
 | ||
|   if ADest = nil then
 | ||
|     exit;
 | ||
|   ADest.Font.Name := AFont.Name;
 | ||
|   if AFont.Size = 0 then AFont.Size := 10;
 | ||
|   ADest.Font.Size := Round(AmulX * AFont.Size);
 | ||
|   ADest.Font.Bold := AFont.Bold;
 | ||
|   ADest.Font.Italic := AFont.Italic;
 | ||
|   ADest.Font.Underline := AFont.Underline;
 | ||
|   {$IF (FPC_FULLVERSION<=20600) or (FPC_FULLVERSION=20602)}
 | ||
|   ADest.Font.StrikeTrough := AFont.StrikeThrough; //old version with typo
 | ||
|   {$ELSE}
 | ||
|   ADest.Font.StrikeThrough := AFont.StrikeThrough;
 | ||
|   {$ENDIF}
 | ||
| 
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   ALCLDest.Font.Orientation := Round(AFont.Orientation * 10);  // wp: was * 16
 | ||
|   {$endif}
 | ||
|   lFPColor := AdjustColorToBackground(AFont.Color, ARenderInfo);
 | ||
|   ADest.Font.FPColor := lFPColor;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithPenBrushAndFont.AssignFont(AFont: TvFont);
 | ||
| begin
 | ||
|   Font.Color := AFont.Color;
 | ||
|   Font.Size := AFont.Size;
 | ||
|   Font.Name := AFont.Name;
 | ||
|   Font.Orientation := AFont.Orientation;
 | ||
|   Font.Bold := AFont.Bold;
 | ||
|   Font.Italic := AFont.Italic;
 | ||
|   Font.Underline := AFont.Underline;
 | ||
|   Font.StrikeThrough := AFont.StrikeThrough;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithPenBrushAndFont.Rotate(AAngle: Double; ABase: T3DPoint);
 | ||
| begin
 | ||
|   inherited Rotate(AAngle, ABase);
 | ||
|   Font.Orientation := RadToDeg(AAngle);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithPenBrushAndFont.Scale(ADeltaScaleX, ADeltaScaleY: Double);
 | ||
| begin
 | ||
|   inherited Scale(ADeltaScaleX, ADeltaScaleY);
 | ||
|   Font.Size := Round(Font.Size * ADeltaScaleX);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithPenBrushAndFont.Render(ADest: TFPCustomCanvas;
 | ||
|   var ARenderInfo: TvRenderInfo; ADestX: Integer; ADestY: Integer; AMulX: Double;
 | ||
|   AMulY: Double; ADoDraw: Boolean);
 | ||
| begin
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|   ApplyFontToCanvas(ADest, ARenderInfo, AMulX);         // wp: why not AMulY ?
 | ||
| end;
 | ||
| 
 | ||
| function TvEntityWithPenBrushAndFont.GenerateDebugTree(
 | ||
|   ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   lStr: string;
 | ||
| begin
 | ||
|   Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
 | ||
|   // Add the font debug info in a sub-item
 | ||
|   lStr := Format('[Font] Color=%s Size=%d Name=%s Orientation=%f Bold=%s Italic=%s Underline=%s StrikeThrough=%s',
 | ||
|     [GenerateDebugStrForFPColor(Font.Color),
 | ||
|     Font.Size, Font.Name, Font.Orientation,
 | ||
|     BoolToStr(Font.Bold),
 | ||
|     BoolToStr(Font.Italic),
 | ||
|     BoolToStr(Font.Underline),
 | ||
|     BoolToStr(Font.StrikeThrough)
 | ||
|     ]);
 | ||
|   ADestRoutine(lStr, Result);
 | ||
| end;
 | ||
| 
 | ||
| { TvEntityWithStyle }
 | ||
| 
 | ||
| constructor TvEntityWithStyle.Create(APage: TvPage);
 | ||
| begin
 | ||
|   inherited Create(APage);
 | ||
| end;
 | ||
| 
 | ||
| destructor TvEntityWithStyle.Destroy;
 | ||
| begin
 | ||
|   inherited Destroy;
 | ||
| end;
 | ||
| 
 | ||
| function TvEntityWithStyle.GetCombinedStyle(AParent: TvEntityWithStyle
 | ||
|   ): TvStyle;
 | ||
| begin
 | ||
|   if (AParent <> nil) and (Style = nil) then Result := AParent.Style
 | ||
|   else Result := Style;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithStyle.Render(ADest: TFPCustomCanvas;
 | ||
|   var ARenderInfo: TvRenderInfo; ADestX: Integer; ADestY: Integer;
 | ||
|   AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| begin
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|   if (Style <> nil) then
 | ||
|   begin
 | ||
|     ApplyPenToCanvas(ADest, ARenderInfo, Style.Pen);
 | ||
|     ApplyBrushToCanvas(ADest, @Style.Brush);
 | ||
|     ApplyFontToCanvas(ADest, ARenderInfo, Style.Font, AMulX);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| { TPath }
 | ||
| 
 | ||
| constructor TPath.Create(APage: TvPage);
 | ||
| begin
 | ||
|   inherited Create(APage);
 | ||
|   FCurMoveSubPartIndex := -1;
 | ||
| end;
 | ||
| 
 | ||
| //GM: Follow the path to cleanly release the chained list!
 | ||
| destructor TPath.Destroy;
 | ||
| begin
 | ||
|   Clear;
 | ||
|   inherited Destroy;
 | ||
| end;
 | ||
| 
 | ||
| procedure TPath.Clear;
 | ||
| var
 | ||
|   p, pp, np: TPathSegment;
 | ||
| begin
 | ||
|   p:=PointsEnd;
 | ||
|   if (p<>nil) then
 | ||
|   begin
 | ||
|     np:=p.Next;
 | ||
|     while (p<>nil) do
 | ||
|     begin
 | ||
|       pp:=p.Previous;
 | ||
|       p.Next:=nil;
 | ||
|       p.Previous:=nil;
 | ||
|       FreeAndNil(p);
 | ||
|       p:=pp;
 | ||
|     end;
 | ||
|     p:=np;
 | ||
|     while (p<>nil) do
 | ||
|     begin
 | ||
|       np:=p.Next;
 | ||
|       p.Next:=nil;
 | ||
|       p.Previous:=nil;
 | ||
|       FreeAndNil(p);
 | ||
|       p:=np;
 | ||
|     end;
 | ||
|   end;
 | ||
|   PointsEnd:=nil;
 | ||
|   Points:=nil;
 | ||
| 
 | ||
|   inherited Clear;
 | ||
| end;
 | ||
| 
 | ||
| procedure TPath.Assign(ASource: TPath);
 | ||
| begin
 | ||
|   Len := ASource.Len;
 | ||
|   Points := ASource.Points;
 | ||
|   PointsEnd := ASource.PointsEnd;
 | ||
|   CurPoint := ASource.CurPoint;
 | ||
|   Pen := ASource.Pen;
 | ||
|   Brush := ASource.Brush;
 | ||
|   ClipPath := ASource.ClipPath;
 | ||
|   ClipMode := ASource.ClipMode;
 | ||
| end;
 | ||
| 
 | ||
| procedure TPath.PrepareForSequentialReading;
 | ||
| begin
 | ||
|   CurPoint := nil;
 | ||
| end;
 | ||
| 
 | ||
| procedure TPath.PrepareForWalking;
 | ||
| begin
 | ||
|   PrepareForSequentialReading();
 | ||
|   CurWalkDistanceInCurSegment := 0;
 | ||
|   Next();
 | ||
| end;
 | ||
| 
 | ||
| function TPath.Next(): TPathSegment;
 | ||
| begin
 | ||
|   if CurPoint = nil then Result := Points
 | ||
|   else Result := CurPoint.Next;
 | ||
| 
 | ||
|   CurPoint := Result;
 | ||
| end;
 | ||
| 
 | ||
| // Walk is walking a distance in the path and obtaining the point where we land and the current tangent
 | ||
| // Returns true if successful, false otherwise
 | ||
| // ATangentAngle - In radians
 | ||
| function TPath.NextWalk(ADistance: Double; out AX, AY, ATangentAngle: Double): Boolean;
 | ||
| var
 | ||
|   lCurPoint: TPathSegment;
 | ||
|   lCurPointLen: Double;
 | ||
| begin
 | ||
|   Result := False;
 | ||
|   lCurPoint := CurPoint;
 | ||
|   CurWalkDistanceInCurSegment := ADistance + CurWalkDistanceInCurSegment;
 | ||
|   if lCurPoint = nil then Exit;
 | ||
|   lCurPointLen := lCurPoint.GetLength();
 | ||
| 
 | ||
|   // get the current segment
 | ||
|   while CurWalkDistanceInCurSegment >= lCurPointLen do
 | ||
|   begin
 | ||
|     CurWalkDistanceInCurSegment := CurWalkDistanceInCurSegment - lCurPointLen;
 | ||
|     lCurPoint := Next();
 | ||
|     if lCurPoint = nil then Exit;
 | ||
|     lCurPointLen := lCurPoint.GetLength();
 | ||
|   end;
 | ||
| 
 | ||
|   Result := lCurPoint.GetPointAndTangentForDistance(CurWalkDistanceInCurSegment, AX, AY, ATangentAngle);
 | ||
| end;
 | ||
| 
 | ||
| procedure TPath.CalculateBoundingBox(ADest: TFPCustomCanvas;
 | ||
|   out ALeft, ATop, ARight, ABottom: Double);
 | ||
| var
 | ||
|   lSegment: TPathSegment;
 | ||
|   l2DSegment: T2DSegment;
 | ||
|   lFirstValue: Boolean = True;
 | ||
| begin
 | ||
|   inherited CalculateBoundingBox(ADest, ALeft, ATop, ARight, ABottom);
 | ||
| 
 | ||
|   PrepareForSequentialReading();
 | ||
|   lSegment := Next();
 | ||
|   while lSegment <> nil do
 | ||
|   begin
 | ||
|     if lSegment is T2DSegment then
 | ||
|     begin
 | ||
|       l2DSegment := T2DSegment(lSegment);
 | ||
|       if lFirstValue then
 | ||
|       begin
 | ||
|         ALeft := l2DSegment.X;
 | ||
|         ATop := l2DSegment.Y;
 | ||
|         ARight := l2DSegment.X;
 | ||
|         ABottom := l2DSegment.Y;
 | ||
|         lFirstValue := False;
 | ||
|       end
 | ||
|       else
 | ||
|       begin
 | ||
|         if l2DSegment.X < ALeft then ALeft := l2DSegment.X;
 | ||
|         if l2DSegment.Y < ATop then ATop := l2DSegment.Y;
 | ||
|         if l2DSegment.X > ARight then ARight := l2DSegment.X;
 | ||
|         if l2DSegment.Y > ABottom then ABottom := l2DSegment.Y;
 | ||
|       end;
 | ||
|     end;
 | ||
| 
 | ||
|     lSegment := Next();
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TPath.AppendSegment(ASegment: TPathSegment);
 | ||
| var
 | ||
|   L: Integer;
 | ||
| begin
 | ||
|   ASegment.FPath := self;
 | ||
| 
 | ||
|   // Check if we are the first segment in the tmp path
 | ||
|   if PointsEnd = nil then
 | ||
|   begin
 | ||
|     if Len <> 0 then
 | ||
|       Exception.Create('[TPath.AppendSegment] Assertion failed Len <> 0 with PointsEnd = nil');
 | ||
| 
 | ||
|     Points := ASegment;
 | ||
|     PointsEnd := ASegment;
 | ||
|     Len := 1;
 | ||
|     Exit;
 | ||
|   end;
 | ||
| 
 | ||
|   L := Len;
 | ||
|   Inc(Len);
 | ||
| 
 | ||
|   // Adds the element to the end of the list
 | ||
|   PointsEnd.Next := ASegment;
 | ||
|   ASegment.Previous := PointsEnd;
 | ||
|   PointsEnd := ASegment;
 | ||
| end;
 | ||
| 
 | ||
| procedure TPath.AppendMoveToSegment(AX, AY: Double);
 | ||
| var
 | ||
|   segment: T2DSegment;
 | ||
| begin
 | ||
|   segment := T2DSegment.Create;
 | ||
|   segment.SegmentType := stMoveTo;
 | ||
|   segment.X := AX;
 | ||
|   segment.Y := AY;
 | ||
|   AppendSegment(segment);
 | ||
| end;
 | ||
| 
 | ||
| procedure TPath.AppendLineToSegment(AX, AY: Double);
 | ||
| var
 | ||
|   segment: T2DSegment;
 | ||
| begin
 | ||
|   segment := T2DSegment.Create;
 | ||
|   segment.SegmentType := st2DLine;
 | ||
|   segment.X := AX;
 | ||
|   segment.Y := AY;
 | ||
|   AppendSegment(segment);
 | ||
| end;
 | ||
| 
 | ||
| procedure TPath.AppendEllipticalArc(ARadX, ARadY, AXAxisRotation, ADestX,
 | ||
|   ADestY: Double; ALeftmostEllipse, AClockwiseArcFlag: Boolean);
 | ||
| var
 | ||
|   segment: T2DEllipticalArcSegment;
 | ||
| begin
 | ||
|   segment := T2DEllipticalArcSegment.Create;
 | ||
|   segment.SegmentType := st2DEllipticalArc;
 | ||
|   segment.X := ADestX;
 | ||
|   segment.Y := ADestY;
 | ||
|   segment.RX := ARadX;
 | ||
|   segment.RY := ARadY;
 | ||
|   segment.XRotation := AXAxisRotation;
 | ||
|   segment.LeftmostEllipse := ALeftmostEllipse;
 | ||
|   segment.ClockwiseArcFlag := AClockwiseArcFlag;
 | ||
| 
 | ||
|   AppendSegment(segment);
 | ||
| end;
 | ||
| 
 | ||
| procedure TPath.AppendEllipticalArcWithCenter(ARadX, ARadY, AXAxisRotation,
 | ||
|   ADestX, ADestY, ACenterX, ACenterY: Double; AClockwiseArcFlag: Boolean);
 | ||
| var
 | ||
|   segment: T2DEllipticalArcSegment;
 | ||
| begin
 | ||
|   segment := T2DEllipticalArcSegment.Create;
 | ||
|   segment.SegmentType := st2DEllipticalArc;
 | ||
|   segment.X := ADestX;
 | ||
|   segment.Y := ADestY;
 | ||
|   segment.RX := ARadX;
 | ||
|   segment.RY := ARadY;
 | ||
|   segment.CX := ACenterX;
 | ||
|   segment.CY := ACenterY;
 | ||
|   segment.XRotation := AXAxisRotation;
 | ||
|   segment.LeftmostEllipse := False; // which value would it have?
 | ||
|   segment.ClockwiseArcFlag := AClockwiseArcFlag;
 | ||
|   segment.CenterSetByUser := True;
 | ||
| 
 | ||
|   AppendSegment(segment);
 | ||
| end;
 | ||
| 
 | ||
| procedure TPath.Move(ADeltaX, ADeltaY: Double);
 | ||
| var
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   inherited Move(ADeltaX, ADeltaY);
 | ||
|   for i := 0 to GetSubpartCount()-1 do
 | ||
|   begin
 | ||
|     MoveSubpart(ADeltaX, ADeltaY, i);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TPath.MoveSubpart(ADeltaX, ADeltaY: Double; ASubpart: Cardinal);
 | ||
| var
 | ||
|   lCurPart: TPathSegment;
 | ||
| begin
 | ||
|   if (ASubPart < 0) or (ASubPart > Len) then
 | ||
|     raise Exception.Create(Format('[TPath.MoveSubpart] Invalid index %d', [ASubpart]));
 | ||
| 
 | ||
|   // Move to the subpart
 | ||
|   lCurPart := MoveToSubpart(ASubpart);
 | ||
| 
 | ||
|   // Do the change
 | ||
|   lCurPart.Move(ADeltaX, ADeltaY);
 | ||
| end;
 | ||
| 
 | ||
| function TPath.MoveToSubpart(ASubpart: Cardinal): TPathSegment;
 | ||
| var
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   if (ASubPart < 0) or (ASubPart > Len) then
 | ||
|     raise Exception.Create(Format('[TPath.MoveToSubpart] Invalid index %d', [ASubpart]));
 | ||
| 
 | ||
|   // Move to the subpart
 | ||
|   if (ASubPart = FCurMoveSubPartIndex) then
 | ||
|   begin
 | ||
|     Result := FCurMoveSubPartSegment;
 | ||
|   end
 | ||
|   else if (FCurMoveSubPartSegment <> nil) and (ASubPart = FCurMoveSubPartIndex + 1) then
 | ||
|   begin
 | ||
|     Result := FCurMoveSubPartSegment.Next;
 | ||
|     FCurMoveSubPartIndex := FCurMoveSubPartIndex + 1;
 | ||
|     FCurMoveSubPartSegment := Result;
 | ||
|   end
 | ||
|   else if (FCurMoveSubPartSegment <> nil) and (ASubPart = FCurMoveSubPartIndex - 1) then
 | ||
|   begin
 | ||
|     Result := FCurMoveSubPartSegment.Previous;
 | ||
|     FCurMoveSubPartIndex := FCurMoveSubPartIndex - 1;
 | ||
|     FCurMoveSubPartSegment := Result;
 | ||
|   end
 | ||
|   else
 | ||
|   begin
 | ||
|     Result := Points;
 | ||
| 
 | ||
|     for i := 0 to ASubpart-1 do
 | ||
|       Result := Result.Next;
 | ||
| 
 | ||
|     FCurMoveSubPartIndex := ASubpart;
 | ||
|     FCurMoveSubPartSegment := Result;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TPath.GetSubpartCount: Integer;
 | ||
| begin
 | ||
|   Result := Len;
 | ||
| end;
 | ||
| 
 | ||
| procedure TPath.Rotate(AAngle: Double; ABase: T3DPoint);
 | ||
| var
 | ||
|   i: Integer;
 | ||
|   lCurPart: TPathSegment;
 | ||
| begin
 | ||
|   inherited Rotate(AAngle, ABase);
 | ||
|   for i := 0 to GetSubpartCount()-1 do
 | ||
|   begin
 | ||
|     // Move to the subpart
 | ||
|     lCurPart := MoveToSubpart(i);
 | ||
|     // Rotate it
 | ||
|     lCurPart.Rotate(AAngle, ABase);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| { Only correct for straight segments. This must have been checked before! }
 | ||
| function TPath.GetLineIntersectionPoints(ACoord: Double;
 | ||
|   ACoordIsX: Boolean): TDoubleDynArray;
 | ||
| const
 | ||
|   COUNT = 100;
 | ||
| var
 | ||
|   seg: TPathSegment;
 | ||
|   seg2D: T2DSegment; // absolute seg;
 | ||
|   j: Integer;
 | ||
|   p, p1, p2: T3DPoint;
 | ||
|   n: Integer;
 | ||
| begin
 | ||
|   SetLength(Result, COUNT);
 | ||
|   PrepareForSequentialReading;
 | ||
|   n := 0;
 | ||
|   if ACoordIsX then
 | ||
|     for j:=0 to Len-1 do
 | ||
|     begin
 | ||
|       seg := TPathSegment(Next);
 | ||
|       if seg.GetStartPoint(p) and (seg is T2DSegment) then
 | ||
|       begin
 | ||
|         seg2D := T2DSegment(seg);
 | ||
|         if p.X < seg2D.X then begin
 | ||
|           p1 := Make3DPoint(p.X, p.Y);
 | ||
|           p2 := Make3DPoint(seg2D.X, seg2D.Y);
 | ||
|         end else
 | ||
|         begin
 | ||
|           p1 := Make3DPoint(seg2D.X, seg2D.Y);
 | ||
|           p2 := Make3DPoint(p.X, p.Y);
 | ||
|         end;
 | ||
|         if (p1.X < ACoord) and (ACoord <= p2.X) then
 | ||
|         begin
 | ||
|           if n >= Length(Result) then
 | ||
|             SetLength(Result, Length(Result) + COUNT);
 | ||
|           if (p1.X = p2.X) then
 | ||
|             Result[n] := p1.Y else
 | ||
|             Result[n] := p1.Y + (ACoord - p1.X) * (p2.Y - p1.Y) / (p2.X - p1.X);
 | ||
|           inc(n);
 | ||
|         end;
 | ||
|       end;
 | ||
|     end
 | ||
|   else
 | ||
|     for j := 0 to Len-1 do
 | ||
|     begin
 | ||
|       seg := TPathSegment(Next);
 | ||
|       if seg.GetStartPoint(p) and (seg is T2DSegment) then
 | ||
|       begin
 | ||
|         seg2D := T2DSegment(seg);
 | ||
|         if p.Y < seg2D.Y then
 | ||
|         begin
 | ||
|           p1 := Make3DPoint(p.X, p.Y);
 | ||
|           p2 := Make3DPoint(seg2D.X, seg2D.Y);
 | ||
|         end else
 | ||
|         begin
 | ||
|           p1 := Make3DPoint(seg2D.X, seg2D.Y);
 | ||
|           p2 := Make3DPoint(p.X, p.Y);
 | ||
|         end;
 | ||
|         if (p1.Y < ACoord) and (ACoord <= p2.Y) then
 | ||
|         begin
 | ||
|           if n >= Length(Result) then
 | ||
|             SetLength(Result, Length(Result) + COUNT);
 | ||
|           if (p1.Y = p2.Y) then
 | ||
|             Result[n] := p1.X else
 | ||
|             Result[n] := p1.X + (ACoord - p1.Y) * (p2.X - p1.x) / (p2.Y - p1.Y);
 | ||
|           inc(n);
 | ||
|         end;
 | ||
|       end;
 | ||
|     end;
 | ||
|   SetLength(Result, n);
 | ||
| end;
 | ||
| 
 | ||
| procedure TPath.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
 | ||
|   ADestX, ADestY: Integer; AMulX, AMulY: Double; ADoDraw: Boolean);
 | ||
| var
 | ||
|   i: Integer;
 | ||
|   j, n: Integer;
 | ||
|   x1, y1, x2, y2: Integer;
 | ||
|   pts: TPointsArray;
 | ||
|   ACanvas: TCanvas absolute ADest;
 | ||
|   coordX, coordY: Integer;
 | ||
|   curSegment: TPathSegment;
 | ||
|   cur2DSegment: T2DSegment absolute curSegment;
 | ||
|   lRect: TRect;
 | ||
|   gv1, gv2: T2DPoint;
 | ||
| begin
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
| 
 | ||
|   ConvertPathToPolygons(self, ADestX, ADestY, AMulX, AMulY, FPolyPoints, FPolyStarts);
 | ||
|   x1 := MaxInt;
 | ||
|   y1 := maxInt;
 | ||
|   x2 := -MaxInt;
 | ||
|   y2 := -MaxInt;
 | ||
|   for i := 0 to High(FPolyPoints) do
 | ||
|   begin
 | ||
|     {$ifdef FPVECTORIAL_AUTOFIT_DEBUG}
 | ||
|     if AutoFitDebug <> nil then AutoFitDebug.Add(Format('==[%d=%d]', [FPolyPoints[i].X, FPolyPoints[i].Y]));
 | ||
|     {$endif}
 | ||
|     x1 := min(x1, FPolyPoints[i].X);
 | ||
|     y1 := min(y1, FPolyPoints[i].Y);
 | ||
|     x2 := max(x2, FPolyPoints[i].X);
 | ||
|     y2 := max(y2, FPolyPoints[i].Y);
 | ||
|   end;
 | ||
|   CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
 | ||
|   // Boundary rect of shape filled with a gradient
 | ||
|   lRect := Rect(x1, y1, x2, y2);
 | ||
| 
 | ||
|   if ADoDraw then
 | ||
|   begin
 | ||
|     // (1) draw background only
 | ||
|     ADest.Pen.Style := psClear;
 | ||
|     if (Length(FPolyPoints) > 2) then
 | ||
|       case Brush.Kind of
 | ||
|         bkSimpleBrush:
 | ||
|           if Brush.Style <> bsClear then
 | ||
|           begin
 | ||
|             if (Brush.Style = bsSolid) and (Length(FPolyStarts) > 1) then
 | ||
|               // Non-contiguous polygon (polygon with "holes") --> use special procedure
 | ||
|               // Disadvantage: it can oly do solid fills!
 | ||
|               DrawPolygon(ADest, ARenderInfo, FPolyPoints, FPolyStarts, lRect)
 | ||
|             else
 | ||
|               {$IFDEF USE_LCL_CANVAS}
 | ||
|               for i := 0 to High(FPolyStarts) do
 | ||
|               begin
 | ||
|                 j := FPolyStarts[i];
 | ||
|                 if i = High(FPolyStarts) then
 | ||
|                   n := Length(FPolyPoints) - j
 | ||
|                 else
 | ||
|                   n := FPolyStarts[i+1] - FPolyStarts[i]; // + 1;
 | ||
|                 ACanvas.Polygon(@FPolyPoints[j], n, WindingRule = vcmNonZeroWindingRule);
 | ||
|               end;
 | ||
|               {$ELSE}
 | ||
|               ADest.Polygon(FPolyPoints);
 | ||
|               {$ENDIF}
 | ||
|           end;
 | ||
| 
 | ||
|         bkHorizontalGradient,
 | ||
|         bkVerticalGradient,
 | ||
|         bkOtherLinearGradient:
 | ||
|           begin
 | ||
|             // calculate gradient vector
 | ||
|             CalcGradientVector(gv1, gv2, lRect, ADestX, ADestY, AMulX, AMulY);
 | ||
|             // Draw the gradient
 | ||
|             DrawPolygonBrushLinearGradient(ADest, ARenderInfo, FPolyPoints, FPolyStarts, lRect, gv1, gv2);
 | ||
|           end;
 | ||
| 
 | ||
|         bkRadialGradient:
 | ||
|           DrawPolygonBrushRadialGradient(ADest, ARenderInfo, FPolyPoints, lRect);
 | ||
|       end;  // case Brush.Kind of...
 | ||
| 
 | ||
|     // (2) draw border, take care of the segments with modified pen
 | ||
|     ADest.Brush.Style := bsClear;               // We will paint no background
 | ||
|     ApplyPenToCanvas(ADest, ARenderInfo, Pen);  // Restore pen
 | ||
| 
 | ||
|     PrepareForSequentialReading;
 | ||
|     for j := 0 to Len - 1 do
 | ||
|     begin
 | ||
|       curSegment := TPathSegment(Next);
 | ||
|       case curSegment.SegmentType of
 | ||
|         stMoveTo:
 | ||
|           begin
 | ||
|             inc(i);
 | ||
|             coordX := CoordToCanvasX(cur2DSegment.X, ADestX, AMulX);
 | ||
|             coordY := CoordToCanvasY(cur2DSegment.Y, ADestY, AMulY);
 | ||
|             ADest.MoveTo(coordX, coordY);
 | ||
|           end;
 | ||
|         st2DLineWithPen, st2DLine, st3DLine:
 | ||
|           begin
 | ||
|             coordX := CoordToCanvasX(cur2DSegment.X, ADestX, AMulX);
 | ||
|             coordY := CoordToCanvasY(cur2DSegment.Y, ADestY, AMulY);
 | ||
|             if curSegment.SegmentType = st2DLineWithPen then
 | ||
|             begin
 | ||
|               ADest.Pen.FPColor := AdjustColorToBackground(T2DSegmentWithPen(Cur2DSegment).Pen.Color, ARenderInfo);
 | ||
|               ADest.Pen.Width := T2DSegmentWithPen(cur2DSegment).Pen.Width;
 | ||
|               ADest.Pen.Style := T2DSegmentWithPen(cur2DSegment).Pen.Style;
 | ||
|               ADest.LineTo(coordX, coordY);
 | ||
|               ApplyPenToCanvas(ADest, ARenderInfo, Pen);
 | ||
|             end else
 | ||
|               ADest.LineTo(coordX, coordY);
 | ||
|           end;
 | ||
|         st2DBezier, st3DBezier, st2DEllipticalArc:
 | ||
|           begin
 | ||
|             coordX := CoordToCanvasX(T2DSegment(curSegment.Previous).X, ADestX, AMulX);
 | ||
|             coordY := CoordToCanvasY(T2DSegment(curSegment.Previous).Y, ADestY, AMulY);
 | ||
|             SetLength(pts, 1);
 | ||
|             pts[0] := Point(coordX, coordY);
 | ||
|             curSegment.AddToPoints(ADestX, ADestY, AMulX, AMulY, pts);
 | ||
|             if Length(pts) > 0 then
 | ||
|             begin
 | ||
|               ADest.PolyLine(pts);
 | ||
|               ADest.MoveTo(pts[High(pts)].X, pts[High(pts)].Y);
 | ||
|             end;
 | ||
|           end;
 | ||
|       end;
 | ||
|     end;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| 
 | ||
| (*
 | ||
| procedure TPath.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
 | ||
|   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| 
 | ||
|   function CanFill: Boolean;
 | ||
|   var
 | ||
|     seg: TPathSegment;
 | ||
|     j: Integer;
 | ||
|   begin
 | ||
|     Result := true;
 | ||
|     PrepareForSequentialReading;
 | ||
|     for j := 0 to Len - 1 do
 | ||
|     begin
 | ||
|       seg := TPathSegment(Next());
 | ||
|       if seg.SegmentType in [st2DBezier, st3dBezier, st2DEllipticalArc] then
 | ||
|       begin
 | ||
|         Result := false;
 | ||
|         exit;
 | ||
|       end;
 | ||
|     end;
 | ||
|   end;
 | ||
| 
 | ||
| const
 | ||
|   POINT_BUFFER = 100;
 | ||
| var
 | ||
|   i, j: Integer;
 | ||
|   PosX, PosY: Double; // Not modified by ADestX, etc
 | ||
|   CoordX, CoordY: Integer;
 | ||
|   CurSegment: TPathSegment;
 | ||
|   Cur2DSegment: T2DSegment absolute CurSegment;
 | ||
|   Cur2DBSegment: T2DBezierSegment absolute CurSegment;
 | ||
|   Cur2DArcSegment: T2DEllipticalArcSegment absolute CurSegment;
 | ||
|   x1, y1, x2, y2: Integer;
 | ||
|   // For bezier
 | ||
|   CoordX2, CoordY2, CoordX3, CoordY3, CoordX4, CoordY4, CoordX5, CoordY5: Integer;
 | ||
|   // For polygons
 | ||
|   lPoints, pts: array of TPoint;
 | ||
|   NumPoints: Integer;
 | ||
|   pts3d: T3dPointsArray = nil;
 | ||
|   // for elliptical arcs
 | ||
|   BoxLeft, BoxTop, BoxRight, BoxBottom: Double;
 | ||
|   EllipseRect: TRect;
 | ||
|    // Clipping Region
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   ClipRegion, OldClipRegion: HRGN;
 | ||
|   ACanvas: TCanvas absolute ADest;
 | ||
|   {$endif}
 | ||
| begin
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
| 
 | ||
|   PosX := 0;
 | ||
|   PosY := 0;
 | ||
| //  ADest.Brush.Style := bsClear;
 | ||
| 
 | ||
|   ADest.MoveTo(ADestX, ADestY);
 | ||
|                            {
 | ||
|   // Set the path Pen and Brush options
 | ||
|   ADest.Pen.Style := Pen.Style;
 | ||
|   ADest.Pen.Width := Round(Pen.Width * AMulX);
 | ||
|   if ADest.Pen.Width < 1 then ADest.Pen.Width := 1;
 | ||
|   if (Pen.Width <= 2) and (ADest.Pen.Width > 2) then ADest.Pen.Width := 2;
 | ||
|   if (Pen.Width <= 5) and (ADest.Pen.Width > 5) then ADest.Pen.Width := 5;
 | ||
|   ADest.Pen.FPColor := AdjustColorToBackground(Pen.Color, ARenderInfo);
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   if (Pen.Style = psPattern)  then
 | ||
|     ACanvas.Pen.SetPattern(Pen.Pattern);
 | ||
|   {$endif}
 | ||
|   ADest.Brush.FPColor := Brush.Color;
 | ||
|                             }
 | ||
|   // Prepare the Clipping Region, if any
 | ||
|   {$ifdef USE_CANVAS_CLIP_REGION}
 | ||
|   if ClipPath <> nil then
 | ||
|   begin
 | ||
|     OldClipRegion := LCLIntf.CreateEmptyRegion();
 | ||
|     GetClipRgn(ACanvas.Handle, OldClipRegion);
 | ||
|     ClipRegion := ConvertPathToRegion(ClipPath, ADestX, ADestY, AMulX, AMulY);
 | ||
|     SelectClipRgn(ACanvas.Handle, ClipRegion);
 | ||
|     DeleteObject(ClipRegion);
 | ||
|     // debug info
 | ||
|     {$ifdef DEBUG_CANVAS_CLIP_REGION}
 | ||
|     ConvertPathToPoints(CurPath.ClipPath, ADestX, ADestY, AMulX, AMulY);
 | ||
|     ACanvas.Polygon(lPoints);
 | ||
|     {$endif}
 | ||
|   end;
 | ||
|   {$endif}
 | ||
| 
 | ||
|   // useful in some paths, like stars!
 | ||
|   {  -- wp: causes artifacts in case of concave path
 | ||
|   if ADoDraw then
 | ||
|     RenderInternalPolygon(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY);
 | ||
|   }
 | ||
| 
 | ||
|   if CanFill then
 | ||
|   begin
 | ||
|     // Manually fill polygon with gradient
 | ||
|     {$IFDEF USE_LCL_CANVAS}
 | ||
|     if ADoDraw and (Brush.Kind in [bkHorizontalGradient, bkVerticalGradient]) then
 | ||
|     begin
 | ||
|       x1 := MaxInt;
 | ||
|       y1 := MaxInt;
 | ||
|       x2 := -MaxInt;
 | ||
|       y2 := -MaxInt;
 | ||
|       PrepareForSequentialReading;
 | ||
|       for j := 0 to Len - 1 do
 | ||
|       begin
 | ||
|         CurSegment := TPathSegment(Next);
 | ||
|         CoordX := CoordToCanvasX(Cur2DSegment.X, ADestX, AMulX);
 | ||
|         CoordY := CoordToCanvasY(Cur2DSegment.Y, ADestY, AMulY);
 | ||
|         x1 := Min(x1, CoordX);
 | ||
|         y1 := Min(y1, CoordY);
 | ||
|         x2 := Max(x2, CoordX);
 | ||
|         y2 := Max(y2, CoordY);
 | ||
|       end;
 | ||
|       DrawBrushGradient(ADest, ARenderInfo, x1, y1, x2, y2, ADestX, ADestY, AMulX, AMulY);
 | ||
|     end;
 | ||
|     {$ENDIF}
 | ||
|   end;
 | ||
| 
 | ||
|   //
 | ||
|   // For other paths, draw more carefully
 | ||
|   //
 | ||
|   ApplyPenToCanvas(ADest, ARenderInfo, Pen);  // Restore pen
 | ||
|   PrepareForSequentialReading;
 | ||
| 
 | ||
|   SetLength(lPoints, POINT_BUFFER);
 | ||
|   NumPoints := 0;
 | ||
| 
 | ||
|   for j := 0 to Len - 1 do
 | ||
|   begin
 | ||
|     //WriteLn('j = ', j);
 | ||
|     CurSegment := TPathSegment(Next());
 | ||
| 
 | ||
|     case CurSegment.SegmentType of
 | ||
|     stMoveTo:
 | ||
|     begin
 | ||
|       CoordX := CoordToCanvasX(Cur2DSegment.X, ADestX, AMulX);
 | ||
|       CoordY := CoordToCanvasY(Cur2DSegment.Y, ADestY, AMulY);
 | ||
| 
 | ||
|       if ADoDraw then
 | ||
|       begin
 | ||
|         // Draw previous polygon
 | ||
|         if NumPoints > 0 then
 | ||
|           begin
 | ||
|           SetLength(lPoints, NumPoints);
 | ||
|           if Length(lPoints) = 2 then
 | ||
|             ADest.Line(lPoints[0].X, lPoints[0].Y, lPoints[1].X, lPoints[1].Y)
 | ||
|           else
 | ||
|             ADest.Polygon(lPoints);
 | ||
|           // Start new polygon
 | ||
|           SetLength(lPoints, POINT_BUFFER);
 | ||
|           NumPoints := 0;
 | ||
|         end;
 | ||
| 
 | ||
|         lPoints[0].X := CoordX;
 | ||
|         lPoints[0].Y := CoordY;
 | ||
|         NumPoints := 1;
 | ||
|       end;
 | ||
| 
 | ||
| 
 | ||
|       {
 | ||
|       if ADoDraw then
 | ||
|         ADest.MoveTo(CoordX, CoordY);
 | ||
|         }
 | ||
|       CalcEntityCanvasMinMaxXY(ARenderInfo, CoordX, CoordY);
 | ||
|       PosX := Cur2DSegment.X;
 | ||
|       PosY := Cur2DSegment.Y;
 | ||
|       {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 | ||
|       Write(Format(' M%d,%d', [CoordX, CoordY]));
 | ||
|       {$endif}
 | ||
|     end;
 | ||
| 
 | ||
|     // This element can override temporarely the Pen
 | ||
| 
 | ||
|     // TO DO: Paint these segments with correct pen at end !!!!
 | ||
| 
 | ||
| 
 | ||
|     st2DLineWithPen:
 | ||
|     begin
 | ||
|       ADest.Pen.FPColor := AdjustColorToBackground(T2DSegmentWithPen(Cur2DSegment).Pen.Color, ARenderInfo);
 | ||
|       CoordX := CoordToCanvasX(PosX, ADestX, AMulX);
 | ||
|       CoordY := CoordToCanvasY(PosY, ADestY, AMulY);
 | ||
|       CoordX2 := CoordToCanvasX(Cur2DSegment.X, ADestX, AMulX);
 | ||
|       CoordY2 := CoordToCanvasY(Cur2DSegment.Y, ADestY, AMulY);
 | ||
|       CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, CoordX, CoordY, CoordX2, CoordY2);
 | ||
|       if ADoDraw then
 | ||
|       begin
 | ||
|         if NumPoints >= Length(lPoints) then
 | ||
|           SetLength(lPoints, Length(lPoints) + POINT_BUFFER);
 | ||
|         lPoints[NumPoints].X := CoordX2;
 | ||
|         lPoints[NumPoints].Y := CoordY2;
 | ||
|         inc(NumPoints);
 | ||
| //        ADest.Line(CoordX, CoordY, CoordX2, CoordY2);
 | ||
|       end;
 | ||
| 
 | ||
|       PosX := Cur2DSegment.X;
 | ||
|       PosY := Cur2DSegment.Y;
 | ||
| 
 | ||
|       ADest.Pen.FPColor := Pen.Color;
 | ||
| 
 | ||
|       {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 | ||
|       Write(Format(' L%d,%d', [CoordX2, CoordY2]));
 | ||
|       {$endif}
 | ||
|     end;
 | ||
| 
 | ||
|     st2DLine, st3DLine:
 | ||
|     begin
 | ||
|       CoordX := CoordToCanvasX(PosX, ADestX, AMulX);
 | ||
|       CoordY := CoordToCanvasY(PosY, ADestY, AMulY);
 | ||
|       CoordX2 := CoordToCanvasX(Cur2DSegment.X, ADestX, AMulX);
 | ||
|       CoordY2 := CoordToCanvasY(Cur2DSegment.Y, ADestY, AMulY);
 | ||
|       CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, CoordX, CoordY, CoordX2, CoordY2);
 | ||
|       if ADoDraw then
 | ||
|       begin
 | ||
|         if NumPoints >= Length(lPoints) then
 | ||
|           SetLength(lPoints, Length(lPoints) + POINT_BUFFER);
 | ||
|         lPoints[NumPoints].X := CoordX2;
 | ||
|         lPoints[NumPoints].Y := CoordY2;
 | ||
|         inc(NumPoints);
 | ||
| //        ADest.Line(CoordX, CoordY, CoordX2, CoordY2);
 | ||
|       end;
 | ||
|       PosX := Cur2DSegment.X;
 | ||
|       PosY := Cur2DSegment.Y;
 | ||
|       {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 | ||
|       Write(Format(' L%d,%d', [CoordX2, CoordY2]));
 | ||
|       {$endif}
 | ||
|     end;
 | ||
| 
 | ||
|     { To draw a bezier we need to divide the interval in parts and make
 | ||
|       lines between this parts }
 | ||
|     st2DBezier, st3DBezier:
 | ||
|     begin
 | ||
|       CoordX := CoordToCanvasX(PosX, ADestX, AMulX);
 | ||
|       CoordY := CoordToCanvasY(PosY, ADestY, AMulY);
 | ||
|       CoordX2 := CoordToCanvasX(Cur2DBSegment.X2, ADestX, AMulX);
 | ||
|       CoordY2 := CoordToCanvasY(Cur2DBSegment.Y2, ADestY, AMulY);
 | ||
|       CoordX3 := CoordToCanvasX(Cur2DBSegment.X3, ADestX, AMulX);
 | ||
|       CoordY3 := CoordToCanvasY(Cur2DBSegment.Y3, ADestY, AMulY);
 | ||
|       CoordX4 := CoordToCanvasX(Cur2DBSegment.X, ADestX, AMulX);
 | ||
|       CoordY4 := CoordToCanvasY(Cur2DBSegment.Y, ADestY, AMulY);
 | ||
| //      SetLength(lPoints, 0);
 | ||
|       CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, CoordX, CoordY, CoordX2, CoordY2);
 | ||
|       CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, CoordX3, CoordY3, CoordX4, CoordY4);
 | ||
|       SetLength(pts, 0);
 | ||
|       AddBezierToPoints(
 | ||
|         Make2DPoint(CoordX, CoordY),
 | ||
|         Make2DPoint(CoordX2, CoordY2),
 | ||
|         Make2DPoint(CoordX3, CoordY3),
 | ||
|         Make2DPoint(CoordX4, CoordY4),
 | ||
|         pts //lPoints
 | ||
|       );
 | ||
| 
 | ||
|       if ADoDraw then
 | ||
|       begin
 | ||
|         if NumPoints + Length(pts) >= POINT_BUFFER then
 | ||
|           SetLength(lPoints, NumPoints + Length(pts));
 | ||
|         for i:=0 to High(pts) do
 | ||
|         begin
 | ||
|           lPoints[NumPoints].X := pts[i].X;
 | ||
|           lPoints[NumPoints].Y := pts[i].Y;
 | ||
|           inc(numPoints);
 | ||
|         end;
 | ||
|       end;
 | ||
| 
 | ||
|       ADest.Brush.Style := Brush.Style;
 | ||
|       {
 | ||
|       if (Length(lPoints) >= 3) and ADoDraw then
 | ||
|         ADest.Polygon(lPoints);
 | ||
|        }
 | ||
|       PosX := Cur2DSegment.X;
 | ||
|       PosY := Cur2DSegment.Y;
 | ||
| 
 | ||
|       {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 | ||
|       Write(Format(' ***C%d,%d %d,%d %d,%d %d,%d',
 | ||
|         [CoordToCanvasX(PosX, ADestX, AMulX), CoordToCanvasY(PosY, ADestY, AMulY),
 | ||
|          CoordToCanvasX(Cur2DBSegment.X2, ADestX, AMulX), CoordToCanvasY(Cur2DBSegment.Y2, ADestY, AMulY),
 | ||
|          CoordToCanvasX(Cur2DBSegment.X3, ADestX, AMulX), CoordToCanvasY(Cur2DBSegment.Y3, ADestY, AMulY),
 | ||
|          CoordToCanvasX(Cur2DBSegment.X, ADestX, AMulX), CoordToCanvasY(Cur2DBSegment.Y, ADestY, AMulY)]));
 | ||
|       {$endif}
 | ||
|     end;
 | ||
| 
 | ||
|     st2DEllipticalArc:
 | ||
|     begin
 | ||
|       CoordX := CoordToCanvasX(PosX, ADestX, AMulX);                   // start point of segment
 | ||
|       CoordY := CoordToCanvasY(PosY, ADestY, AMulY);
 | ||
|       CoordX2 := CoordToCanvasX(Cur2DArcSegment.RX, ADestX, AMulX);    // major axis radius
 | ||
|       CoordY2 := CoordToCanvasY(Cur2DArcSegment.RY, ADestY, AMulY);    // minor axis radius
 | ||
|       CoordX3 := CoordToCanvasX(Cur2DArcSegment.XRotation, 0, sign(AMulX));   // axis rotation angle
 | ||
|       CoordX4 := CoordToCanvasX(Cur2DArcSegment.X, ADestX, AMulX);     // end point of segment
 | ||
|       CoordY4 := CoordToCanvasY(Cur2DArcSegment.Y, ADestY, AMulY);
 | ||
|       CoordX5 := CoordToCanvasX(Cur2DArcSegment.Cx, ADestX, AMulX);    // Ellipse center
 | ||
|       CoordY5 := CoordToCanvasY(Cur2DArcSegment.Cy, ADestY, AMulY);
 | ||
| //      SetLength(lPoints, 0);
 | ||
| 
 | ||
|       Cur2DArcSegment.CalculateEllipseBoundingBox(nil, BoxLeft, BoxTop, BoxRight, BoxBottom);
 | ||
| 
 | ||
|       EllipseRect.Left := CoordToCanvasX(BoxLeft, ADestX, AMulX);
 | ||
|       EllipseRect.Top := CoordToCanvasY(BoxTop, ADestY, AMulY);
 | ||
|       EllipseRect.Right := CoordToCanvasX(BoxRight, ADestX, AMulX);
 | ||
|       EllipseRect.Bottom := CoordToCanvasY(BoxBottom, ADestY, AMulY);
 | ||
| 
 | ||
|       {$ifdef FPVECTORIAL_TOCANVAS_ELLIPSE_VISUALDEBUG}
 | ||
|       ACanvas.Pen.Color := clRed;
 | ||
|       ACanvas.Brush.Style := bsClear;
 | ||
|       ACanvas.Rectangle(  // Ellipse bounding box
 | ||
|         EllipseRect.Left, EllipseRect.Top, EllipseRect.Right, EllipseRect.Bottom);
 | ||
|       ACanvas.Line(CoordX5-5, CoordY5, CoordX5+5, CoordY5);  // Ellipse center
 | ||
|       ACanvas.Line(CoordX5, CoordY5-5, CoordX5, CoordY5+5);
 | ||
|       ACanvas.Pen.Color := clBlue;
 | ||
|       ACanvas.Line(CoordX-5, CoordY, CoordX+5, CoordY);      // Start point
 | ||
|       ACanvas.Line(CoordX, CoordY-5, CoordX, CoordY+5);
 | ||
|       ACanvas.Line(CoordX4-5, CoordY4, CoordX4+5, CoordY4);  // End point
 | ||
|       ACanvas.Line(CoordX4, CoordY4-5, CoordX4, CoordY4+5);
 | ||
| 
 | ||
|       {$endif}
 | ||
| 
 | ||
| //      ADest.Brush.Style := Brush.Style;
 | ||
|       CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo,
 | ||
|         EllipseRect.Left, EllipseRect.Top, EllipseRect.Right, EllipseRect.Bottom);
 | ||
| 
 | ||
|       if ADoDraw then
 | ||
|       begin
 | ||
|         Cur2DArcSegment.PolyApproximate(pts3D);
 | ||
| //        Cur2DArcSegment.BezierApproximate(pts3D);
 | ||
|         if NumPoints + Length(pts3D) >= POINT_BUFFER then
 | ||
|           SetLength(lPoints, NumPoints + Length(pts3D));
 | ||
|         for i:=1 to High(pts3D) do        // i=0 is end point of prev segment -> we can skip it.
 | ||
|         begin
 | ||
|           lPoints[NumPoints].X := CoordToCanvasX(pts3D[i].X, ADestX, AMulX);
 | ||
|           lPoints[NumPoints].Y := CoordToCanvasY(pts3D[i].Y, ADestY, AMulY);
 | ||
|           inc(numPoints);
 | ||
|         end;
 | ||
|         {
 | ||
|         SetLength(lPoints, Length(pts3D));
 | ||
|         for i:=0 to High(pts3D) do
 | ||
|         begin
 | ||
|           lPoints[i].X := CoordToCanvasX(pts3D[i].X, ADestX, AMulX);
 | ||
|           lPoints[i].Y := CoordToCanvasY(pts3D[i].Y, ADestY, AMulY);
 | ||
|         end;
 | ||
|         ADest.Polygon(lPoints);
 | ||
|         }
 | ||
|                                {
 | ||
|         i := 0;
 | ||
|         while i < Length(lPoints) do
 | ||
|         begin
 | ||
|           ADest.Polygon([lPoints[i], lPoints[i+1], lPoints[i+2], lPoints[i+3]]);
 | ||
|           inc(i, 4);
 | ||
|         end;
 | ||
|         }
 | ||
|         {
 | ||
|         // Arc draws counterclockwise
 | ||
|         if Cur2DArcSegment.ClockwiseArcFlag then
 | ||
|           ACanvas.Arc(
 | ||
|             EllipseRect.Left, EllipseRect.Top, EllipseRect.Right, EllipseRect.Bottom,
 | ||
|             CoordX4, CoordY4, CoordX, CoordY)
 | ||
|         else
 | ||
|           ACanvas.Arc(
 | ||
|             EllipseRect.Left, EllipseRect.Top, EllipseRect.Right, EllipseRect.Bottom,
 | ||
|             CoordX, CoordY, CoordX4, CoordY4);
 | ||
|         end;
 | ||
|         }
 | ||
|       end;
 | ||
|       PosX := Cur2DArcSegment.X;
 | ||
|       PosY := Cur2DArcSegment.Y;
 | ||
| 
 | ||
|       {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 | ||
|       {Write(Format(' ***C%d,%d %d,%d %d,%d %d,%d',
 | ||
|         [CoordToCanvasX(PosX), CoordToCanvasY(PosY),
 | ||
|          CoordToCanvasX(Cur2DBSegment.X2), CoordToCanvasY(Cur2DBSegment.Y2),
 | ||
|          CoordToCanvasX(Cur2DBSegment.X3), CoordToCanvasY(Cur2DBSegment.Y3),
 | ||
|          CoordToCanvasX(Cur2DBSegment.X), CoordToCanvasY(Cur2DBSegment.Y)]));}
 | ||
|       {$endif}
 | ||
|     end;
 | ||
|     end;
 | ||
|   end;
 | ||
|   {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 | ||
|   WriteLn('');
 | ||
|   {$endif}
 | ||
| 
 | ||
|   // Draw polygon
 | ||
|   if ADoDraw then begin
 | ||
|     SetLength(lPoints, NumPoints);
 | ||
|     if Length(lPoints) = 2 then
 | ||
|       ADest.Line(lPoints[0].X, lPoints[0].Y, lPoints[1].X, lPoints[1].Y)
 | ||
|     else
 | ||
|       ADest.Polygon(lPoints);
 | ||
|   end;
 | ||
| 
 | ||
|   // Restores the previous Clip Region
 | ||
|   {$ifdef USE_CANVAS_CLIP_REGION}
 | ||
|   if ClipPath <> nil then
 | ||
|   begin
 | ||
|     SelectClipRgn(ACanvas.Handle, OldClipRegion); //Using OldClipRegion crashes in Qt
 | ||
|   end;
 | ||
|   {$endif}
 | ||
| end;
 | ||
|                              *)
 | ||
| 
 | ||
| procedure TPath.RenderInternalPolygon(ADest: TFPCustomCanvas;
 | ||
|   ARenderInfo: TvRenderInfo; ADestX: Integer; ADestY: Integer; AMulX: Double;
 | ||
|   AMulY: Double);
 | ||
| 
 | ||
|   function CoordToCanvasX(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestX + AmulX * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CoordToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestY + AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   j: Integer;
 | ||
|   CoordX, CoordY: Integer;
 | ||
|   CurSegment: TPathSegment;
 | ||
|   Cur2DSegment: T2DSegment absolute CurSegment;
 | ||
|   Cur2DBSegment: T2DBezierSegment absolute CurSegment;
 | ||
|   Cur2DArcSegment: T2DEllipticalArcSegment absolute CurSegment;
 | ||
|   // For bezier
 | ||
|   // For polygons
 | ||
|   MultiPoints: array of array of TPoint;
 | ||
|   lCurPoligon, lCurPoligonStartIndex: Integer;
 | ||
| begin
 | ||
|   //
 | ||
|   // For solid paths, draw a polygon for the main internal area
 | ||
|   //
 | ||
|   // If there is a move-to in the middle of the path, we should
 | ||
|   // draw then multiple poligons
 | ||
|   //
 | ||
|   if Brush.Style <> bsClear then
 | ||
|   begin
 | ||
|     PrepareForSequentialReading;
 | ||
| 
 | ||
|     {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 | ||
|     Write(' Solid Path Internal Area');
 | ||
|     {$endif}
 | ||
|     ADest.Brush.Style := Brush.Style;
 | ||
|     ADest.Pen.Style := psClear;
 | ||
| 
 | ||
|     SetLength(MultiPoints, 1);
 | ||
|     SetLength(MultiPoints[0], Len);
 | ||
|     lCurPoligon := 0;
 | ||
|     lCurPoligonStartIndex := 0;
 | ||
| 
 | ||
|     for j := 0 to Len - 1 do
 | ||
|     begin
 | ||
|       //WriteLn('j = ', j);
 | ||
|       CurSegment := TPathSegment(Next());
 | ||
| 
 | ||
|       if (j > 0) and (CurSegment.SegmentType = stMoveTo) then
 | ||
|       begin
 | ||
|         SetLength(MultiPoints[lCurPoligon], j-lCurPoligonStartIndex);
 | ||
|         Inc(lCurPoligon);
 | ||
|         SetLength(MultiPoints, lCurPoligon+1);
 | ||
|         SetLength(MultiPoints[lCurPoligon], Len);
 | ||
|         lCurPoligonStartIndex := j;
 | ||
|       end;
 | ||
| 
 | ||
|       CoordX := CoordToCanvasX(Cur2DSegment.X);
 | ||
|       CoordY := CoordToCanvasY(Cur2DSegment.Y);
 | ||
| 
 | ||
|       MultiPoints[lCurPoligon][j-lCurPoligonStartIndex].X := CoordX;
 | ||
|       MultiPoints[lCurPoligon][j-lCurPoligonStartIndex].Y := CoordY;
 | ||
| 
 | ||
|       {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 | ||
|       Write(Format(' P%d,%d', [CoordY, CoordY]));
 | ||
|       {$endif}
 | ||
|     end;
 | ||
| 
 | ||
|     // Cut off excess from the last poligon
 | ||
|     SetLength(MultiPoints[lCurPoligon], Len-lCurPoligonStartIndex);
 | ||
| 
 | ||
|     // Draw each polygon now
 | ||
|     for j := 0 to lCurPoligon do
 | ||
|     begin
 | ||
|       ADest.Polygon(MultiPoints[j]);
 | ||
|     end;
 | ||
| 
 | ||
|     {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 | ||
|     Write(' Now the details ');
 | ||
|     {$endif}
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TPath.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   lStr: string;
 | ||
|   lCurPathSeg: TPathSegment;
 | ||
| begin
 | ||
|   lStr := Format('[%s] Name=%s Pen.Color=%s Pen.Style=%s Brush.Color=%s Brush.Style=%s'
 | ||
|     + ' Brush.Kind=%s',
 | ||
|     [Self.ClassName, Self.Name,
 | ||
|     GenerateDebugStrForFPColor(Pen.Color),
 | ||
|     GetEnumName(TypeInfo(TFPPenStyle), integer(Pen.Style)),
 | ||
|     GenerateDebugStrForFPColor(Brush.Color),
 | ||
|     GetEnumName(TypeInfo(TFPBrushStyle), integer(Brush.Style)),
 | ||
|     GetEnumName(TypeInfo(TvBrushKind), integer(Brush.Kind))
 | ||
|     ]);
 | ||
|   Result := ADestRoutine(lStr, APageItem);
 | ||
|   // Add sub-entities
 | ||
|   PrepareForSequentialReading();
 | ||
|   lCurPathSeg := Next();
 | ||
|   while lCurPathSeg <> nil do
 | ||
|   begin
 | ||
|     lCurPathSeg.GenerateDebugTree(ADestRoutine, Result);
 | ||
|     lCurPathSeg := Next();
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| { TvText }
 | ||
| 
 | ||
| function TvText.GetTextMetric_Descender_px(ADest: TFPCustomCanvas; AMulX: Double = 1.0): Integer;
 | ||
| var
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   ACanvas: TCanvas absolute ADest;
 | ||
|   tm: TLCLTextMetric;
 | ||
|   {$else}
 | ||
|   lFontSizePx: Integer;
 | ||
|   lTextSize: TSize;
 | ||
|   {$endif}
 | ||
| begin
 | ||
|   Result := 0;
 | ||
| 
 | ||
|   {$IFDEF USE_LCL_CANVAS}
 | ||
|   if ACanvas.GetTextMetrics(tm) then
 | ||
|     Result := tm.Descender;
 | ||
|   {$ELSE}
 | ||
|   lFontSizePx := Font.Size;        // is without multiplier!
 | ||
|   if lFontSizePx = 0 then lFontSizePx := 10;
 | ||
|   lTextSize := ADest.TextExtent(Str_Line_Height_Tester);
 | ||
|   Result := (lTextSize.CY - lFontSizePx) div 2;  // rough estimate only
 | ||
|   {$ENDIF}
 | ||
| end;
 | ||
| 
 | ||
| constructor TvText.Create(APage: TvPage);
 | ||
| begin
 | ||
|   inherited Create(APage);
 | ||
|   Value := TStringList.Create;
 | ||
|   Font.Color := colBlack;
 | ||
| end;
 | ||
| 
 | ||
| destructor TvText.Destroy;
 | ||
| begin
 | ||
|   Value.Free;
 | ||
|   inherited Destroy;
 | ||
| end;
 | ||
| 
 | ||
| function TvText.TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult;
 | ||
| var
 | ||
|   lProximityFactor: Integer;
 | ||
| begin
 | ||
|   lProximityFactor := ASnapFlexibility;
 | ||
|   if (APos.X > X - lProximityFactor) and (APos.X < X + lProximityFactor)
 | ||
|     and (APos.Y > Y - lProximityFactor) and (APos.Y < Y + lProximityFactor) then
 | ||
|     Result := vfrFound
 | ||
|   else Result := vfrNotFound;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvText.CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop,
 | ||
|   ARight, ABottom: Double);
 | ||
| var
 | ||
|   i: Integer;
 | ||
|   lSize: TSize;
 | ||
|   lWidth, lHeight: Integer;
 | ||
|   lRenderInfo: TvRenderInfo;
 | ||
|   lText: String;
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   ACanvas: TCanvas absolute ADest;
 | ||
|   {$endif}
 | ||
| begin
 | ||
|   //lText := Value.Text; // For debugging
 | ||
|   inherited Render(ADest, lRenderInfo, 0, 0, 1, 1, False);
 | ||
| 
 | ||
|   ALeft := X;
 | ||
|   ATop := Y;
 | ||
|   lWidth := 0;
 | ||
|   lHeight := 0;
 | ||
|   ARight := ALeft;
 | ||
|   ABottom := ATop;
 | ||
|   if (ADest = nil) or (not (ADest is TCanvas)) then Exit;
 | ||
| 
 | ||
|   for i := 0 to Value.Count-1 do
 | ||
|   begin
 | ||
|     lText := Value.Strings[i];
 | ||
|     lSize := ACanvas.TextExtent(lText);
 | ||
|     lWidth := Max(lWidth, lSize.cx);
 | ||
|     lSize := ACanvas.TextExtent(Str_Line_Height_Tester);
 | ||
|     lHeight := lHeight + lSize.cy + 2;
 | ||
|   end;
 | ||
| 
 | ||
|   ALeft := X;
 | ||
|   ATop := Y - lHeight;
 | ||
|   ARight := ALeft + lWidth;
 | ||
|   ABottom := Y;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvText.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
 | ||
|   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| const
 | ||
|   LINE_SPACING = 0.2;  // fraction of font height for line spacing
 | ||
| var
 | ||
|   i: Integer;
 | ||
|   //
 | ||
|   pt, refPt: TPoint;
 | ||
|   LowerDimY, UpperDimY, CurDimY: Double;
 | ||
|   XAnchorAdjustment: Integer;
 | ||
|   lLongestLine, lLineWidth, lFontSizePx, lFontDescenderPx: Integer;
 | ||
|   lText: string;
 | ||
|   lDescender: Integer;
 | ||
|   phi: Double;
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   ACanvas: TCanvas absolute ADest;
 | ||
|   lTextSize: TSize;
 | ||
|   lTextWidth: Integer;
 | ||
|   {$endif}
 | ||
| begin
 | ||
|   lText := Value.Text + Format(' F=%d', [ADest.Font.Size]); // for debugging
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
| 
 | ||
|   InitializeRenderInfo(ARenderInfo, Self);
 | ||
| 
 | ||
|   // Don't draw anything if we have alpha=zero
 | ||
|   if Font.Color.Alpha = 0 then Exit;
 | ||
|   ADest.Font.FPColor := AdjustColorToBackground(Font.Color, ARenderInfo);
 | ||
| 
 | ||
|   // Font metric
 | ||
|   lFontSizePx := Font.Size;        // is without multiplier!
 | ||
|   if lFontSizePx = 0 then lFontSizePx := 10;
 | ||
|   lTextSize := ADest.TextExtent(Str_Line_Height_Tester);
 | ||
|   lDescender := GetTextMetric_Descender_px(ADest, AMulX);
 | ||
| 
 | ||
|   // Angle of text rotation
 | ||
|   phi := sign(AMulY) * DegToRad(Font.Orientation);
 | ||
| 
 | ||
|   // Reference point of the entity (X,Y) in pixels
 | ||
|   // rotation center in case of rotated text
 | ||
|   refPt := Point(
 | ||
|     round(CoordToCanvasX(X, ADestX, AMulX)),
 | ||
|     round(CoordToCanvasY(Y, ADestY, AMulY))
 | ||
|   );
 | ||
| 
 | ||
|   // if an anchor is set, use it
 | ||
|   // to do this, first search for the longest line
 | ||
|   XAnchorAdjustment := 0;
 | ||
|   if TextAnchor <> vtaStart then
 | ||
|   begin
 | ||
|     lLongestLine := 0;
 | ||
|     for i := 0 to Value.Count - 1 do
 | ||
|     begin
 | ||
|       lLineWidth := ACanvas.TextWidth(Value.Strings[i]);   // contains multiplier
 | ||
|       if lLineWidth > lLongestLine then
 | ||
|         lLongestLine := lLineWidth;
 | ||
|     end;
 | ||
|     case TextAnchor of
 | ||
|       vtaMiddle : XAnchorAdjustment := -lLongestLine div 2;
 | ||
|       vtaEnd    : XAnchorAdjustment := -lLongestLine;
 | ||
|     end;
 | ||
|   end;
 | ||
| 
 | ||
|   // Begin first line at reference point and grow downwards.
 | ||
|   // ...
 | ||
|   // We need to keep the order of lines drawing correct regardless of
 | ||
|   // the drawing direction
 | ||
|   lowerDimY := refPt.Y - (lTextSize.CY - lDescender); // lowerDim.Y := refPt.Y + lFontSizePx * (1 + LINE_SPACING) * Value.Count * AMulY
 | ||
|   upperDimY := refPt.Y;
 | ||
|   curDimY := IfThen(AMulY < 0, lowerDimY, upperDimY);
 | ||
| 
 | ||
|   // TvText supports multiple lines
 | ||
|   for i := 0 to Value.Count - 1 do
 | ||
|   begin
 | ||
|     lText := Value.Strings[i];
 | ||
|     if not Render_Use_NextText_X then
 | ||
|       Render_NextText_X := refPt.X + XAnchorAdjustment;
 | ||
| 
 | ||
|     // Start point of text, rotated around the reference point
 | ||
|     pt := Point(round(Render_NextText_X), round(curDimY));  // before rotation
 | ||
|     pt := Rotate2dPoint(pt, refPt, -Phi);                   // after rotation
 | ||
| 
 | ||
|     // Paint line
 | ||
|     if ADoDraw then
 | ||
|     begin
 | ||
|       ADest.TextOut(pt.x, pt.y, lText);
 | ||
|     end;
 | ||
| 
 | ||
|     // Calc text boundaries respecting text rotation.
 | ||
|     CalcEntityCanvasMinMaxXY(ARenderInfo, pt.x, pt.y);
 | ||
|     lTextSize := ACanvas.TextExtent(lText);
 | ||
|     lTextWidth := lTextSize.cx;
 | ||
|     // Reserve vertical space for </br> and similar line ending constructs
 | ||
|     if (lText = '') then
 | ||
|       lTextSize.cy := ACanvas.TextHeight(STR_FPVECTORIAL_TEXT_HEIGHT_SAMPLE);
 | ||
|     // other end of the text
 | ||
|     pt := Point(round(Render_NextText_X) + lTextWidth, round(curDimY) + lTextSize.cy );
 | ||
|     pt := Rotate2dPoint(pt, refPt, -Phi);
 | ||
|     CalcEntityCanvasMinMaxXY(ARenderInfo, pt.x, pt.y);
 | ||
| 
 | ||
|     // Prepare next line
 | ||
|     Render_NextText_X := Render_NextText_X + lTextWidth;
 | ||
|     curDimY := IfThen(AMulY < 0,
 | ||
|       curDimY - (lFontSizePx * (1 + LINE_SPACING) * AMulY),
 | ||
|       curDimY + (lFontSizePx * (1 + LINE_SPACING) * AMulY));
 | ||
|     // wp: isn't this the same as
 | ||
|     // curDimY := curDimY + (lFontSizePx * (1 + LINE_SPACING) * abs(AMulY);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvText.GetEntityFeatures(ADest: TFPCustomCanvas; AMulX, AMulY: Double): TvEntityFeatures;
 | ||
| var
 | ||
|   ActualText: String;
 | ||
|   lHeight_px: Integer = 0;
 | ||
| begin
 | ||
|   // Calculate the total height
 | ||
|   CalculateHeightInCanvas(ADest, AMulX, AMulY, lHeight_px);
 | ||
|   Result.TotalHeight := lHeight_px;
 | ||
| 
 | ||
|   Result.DrawsUpwardHeightAdjustment := 0;
 | ||
|   if (not FPage.UseTopLeftCoordinates) then
 | ||
|     Result.DrawsUpwardHeightAdjustment := lHeight_px;
 | ||
| 
 | ||
|   Result.FirstLineHeight := 0;
 | ||
|   if (Value.Count > 0) then
 | ||
|   begin
 | ||
|     ActualText := Value.Text;
 | ||
|     Value.Text := Value.Strings[0];
 | ||
|     CalculateHeightInCanvas(ADest, AMulX, AMulY, lHeight_px);
 | ||
|     Result.FirstLineHeight := lHeight_px - GetTextMetric_Descender_px(ADest, AMulX);
 | ||
| 
 | ||
|     Value.Text := ActualText;
 | ||
|   end;
 | ||
|   Result.DrawsUpwards := True;
 | ||
| end;
 | ||
| 
 | ||
| function TvText.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   lStr, lValueStr: string;
 | ||
| begin
 | ||
|   lValueStr := GenerateDebugStrForString(Value.Text);
 | ||
|   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',
 | ||
|     [
 | ||
|     Self.ClassName, Name, X, Y, lValueStr,
 | ||
|     GenerateDebugStrForFPColor(Font.Color),
 | ||
|     Font.Size, Font.Name, Font.Orientation,
 | ||
|     BoolToStr(Font.Bold),
 | ||
|     BoolToStr(Font.Italic),
 | ||
|     BoolToStr(Font.Underline),
 | ||
|     BoolToStr(Font.StrikeThrough),
 | ||
|     GetEnumName(TypeInfo(TvTextAnchor), integer(TextAnchor))
 | ||
|   ]);
 | ||
|   Result := ADestRoutine(lStr, APageItem);
 | ||
|   // Add the style as a sub-item
 | ||
|   if Style <> nil then
 | ||
|   begin
 | ||
|     Style.GenerateDebugTree(ADestRoutine, Result);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| { TvCurvedText }
 | ||
| 
 | ||
| procedure TvCurvedText.Render(ADest: TFPCustomCanvas;
 | ||
|   var ARenderInfo: TvRenderInfo; ADestX: Integer; ADestY: Integer;
 | ||
|   AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| var
 | ||
|   i, lCharLen: Integer;
 | ||
|   lText, lUTF8Char: string;
 | ||
|   lX, lY, lTangentAngle, lTextHeight: Double;
 | ||
|   pt: TPoint;
 | ||
|   //lLeft, lTop, lWidth, lHeight: Integer;
 | ||
| begin
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, False);
 | ||
| 
 | ||
|   InitializeRenderInfo(ARenderInfo, Self);
 | ||
|        (*
 | ||
|   if not ADoDraw then
 | ||
|   begin
 | ||
|     //Path.CalculateSizeInCanvas(ADest, lLeft, lTop, lWidth, lHeight);
 | ||
|     Exit;
 | ||
|   end;   *)
 | ||
| 
 | ||
|   // Don't draw anything if we have alpha=zero
 | ||
|   if Font.Color.Alpha = 0 then Exit;
 | ||
|   if Path = nil then Exit;
 | ||
| 
 | ||
|   ADest.Font.FPColor := AdjustColorToBackground(Font.Color, ARenderInfo);
 | ||
|   if Value.Count = 0 then Exit;
 | ||
|   lText := Value.Strings[0];
 | ||
|   Render_NextText_X := CoordToCanvasX(X, ADestX, AMulX);
 | ||
| 
 | ||
|   Path.PrepareForWalking();
 | ||
|   Path.NextWalk(0, lX, lY, lTangentAngle);
 | ||
| 
 | ||
|   // render each character separately
 | ||
|   for i := 0 to UTF8Length(lText)-1 do
 | ||
|   begin
 | ||
|     lUTF8Char := UTF8Copy(lText, i+1, 1);
 | ||
|     ADest.Font.Orientation := Round(Math.radtodeg(lTangentAngle)*10);
 | ||
| 
 | ||
|     // Without adjustment the text is down bellow the path, but we want it on top of it
 | ||
|     {lTextHeight := Abs(AMulY) * ADest.TextHeight(lUTF8Char);
 | ||
|     lX := lX - Sin(Pi / 2 - lTangentAngle) * lTextHeight;
 | ||
|     lY := lY + Cos(Pi / 2 - lTangentAngle) * lTextHeight;}
 | ||
| 
 | ||
|     pt := Point(CoordToCanvasX(lX, ADestX, AMulX), CoordToCanvasY(lY, ADestY, AMulY));
 | ||
|     CalcEntityCanvasMinMaxXY(ARenderInfo, pt.x, pt.y);
 | ||
| 
 | ||
|     if ADoDraw then
 | ||
|       ADest.TextOut(pt.X, pt.Y, lUTF8Char);
 | ||
| 
 | ||
|     lCharLen := ADest.TextWidth(lUTF8Char);
 | ||
|     Path.NextWalk(lCharLen, lX, lY, lTangentAngle);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvCurvedText.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| begin
 | ||
|   Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
 | ||
|   if Path <> nil then
 | ||
|     Path.GenerateDebugTree(ADestRoutine, Result);
 | ||
| end;
 | ||
| 
 | ||
| { TvField }
 | ||
| 
 | ||
| constructor TvField.Create(APage: TvPage);
 | ||
| begin
 | ||
|   inherited Create(APage);
 | ||
| 
 | ||
|   DateFormat := 'dd/MM/yyyy hh:mm:ss';
 | ||
|   NumberFormat := vnfDecimal;
 | ||
| end;
 | ||
| 
 | ||
| { TvCircle }
 | ||
| 
 | ||
| procedure TvCircle.CalculateBoundingBox(ADest: TFPCustomCanvas;
 | ||
|   out ALeft, ATop, ARight, ABottom: Double);
 | ||
| begin
 | ||
|   ALeft := X - Radius;
 | ||
|   ARight := X + Radius;
 | ||
|   ATop := Y + Radius;
 | ||
|   ABottom := Y - Radius;
 | ||
| end;
 | ||
| 
 | ||
| function TvCircle.CreatePath: TPath;
 | ||
| begin
 | ||
|   Result := TPath.Create(FPage);
 | ||
|   Result.AppendMoveToSegment(X + Radius, Y);
 | ||
|   Result.AppendEllipticalArcWithCenter(Radius, Radius, 0, X - Radius, Y, X, Y, true);
 | ||
|   Result.AppendEllipticalArcWithCenter(Radius, Radius, 0, X + Radius, Y, X, Y, true);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvCircle.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
 | ||
|   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| var
 | ||
|   x1, y1, x2, y2: Integer;
 | ||
| begin
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
| 
 | ||
|   x1 := CoordToCanvasX(X - Radius, ADestX, AMulX);
 | ||
|   y1 := CoordToCanvasY(Y - Radius, ADestY, AMulY);
 | ||
|   x2 := CoordToCanvasX(X + Radius, ADestX, AMulX);
 | ||
|   y2 := CoordToCanvasY(Y + Radius, ADestY, AMulY);
 | ||
|   CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
 | ||
| 
 | ||
|   if ADoDraw then
 | ||
|   begin
 | ||
|     if Brush.Kind <> bkSimpleBrush then
 | ||
|       // Draw gradient and border
 | ||
|       DrawBrushGradient(ADest, ARenderInfo, x1, y1, x2, y2, ADestX, ADestY, AMulX, AMulY)
 | ||
|     else
 | ||
|       // Draw uniform fill and border
 | ||
|       DrawBrush(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMuly);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvCircle.Rotate(AAngle: Double; ABase: T3DPoint);
 | ||
| var
 | ||
|   ctr: T3dPoint;
 | ||
| begin
 | ||
|   ctr := Rotate3dPointInXY(Make3dPoint(X,Y), ABase, -AAngle);
 | ||
|     // use inverted angle due to sign convention in Rotate3DPointInXY
 | ||
|   X := ctr.X;
 | ||
|   Y := ctr.Y;
 | ||
| end;
 | ||
| 
 | ||
| 
 | ||
| { TvCircularArc }
 | ||
| 
 | ||
| procedure TvCircularArc.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
 | ||
|   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| 
 | ||
|   function CoordToCanvasX(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestX + AmulX * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CoordToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestY + AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   FinalStartAngle, FinalEndAngle: double;
 | ||
|   BoundsLeft, BoundsTop, BoundsRight, BoundsBottom,
 | ||
|    IntStartAngle, IntAngleLength, IntTmp: Integer;
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   ALCLDest: TCanvas absolute ADest;
 | ||
|   {$endif}
 | ||
| begin
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   // ToDo: Consider a X axis inversion
 | ||
|   // If the Y axis is inverted, then we need to mirror our angles as well
 | ||
|   BoundsLeft := CoordToCanvasX(X - Radius);
 | ||
|   BoundsTop := CoordToCanvasY(Y - Radius);
 | ||
|   BoundsRight := CoordToCanvasX(X + Radius);
 | ||
|   BoundsBottom := CoordToCanvasY(Y + Radius);
 | ||
|   {if AMulY > 0 then
 | ||
|   begin}
 | ||
|     FinalStartAngle := StartAngle;
 | ||
|     FinalEndAngle := EndAngle;
 | ||
|   {end
 | ||
|   else // AMulY is negative
 | ||
|   begin
 | ||
|     // Inverting the angles generates the correct result for Y axis inversion
 | ||
|     if CurArc.EndAngle = 0 then FinalStartAngle := 0
 | ||
|     else FinalStartAngle := 360 - 1* CurArc.EndAngle;
 | ||
|     if CurArc.StartAngle = 0 then FinalEndAngle := 0
 | ||
|     else FinalEndAngle := 360 - 1* CurArc.StartAngle;
 | ||
|   end;}
 | ||
|   IntStartAngle := Round(16*FinalStartAngle);
 | ||
|   IntAngleLength := Round(16*(FinalEndAngle - FinalStartAngle));
 | ||
|   // On Gtk2 and Carbon, the Left really needs to be to the Left of the Right position
 | ||
|   // The same for the Top and Bottom
 | ||
|   // On Windows it works fine either way
 | ||
|   // On Gtk2 if the positions are inverted then the arcs are screwed up
 | ||
|   // In Carbon if the positions are inverted, then the arc is inverted
 | ||
|   if BoundsLeft > BoundsRight then
 | ||
|   begin
 | ||
|     IntTmp := BoundsLeft;
 | ||
|     BoundsLeft := BoundsRight;
 | ||
|     BoundsRight := IntTmp;
 | ||
|   end;
 | ||
|   if BoundsTop > BoundsBottom then
 | ||
|   begin
 | ||
|     IntTmp := BoundsTop;
 | ||
|     BoundsTop := BoundsBottom;
 | ||
|     BoundsBottom := IntTmp;
 | ||
|   end;
 | ||
|   // Arc(ALeft, ATop, ARight, ABottom, Angle16Deg, Angle16DegLength: Integer);
 | ||
|   {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 | ||
| //    WriteLn(Format('Drawing Arc Center=%f,%f Radius=%f StartAngle=%f AngleLength=%f',
 | ||
| //      [CurArc.CenterX, CurArc.CenterY, CurArc.Radius, IntStartAngle/16, IntAngleLength/16]));
 | ||
|   {$endif}
 | ||
|   ALCLDest.Arc(
 | ||
|     BoundsLeft, BoundsTop, BoundsRight, BoundsBottom,
 | ||
|     IntStartAngle, IntAngleLength
 | ||
|     );
 | ||
|   // Debug info
 | ||
| //      {$define FPVECTORIALDEBUG}
 | ||
| //      {$ifdef FPVECTORIALDEBUG}
 | ||
| //      WriteLn(Format('Drawing Arc x1y1=%d,%d x2y2=%d,%d start=%d end=%d',
 | ||
| //        [BoundsLeft, BoundsTop, BoundsRight, BoundsBottom, IntStartAngle, IntAngleLength]));
 | ||
| //      {$endif}
 | ||
| {      ADest.TextOut(CoordToCanvasX(CurArc.CenterX), CoordToCanvasY(CurArc.CenterY),
 | ||
|     Format('R=%d S=%d L=%d', [Round(CurArc.Radius*AMulX), Round(FinalStartAngle),
 | ||
|     Abs(Round((FinalEndAngle - FinalStartAngle)))]));
 | ||
|   ADest.Pen.Color := TColor($DDDDDD);
 | ||
|   ADest.Rectangle(
 | ||
|     BoundsLeft, BoundsTop, BoundsRight, BoundsBottom);
 | ||
|   ADest.Pen.Color := clBlack;}
 | ||
|   {$endif}
 | ||
| end;
 | ||
| 
 | ||
| 
 | ||
| { TvEllipse }
 | ||
| 
 | ||
| function TvEllipse.CreatePath: TPath;
 | ||
| var
 | ||
|   p1, p2: T2dPoint;
 | ||
| begin
 | ||
|   Result := TPath.Create(FPage);
 | ||
| 
 | ||
|   CalcEllipsePoint(0,  HorzHalfAxis,VertHalfAxis, X,Y, Angle, p1.x, p1.y);
 | ||
|   CalcEllipsePoint(pi, HorzHalfAxis,VertHalfAxis, X,Y, Angle, p2.x, p2.y);
 | ||
| 
 | ||
|   Result.AppendMoveToSegment(p1.x, p1.y);
 | ||
|   Result.AppendEllipticalArcWithCenter(HorzHalfAxis, VertHalfAxis, Angle, p2.x, p2.y, X, Y, false);
 | ||
|   Result.AppendEllipticalArcWithCenter(HorzHalfAxis, VertHalfAxis, Angle, p1.x, p1.y, X, Y, false);
 | ||
| end;
 | ||
| 
 | ||
| // wp: no longer needed
 | ||
| function TvEllipse.GetLineIntersectionPoints(ACoord: Double; ACoordIsX: Boolean): TDoubleDynArray;
 | ||
| begin
 | ||
|   SetLength(Result, 2);
 | ||
|   // this is for axis-aligned ellipses
 | ||
|   // (X-Xcenter)^2 / Rx^2 + (Y-Ycenter)^2 / Ry^2 <= 1
 | ||
|   if ACoordIsX then
 | ||
|   begin
 | ||
|     // Y = sqrt( 1 - (X-Xcenter)^2 / Rx^2 ) * Ry + Ycenter
 | ||
|     Result[0] := Max(0, 1-sqr(ACoord-X) / sqr(HorzHalfAxis));
 | ||
|     Result[0] := sqrt(Result[0]) * VertHalfAxis + Y;
 | ||
|     Result[1] := Max(0, 1-sqr(ACoord-X) / sqr(HorzHalfAxis));
 | ||
|     Result[1] := -1 * sqrt(Result[1]) * VertHalfAxis + Y;
 | ||
|   end
 | ||
|   else
 | ||
|   begin
 | ||
|     Result[0] := Max(0, 1-sqr(ACoord-Y) / sqr(VertHalfAxis));
 | ||
|     Result[0] := sqrt(Result[0]) * HorzHalfAxis + X;
 | ||
|     Result[1] := Max(0, 1-sqr(ACoord-Y) / sqr(VertHalfAxis));
 | ||
|     Result[1] := -1 * sqrt(Result[1]) * HorzHalfAxis + X;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvEllipse.TryToSelect(APos: TPoint; var ASubpart: Cardinal;
 | ||
|   ASnapFlexibility: Integer): TvFindEntityResult;
 | ||
| begin
 | ||
|   // this is for axis-aligned ellipses
 | ||
|   // (X-Xcenter)^2 / Rx^2 + (Y-Ycenter)^2 / Ry^2 <= 1
 | ||
|   Result := vfrNotFound;
 | ||
|   //Result := vfrFound;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEllipse.CalculateBoundingBox(ADest: TFPCustomCanvas;
 | ||
|   out ALeft, ATop, ARight, ABottom: Double);
 | ||
| var
 | ||
|   t, tmp: Double;
 | ||
| begin
 | ||
|   { To calculate the bounding rectangle we can do this:
 | ||
| 
 | ||
|     Ellipse equations:
 | ||
|     You could try using the parametrized equations for an ellipse rotated by
 | ||
|     an arbitrary angle:
 | ||
| 
 | ||
|     x = cx + a*cos(t)*cos(Angle) - b*sin(t)*sin(Angle)
 | ||
|     y = cy + b*sin(t)*cos(Angle) + a*cos(t)*sin(Angle)
 | ||
| 
 | ||
|     You can then differentiate and solve for gradient = 0:
 | ||
|     0 = dx/dt = -a*sin(t)*cos(Angle) - b*cos(t)*sin(Angle)
 | ||
|       ==> tan(t) = -b*tan(Angle)/a
 | ||
|       ==> t = arctan(-b*tan(Angle)/a)
 | ||
|       ==> left and right corner of bounding box
 | ||
| 
 | ||
|     On the other axis:
 | ||
|     0 = dy/dt = b*cos(t)*cos(Angle) - a*sin(t)*sin(Angle)
 | ||
|       ==> tan(t) = b*cot(Angle)/a
 | ||
|       ==> t = arctan(b*cot(Angle)/a)
 | ||
|       ==> top and bottom corner of bounding box
 | ||
|   }
 | ||
|   if Angle <> 0.0 then
 | ||
|   begin
 | ||
|     t := arctan(-VertHalfAxis*tan(Angle)/HorzHalfAxis);
 | ||
|     tmp := abs(HorzHalfAxis*cos(t)*cos(Angle) - VertHalfAxis*sin(t)*sin(Angle));
 | ||
|     ALeft := X - Round(tmp);
 | ||
|     ARight := X + Round(tmp);
 | ||
|     t := arctan(VertHalfAxis*cot(Angle) / HorzHalfAxis);
 | ||
|     tmp := abs(VertHalfAxis*sin(t)*cos(Angle) + HorzHalfAxis*cos(t)*sin(Angle));
 | ||
|     ATop := Y + Round(tmp);
 | ||
|     ABottom := Y - Round(tmp);
 | ||
|   end else
 | ||
|   begin
 | ||
|     ALeft := X - HorzHalfAxis;
 | ||
|     ARight := X + HorzHalfAxis;
 | ||
|     ATop := Y + VertHalfAxis;       // wp: changed from - to +
 | ||
|     ABottom := Y - VertHalfAxis;    // ... and this from + to -
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEllipse.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
 | ||
|   ADestX, ADestY: Integer; AMulX, AMulY: Double; ADoDraw: Boolean);
 | ||
| var
 | ||
|   x1, y1, x2, y2: Integer;
 | ||
|   fx1, fx2, fy1, fy2: Double;
 | ||
| begin
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
| 
 | ||
|   CalculateBoundingBox(ADest, fx1, fy1, fx2, fy2);
 | ||
|   x1 := CoordToCanvasX(fx1, ADestX, AMulX);
 | ||
|   x2 := CoordToCanvasX(fx2, ADestX, AMulX);
 | ||
|   y1 := CoordToCanvasY(fy1, ADestY, AMulY);
 | ||
|   y2 := CoordToCanvasY(fy2, ADestY, AMulY);
 | ||
|   CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
 | ||
| 
 | ||
|   if ADoDraw then
 | ||
|   begin
 | ||
|     if Brush.Kind <> bkSimpleBrush then
 | ||
|       // Draw gradient and border
 | ||
|       DrawBrushGradient(ADest, ARenderInfo, x1, y1, x2, y2, ADestX, ADestY, AMulX, AMulY)
 | ||
|     else
 | ||
|       // Draw uniform fill and border
 | ||
|       DrawBrush(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMuly);
 | ||
| //      ADest.Ellipse(x1, y1, x2, y2);
 | ||
|   end;
 | ||
| end;
 | ||
|                                               (*
 | ||
| procedure TvEllipse.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
 | ||
|   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| 
 | ||
|   function CoordToCanvasX(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestX + AmulX * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CoordToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestY + AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   PointList: array[0..6] of TPoint;
 | ||
|   f: TPoint;
 | ||
|   dk, x1, x2, y1, y2: Integer;
 | ||
|   fx1, fy1, fx2, fy2: Double;
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   ALCLDest: TCanvas absolute ADest;
 | ||
|   {$endif}
 | ||
| begin
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
| 
 | ||
|   CalculateBoundingBox(ADest, fx1, fy1, fx2, fy2);
 | ||
|   x1 := CoordToCanvasX(fx1);
 | ||
|   x2 := CoordToCanvasX(fx2);
 | ||
|   y1 := CoordToCanvasY(fy1);
 | ||
|   y2 := CoordToCanvasY(fy2);
 | ||
| 
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   if Angle <> 0 then
 | ||
|   begin
 | ||
|     dk := Round(0.654 * Abs(y2-y1));
 | ||
|     f.x := Round(X);
 | ||
|     f.y := Round(Y - 1);
 | ||
|     PointList[0] := Rotate2DPoint(Point(x1, f.y), f, Angle) ;  // Startpoint
 | ||
|     PointList[1] := Rotate2DPoint(Point(x1,  f.y - dk), f, Angle);
 | ||
|     //Controlpoint of Startpoint first part
 | ||
|     PointList[2] := Rotate2DPoint(Point(x2- 1,  f.y - dk), f, Angle);
 | ||
|     //Controlpoint of secondpoint first part
 | ||
|     PointList[3] := Rotate2DPoint(Point(x2 -1 , f.y), f, Angle);
 | ||
|     // Firstpoint of secondpart
 | ||
|     PointList[4] := Rotate2DPoint(Point(x2-1 , f.y + dk), f, Angle);
 | ||
|     // Controllpoint of secondpart firstpoint
 | ||
|     PointList[5] := Rotate2DPoint(Point(x1, f.y +  dk), f, Angle);
 | ||
|     // Conrollpoint of secondpart endpoint
 | ||
|     PointList[6] := PointList[0];   // Endpoint of
 | ||
|      // Back to the startpoint
 | ||
|      if ADoDraw then
 | ||
|       ALCLDest.PolyBezier(Pointlist[0]);
 | ||
|   end
 | ||
|   else
 | ||
|   {$endif}
 | ||
|   begin
 | ||
|     if ADoDraw then ADest.Ellipse(x1, y1, x2, y2);
 | ||
|   end;
 | ||
|   // Apply brush gradient
 | ||
|   if x1 > x2 then
 | ||
|   begin
 | ||
|     dk := x1;
 | ||
|     x1 := x2;
 | ||
|     x2 := dk;
 | ||
|   end;
 | ||
|   if y1 > y2 then
 | ||
|   begin
 | ||
|     dk := y1;
 | ||
|     y1 := y2;
 | ||
|     y2 := dk;
 | ||
|   end;
 | ||
|   DrawBrushGradient(ADest, ARenderInfo, x1, y1, x2, y2, ADestX, ADestY, AMulX, AMulY);
 | ||
| 
 | ||
|   CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
 | ||
| end;                                            *)
 | ||
| 
 | ||
| procedure TvEllipse.Rotate(AAngle: Double; ABase: T3DPoint);
 | ||
| var
 | ||
|   ctr: T3dPoint;
 | ||
| begin
 | ||
|   ctr := Rotate3dPointInXY(Make3dPoint(X,Y), ABase, -AAngle);
 | ||
|     // use inverted angle due to sign convention in Rotate3DPointInXY
 | ||
|   X := ctr.X;
 | ||
|   Y := ctr.Y;
 | ||
|   Angle := AAngle + Angle;
 | ||
| end;
 | ||
| 
 | ||
| 
 | ||
| { TvRectangle }
 | ||
| 
 | ||
| procedure TvRectangle.CalculateBoundingBox(ADest: TFPCustomCanvas;
 | ||
|   out ALeft, ATop, ARight, ABottom: Double);
 | ||
| var
 | ||
|   pts: Array[0..3] of T3DPoint;
 | ||
|   j: Integer;
 | ||
| begin
 | ||
|   if Angle <> 0 then
 | ||
|   begin
 | ||
|     pts[0] := Make3dPoint(X, Y);  // corner points, ignoring rounded corner!
 | ||
|     pts[1] := Make3dPoint(X+CX, Y);
 | ||
|     pts[2] := Make3dPoint(X+CX, Y-CY);
 | ||
|     pts[3] := Make3dPoint(X, Y-CY);
 | ||
|     for j:=0 to High(pts) do
 | ||
|       pts[j] := Rotate3DPointInXY(pts[j], pts[0], -Angle);   // left/top is rot center!
 | ||
|       // Use inverted angle due to sign convention in Rotate3DPointInXY
 | ||
|     ALeft := pts[0].x;
 | ||
|     ARight := Pts[0].x;
 | ||
|     ATop := pts[0].y;
 | ||
|     ABottom := pts[0].y;
 | ||
|     for j:=1 to High(pts) do
 | ||
|     begin
 | ||
|       ALeft := Min(ALeft, pts[j].x);
 | ||
|       ARight := Max(ARight, pts[j].x);
 | ||
|       ATop := Max(ATop, pts[j].y);
 | ||
|       ABottom := Min(ABottom, pts[j].y);
 | ||
|     end;
 | ||
|   end else
 | ||
|   begin
 | ||
|     ALeft := X;
 | ||
|     ATop := Y;
 | ||
|     ARight := X + CX;
 | ||
|     ABottom := IfThen(FPage.FUseTopLeftCoordinates, Y + CY, Y - CY);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvRectangle.CreatePath: TPath;
 | ||
| var
 | ||
|   pts: T3dPointsArray;
 | ||
|   ctr: T3dPoint;
 | ||
|   j: Integer;
 | ||
|   phi, lYAdj: Double;
 | ||
| begin
 | ||
|   lYAdj := FPage.GetTopLeftCoords_Adjustment(); // top/left: +1, bottom/left: -1
 | ||
| 
 | ||
|   if (RX > 0) and (RY > 0) then
 | ||
|   begin
 | ||
|     SetLength(pts, 9);
 | ||
|     pts[0] := Make3dPoint(X, Y+lYAdj*RY);           {    1              2    }
 | ||
|     pts[1] := Make3dPoint(X+RX, Y);                 {  0,8                3  }
 | ||
|     pts[2] := Make3dPoint(X+CX-RX, Y);              {                        }
 | ||
|     pts[3] := Make3dPoint(X+CX, Y+lYAdj*RY);        {                        }
 | ||
|     pts[4] := Make3dPoint(X+CX, Y+lYAdj*(CY-RY));   {  7                  4  }
 | ||
|     pts[5] := Make3dPoint(X+CX-RX, Y+lYAdj*CY);     {    6              5    }
 | ||
|     pts[6] := Make3dPoint(X+RX, Y+lYAdj*CY);
 | ||
|     pts[7] := Make3dPoint(X, Y+lYAdj*(CY-RY));
 | ||
|     pts[8] := Make3dPoint(X, Y+lYAdj*RY);
 | ||
|   end
 | ||
|   else
 | ||
|   begin
 | ||
|     SetLength(pts, 5);
 | ||
|     pts[0] := Make3dPoint(X, Y);
 | ||
|     pts[1] := Make3dPoint(X+CX, Y);
 | ||
|     pts[2] := Make3dPoint(X+CX, Y+lYAdj*CY);
 | ||
|     pts[3] := Make3dPoint(X, Y+lYAdj*CY);
 | ||
|     pts[4] := Make3dPoint(X, Y);
 | ||
|   end;
 | ||
|   ctr := Make3DPoint(X, Y);  // Rotation center
 | ||
|   phi := -Angle;             // Angle must be inverted due to sign convention in Rotate3DPointInXY
 | ||
|   for j:=0 to High(pts) do
 | ||
|     pts[j] := Rotate3DPointInXY(pts[j], ctr, phi);
 | ||
| 
 | ||
|   Result := TPath.Create(FPage);
 | ||
|   if (RX > 0) and (RY > 0) then
 | ||
|   begin
 | ||
|     Result.AppendMoveToSegment(pts[0].x, pts[0].y);
 | ||
|     Result.AppendEllipticalArcWithCenter(RX, RY, phi, pts[1].x, pts[1].y,
 | ||
|       pts[1].x, pts[0].y, true);
 | ||
|     Result.AppendLineToSegment(pts[2].x, pts[2].y);
 | ||
|     Result.AppendEllipticalArcWithCenter(RX, RY, phi, pts[3].x, pts[3].y,
 | ||
|       pts[2].x, pts[3].y, true);
 | ||
|     Result.AppendLineToSegment(pts[4].x, pts[4].y);
 | ||
|     Result.AppendEllipticalArcWithCenter(RX, RY, phi, pts[5].x, pts[5].y,
 | ||
|       pts[5].x, pts[4].y, true);
 | ||
|     Result.AppendLineToSegment(pts[6].x, pts[6].y);
 | ||
|     Result.AppendEllipticalArcWithCenter(RX, RY, phi, pts[7].x, pts[7].y,
 | ||
|       pts[6].x, pts[7].y, true);
 | ||
|     Result.AppendLineToSegment(pts[8].x, pts[8].y);
 | ||
|   end else
 | ||
|   begin
 | ||
|     Result.AppendMoveToSegment(pts[0].x, pts[0].y);
 | ||
|     Result.AppendLineToSegment(pts[1].x, pts[1].y);
 | ||
|     Result.AppendLineToSegment(pts[2].x, pts[2].y);
 | ||
|     Result.AppendLineToSegment(pts[3].x, pts[3].y);
 | ||
|     Result.AppendLineToSegment(pts[4].x, pts[4].y);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvRectangle.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
 | ||
|   ADestX, ADestY: Integer; AMulX, AMulY: Double; ADoDraw: Boolean);
 | ||
| var
 | ||
|   x1, y1, x2, y2: Integer;
 | ||
|   fx1, fy1, fx2, fy2: Double;
 | ||
| begin
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
| 
 | ||
|   CalculateBoundingBox(ADest, fx1, fy1, fx2, fy2);
 | ||
|   x1 := CoordToCanvasX(fx1, ADestX, AMulX);
 | ||
|   x2 := CoordToCanvasX(fx2, ADestX, AMulX);
 | ||
|   y1 := CoordToCanvasY(fy1, ADestY, AMulY);
 | ||
|   y2 := CoordToCanvasY(fy2, ADestY, AMulY);
 | ||
|   CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
 | ||
| 
 | ||
|   if ADoDraw then
 | ||
|   begin
 | ||
|     if Brush.Kind <> bkSimpleBrush then
 | ||
|       // Draw gradient and border
 | ||
|       DrawBrushGradient(ADest, ARenderInfo, x1, y1, x2, y2, ADestX, ADestY, AMulX, AMulY)
 | ||
|     else
 | ||
|       // Draw uniform fill and border
 | ||
|       DrawBrush(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY);
 | ||
|   end;
 | ||
| end;
 | ||
|                             (*
 | ||
| procedure TvRectangle.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
 | ||
|   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| 
 | ||
|   function CoordToCanvasX(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestX + AmulX * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CoordToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestY + AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   x1, x2, y1, y2: Integer;
 | ||
|   fx1, fy1, fx2, fy2: Double;
 | ||
| begin
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
| 
 | ||
|   CalculateBoundingBox(ADest, fx1, fy1, fx2, fy2);
 | ||
|   x1 := CoordToCanvasX(fx1);
 | ||
|   x2 := CoordToCanvasX(fx2);
 | ||
|   y1 := CoordToCanvasY(fy1);
 | ||
|   y2 := CoordToCanvasY(fy2);
 | ||
| 
 | ||
|   if ADoDraw then
 | ||
|   begin
 | ||
|     {$ifdef USE_LCL_CANVAS}
 | ||
|     if (RX = 0) and (RY = 0) then
 | ||
|       ADest.Rectangle(x1, y1, x2, y2)
 | ||
|     else
 | ||
|       LCLIntf.RoundRect(TCanvas(ADest).Handle, x1, y1, x2, y2, Round(rx), Round(ry));
 | ||
|     {$else}
 | ||
|     ADest.Rectangle(x1, y1, x2, y2)
 | ||
|     {$endif}
 | ||
|   end;
 | ||
| 
 | ||
|   CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
 | ||
| end;                 *)
 | ||
| 
 | ||
| procedure TvRectangle.Rotate(AAngle: Double; ABase: T3DPoint);
 | ||
| var
 | ||
|   ref: T3dPoint;  // reference point of rectangle
 | ||
| begin
 | ||
|   ref := Rotate3dPointInXY(Make3dPoint(X, Y), ABase, -AAngle);
 | ||
|   X := ref.X;
 | ||
|   Y := ref.Y;
 | ||
|   Angle := AAngle + Angle;
 | ||
| end;
 | ||
| 
 | ||
| function TvRectangle.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   lStr: string;
 | ||
| begin
 | ||
|   Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
 | ||
|   // Add the font debug info in a sub-item
 | ||
|   lStr := Format('[TvRectangle] Text=%s CX=%f CY=%f CZ=%f RX=%f RY=%f',
 | ||
|     [Text,
 | ||
|     CX, CY, CZ,
 | ||
|     RX, RY
 | ||
|     ]);
 | ||
|   ADestRoutine(lStr, Result);
 | ||
| end;
 | ||
| 
 | ||
| { TvPolygon }
 | ||
| 
 | ||
| procedure TvPolygon.CalculateBoundingBox(ADest: TFPCustomCanvas;
 | ||
|   out ALeft, ATop, ARight, ABottom: Double);
 | ||
| var
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   inherited CalculateBoundingBox(ADest, ALeft, ATop, ARight, ABottom);
 | ||
|   for i := 0 to Length(Points)-1 do
 | ||
|   begin
 | ||
|     ALeft := Min(ALeft, Points[i].X);
 | ||
|     ATop := Min(ATop, Points[i].Y);
 | ||
|     ARight := Max(ARight, Points[i].X);
 | ||
|     ABottom := Max(ABottom, Points[i].Y);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvPolygon.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
 | ||
|   ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| var
 | ||
|   lPoints: array of TPoint;
 | ||
|   i: Integer;
 | ||
|   x1, x2, y1, y2: Integer;
 | ||
|   polystarts: TIntegerDynArray;
 | ||
|   lRect: TRect;
 | ||
|   gv1, gv2: T2DPoint;
 | ||
| begin
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
| 
 | ||
|   x1 := MaxInt;
 | ||
|   y1 := maxInt;
 | ||
|   x2 := -MaxInt;
 | ||
|   y2 := -MaxInt;
 | ||
|   SetLength(lPoints, Length(Points));
 | ||
|   for i := 0 to High(Points) do
 | ||
|   begin
 | ||
|     lPoints[i].X := CoordToCanvasX(Points[i].X, ADestX, AMulX);
 | ||
|     lPoints[i].Y := CoordToCanvasY(Points[i].Y, ADestY, AMulY);
 | ||
|     x1 := min(x1, lPoints[i].X);
 | ||
|     y1 := min(y1, lPoints[i].Y);
 | ||
|     x2 := max(x2, lPoints[i].X);
 | ||
|     y2 := max(y2, lPoints[i].Y);
 | ||
|   end;
 | ||
|   CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
 | ||
| 
 | ||
|   if ADoDraw then
 | ||
|     if (Length(lPoints) > 2) then
 | ||
|     begin
 | ||
|       case Brush.Kind of
 | ||
|         bkSimpleBrush:
 | ||
|           ADest.Polygon(lPoints);  // fills the polygon and paints the border
 | ||
|         bkHorizontalGradient,
 | ||
|         bkVerticalGradient,
 | ||
|         bkOtherLinearGradient:
 | ||
|           begin
 | ||
|             // Border will be drawn later (gradient painting needs its own pen)
 | ||
|             ADest.Pen.Style := psClear;
 | ||
|             // Boundary rect of shape to be filled by a gradient
 | ||
|             lRect := Rect(x1, y1, x2, y2);
 | ||
|             // Calculate gradient vector
 | ||
|             CalcGradientVector(gv1, gv2, lRect, ADestX, ADestY, AMulX, AMulY);
 | ||
|             // Indexes where polygon starts: no multiple polygones here
 | ||
|             SetLength(polyStarts, 1);
 | ||
|             polyStarts[0] := 0;
 | ||
|             // Draw the gradient
 | ||
|             DrawPolygonBrushLinearGradient(ADest, ARenderInfo, lPoints, polyStarts, lRect, gv1, gv2);
 | ||
|             // Draw border
 | ||
|             DrawPolygonBorderOnly(ADest, ARenderInfo, lPoints);
 | ||
|           end;
 | ||
|         bkRadialGradient:
 | ||
|           begin
 | ||
|             // Border will be drawn later (gradient painting needs its own pen)
 | ||
|             ADest.Pen.Style := psClear;
 | ||
|             // Draw the gradient
 | ||
|             DrawPolygonBrushRadialGradient(ADest, ARenderInfo, lPoints, lRect);
 | ||
|             // Draw border
 | ||
|             DrawPolygonBorderOnly(ADest, ARenderInfo, lPoints);
 | ||
|           end;
 | ||
|       end;
 | ||
|     end;
 | ||
| end;
 | ||
| 
 | ||
| 
 | ||
| { TvAlignedDimension }
 | ||
| 
 | ||
| procedure TvAlignedDimension.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
 | ||
|   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| 
 | ||
|   function CoordToCanvasX(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestX + AmulX * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CoordToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestY + AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   Points: array of TPoint;
 | ||
|   UpperDim, LowerDim: T3DPoint;
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   ALCLDest: TCanvas absolute ADest;
 | ||
|   {$endif}
 | ||
|   txt: String;
 | ||
| begin
 | ||
|   ADest.Pen.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
 | ||
|   ADest.Pen.Width := 1;
 | ||
|   ADest.Pen.Style := psSolid;
 | ||
|   //
 | ||
|   // Draws this shape:
 | ||
|   // horizontal     vertical
 | ||
|   // ___
 | ||
|   // | |     or   ---| X cm
 | ||
|   //   |           --|
 | ||
|   // Which marks the dimension
 | ||
|   ADest.MoveTo(CoordToCanvasX(BaseRight.X), CoordToCanvasY(BaseRight.Y));
 | ||
|   ADest.LineTo(CoordToCanvasX(DimensionRight.X), CoordToCanvasY(DimensionRight.Y));
 | ||
|   ADest.LineTo(CoordToCanvasX(DimensionLeft.X), CoordToCanvasY(DimensionLeft.Y));
 | ||
|   ADest.LineTo(CoordToCanvasX(BaseLeft.X), CoordToCanvasY(BaseLeft.Y));
 | ||
|   // Now the arrows
 | ||
|   // horizontal
 | ||
|   SetLength(Points, 3);
 | ||
|   if DimensionRight.Y = DimensionLeft.Y then
 | ||
|   begin
 | ||
|     ADest.Brush.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
 | ||
|     ADest.Brush.Style := bsSolid;
 | ||
|     // Left arrow
 | ||
|     Points[0] := Point(CoordToCanvasX(DimensionLeft.X), CoordToCanvasY(DimensionLeft.Y));
 | ||
|     Points[1] := Point(Points[0].X + 7, Points[0].Y - 3);
 | ||
|     Points[2] := Point(Points[0].X + 7, Points[0].Y + 3);
 | ||
|     CalcEntityCanvasMinMaxXY(ARenderInfo, Points[0].X, Points[1].Y);
 | ||
|     if ADoDraw then ADest.Polygon(Points);
 | ||
|     // Right arrow
 | ||
|     Points[0] := Point(CoordToCanvasX(DimensionRight.X), CoordToCanvasY(DimensionRight.Y));
 | ||
|     Points[1] := Point(Points[0].X - 7, Points[0].Y - 3);
 | ||
|     Points[2] := Point(Points[0].X - 7, Points[0].Y + 3);
 | ||
|     CalcEntityCanvasMinMaxXY(ARenderInfo, Points[0].X, Points[2].Y);
 | ||
|     if ADoDraw then ADest.Polygon(Points);
 | ||
|     ADest.Brush.Style := bsClear;
 | ||
|     // Dimension text
 | ||
|     LowerDim.X := DimensionRight.X-DimensionLeft.X;
 | ||
|     ADest.Font.Size := 10;
 | ||
|     ADest.Font.Orientation := 0;
 | ||
|     ADest.Font.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
 | ||
|     txt := Format('%.1f', [LowerDim.X]);
 | ||
|     Points[0].X := CoordToCanvasX((DimensionLeft.X+DimensionRight.X)/2)-ADest.TextWidth(txt) div 2;
 | ||
|     Points[0].Y := CoordToCanvasY(DimensionLeft.Y);
 | ||
|     if ADoDraw then
 | ||
|       ADest.TextOut(Points[0].X, Points[0].Y-Round(ADest.Font.Size*1.5), txt);
 | ||
|     CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo,
 | ||
|       Points[0].X, Points[0].Y - round(ADest.Font.Size*1.5),
 | ||
|       Points[0].X + ADest.TextWidth(txt), Points[0].Y);
 | ||
|   end
 | ||
|   else
 | ||
|   begin
 | ||
|     ADest.Brush.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
 | ||
|     ADest.Brush.Style := bsSolid;
 | ||
|     // There is no upper/lower preference for DimensionLeft/Right, so we need to check
 | ||
|     if DimensionLeft.Y > DimensionRight.Y then
 | ||
|     begin
 | ||
|       UpperDim := DimensionLeft;
 | ||
|       LowerDim := DimensionRight;
 | ||
|     end
 | ||
|     else
 | ||
|     begin
 | ||
|       UpperDim := DimensionRight;
 | ||
|       LowerDim := DimensionLeft;
 | ||
|     end;
 | ||
|     // Upper arrow
 | ||
|     Points[0] := Point(CoordToCanvasX(UpperDim.X), CoordToCanvasY(UpperDim.Y));
 | ||
|     Points[1] := Point(Points[0].X + Round(AMulX), Points[0].Y - Round(AMulY*3));
 | ||
|     Points[2] := Point(Points[0].X - Round(AMulX), Points[0].Y - Round(AMulY*3));
 | ||
|     if ADoDraw then ADest.Polygon(Points);
 | ||
|     CalcEntityCanvasMinMaxXY(ARenderInfo, Points[1].X, Points[0].Y);
 | ||
|     // Lower arrow
 | ||
|     Points[0] := Point(CoordToCanvasX(LowerDim.X), CoordToCanvasY(LowerDim.Y));
 | ||
|     Points[1] := Point(Points[0].X + Round(AMulX), Points[0].Y + Round(AMulY*3));
 | ||
|     Points[2] := Point(Points[0].X - Round(AMulX), Points[0].Y + Round(AMulY*3));
 | ||
|     if ADoDraw then ADest.Polygon(Points);
 | ||
|     CalcEntityCanvasMinMaxXY(ARenderInfo, Points[2].X, Points[0].Y);
 | ||
|     ADest.Brush.Style := bsClear;
 | ||
|     // Dimension text
 | ||
|     LowerDim.Y := DimensionRight.Y-DimensionLeft.Y;
 | ||
|     if LowerDim.Y < 0 then LowerDim.Y := -1 * LowerDim.Y;
 | ||
|     ADest.Font.Size := 10;
 | ||
|     ADest.Font.Orientation := 900;
 | ||
|     ADest.Font.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
 | ||
|     txt := Format('%.1f', [LowerDim.Y]);
 | ||
|     Points[0].X := CoordToCanvasX(DimensionLeft.X);
 | ||
|     Points[0].Y := CoordToCanvasY((DimensionLeft.Y+DimensionRight.Y)/2)
 | ||
|       - sign(AMulY) * ADest.TextWidth(txt) div 2;
 | ||
|     if ADoDraw then
 | ||
|       ADest.TextOut(Points[0].X-Round(ADest.Font.Size*1.5), Points[0].Y, txt);
 | ||
|     ADest.Font.Orientation := 0;
 | ||
|     CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo,
 | ||
|       Points[0].X - Round(ADest.Font.Size*1.5), Points[0].Y,
 | ||
|       Points[0].X, Points[0].Y + ADest.TextWidth(txt)
 | ||
|       );
 | ||
|   end;
 | ||
|   SetLength(Points, 0);
 | ||
| 
 | ||
|   {$IFDEF FPVECTORIAL_DEBUG_DIMENSIONS}
 | ||
|   WriteLn(Format('[TvAlignedDimension.Render] BaseRightXY=%f | %f DimensionRightXY=%f | %f DimensionLeftXY=%f | %f',
 | ||
|     [BaseRight.X, BaseRight.Y, DimensionRight.X, DimensionRight.Y, DimensionLeft.X, DimensionLeft.Y]));
 | ||
|   {$ENDIF}
 | ||
| 
 | ||
| {      // Debug info
 | ||
|   ADest.TextOut(CoordToCanvasX(CurDim.BaseRight.X), CoordToCanvasY(CurDim.BaseRight.Y), 'BR');
 | ||
|   ADest.TextOut(CoordToCanvasX(CurDim.DimensionRight.X), CoordToCanvasY(CurDim.DimensionRight.Y), 'DR');
 | ||
|   ADest.TextOut(CoordToCanvasX(CurDim.DimensionLeft.X), CoordToCanvasY(CurDim.DimensionLeft.Y), 'DL');
 | ||
|   ADest.TextOut(CoordToCanvasX(CurDim.BaseLeft.X), CoordToCanvasY(CurDim.BaseLeft.Y), 'BL');}
 | ||
| end;
 | ||
| 
 | ||
| function TvAlignedDimension.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   lStr: string;
 | ||
| begin
 | ||
|   Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
 | ||
|   // Add the font debug info in a sub-item
 | ||
|   lStr := Format('[TvAlignedDimension] BaseLeft=%f %f BaseRight=%f %f DimensionLeft=%f %f DimensionRight=%f %f',
 | ||
|     [BaseLeft.X, BaseLeft.Y,
 | ||
|      BaseRight.X, BaseRight.Y,
 | ||
|      DimensionLeft.X, DimensionLeft.Y,
 | ||
|      DimensionRight.X, DimensionRight.Y
 | ||
|     ]);
 | ||
|   ADestRoutine(lStr, Result);
 | ||
| end;
 | ||
| 
 | ||
| { TvRadialDimension }
 | ||
| 
 | ||
| procedure TvRadialDimension.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
 | ||
|   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| 
 | ||
|   function CoordToCanvasX(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestX + AmulX * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CoordToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestY + AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   Points: array of TPoint;
 | ||
|   lAngle, lRadius: Double;
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   ALCLDest: TCanvas absolute ADest;
 | ||
|   {$endif}
 | ||
| begin
 | ||
|   ADest.Pen.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
 | ||
|   ADest.Pen.Width := 1;
 | ||
|   ADest.Pen.Style := psSolid;
 | ||
| 
 | ||
|   // The size of the radius of the circle
 | ||
|   lRadius := sqrt(sqr(Center.X - DimensionLeft.X) + sqr(Center.Y - DimensionLeft.Y));
 | ||
|   // The angle to the first dimension
 | ||
|   lAngle := arctan((DimensionLeft.Y - Center.Y) / (DimensionLeft.X - Center.X));
 | ||
| 
 | ||
|   // Get an arrow in the right part of the circle
 | ||
|   SetLength(Points, 3);
 | ||
|   ADest.Brush.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
 | ||
|   ADest.Brush.Style := bsSolid;
 | ||
|   Points[0] := Point(CoordToCanvasX(Center.X + lRadius),     CoordToCanvasY(Center.Y));
 | ||
|   Points[1] := Point(CoordToCanvasX(Center.X + lRadius*0.8), CoordToCanvasY(Center.Y - lRadius*0.1));
 | ||
|   Points[2] := Point(CoordToCanvasX(Center.X + lRadius*0.8), CoordToCanvasY(Center.Y + lRadius*0.1));
 | ||
|   // Now rotate it to the actual position
 | ||
|   Points[0] := Rotate2DPoint(Points[0], Point(CoordToCanvasX(Center.X), CoordToCanvasY(Center.Y)),  lAngle);
 | ||
|   Points[1] := Rotate2DPoint(Points[1], Point(CoordToCanvasX(Center.X),  CoordToCanvasY(Center.Y)), lAngle);
 | ||
|   Points[2] := Rotate2DPoint(Points[2], Point(CoordToCanvasX(Center.X),  CoordToCanvasY(Center.Y)), lAngle);
 | ||
| 
 | ||
|   if ADoDraw then
 | ||
|   begin
 | ||
|     if not IsDiameter then
 | ||
|     begin
 | ||
|       // Basic line
 | ||
|       ADest.MoveTo(CoordToCanvasX(Center.X), CoordToCanvasY(Center.Y));
 | ||
|       ADest.LineTo(CoordToCanvasX(DimensionLeft.X), CoordToCanvasY(DimensionLeft.Y));
 | ||
| 
 | ||
|       // Draw the arrow
 | ||
|       ADest.Polygon(Points);
 | ||
|       ADest.Brush.Style := bsClear;
 | ||
| 
 | ||
|       // Dimension text
 | ||
|       Points[0].X := CoordToCanvasX(Center.X);
 | ||
|       Points[0].Y := CoordToCanvasY(Center.Y);
 | ||
|       ADest.Font.Size := 10;
 | ||
|       ADest.Font.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
 | ||
|       ADest.TextOut(Points[0].X, Points[0].Y, Format('%.1f', [lRadius]));
 | ||
|     end
 | ||
|     else
 | ||
|     begin
 | ||
|       // Basic line
 | ||
|       ADest.MoveTo(CoordToCanvasX(DimensionLeft.X), CoordToCanvasY(DimensionLeft.Y));
 | ||
|       ADest.LineTo(CoordToCanvasX(DimensionRight.X), CoordToCanvasY(DimensionRight.Y));
 | ||
| 
 | ||
|       // Draw the first arrow
 | ||
|       ADest.Polygon(Points);
 | ||
|       ADest.Brush.Style := bsClear;
 | ||
| 
 | ||
|       // And the second
 | ||
|       Points[0] := Point(CoordToCanvasX(Center.X + lRadius),     CoordToCanvasY(Center.Y));
 | ||
|       Points[1] := Point(CoordToCanvasX(Center.X + lRadius*0.8), CoordToCanvasY(Center.Y - lRadius*0.1));
 | ||
|       Points[2] := Point(CoordToCanvasX(Center.X + lRadius*0.8), CoordToCanvasY(Center.Y + lRadius*0.1));
 | ||
|       // Now rotate it to the actual position
 | ||
|       Points[0] := Rotate2DPoint(Points[0], Point(CoordToCanvasX(Center.X), CoordToCanvasY(Center.Y)),  lAngle + Pi);
 | ||
|       Points[1] := Rotate2DPoint(Points[1], Point(CoordToCanvasX(Center.X),  CoordToCanvasY(Center.Y)), lAngle + Pi);
 | ||
|       Points[2] := Rotate2DPoint(Points[2], Point(CoordToCanvasX(Center.X),  CoordToCanvasY(Center.Y)), lAngle + Pi);
 | ||
|       //
 | ||
|       ADest.Polygon(Points);
 | ||
|       ADest.Brush.Style := bsClear;
 | ||
| 
 | ||
|       // Dimension text
 | ||
|       Points[0].X := CoordToCanvasX(Center.X);
 | ||
|       Points[0].Y := CoordToCanvasY(Center.Y);
 | ||
|       ADest.Font.Size := 10;
 | ||
|       ADest.Font.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
 | ||
|       ADest.TextOut(Points[0].X, Points[0].Y, Format('%.1f', [lRadius * 2]));
 | ||
|     end;
 | ||
|   end;
 | ||
| 
 | ||
|   SetLength(Points, 0);
 | ||
| end;
 | ||
| 
 | ||
| function TvRadialDimension.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   lStr, lIsDiameterStr: string;
 | ||
| begin
 | ||
|   Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
 | ||
|   // Add the font debug info in a sub-item
 | ||
|   if IsDiameter then lIsDiameterStr := 'true' else lIsDiameterStr := 'false';
 | ||
|   lStr := Format('[TvAlignedDimension] IsDiameter=%s Center=%f %f DimensionLeft=%f %f DimensionRight=%f %f',
 | ||
|     [lIsDiameterStr,
 | ||
|      Center.X, Center.Y,
 | ||
|      DimensionLeft.X, DimensionLeft.Y,
 | ||
|      DimensionRight.X, DimensionRight.Y
 | ||
|     ]);
 | ||
|   ADestRoutine(lStr, Result);
 | ||
| end;
 | ||
| 
 | ||
| { TvArcDimension }
 | ||
| 
 | ||
| procedure TvArcDimension.Render(ADest: TFPCustomCanvas;
 | ||
|   var ARenderInfo: TvRenderInfo; ADestX: Integer; ADestY: Integer; AMulX: Double;
 | ||
|   AMulY: Double; ADoDraw: Boolean);
 | ||
| 
 | ||
|   function CoordToCanvasX(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestX + AmulX * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CoordToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestY + AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   Points: array of TPoint;
 | ||
|   lTriangleCenter, lTriangleCorner: T3DPoint;
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   ALCLDest: TCanvas absolute ADest;
 | ||
|   {$endif}
 | ||
|   txt: String;
 | ||
| begin
 | ||
|   ADest.Pen.FPColor := colYellow;//AdjustColorToBackground(colBlack, ARenderInfo);
 | ||
|   ADest.Pen.Width := 1;
 | ||
|   ADest.Pen.Style := psSolid;
 | ||
| 
 | ||
|   // Debug lines
 | ||
|   //ADest.Line(CoordToCanvasX(BaseLeft.X), CoordToCanvasY(BaseLeft.Y), CoordToCanvasX(DimensionLeft.X), CoordToCanvasY(DimensionLeft.Y));
 | ||
|   //ADest.Line(CoordToCanvasX(BaseRight.X), CoordToCanvasY(BaseRight.Y), CoordToCanvasX(DimensionRight.X), CoordToCanvasY(DimensionRight.Y));
 | ||
| 
 | ||
|   // Now the arc
 | ||
|   if ADoDraw then
 | ||
|     ALCLDest.Arc(
 | ||
|       CoordToCanvasX(BaseLeft.X - ArcRadius), CoordToCanvasY(BaseLeft.Y - ArcRadius),
 | ||
|       CoordToCanvasX(BaseLeft.X + ArcRadius), CoordToCanvasY(BaseLeft.Y + ArcRadius),
 | ||
|       CoordToCanvasX(DimensionRight.X), CoordToCanvasY(DimensionRight.Y),
 | ||
|       CoordToCanvasX(DimensionLeft.X),  CoordToCanvasY(DimensionLeft.Y));
 | ||
| 
 | ||
|   // Now the arrows
 | ||
|   SetLength(Points, 3);
 | ||
|   CalculateExtraArcInfo();
 | ||
|   ADest.Brush.FPColor := colYellow;//AdjustColorToBackground(colBlack, ARenderInfo);
 | ||
|   ADest.Brush.Style := bsSolid;
 | ||
| 
 | ||
|   // Left Arrow
 | ||
|   Points[0] := Point(CoordToCanvasX(ArcLeft.X), CoordToCanvasY(ArcLeft.Y));
 | ||
|   lTriangleCenter.X := Cos(AngleLeft+Pi/2) * -(ArcRadius/10) + ArcLeft.X;
 | ||
|   lTriangleCenter.Y := Sin(AngleLeft+Pi/2) * -(ArcRadius/10) + ArcLeft.Y;
 | ||
|   lTriangleCorner := Rotate3DPointInXY(lTriangleCenter, ArcLeft, Pi * 10 / 180);
 | ||
|   Points[1] := Point(CoordToCanvasX(lTriangleCorner.X), CoordToCanvasY(lTriangleCorner.Y));
 | ||
|   lTriangleCorner := Rotate3DPointInXY(lTriangleCenter, ArcLeft, - Pi * 10 / 180);
 | ||
|   Points[2] := Point(CoordToCanvasX(lTriangleCorner.X), CoordToCanvasY(lTriangleCorner.Y));
 | ||
|   if ADoDraw then
 | ||
|     ADest.Polygon(Points);
 | ||
| 
 | ||
|   // Right Arrow
 | ||
|   Points[0] := Point(CoordToCanvasX(ArcRight.X), CoordToCanvasY(ArcRight.Y));
 | ||
|   lTriangleCenter.X := Cos(AngleRight+Pi/2) * (ArcRadius/10) + ArcRight.X;
 | ||
|   lTriangleCenter.Y := Sin(AngleRight+Pi/2) * (ArcRadius/10) + ArcRight.Y;
 | ||
|   lTriangleCorner := Rotate3DPointInXY(lTriangleCenter, ArcRight, Pi * 10 / 180);
 | ||
|   Points[1] := Point(CoordToCanvasX(lTriangleCorner.X), CoordToCanvasY(lTriangleCorner.Y));
 | ||
|   lTriangleCorner := Rotate3DPointInXY(lTriangleCenter, ArcRight, - Pi * 10 / 180);
 | ||
|   Points[2] := Point(CoordToCanvasX(lTriangleCorner.X), CoordToCanvasY(lTriangleCorner.Y));
 | ||
|   ADest.Polygon(Points);
 | ||
|   if ADoDraw then
 | ||
|     ADest.Brush.Style := bsClear;
 | ||
| 
 | ||
|   // Dimension text
 | ||
|   Points[0].X := CoordToCanvasX(TextPos.X);
 | ||
|   Points[0].Y := CoordToCanvasY(TextPos.Y);
 | ||
|   ADest.Font.Size := 10;
 | ||
|   ADest.Font.Orientation := 0;
 | ||
|   ADest.Font.FPColor := colYellow;//AdjustColorToBackground(colBlack, ARenderInfo);
 | ||
|   txt := Format('%.1fº', [ArcValue]);
 | ||
|   if ADoDraw then
 | ||
|     ADest.TextOut(Points[0].X, Points[0].Y-Round(ADest.Font.Size*1.5), txt);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvArcDimension.CalculateExtraArcInfo;
 | ||
| begin
 | ||
|   // Line equation of the Left line
 | ||
|   AngleLeft := arctan(Abs(BaseLeft.Y-DimensionLeft.Y)/Abs(BaseLeft.X-DimensionLeft.X));
 | ||
|   if DimensionLeft.X<BaseLeft.X then AngleLeft := Pi-AngleLeft;
 | ||
|   al := Tan(AngleLeft);
 | ||
|   bl := BaseLeft.Y - al * BaseLeft.X;
 | ||
| 
 | ||
|   // Line equation of the Right line
 | ||
|   AngleRight := arctan(Abs(BaseRight.Y-DimensionRight.Y)/Abs(BaseRight.X-DimensionRight.X));
 | ||
|   if DimensionRight.X<BaseRight.X then AngleRight := Pi-AngleRight;
 | ||
|   ar := Tan(AngleRight);
 | ||
|   br := BaseRight.Y - ar * BaseRight.X;
 | ||
| 
 | ||
|   // The lines meet at the AngleBase
 | ||
|   AngleBase.X := (bl - br) / (ar - al);
 | ||
|   AngleBase.Y := al * AngleBase.X + bl;
 | ||
| 
 | ||
|   //  And also now the left and right points of the arc
 | ||
|   ArcLeft.X := Cos(AngleLeft) * ArcRadius + AngleBase.X;
 | ||
|   ArcLeft.Y := Sin(AngleLeft) * ArcRadius + AngleBase.Y;
 | ||
|   ArcRight.X := Cos(AngleRight) * ArcRadius + AngleBase.X;
 | ||
|   ArcRight.Y := Sin(AngleRight) * ArcRadius + AngleBase.Y;
 | ||
| end;
 | ||
| 
 | ||
| function TvArcDimension.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   lStr: string;
 | ||
| begin
 | ||
|   Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
 | ||
|   // Add the font debug info in a sub-item
 | ||
|   lStr := Format('[TvArcDimension] ArcValue=%f ArcRadius=%f TextPos=%f %f BaseLeft=%f %f BaseRight=%f %f DimensionLeft=%f %f DimensionRight=%f %f',
 | ||
|     [ArcValue, ArcRadius,
 | ||
|      TextPos.X, TextPos.Y,
 | ||
|      BaseLeft.X, BaseLeft.Y,
 | ||
|      BaseRight.X, BaseRight.Y,
 | ||
|      DimensionLeft.X, DimensionLeft.Y,
 | ||
|      DimensionRight.X, DimensionRight.Y
 | ||
|     ]);
 | ||
|   ADestRoutine(lStr, Result);
 | ||
| end;
 | ||
| 
 | ||
| { TvRasterImage }
 | ||
| 
 | ||
| destructor TvRasterImage.Destroy;
 | ||
| begin
 | ||
|   if Assigned(RasterImage) then RasterImage.Free;
 | ||
|   inherited Destroy;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvRasterImage.CalculateBoundingBox(ADest: TFPCustomCanvas;
 | ||
|   out ALeft, ATop, ARight, ABottom: Double);
 | ||
| begin
 | ||
|   ALeft := X;
 | ||
|   ATop := Y;
 | ||
|   ARight := X + Width;
 | ||
|   ABottom := Y + Height;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvRasterImage.CreateRGB888Image(AWidth, AHeight: Cardinal);
 | ||
| {$ifdef USE_LCL_CANVAS}
 | ||
| var
 | ||
|   AImage: TLazIntfImage;
 | ||
|   lRawImage: TRawImage;
 | ||
| {$endif}
 | ||
| begin
 | ||
| {$ifdef USE_LCL_CANVAS}
 | ||
|   lRawImage.Init;
 | ||
|   lRawImage.Description.Init_BPP24_R8G8B8_BIO_TTB(AWidth, AHeight);
 | ||
|   lRawImage.CreateData(True);
 | ||
|   AImage := TLazIntfImage.Create(AWidth, AHeight);
 | ||
|   AImage.SetRawImage(lRawImage);
 | ||
| 
 | ||
|   RasterImage := AImage;
 | ||
| {$endif}
 | ||
| end;
 | ||
| 
 | ||
| procedure TvRasterImage.CreateImageFromFile(AFilename: string);
 | ||
| {$ifdef USE_LCL_CANVAS}
 | ||
| var
 | ||
|   AImage: TLazIntfImage;
 | ||
|   lRawImage: TRawImage;
 | ||
| {$endif}
 | ||
| begin
 | ||
| {$ifdef USE_LCL_CANVAS}
 | ||
|   lRawImage.Init;
 | ||
|   lRawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(0,0);
 | ||
|   lRawImage.CreateData(false);
 | ||
|   AImage := TLazIntfImage.Create(0,0);
 | ||
|   AImage.SetRawImage(lRawImage);
 | ||
|   AImage.LoadFromFile(AFilename);
 | ||
| 
 | ||
|   RasterImage := AImage;
 | ||
| {$endif}
 | ||
| end;
 | ||
| 
 | ||
| procedure TvRasterImage.CreateImageFromStream(AStream: TStream; Handler:TFPCustomImageReader);
 | ||
| {$ifdef USE_LCL_CANVAS}
 | ||
| var
 | ||
|   AImage: TLazIntfImage;
 | ||
|   lRawImage: TRawImage;
 | ||
| {$endif}
 | ||
| begin
 | ||
| {$ifdef USE_LCL_CANVAS}
 | ||
|   lRawImage.Init;
 | ||
|   lRawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(0,0);
 | ||
|   lRawImage.CreateData(false);
 | ||
|   AImage := TLazIntfImage.Create(0,0);
 | ||
|   AImage.SetRawImage(lRawImage);
 | ||
|   AImage.LoadFromStream(AStream, Handler);
 | ||
| 
 | ||
|   RasterImage := AImage;
 | ||
| {$endif}
 | ||
| end;
 | ||
| 
 | ||
| procedure TvRasterImage.InitializeWithConvertionOf3DPointsToHeightMap(APage: TvVectorialPage; AWidth, AHeight: Integer);
 | ||
| var
 | ||
|   lEntity: TvEntity;
 | ||
|   i: Integer;
 | ||
|   lPos: TPoint;
 | ||
|   lValue: TFPColor;
 | ||
|   PreviousValue: Word;
 | ||
|   PreviousCount: Integer;
 | ||
| begin
 | ||
|   lValue := colBlack;
 | ||
| 
 | ||
|   // First setup the map and initialize it
 | ||
|   if RasterImage <> nil then RasterImage.Free;
 | ||
|   RasterImage := TFPMemoryImage.create(AWidth, AHeight);
 | ||
| 
 | ||
|   // Now go through all points and attempt to fit them to our grid
 | ||
|   for i := 0 to APage.GetEntitiesCount - 1 do
 | ||
|   begin
 | ||
|     lEntity := APage.GetEntity(i);
 | ||
|     if lEntity is TvPoint then
 | ||
|     begin
 | ||
|       lPos.X := Round((lEntity.X - APage.MinX) * AWidth / (APage.MaxX - APage.MinX));
 | ||
|       lPos.Y := Round((lEntity.Y - APage.MinY) * AHeight / (APage.MaxY - APage.MinY));
 | ||
| 
 | ||
|       if lPos.X >= AWidth then lPos.X := AWidth-1;
 | ||
|       if lPos.Y >= AHeight then lPos.Y := AHeight-1;
 | ||
|       if lPos.X < 0 then lPos.X := 0;
 | ||
|       if lPos.Y < 0 then lPos.Y := 0;
 | ||
| 
 | ||
|       // Calculate the height of this point
 | ||
|       PreviousValue := lValue.Red;
 | ||
|       lValue.Red := Round((lEntity.Z - APage.MinZ) * $FFFF / (APage.MaxZ - APage.MinZ));
 | ||
| 
 | ||
|       // And apply it as a fraction of the total number of points which fall in this square
 | ||
|       // we store the number of points in the Alpha channel
 | ||
|       PreviousCount := lValue.Alpha div $100;
 | ||
|       lValue.Red := Round((PreviousCount * PreviousValue + lValue.Red) / (PreviousCount + 1));
 | ||
| 
 | ||
|       lValue.Green := lValue.Red;
 | ||
|       lValue.Blue := lValue.Red;
 | ||
|       lValue.Alpha := lValue.Alpha + $100;
 | ||
|       //lValue.alpha:=;
 | ||
|       RasterImage.Colors[lPos.X, lPos.Y] := lValue;
 | ||
|     end;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvRasterImage.Render(ADest: TFPCustomCanvas;
 | ||
|   var ARenderInfo: TvRenderInfo; ADestX: Integer; ADestY: Integer; AMulX: Double;
 | ||
|   AMulY: Double; ADoDraw: Boolean);
 | ||
| 
 | ||
|   function CoordToCanvasX(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestX + AmulX * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CoordToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestY + AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   lFinalX, lFinalY, lFinalW, lFinalH: Integer;
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   lBitmap: TBitmap;
 | ||
|   lMemoryStream: TMemoryStream;
 | ||
|   lImageWriter: TFPWriterBMP;
 | ||
|   {$endif}
 | ||
| begin
 | ||
|   if (RasterImage = nil) then Exit;
 | ||
|   if (RasterImage.Width = 0) or (RasterImage.Height = 0) then Exit;
 | ||
| 
 | ||
|   lFinalX := CoordToCanvasX(X);
 | ||
|   lFinalY := CoordToCanvasY(Y);
 | ||
| 
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   lBitmap := TBitmap.Create;
 | ||
|   lMemoryStream := TMemoryStream.Create;
 | ||
|   lImageWriter := TFPWriterBMP.Create;
 | ||
|   try
 | ||
|     // Previous try, but didn't work for some particular PNG images =(
 | ||
|     // For example: qr_www_lazarus_freepascal_org.svg
 | ||
|     // The image appeared corrupted in Qt, as if with wrong pixel format =(
 | ||
|     // It also didn't work in Gtk at all due to not matching Gdk format =(
 | ||
|     // But if it worked it would have been faster =)
 | ||
|     // Old code:
 | ||
|     // lBitmap.LoadFromIntfImage(TLazIntfImage(RasterImage));
 | ||
|     // New code:
 | ||
|     RasterImage.SaveToStream(lMemoryStream, lImageWriter);
 | ||
|     lMemoryStream.Position := 0;
 | ||
|     lBitmap.LoadFromStream(lMemoryStream);
 | ||
| 
 | ||
|     // without stretch support
 | ||
|     //TCanvas(ADest).Draw(lFinalX, lFinalY, lBitmap);
 | ||
| 
 | ||
|     // with stretch support
 | ||
|     lFinalW := Round(Width * AMulX);
 | ||
|     if lFinalW < 0 then lFinalW := lFinalW * -1;
 | ||
|     lFinalH := Round(Height * AMulY);
 | ||
|     if lFinalH < 0 then lFinalH := lFinalH * -1;
 | ||
|     if ADoDraw then
 | ||
|       TCanvas(ADest).StretchDraw(Bounds(lFinalX, lFinalY, lFinalW, lFinalH), lBitmap);
 | ||
|   finally
 | ||
|     lImageWriter.Free;
 | ||
|     lMemoryStream.Free;
 | ||
|     lBitmap.Free;
 | ||
|   end;
 | ||
|   {$endif}
 | ||
| 
 | ||
|   CalcEntityCanvasMinMaxXY(ARenderInfo, lFinalX, lFinalY);
 | ||
|   CalcEntityCanvasMinMaxXY(ARenderInfo, lFinalX+lFinalW, lFinalY+lFinalH);
 | ||
| 
 | ||
|   //ADest.Draw(lFinalX, lFinalY, RasterImage); doesnt work
 | ||
| end;
 | ||
| 
 | ||
| function TvRasterImage.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   lStr: string;
 | ||
| begin
 | ||
|   Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
 | ||
|   // Add the debug info in a sub-item
 | ||
|   if RasterImage <> nil then
 | ||
|   begin
 | ||
|     lStr := Format('[TvRasterImage] Width=%f Height=%f RasterImage.Width=%d RasterImage.Height=%d AltText=%s',
 | ||
|       [Width, Height, RasterImage.Width, RasterImage.Height, AltText]);
 | ||
|     ADestRoutine(lStr, Result);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| { TvArrow }
 | ||
| 
 | ||
| procedure TvArrow.CalculateBoundingBox(ADest: TFPCustomCanvas;
 | ||
|   out ALeft, ATop, ARight, ABottom: Double);
 | ||
| begin
 | ||
| 
 | ||
| end;
 | ||
| 
 | ||
| procedure TvArrow.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
 | ||
|   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| 
 | ||
|   function CoordToCanvasX(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestX + AmulX * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CoordToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestY + AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   lArrow, lBase, lExtraBase: TPoint;
 | ||
|   lPointD, lPointE, lPointF: T3DPoint;
 | ||
|   lPoints: array[0..2] of TPoint;
 | ||
|   AlfaAngle: Double;
 | ||
| begin
 | ||
|   ApplyPenToCanvas(ADest, ARenderInfo);
 | ||
|   ApplyBrushToCanvas(ADest);
 | ||
| 
 | ||
|   lArrow.X := CoordToCanvasX(X);
 | ||
|   lArrow.Y := CoordToCanvasY(Y);
 | ||
|   lBase.X := CoordToCanvasX(Base.X);
 | ||
|   lBase.Y := CoordToCanvasY(Base.Y);
 | ||
|   lExtraBase.X := CoordToCanvasX(ExtraLineBase.X);
 | ||
|   lExtraBase.Y := CoordToCanvasY(ExtraLineBase.Y);
 | ||
| 
 | ||
|   // Start with the lines
 | ||
| 
 | ||
|   ADest.Line(lArrow, lBase);
 | ||
| 
 | ||
|   if HasExtraLine then
 | ||
|     ADest.Line(lBase, lExtraBase);
 | ||
| 
 | ||
|   // Now draw the arrow head
 | ||
|   lPoints[0].X := CoordToCanvasX(X);
 | ||
|   lPoints[0].Y := CoordToCanvasY(Y);
 | ||
|   //
 | ||
|   // Here a lot of trigonometry comes to play, it is hard to explain in text, but in essence
 | ||
|   //
 | ||
|   // A line L is formed by the points A (Arrow head) and B (Base)
 | ||
|   // Our smaller triangle starts at a point D in this line which has length ArrowLength counting from A
 | ||
|   // This forms a rectangle triangle with a line paralel to the X axis
 | ||
|   // Alfa is the angle between A and the line parallel to the X axis
 | ||
|   //
 | ||
|   // This brings this equations:
 | ||
|   // AlfaAngle := arctg((B.Y - A.Y) / (B.X - A.X));
 | ||
|   // Sin(Alfa) := (D.Y - A.Y) / ArrowLength
 | ||
|   // Cos(Alfa) := (D.X - A.X) / ArrowLength
 | ||
|   //
 | ||
|   // Then at this point D we start a line perpendicular to the line L
 | ||
|   // And with this line we progress a length of ArrowBaseLength/2
 | ||
|   // This line, the D point and a line parallel to the Y axis for another
 | ||
|   // rectangle triangle with the same Alfa angle at the point D
 | ||
|   // The point at the end of the hipotenuse of this triangle is our point E
 | ||
|   // So we have more equations:
 | ||
|   //
 | ||
|   // Sin(Alfa) := (E.x - D.X) / (ArrowBaseLength/2)
 | ||
|   // Cos(Alfa) := (E.Y - D.Y) / (ArrowBaseLength/2)
 | ||
|   //
 | ||
|   // And the same in the opposite direction for our point F:
 | ||
|   //
 | ||
|   // Sin(Alfa) := (D.X - F.X) / (ArrowBaseLength/2)
 | ||
|   // Cos(Alfa) := (D.Y - F.Y) / (ArrowBaseLength/2)
 | ||
|   //
 | ||
|   if (Base.X - X) = 0 then
 | ||
|     AlfaAngle := 0
 | ||
|   else
 | ||
|     AlfaAngle := ArcTan((Base.Y - Y) / (Base.X - X));
 | ||
|   lPointD.Y := Sin(AlfaAngle) * ArrowLength + Y;
 | ||
|   lPointD.X := Cos(AlfaAngle) * ArrowLength + X;
 | ||
|   lPointE.X := Sin(AlfaAngle) * (ArrowBaseLength/2) + lPointD.X;
 | ||
|   lPointE.Y := Cos(AlfaAngle) * (ArrowBaseLength/2) + lPointD.Y;
 | ||
|   lPointF.X := - Sin(AlfaAngle) * (ArrowBaseLength/2) + lPointD.X;
 | ||
|   lPointF.Y := - Cos(AlfaAngle) * (ArrowBaseLength/2) + lPointD.Y;
 | ||
|   lPoints[1].X := CoordToCanvasX(lPointE.X);
 | ||
|   lPoints[1].Y := CoordToCanvasY(lPointE.Y);
 | ||
|   lPoints[2].X := CoordToCanvasX(lPointF.X);
 | ||
|   lPoints[2].Y := CoordToCanvasY(lPointF.Y);
 | ||
|   if ADoDraw then ADest.Polygon(lPoints);
 | ||
| end;
 | ||
| 
 | ||
| { TvFormulaElement }
 | ||
| 
 | ||
| function TvFormulaElement.CalculateHeight(ADest: TFPCustomCanvas): Double;
 | ||
| var
 | ||
|   lLineHeight: Integer;
 | ||
| begin
 | ||
|   if ADest <> nil then
 | ||
|     lLineHeight := TCanvas(ADest).TextHeight(STR_FPVECTORIAL_TEXT_HEIGHT_SAMPLE) + 2
 | ||
|   else
 | ||
|     lLineHeight := 15;
 | ||
| 
 | ||
|   case Kind of
 | ||
|     //fekVariable,  // Text is the text of the variable
 | ||
|     //fekEqual,     // = symbol
 | ||
|     //fekSubtraction, // - symbol
 | ||
|     //fekMultiplication, // either a point . or a small x
 | ||
|     //fekSum,       // + symbol
 | ||
|     //fekPlusMinus, // The +/- symbol
 | ||
|     fekHorizontalLine: Result := 5;
 | ||
|     fekFraction:
 | ||
|     begin
 | ||
|       Formula.CalculateHeight(ADest);
 | ||
|       AdjacentFormula.CalculateHeight(ADest);
 | ||
|       Result := Formula.Height + AdjacentFormula.Height * 1.2;
 | ||
|     end;
 | ||
|     fekRoot: Result := Formula.CalculateHeight(ADest) * 1.2;
 | ||
|     fekPower: Result := lLineHeight * 1.2;
 | ||
|     fekSummation: Result := lLineHeight * 1.5;
 | ||
|     fekFormula: Result := Formula.CalculateHeight(ADest);
 | ||
|   else
 | ||
|     Result := lLineHeight;
 | ||
|   end;
 | ||
| 
 | ||
|   Height := Result;
 | ||
| end;
 | ||
| 
 | ||
| function TvFormulaElement.CalculateWidth(ADest: TFPCustomCanvas): Double;
 | ||
| var
 | ||
|   lText: String;
 | ||
| begin
 | ||
|   Result := 0;
 | ||
| 
 | ||
|   lText := AsText;
 | ||
|   if lText <> '' then
 | ||
|   begin
 | ||
|     if ADest = nil then Result := 10 * UTF8Length(lText)
 | ||
|     else Result := TCanvas(ADest).TextWidth(lText);
 | ||
|   end;
 | ||
| 
 | ||
|   case Kind of
 | ||
|     fekMultiplication: Result := 0;
 | ||
|     fekHorizontalLine: Result := 25;
 | ||
|     //
 | ||
|     fekFraction:
 | ||
|     begin
 | ||
|       Formula.CalculateWidth(ADest);
 | ||
|       AdjacentFormula.CalculateWidth(ADest);
 | ||
|       Result := Max(Formula.Width, AdjacentFormula.Width);
 | ||
|     end;
 | ||
|     fekRoot: Result := Formula.CalculateWidth(ADest) + 10;
 | ||
|     fekPower, fekSubscript:
 | ||
|     begin
 | ||
|       Result := Formula.CalculateWidth(ADest) +
 | ||
|         AdjacentFormula.CalculateWidth(ADest) / 2;
 | ||
|     end;
 | ||
|     fekSummation: Result := 8;
 | ||
|     fekFormula: Result := Formula.CalculateWidth(ADest);
 | ||
|   else
 | ||
|   end;
 | ||
| 
 | ||
|   Width := Result;
 | ||
| end;
 | ||
| 
 | ||
| function TvFormulaElement.AsText: string;
 | ||
| begin
 | ||
|   case Kind of
 | ||
|     fekVariable:  Result := Text;
 | ||
|     fekEqual:     Result := '=';
 | ||
|     fekSubtraction: Result := '-';
 | ||
|     fekMultiplication: Result := 'x';
 | ||
|     fekSum:       Result := '+';
 | ||
|     fekPlusMinus: Result := '+/-';
 | ||
|     fekLessThan:  Result := '<';
 | ||
|     fekLessOrEqualThan: Result := '<=';
 | ||
|     fekGreaterThan: Result := '>';
 | ||
|     fekGreaterOrEqualThan: Result := '>=';
 | ||
|     fekHorizontalLine: Result := '=';
 | ||
|   // More complex elements
 | ||
|   else
 | ||
|     Result := Format('[%s]', [GetEnumName(TypeInfo(TvFormulaElementKind), integer(Kind))]);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvFormulaElement.PositionSubparts(ADest: TFPCustomCanvas; ABaseX,
 | ||
|   ABaseY: Double);
 | ||
| var
 | ||
|   lCentralizeFactor: Double = 0;
 | ||
|   lCentralizeFactorAdj: Double = 0;
 | ||
| begin
 | ||
|   case Self.Kind of
 | ||
|     fekFraction:
 | ||
|     begin
 | ||
|       // Check which fraction is the largest and centralize the other one
 | ||
|       Self.Formula.CalculateWidth(ADest);
 | ||
|       Self.AdjacentFormula.CalculateWidth(ADest);
 | ||
|       if Self.Formula.Width > Self.AdjacentFormula.Width then
 | ||
|       begin
 | ||
|         lCentralizeFactor := 0;
 | ||
|         lCentralizeFactorAdj := Self.Formula.Width / 2 - Self.AdjacentFormula.Width / 2;
 | ||
|       end
 | ||
|       else
 | ||
|       begin
 | ||
|         lCentralizeFactor := Self.AdjacentFormula.Width / 2 - Self.Formula.Width / 2;
 | ||
|         lCentralizeFactorAdj := 0;
 | ||
|       end;
 | ||
| 
 | ||
|       Self.Formula.PositionSubparts(ADest, Self.Left + lCentralizeFactor, Self.Top);
 | ||
|       Self.AdjacentFormula.PositionSubparts(ADest, Self.Left + lCentralizeFactorAdj, Self.Top - Self.Formula.Height - 3);
 | ||
|     end;
 | ||
|     fekRoot:
 | ||
|     begin
 | ||
|       // Give a factor for the root drawing
 | ||
|       Self.Formula.PositionSubparts(ADest, Self.Left + 10, Self.Top);
 | ||
|     end;
 | ||
|     fekPower:
 | ||
|     begin
 | ||
|       Self.Formula.PositionSubparts(ADest, Self.Left, Self.Top);
 | ||
|       Self.AdjacentFormula.PositionSubparts(ADest, Self.Left + Self.Formula.Width, Self.Top);
 | ||
|     end;
 | ||
|     fekSubscript:
 | ||
|     begin
 | ||
|       Self.Formula.PositionSubparts(ADest, Self.Left, Self.Top);
 | ||
|       Self.AdjacentFormula.PositionSubparts(ADest, Self.Left + Self.Formula.Width, Self.Top - Self.Formula.Height / 2);
 | ||
|     end;
 | ||
|     fekSummation:
 | ||
|     begin
 | ||
|       // main/bottom formula
 | ||
|       Self.Formula.PositionSubparts(ADest, Self.Left, Self.Top - 30);
 | ||
|       // top formula
 | ||
|       Self.AdjacentFormula.PositionSubparts(ADest, Self.Left, Self.Top);
 | ||
|     end;
 | ||
|     fekFormula:
 | ||
|     begin
 | ||
|       Self.Formula.PositionSubparts(ADest, Self.Left, Self.Top);
 | ||
|     end;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvFormulaElement.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
 | ||
|   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| 
 | ||
|   function CoordToCanvasX(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestX + AmulX * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CoordToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestY + AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   LeftC, TopC: Integer;
 | ||
|   lPt: array[0..3] of TPoint;
 | ||
|   lOldFontSize: Integer;
 | ||
|   lStr: string;
 | ||
| begin
 | ||
|   LeftC := CoordToCanvasX(Left);
 | ||
|   TopC := CoordToCanvasY(Top);
 | ||
| 
 | ||
|   if ADoDraw then
 | ||
|     case Kind of
 | ||
|       fekVariable: ADest.TextOut(LeftC, TopC, Text);
 | ||
|       fekEqual:    ADest.TextOut(LeftC, TopC, '=');
 | ||
|       fekSubtraction: ADest.TextOut(LeftC, TopC, '-');
 | ||
|       fekMultiplication:
 | ||
|       begin
 | ||
|         // Don't draw anything, leave an empty space, it looks better
 | ||
|         //ADest.TextOut(LeftC, TopC, 'x'); // × -> Unicode times symbol
 | ||
|       end;
 | ||
|       fekSum:      ADest.TextOut(LeftC, TopC, '+');
 | ||
|       fekPlusMinus:ADest.TextOut(LeftC, TopC, '±');
 | ||
|       fekLessThan: ADest.TextOut(LeftC, TopC, '<');
 | ||
|       fekLessOrEqualThan: ADest.TextOut(LeftC, TopC, '≤');
 | ||
|       fekGreaterThan: ADest.TextOut(LeftC, TopC, '>');
 | ||
|       fekGreaterOrEqualThan: ADest.TextOut(LeftC, TopC, '≥');
 | ||
|       fekHorizontalLine: ADest.Line(LeftC, TopC, CoordToCanvasX(Left+Width), TopC);
 | ||
|       // Complex ones
 | ||
|       fekFraction:
 | ||
|       begin
 | ||
|         Formula.Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|         AdjacentFormula.Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
| 
 | ||
|         // Division line
 | ||
|         lPt[0].X := CoordToCanvasX(Formula.Left);
 | ||
|         lPt[1].X := CoordToCanvasX(Formula.Left + Formula.Width);
 | ||
|         lPt[0].Y := CoordToCanvasY(Formula.Top - Formula.Height);
 | ||
|         lPt[1].Y := CoordToCanvasY(Formula.Top - Formula.Height);
 | ||
|         ADest.Line(lPt[0].X, lPt[0].Y, lPt[1].X, lPt[1].Y);
 | ||
|       end;
 | ||
|       fekRoot:
 | ||
|       begin
 | ||
|         Formula.Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
| 
 | ||
|         // Root drawing
 | ||
|         lPt[0].X := CoordToCanvasX(Left);
 | ||
|         lPt[0].Y := CoordToCanvasY(Top - Formula.Height * 0.7 + 5);
 | ||
|         // diagonal down
 | ||
|         lPt[1].X := CoordToCanvasX(Left + 5);
 | ||
|         lPt[1].Y := CoordToCanvasY(Top - Formula.Height * 0.7);
 | ||
|         // up
 | ||
|         lPt[2].X := CoordToCanvasX(Left + 5);
 | ||
|         lPt[2].Y := CoordToCanvasY(Top);
 | ||
|         // straight right
 | ||
|         lPt[3].X := CoordToCanvasX(Left + Formula.Width);
 | ||
|         lPt[3].Y := CoordToCanvasY(Top);
 | ||
|         //
 | ||
|         ADest.Polyline(lPt);
 | ||
|       end;
 | ||
|       fekPower:
 | ||
|       begin
 | ||
|         Formula.Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|         // The superscripted power
 | ||
|         lOldFontSize := ADest.Font.Size;
 | ||
|         if lOldFontSize = 0 then ADest.Font.Size := 5
 | ||
|         else ADest.Font.Size := lOldFontSize div 2;
 | ||
|         AdjacentFormula.Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|         ADest.Font.Size := lOldFontSize;
 | ||
|       end;
 | ||
|       fekSubscript:
 | ||
|       begin
 | ||
|         Formula.Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|         // The subscripted item
 | ||
|         lOldFontSize := ADest.Font.Size;
 | ||
|         if lOldFontSize = 0 then ADest.Font.Size := 5
 | ||
|         else ADest.Font.Size := lOldFontSize div 2;
 | ||
|         AdjacentFormula.Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|         ADest.Font.Size := lOldFontSize;
 | ||
|       end;
 | ||
|       fekSummation:
 | ||
|       begin
 | ||
|         // Draw the summation symbol
 | ||
|         lOldFontSize := ADest.Font.Size;
 | ||
|         ADest.Font.Size := 15;
 | ||
|         lStr := #$E2#$88#$91; // Unicode Character 'N-ARY SUMMATION' (U+2211)
 | ||
|         ADest.TextOut(LeftC, TopC, lStr);
 | ||
|         ADest.Font.Size := lOldFontSize;
 | ||
| 
 | ||
|         // Draw the bottom/main formula
 | ||
|         Formula.Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
| 
 | ||
|         // Draw the top formula
 | ||
|         AdjacentFormula.Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|       end;
 | ||
|       fekFormula:
 | ||
|       begin
 | ||
|         // Draw the formula
 | ||
|         Formula.Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|       end;
 | ||
|     end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvFormulaElement.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer);
 | ||
| var
 | ||
|   lDBGItem, lDBGFormula, lDBGFormulaBottom: Pointer;
 | ||
|   lStr: string;
 | ||
| begin
 | ||
|   lStr := Format('%s [%s]', [Self.AsText(), GetEnumName(TypeInfo(TvFormulaElementKind), integer(Kind))]);
 | ||
|   lStr := lStr + Format(' Left=%f Top=%f Width=%f Height=%f', [Left, Top, Width, Height]);
 | ||
|   lDBGItem := ADestRoutine(lStr, APageItem);
 | ||
| 
 | ||
|   case Kind of
 | ||
|     fekFraction, fekPower, fekSubscript, fekSummation:
 | ||
|     begin
 | ||
|       lDBGFormula := ADestRoutine('Main Formula', lDBGItem);
 | ||
|       Formula.GenerateDebugTree(ADestRoutine, lDBGFormula);
 | ||
|       if Kind in [fekPower, fekSummation] then
 | ||
|         lDBGFormulaBottom := ADestRoutine('Top Formula', lDBGItem)
 | ||
|       else
 | ||
|         lDBGFormulaBottom := ADestRoutine('Bottom Formula', lDBGItem);
 | ||
|       AdjacentFormula.GenerateDebugTree(ADestRoutine, lDBGFormulaBottom);
 | ||
|     end;
 | ||
|     fekRoot: Formula.GenerateDebugTree(ADestRoutine, lDBGItem);
 | ||
|     //fekSomatory: Result := 1.5;
 | ||
|     fekFormula: Formula.GenerateDebugTree(ADestRoutine, lDBGItem);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| // http://en.wikipedia.org/wiki/Shunting-yard_algorithm
 | ||
| class function TvFormulaElement.GetPrecedenceFromKind(
 | ||
|   AKind: TvFormulaElementKind): Byte;
 | ||
| begin
 | ||
|   Result := 0;
 | ||
|   case AKind of
 | ||
|   fekSubtraction, fekSum: Result := 2;
 | ||
|   fekMultiplication, fekFraction: Result := 3;
 | ||
|   //fekRoot,   // A root. For example sqrt(something). Number gives the root, usually 2, and inside it goes a Formula
 | ||
|   fekPower: Result := 4;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| // See http://en.wikipedia.org/wiki/Shunting-yard_algorithm
 | ||
| class function TvFormulaElement.IsLeftAssociativeFromKind(
 | ||
|   AKind: TvFormulaElementKind): Boolean;
 | ||
| begin
 | ||
|   Result := True;
 | ||
|   case AKind of
 | ||
|   fekPower: Result := False;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| { TvFormula }
 | ||
| 
 | ||
| procedure TvFormula.CallbackDeleteElement(data, arg: pointer);
 | ||
| begin
 | ||
|   TvFormulaElement(data).Free;
 | ||
| end;
 | ||
| 
 | ||
| constructor TvFormula.Create(APage: TvPage);
 | ||
| begin
 | ||
|   inherited Create(APage);
 | ||
|   FElements := TFPList.Create;
 | ||
|   SpacingBetweenElementsX := 5;
 | ||
|   SpacingBetweenElementsY := 1; // elements already give a fair amount of vertical spacing in their own area
 | ||
| end;
 | ||
| 
 | ||
| destructor TvFormula.Destroy;
 | ||
| begin
 | ||
|   FElements.Free;
 | ||
|   inherited Destroy;
 | ||
| end;
 | ||
| 
 | ||
| function TvFormula.GetFirstElement: TvFormulaElement;
 | ||
| begin
 | ||
|   if FElements.Count = 0 then Exit(nil);
 | ||
|   Result := TvFormulaElement(FElements.Items[0]);
 | ||
|   FCurIndex := 1;
 | ||
| end;
 | ||
| 
 | ||
| function TvFormula.GetNextElement: TvFormulaElement;
 | ||
| begin
 | ||
|   if FElements.Count <= FCurIndex then Exit(nil);
 | ||
|   Result := TvFormulaElement(FElements.Items[FCurIndex]);
 | ||
|   Inc(FCurIndex);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvFormula.AddElement(AElement: TvFormulaElement);
 | ||
| begin
 | ||
|   FElements.Add(AElement);
 | ||
| end;
 | ||
| 
 | ||
| function TvFormula.AddElementWithKind(AKind: TvFormulaElementKind): TvFormulaElement;
 | ||
| begin
 | ||
|   Result := AddElementWithKindAndText(AKind, '');
 | ||
| end;
 | ||
| 
 | ||
| function TvFormula.AddElementWithKindAndText(AKind: TvFormulaElementKind;
 | ||
|   AText: string): TvFormulaElement;
 | ||
| begin
 | ||
|   Result := TvFormulaElement.Create;
 | ||
|   Result.Kind := AKind;
 | ||
|   Result.Text := AText;
 | ||
|   AddElement(Result);
 | ||
| 
 | ||
|   case AKind of
 | ||
|     fekFraction, fekPower, fekSubscript, fekSummation:
 | ||
|     begin
 | ||
|       Result.Formula := TvFormula.Create(FPage);
 | ||
|       Result.AdjacentFormula := TvFormula.Create(FPage);
 | ||
|     end;
 | ||
|     fekRoot:
 | ||
|     begin
 | ||
|       Result.Formula := TvFormula.Create(FPage);
 | ||
|     end;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| // Based on:
 | ||
| // http://en.wikipedia.org/wiki/Shunting-yard_algorithm
 | ||
| procedure TvFormula.AddItemsByConvertingInfixToRPN(AInfix: TFPList);
 | ||
| var
 | ||
|   OperatorStack: TObjectStack;
 | ||
|   i: Integer;
 | ||
|   CurItem: TvFormulaElement;
 | ||
| 
 | ||
|   procedure PopFromStackIntoList(APopTopOperators: Boolean; APopUntilParenteses: Boolean);
 | ||
|   var
 | ||
|     lElement: TvFormulaElement;
 | ||
|     lAllowContinue: Boolean;
 | ||
|   begin
 | ||
|     while OperatorStack.Count > 0 do
 | ||
|     begin
 | ||
|       lElement := OperatorStack.Pop() as TvFormulaElement;
 | ||
| 
 | ||
|       // while there is an operator token, o2, at the top of the stack, and
 | ||
|       // either o1 is left-associative and its precedence is equal to that of o2,
 | ||
|       // or o1 has precedence less than that of o2,
 | ||
|       if APopTopOperators then
 | ||
|       begin
 | ||
|         if not (lElement.Kind in FormulaOperators) then Exit;
 | ||
| 
 | ||
|         lAllowContinue := TvFormulaElement.IsLeftAssociativeFromKind(lElement.Kind)
 | ||
|          and (TvFormulaElement.GetPrecedenceFromKind(lElement.Kind) =
 | ||
|               TvFormulaElement.GetPrecedenceFromKind(CurItem.Kind));
 | ||
|         lAllowContinue := lAllowContinue or
 | ||
|           (TvFormulaElement.GetPrecedenceFromKind(lElement.Kind) >
 | ||
|           TvFormulaElement.GetPrecedenceFromKind(CurItem.Kind));
 | ||
|         if not lAllowContinue then Exit;
 | ||
|       end;
 | ||
| 
 | ||
|       if APopUntilParenteses and (lElement.Kind = fekParentesesOpen) then Exit;
 | ||
| 
 | ||
|       FElements.Add(lElement);
 | ||
|     end;
 | ||
|   end;
 | ||
| 
 | ||
| begin
 | ||
|   Clear();
 | ||
| 
 | ||
|   OperatorStack := TObjectStack.Create;
 | ||
|   try
 | ||
|     for i := 0 to AInfix.Count-1 do
 | ||
|     begin
 | ||
|       CurItem := TvFormulaElement(AInfix.Items[i]);
 | ||
|       case CurItem.Kind of
 | ||
|       fekVariable:
 | ||
|       begin
 | ||
|         FElements.Add(CurItem);
 | ||
|       end;
 | ||
|       fekSubtraction, fekMultiplication, fekSum, fekFraction:
 | ||
|       begin
 | ||
|         PopFromStackIntoList(True, False);
 | ||
|         OperatorStack.Push(CurItem);
 | ||
|       end;
 | ||
|       fekParentesesOpen:
 | ||
|       begin
 | ||
|         OperatorStack.Push(CurItem);
 | ||
|       end;
 | ||
|       freParentesesClose:
 | ||
|       begin
 | ||
|         PopFromStackIntoList(False, True);
 | ||
|       end;
 | ||
|       end;
 | ||
|     end;
 | ||
| 
 | ||
|     PopFromStackIntoList(True, False);
 | ||
|   finally
 | ||
|     OperatorStack.Free;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvFormula.AddItemsByConvertingInfixStringToRPN(AStr: string);
 | ||
| var
 | ||
|   lInfix: TFPList;
 | ||
| begin
 | ||
|   lInfix := TFPList.Create;
 | ||
|   try
 | ||
|     TokenizeInfixString(AStr, lInfix);
 | ||
|     AddItemsByConvertingInfixToRPN(lInfix);
 | ||
|   finally
 | ||
|     lInfix.Free;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvFormula.TokenizeInfixString(AStr: string; AOutput: TFPList);
 | ||
| const
 | ||
|   Str_Space: Char = ' ';
 | ||
| 
 | ||
|   procedure AddToken(AStr: string);
 | ||
|   var
 | ||
|     lToken: TvFormulaElement;
 | ||
|     lStr: string;
 | ||
|     FPointSeparator: TFormatSettings;
 | ||
|   begin
 | ||
|     FPointSeparator := DefaultFormatSettings;
 | ||
|     FPointSeparator.DecimalSeparator := '.';
 | ||
|     FPointSeparator.ThousandSeparator := '#';// disable the thousand separator
 | ||
| 
 | ||
|     lStr := Trim(AStr);
 | ||
|     if lStr = '' then Exit;
 | ||
| 
 | ||
|     lToken := TvFormulaElement.Create;
 | ||
| 
 | ||
|     // Moves
 | ||
|     case lStr[1] of
 | ||
|     '*': lToken.Kind := fekMultiplication;
 | ||
|     '/': lToken.Kind := fekFraction;
 | ||
|     '+': lToken.Kind := fekSum;
 | ||
|     '-': lToken.Kind := fekSubtraction;
 | ||
|     '(': lToken.Kind := fekParentesesOpen;
 | ||
|     ')': lToken.Kind := freParentesesClose;
 | ||
|     else
 | ||
|       lToken.Kind := fekVariable;
 | ||
|       lToken.Number := StrToFloat(AStr, FPointSeparator);
 | ||
|     end;
 | ||
| 
 | ||
|     AOutput.Add(lToken);
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   i: Integer;
 | ||
|   lTmpStr: string = '';
 | ||
|   lState: Integer;
 | ||
|   lCurChar: Char;
 | ||
| begin
 | ||
|   lState := 0;
 | ||
| 
 | ||
|   i := 1;
 | ||
|   while i <= Length(AStr) do
 | ||
|   begin
 | ||
|     case lState of
 | ||
|     0: // Adding to the tmp string
 | ||
|     begin
 | ||
|       lCurChar := AStr[i];
 | ||
|       if lCurChar = Str_Space then
 | ||
|       begin
 | ||
|         //lState := 1;
 | ||
|         AddToken(lTmpStr);
 | ||
|         lTmpStr := '';
 | ||
|       end
 | ||
|       else if lCurChar in ['/', '*', '+', '-', '(', ')'] then
 | ||
|       begin
 | ||
|         if lTmpStr <> '' then AddToken(lTmpStr);
 | ||
|         lTmpStr := '';
 | ||
|         lState := 0;
 | ||
|         AddToken(lCurChar);
 | ||
|       end
 | ||
|       else
 | ||
|       begin
 | ||
|         lTmpStr := lTmpStr + lCurChar;
 | ||
|       end;
 | ||
|     end;
 | ||
|     end;
 | ||
| 
 | ||
|     Inc(i);
 | ||
|   end;
 | ||
| 
 | ||
|   // If there is a token still to be added, add it now
 | ||
|   if (lState = 0) and (lTmpStr <> '') then AddToken(lTmpStr);
 | ||
| end;
 | ||
| 
 | ||
| // The formula must be in RPN for this to work
 | ||
| function TvFormula.CalculateRPNFormulaValue: Double;
 | ||
| var
 | ||
|   lOperand_A, lOperand_B, CurElement: TvFormulaElement;
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   lOperand_A := nil;
 | ||
|   lOperand_B := nil;
 | ||
|   Result := 0;
 | ||
|   for i := 0 to FElements.Count-1 do
 | ||
|   begin
 | ||
|     CurElement := TvFormulaElement(FElements.Items[i]);
 | ||
|     case CurElement.Kind of
 | ||
|     fekVariable:
 | ||
|     begin
 | ||
|       if lOperand_A = nil then lOperand_A := CurElement
 | ||
|       else lOperand_B := CurElement;
 | ||
|     end;
 | ||
|     fekSubtraction:
 | ||
|     begin
 | ||
|       lOperand_A.Number := lOperand_A.Number - lOperand_B.Number;
 | ||
|       lOperand_B := nil;
 | ||
|     end;
 | ||
|     fekMultiplication:
 | ||
|     begin
 | ||
|       lOperand_A.Number := lOperand_A.Number * lOperand_B.Number;
 | ||
|       lOperand_B := nil;
 | ||
|     end;
 | ||
|     fekSum:
 | ||
|     begin
 | ||
|       lOperand_A.Number := lOperand_A.Number + lOperand_B.Number;
 | ||
|       lOperand_B := nil;
 | ||
|     end;
 | ||
|     fekFraction:
 | ||
|     begin
 | ||
|       lOperand_A.Number := lOperand_A.Number / lOperand_B.Number;
 | ||
|       lOperand_B := nil;
 | ||
|     end;
 | ||
|     end;
 | ||
|   end;
 | ||
| 
 | ||
|   Result := lOperand_A.Number;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvFormula.Clear;
 | ||
| begin
 | ||
|   inherited Clear;
 | ||
|   FElements.ForEachCall(@CallbackDeleteElement, nil);
 | ||
|   FElements.Clear;
 | ||
| end;
 | ||
| 
 | ||
| function TvFormula.CalculateHeight(ADest: TFPCustomCanvas): Double;
 | ||
| var
 | ||
|   lElement: TvFormulaElement;
 | ||
| begin
 | ||
|   if ADest <> nil then
 | ||
|     Result := TCanvas(ADest).TextHeight(STR_FPVECTORIAL_TEXT_HEIGHT_SAMPLE) + 2
 | ||
|   else
 | ||
|     Result := 15;
 | ||
| 
 | ||
|   lElement := GetFirstElement();
 | ||
|   while lElement <> nil do
 | ||
|   begin
 | ||
|     Result := Max(Result, lElement.CalculateHeight(ADest));
 | ||
|     lElement := GetNextElement;
 | ||
|   end;
 | ||
| 
 | ||
|   // Cache the result
 | ||
|   Height := Result;
 | ||
| end;
 | ||
| 
 | ||
| function TvFormula.CalculateWidth(ADest: TFPCustomCanvas): Double;
 | ||
| var
 | ||
|   lElement: TvFormulaElement;
 | ||
| begin
 | ||
|   Result := 0;
 | ||
|   lElement := GetFirstElement();
 | ||
|   while lElement <> nil do
 | ||
|   begin
 | ||
|     if lElement.Kind <> fekMultiplication then
 | ||
|       Result := Result + lElement.CalculateWidth(ADest) + SpacingBetweenElementsX;
 | ||
|     lElement := GetNextElement;
 | ||
|   end;
 | ||
|   // Remove an extra spacing, since it is added even to the last item
 | ||
|   Result := Result - SpacingBetweenElementsX;
 | ||
|   // Cache the result
 | ||
|   Width := Result;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvFormula.PositionSubparts(ADest: TFPCustomCanvas; ABaseX, ABaseY: Double);
 | ||
| var
 | ||
|   lElement: TvFormulaElement;
 | ||
|   lPosX: Double = 0;
 | ||
|   lMaxHeight: Double = 0;
 | ||
| begin
 | ||
|   CalculateHeight(ADest);
 | ||
|   CalculateWidth(ADest);
 | ||
|   Left := ABaseX;
 | ||
|   Top := ABaseY;
 | ||
| 
 | ||
|   // Then calculate the position of each element
 | ||
|   lElement := GetFirstElement();
 | ||
|   if lElement = nil then Exit;
 | ||
|   while lElement <> nil do
 | ||
|   begin
 | ||
|     lElement.Left := Left + lPosX;
 | ||
|     lPosX := lPosX + lElement.Width + SpacingBetweenElementsX;
 | ||
|     lElement.Top := Top;
 | ||
|     lMaxHeight := Max(lMaxHeight, lElement.Height);
 | ||
| 
 | ||
|     lElement.PositionSubparts(ADest, ABaseX, ABaseY);
 | ||
| 
 | ||
|     lElement := GetNextElement();
 | ||
|   end;
 | ||
| 
 | ||
|   // Go back and make a second loop to
 | ||
|   // check if there are any high elements in the same line,
 | ||
|   // and if yes, centralize the smaller ones
 | ||
|   lElement := GetFirstElement();
 | ||
|   if lElement = nil then Exit;
 | ||
|   while lElement <> nil do
 | ||
|   begin
 | ||
|     if lElement.Height < lMaxHeight then
 | ||
|     begin
 | ||
|       lElement.Top := Top - lMaxHeight / 2 + lElement.Height / 2;
 | ||
|     end;
 | ||
| 
 | ||
|     lElement := GetNextElement();
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvFormula.CalculateBoundingBox(ADest: TFPCustomCanvas;
 | ||
|   out ALeft, ATop, ARight, ABottom: Double);
 | ||
| begin
 | ||
|   ALeft := X;
 | ||
|   ATop := Y;
 | ||
|   ARight := CalculateWidth(ADest);
 | ||
|   if ADest = nil then ABottom := CalculateHeight(ADest) * 15
 | ||
|   else ABottom := CalculateHeight(ADest) * TCanvas(ADest).TextHeight('Źç');
 | ||
|   ARight := X + ARight;
 | ||
|   ABottom := Y + ABottom;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvFormula.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
 | ||
|   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| var
 | ||
|   lElement: TvFormulaElement;
 | ||
| begin
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
| 
 | ||
|   // First position all elements
 | ||
|   PositionSubparts(ADest, Left, Top);
 | ||
| 
 | ||
|   // Now draw them all
 | ||
|   lElement := GetFirstElement();
 | ||
|   if lElement = nil then Exit;
 | ||
|   while lElement <> nil do
 | ||
|   begin
 | ||
|     lElement.Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
| 
 | ||
|     lElement := GetNextElement();
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvFormula.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   lFormulaElement: TvFormulaElement;
 | ||
|   lStr: string;
 | ||
| begin
 | ||
|   lStr := Format('[%s]', [Self.ClassName]);
 | ||
|   lStr := lStr + Format(' Left=%f Top=%f Width=%f Height=%f', [Left, Top, Width, Height]);
 | ||
|   Result := ADestRoutine(lStr, APageItem);
 | ||
| 
 | ||
|   lFormulaElement := GetFirstElement();
 | ||
|   while lFormulaElement <> nil do
 | ||
|   begin
 | ||
|     lFormulaElement.GenerateDebugTree(ADestRoutine, Result);
 | ||
| 
 | ||
|     lFormulaElement := GetNextElement()
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| { TvEntityWithSubEntities }
 | ||
| 
 | ||
| procedure TvEntityWithSubEntities.CallbackDeleteElement(data, arg: pointer);
 | ||
| begin
 | ||
|   TvEntity(data).Free;
 | ||
| end;
 | ||
| 
 | ||
| constructor TvEntityWithSubEntities.Create(APage: TvPage);
 | ||
| begin
 | ||
|   inherited Create(APage);
 | ||
|   FElements := TFPList.Create;
 | ||
| end;
 | ||
| 
 | ||
| destructor TvEntityWithSubEntities.Destroy;
 | ||
| var
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   for i:= FElements.Count-1 downto 0 do
 | ||
|     TvEntity(FElements[i]).Free;
 | ||
|   FElements.Free;
 | ||
|   inherited Destroy;
 | ||
| end;
 | ||
| 
 | ||
| function TvEntityWithSubEntities.GetFirstEntity: TvEntity;
 | ||
| begin
 | ||
|   if FElements.Count = 0 then Exit(nil);
 | ||
|   Result := TvEntity(FElements.Items[0]);
 | ||
|   FCurIndex := 1;
 | ||
| end;
 | ||
| 
 | ||
| function TvEntityWithSubEntities.GetNextEntity: TvEntity;
 | ||
| begin
 | ||
|   if FElements.Count <= FCurIndex then Exit(nil);
 | ||
|   Result := TvEntity(FElements.Items[FCurIndex]);
 | ||
|   Inc(FCurIndex);
 | ||
| end;
 | ||
| 
 | ||
| function TvEntityWithSubEntities.GetEntitiesCount: Integer;
 | ||
| begin
 | ||
|   Result := FElements.Count;
 | ||
| end;
 | ||
| 
 | ||
| function TvEntityWithSubEntities.GetEntity(AIndex: Integer): TvEntity;
 | ||
| begin
 | ||
|   Result := TvEntity(FElements.Items[AIndex]);
 | ||
| end;
 | ||
| 
 | ||
| function TvEntityWithSubEntities.AddEntity(AEntity: TvEntity): Integer;
 | ||
| begin
 | ||
|   //AEntity.Parent := Self;
 | ||
|   AEntity.SetPage(Self.FPage);
 | ||
|   Result := FElements.Add(AEntity);
 | ||
| end;
 | ||
| 
 | ||
| function TvEntityWithSubEntities.GetEntityIndex(AEntity: TvEntity): Integer;
 | ||
| var
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   Result := -1;
 | ||
|   for i := 0 to FElements.Count-1 do
 | ||
|     if TvEntity(FElements.Items[i]) = AEntity then Exit(i);
 | ||
| end;
 | ||
| 
 | ||
| function TvEntityWithSubEntities.DeleteEntity(AIndex: Cardinal): Boolean;
 | ||
| var
 | ||
|   lEntity: TvEntity;
 | ||
| begin
 | ||
|   lEntity := TvEntity(FElements.Items[AIndex]);
 | ||
|   FElements.Remove(lEntity);
 | ||
|   lEntity.Free;
 | ||
|   Result := True;
 | ||
| end;
 | ||
| 
 | ||
| function TvEntityWithSubEntities.RemoveEntity(AEntity: TvEntity;
 | ||
|   AFreeAfterRemove: Boolean): Boolean;
 | ||
| var
 | ||
|   lIndex: Integer;
 | ||
| begin
 | ||
|   Result := False;
 | ||
|   lIndex := FindEntityWithReference(AEntity);
 | ||
|   if lIndex < 0 then Exit;
 | ||
|   if AFreeAfterRemove then DeleteEntity(lIndex)
 | ||
|   else FElements.Remove(AEntity);
 | ||
|   Result := True;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithSubEntities.Rotate(AAngle: Double; ABase: T3DPoint);
 | ||
| var
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   for i := 0 to FElements.Count-1 do
 | ||
|   begin
 | ||
|     TvEntity(FElements.Items[i]).Rotate(AAngle, ABase);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithSubEntities.Clear;
 | ||
| begin
 | ||
|   inherited Clear;
 | ||
|   FElements.ForEachCall(@CallbackDeleteElement, nil);
 | ||
|   FElements.Clear;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvEntityWithSubEntities.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
 | ||
|   ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| var
 | ||
|   lEntity: TvEntity;
 | ||
|   rinfo: TvRenderInfo;
 | ||
|   isFirst: Boolean;
 | ||
| begin
 | ||
|   rinfo := ARenderInfo;
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|   isFirst := true;
 | ||
|   lEntity := GetFirstEntity();
 | ||
|   while lEntity <> nil do
 | ||
|   begin
 | ||
|     {$IFDEF FPVECTORIAL_DEBUG_BLOCKS}
 | ||
|     //WriteLn(Format('[TvInsert.Render] Name=%s Block=%s Entity=%s EntityXY=%f | %f BlockXY=%f | %f InsertXY=%f | %f',
 | ||
|     //  [Name, Block.Name, lEntity.ClassName, lEntity.X, lEntity.Y, Block.X, Block.Y, X, Y]));
 | ||
|     {$ENDIF}
 | ||
| 
 | ||
|     // Render
 | ||
|     lEntity.Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMuly, ADoDraw);
 | ||
| 
 | ||
|     if isFirst then
 | ||
|     begin
 | ||
|       rinfo := ARenderInfo;
 | ||
|       isFirst := false;
 | ||
|     end else
 | ||
|       CalcEntityCanvasMinMaxXY_With2Points(rinfo,
 | ||
|         ARenderInfo.EntityCanvasMinXY.X,
 | ||
|         ARenderInfo.EntityCanvasMinXY.Y,
 | ||
|         ARenderInfo.EntityCanvasMaxXY.X,
 | ||
|         ARenderInfo.EntityCanvasMaxXY.Y
 | ||
|       );
 | ||
| 
 | ||
|     {$ifdef FPVECTORIAL_AUTOFIT_DEBUG}
 | ||
|     if AutoFitDebug <> nil then AutoFitDebug.Add(Format('=[%s] MinX=%d MinY=%d MaxX=%d MaxY=%d',
 | ||
|       [lEntity.ClassName, ARenderInfo.EntityCanvasMinXY.X, ARenderInfo.EntityCanvasMinXY.Y,
 | ||
|        ARenderInfo.EntityCanvasMaxXY.X, ARenderInfo.EntityCanvasMaxXY.Y]));
 | ||
|     {$endif}
 | ||
| 
 | ||
|     lEntity := GetNextEntity();
 | ||
|   end;
 | ||
| 
 | ||
|   ARenderInfo := rinfo;
 | ||
| end;
 | ||
| 
 | ||
| function TvEntityWithSubEntities.GenerateDebugTree(
 | ||
|   ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer;
 | ||
| var
 | ||
|   lStr: string;
 | ||
|   lCurEntity: TvEntity;
 | ||
| begin
 | ||
|   lStr := Format('[%s] Name="%s" X=%f Y=%f' + FExtraDebugStr,
 | ||
|     [Self.ClassName, Self.Name, X, Y]);
 | ||
| 
 | ||
|   // Add styles
 | ||
|   // Pen
 | ||
|   if spbfPenColor in SetPenBrushAndFontElements then
 | ||
|     lStr := lStr + Format(' Pen.Color=%s', [GenerateDebugStrForFPColor(Pen.Color)]);
 | ||
|   if spbfPenStyle in SetPenBrushAndFontElements then
 | ||
|     lStr := lStr + Format(' Pen.Style=%s', [GetEnumName(TypeInfo(TFPPenStyle), integer(Pen.Style))]);
 | ||
|   if spbfPenWidth in SetPenBrushAndFontElements then
 | ||
|     lStr := lStr + Format(' Pen.Width=%d', [Pen.Width]);
 | ||
|   // Brush
 | ||
|   if spbfBrushColor in SetPenBrushAndFontElements then
 | ||
|     lStr := lStr + Format(' Brush.Color=%s', [GenerateDebugStrForFPColor(Brush.Color)]);
 | ||
|   if spbfBrushStyle in SetPenBrushAndFontElements then
 | ||
|     lStr := lStr + Format(' Brush.Style=%s', [GetEnumName(TypeInfo(TFPBrushStyle), integer(Brush.Style))]);
 | ||
|   // Font
 | ||
|   if spbfFontColor in SetPenBrushAndFontElements then
 | ||
|     lStr := lStr + Format(' Font.Color=%s', [GenerateDebugStrForFPColor(Font.Color)]);
 | ||
|   if spbfFontSize in SetPenBrushAndFontElements then
 | ||
|     lStr := lStr + Format(' Font.Size=%d', [Font.Size]);
 | ||
| 
 | ||
|   Result := ADestRoutine(lStr, APageItem);
 | ||
| 
 | ||
|   // Add sub-entities
 | ||
|   lCurEntity := GetFirstEntity();
 | ||
|   while lCurEntity <> nil do
 | ||
|   begin
 | ||
|     lCurEntity.GenerateDebugTree(ADestRoutine, Result);
 | ||
|     lCurEntity := GetNextEntity();
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvEntityWithSubEntities.FindEntityWithReference(AEntity: TvEntity
 | ||
|   ): Integer;
 | ||
| var
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   Result := -1;
 | ||
|   for i := 0 to FElements.Count - 1 do
 | ||
|   begin
 | ||
|     if TvEntity(FElements.Items[i]) = AEntity then Exit(i);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvEntityWithSubEntities.FindEntityWithNameAndType(AName: string;
 | ||
|   AType: TvEntityClass; ARecursively: Boolean): TvEntity;
 | ||
| var
 | ||
|   lCurEntity: TvEntity;
 | ||
|   lCurName: String;
 | ||
| begin
 | ||
|   Result := nil;
 | ||
|   lCurEntity := GetFirstEntity();
 | ||
|   while lCurEntity <> nil do
 | ||
|   begin
 | ||
|     if (lCurEntity is TvNamedEntity) then
 | ||
|       lCurName := TvNamedEntity(lCurEntity).Name
 | ||
|     else
 | ||
|       lCurName := '';
 | ||
| 
 | ||
|     if (lCurEntity is AType) and
 | ||
|       (lCurEntity is TvNamedEntity) and (lCurName = AName) then
 | ||
|     begin
 | ||
|       Result := lCurEntity;
 | ||
|       Exit;
 | ||
|     end;
 | ||
| 
 | ||
|     if ARecursively and (lCurEntity is TvEntityWithSubEntities) then
 | ||
|     begin
 | ||
|       Result := TvEntityWithSubEntities(lCurEntity).FindEntityWithNameAndType(AName, AType, True);
 | ||
|       if Result <> nil then Exit;
 | ||
|     end;
 | ||
| 
 | ||
|     lCurEntity := GetNextEntity();
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| { TvInsert }
 | ||
| 
 | ||
| constructor TvInsert.Create(APage: TvPage);
 | ||
| begin
 | ||
|   inherited Create(APage);
 | ||
|   Style := TvStyle.Create;
 | ||
| end;
 | ||
| 
 | ||
| destructor TvInsert.Destroy;
 | ||
| begin
 | ||
|   FreeAndNil(Style);
 | ||
|   inherited Destroy;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvInsert.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
 | ||
|   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| var
 | ||
|   OldForceRenderBlock: Boolean;
 | ||
| begin
 | ||
|   inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|   if InsertEntity = nil then Exit;
 | ||
|   // If we are inserting a block, make sure it will render its contents
 | ||
|   OldForceRenderBlock := ARenderInfo.ForceRenderBlock;
 | ||
|   ARenderInfo.ForceRenderBlock := True;
 | ||
|   // If necessary rotate the canvas
 | ||
|   if RotationAngle <> 0 then
 | ||
|   begin
 | ||
|     InsertEntity.Rotate(RotationAngle, Make3DPoint(0, 0));
 | ||
|   end;
 | ||
|   // Alter the position of the elements to consider the positioning of the BLOCK and of the INSERT
 | ||
|   InsertEntity.Move(X, Y);
 | ||
|   Style.ApplyOverFromPen(@Pen, SetElements);
 | ||
|   Style.ApplyOverFromBrush(@Brush, SetElements);
 | ||
|   Style.ApplyOverFromFont(@Font, SetElements);
 | ||
|   Style.ApplyIntoEntity(InsertEntity);
 | ||
|   // Render
 | ||
|   InsertEntity.Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMuly, ADoDraw);
 | ||
|   // Change them back
 | ||
|   InsertEntity.Move(-X, -Y);
 | ||
|   // And unrotate it back again
 | ||
|   if RotationAngle <> 0 then
 | ||
|   begin
 | ||
|     InsertEntity.Rotate(-1 * RotationAngle, Make3DPoint(0, 0));
 | ||
|   end;
 | ||
|   ARenderInfo.ForceRenderBlock := OldForceRenderBlock;
 | ||
| end;
 | ||
| 
 | ||
| function TvInsert.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| begin
 | ||
|   FExtraDebugStr := Format(' RotationAngle(degrees)=%f', [RotationAngle * 180 / Pi]);
 | ||
|   if (InsertEntity <> nil) and (InsertEntity is TvNamedEntity) then
 | ||
|     FExtraDebugStr := FExtraDebugStr + Format(' InsertEntity="%s"', [TvNamedEntity(InsertEntity).Name]);
 | ||
|   Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
 | ||
| end;
 | ||
| 
 | ||
| { TvBlock }
 | ||
| 
 | ||
| procedure TvBlock.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
 | ||
|   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| var
 | ||
|   lEntity: TvEntity;
 | ||
| begin
 | ||
|   // blocks are invisible by themselves
 | ||
|   //inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|   if not ARenderInfo.ForceRenderBlock then Exit;
 | ||
| 
 | ||
|   lEntity := GetFirstEntity();
 | ||
|   while lEntity <> nil do
 | ||
|   begin
 | ||
|     {$IFDEF FPVECTORIAL_DEBUG_BLOCKS}
 | ||
|     WriteLn(Format('[TvInsert.Render] Name=%s Block=%s Entity=%s EntityXY=%f | %f BlockXY=%f | %f InsertXY=%f | %f',
 | ||
|       [Name, Block.Name, lEntity.ClassName, lEntity.X, lEntity.Y, Block.X, Block.Y, X, Y]));
 | ||
|     {$ENDIF}
 | ||
| 
 | ||
|     // Alter the position of the elements to consider the positioning of the BLOCK and of the INSERT
 | ||
|     lEntity.Move(X, Y);
 | ||
|     // Render
 | ||
|     lEntity.Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMuly, ADoDraw);
 | ||
|     // Change them back
 | ||
|     lEntity.Move(-X, -Y);
 | ||
| 
 | ||
|     lEntity := GetNextEntity();
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| { TvParagraph }
 | ||
| 
 | ||
| constructor TvParagraph.Create(APage: TvPage);
 | ||
| begin
 | ||
|   inherited Create(APage);
 | ||
| end;
 | ||
| 
 | ||
| destructor TvParagraph.Destroy;
 | ||
| begin
 | ||
|   inherited Destroy;
 | ||
| end;
 | ||
| 
 | ||
| function TvParagraph.AddText(AText: string): TvText;
 | ||
| begin
 | ||
|   Result := TvText.Create(FPage);
 | ||
|   Result.Value.Text := AText;
 | ||
|   AddEntity(Result);
 | ||
| end;
 | ||
| 
 | ||
| function TvParagraph.AddCurvedText(AText: string): TvCurvedText;
 | ||
| begin
 | ||
|   Result := TvCurvedText.Create(FPage);
 | ||
|   Result.Value.Text := AText;
 | ||
|   AddEntity(Result);
 | ||
| end;
 | ||
| 
 | ||
| function TvParagraph.AddField(AKind: TvFieldKind): TvField;
 | ||
| begin
 | ||
|   Result := TvField.Create(FPage);
 | ||
|   Result.Kind := AKind;
 | ||
|   AddEntity(Result);
 | ||
| end;
 | ||
| 
 | ||
| function TvParagraph.AddRasterImage: TvRasterImage;
 | ||
| begin
 | ||
|   Result := TvRasterImage.Create(FPage);
 | ||
|   AddEntity(Result);
 | ||
| end;
 | ||
| 
 | ||
| function TvParagraph.AddEmbeddedVectorialDoc: TvEmbeddedVectorialDoc;
 | ||
| begin
 | ||
|   Result := TvEmbeddedVectorialDoc.Create(FPage);
 | ||
|   AddEntity(Result);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvParagraph.CalculateBoundingBox(ADest: TFPCustomCanvas;
 | ||
|   out ALeft, ATop, ARight, ABottom: Double);
 | ||
| var
 | ||
|   lEntity: TvEntity;
 | ||
|   lCurWidth: Double = 0.0;
 | ||
|   lCurHeight: Double = 0.0;
 | ||
|   lLeft, lTop, lRight, lBottom: Double;
 | ||
|   lText: TvText absolute lEntity;
 | ||
|   {$ifdef USE_LCL_CANVAS}
 | ||
|   ACanvas: TCanvas absolute ADest;
 | ||
|   {$endif}
 | ||
| begin
 | ||
|   ALeft := X;
 | ||
|   ATop := Y;
 | ||
|   ARight := X;
 | ||
|   ABottom := Y;
 | ||
| 
 | ||
|   lEntity := GetFirstEntity();
 | ||
|   while lEntity <> nil do
 | ||
|   begin
 | ||
|     if Style <> nil then
 | ||
|       Style.ApplyIntoEntity(lEntity);
 | ||
|     lEntity.CalculateBoundingBox(ADest, lLeft, lTop, lRight, lBottom);
 | ||
|     lCurWidth := lCurWidth + (lRight - lLeft);
 | ||
|     lCurHeight := Max(lCurHeight, Abs(lTop - lBottom));
 | ||
|     lEntity := GetNextEntity();
 | ||
|   end;
 | ||
| 
 | ||
|   ALeft := X;
 | ||
|   ATop := Y - lCurHeight;
 | ||
|   ARight := X + lCurWidth;
 | ||
|   ABottom := Y;
 | ||
| end;
 | ||
| 
 | ||
| function TvParagraph.TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult;
 | ||
| begin
 | ||
|   Result:=inherited TryToSelect(APos, ASubpart, ASnapFlexibility);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvParagraph.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
 | ||
|   ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| var
 | ||
|   lCurWidth: Double = 0.0;
 | ||
|   lLeft, lTop, lRight, lBottom: Double;
 | ||
|   OldTextX: Double = 0.0;
 | ||
|   OldTextY: Double = 0.0;
 | ||
|   lEntity: TvEntity;
 | ||
|   lText: TvText; // absolute lEntity;
 | ||
|   lPrevText: TvText = nil;
 | ||
|   lFirstText: Boolean = True;
 | ||
|   lResetOldStyle: Boolean = False;
 | ||
|   lEntityRenderInfo: TvRenderInfo;
 | ||
|   CurX, CurY, lHeight_px: Integer;
 | ||
|   lFeatures: TvEntityFeatures;
 | ||
| begin
 | ||
|   InitializeRenderInfo(ARenderInfo, Self);
 | ||
|   InitializeRenderInfo(lEntityRenderInfo, Self);
 | ||
| 
 | ||
|   // Don't call inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|   lEntity := GetFirstEntity();
 | ||
|   while lEntity <> nil do
 | ||
|   begin
 | ||
|     lFeatures := lEntity.GetEntityFeatures(ADest, AMulX, AMulY);
 | ||
|     lHeight_px := 0;
 | ||
|     if YPos_NeedsAdjustment_DelFirstLineBodyHeight then
 | ||
|       lHeight_px := -1 * lFeatures.FirstLineHeight;
 | ||
|     if (lFeatures.DrawsUpwardHeightAdjustment > 0) then
 | ||
|       lHeight_px := lFeatures.DrawsUpwardHeightAdjustment - lFeatures.FirstLineHeight;
 | ||
| 
 | ||
|     if lEntity is TvText then
 | ||
|     begin
 | ||
|       lText := TvText(lEntity);  // cannot debug with "absolute"...
 | ||
| 
 | ||
|       // Set the text style if not already set
 | ||
|       lResetOldStyle := False;
 | ||
|       if (Style <> nil) and (lText.Style = nil) then
 | ||
|       begin
 | ||
|         lText.Style := Style;
 | ||
|         lResetOldStyle := True
 | ||
|       end;
 | ||
| 
 | ||
|       // Direct text position setting resets the auto-positioning
 | ||
|       if (OldTextX <> lText.X) or (OldTextY <> lText.Y) then
 | ||
|       begin
 | ||
|         lCurWidth := 0;
 | ||
|         lFirstText := True;
 | ||
|       end;
 | ||
| 
 | ||
|       OldTextX := lText.X;
 | ||
|       OldTextY := lText.Y;
 | ||
|       CurX := CoordToCanvasX(lText.X + X + lCurWidth, ADestX, AMulX);
 | ||
|       CurY := CoordToCanvasY(lText.Y + Y, ADestY, AMulY);
 | ||
|       lText.X := 0;
 | ||
|       lText.Y := 0;
 | ||
|       CurY += lHeight_px;
 | ||
|       lText.Render_Use_NextText_X := not lFirstText;
 | ||
|       if lText.Render_Use_NextText_X then
 | ||
|         lText.Render_NextText_X := lPrevText.Render_NextText_X;
 | ||
| 
 | ||
|       // Style apply
 | ||
|       if Style <> nil then
 | ||
|         Style.ApplyIntoEntity(lText);
 | ||
| 
 | ||
|       CopyAndInitDocumentRenderInfo(lEntityRenderInfo, ARenderInfo);
 | ||
|       lText.Render(ADest, lEntityRenderInfo, CurX, CurY, AMulX, AMulY, ADoDraw);
 | ||
|       lText.CalculateBoundingBox(ADest, lLeft, lTop, lRight, lBottom);
 | ||
|       lCurWidth := lCurWidth + Abs(lRight - lLeft);
 | ||
|       lFirstText := False;
 | ||
|       lPrevText := lText;
 | ||
| 
 | ||
|       lText.X := OldTextX;
 | ||
|       lText.Y := OldTextY;
 | ||
|       if lResetOldStyle then
 | ||
|         TvText(lEntity).Style := nil;
 | ||
|     end
 | ||
|     else
 | ||
|     begin
 | ||
|       OldTextX := lEntity.X;
 | ||
|       OldTextY := lEntity.Y;
 | ||
|       lEntity.X := lEntity.X + X + lCurWidth;
 | ||
|       lEntity.Y := lEntity.Y + Y;
 | ||
| 
 | ||
|       CopyAndInitDocumentRenderInfo(lEntityRenderInfo, ARenderInfo);
 | ||
|       lEntity.Render(ADest, lEntityRenderInfo, ADestX, ADestY + lHeight_px, AMulX, AMulY, ADoDraw);
 | ||
| 
 | ||
|       lEntity.X := OldTextX;
 | ||
|       lEntity.Y := OldTextY;
 | ||
|     end;
 | ||
| 
 | ||
|     MergeRenderInfo(lEntityRenderInfo, ARenderInfo);
 | ||
| 
 | ||
|     lEntity := GetNextEntity();
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvParagraph.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| begin
 | ||
|   Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
 | ||
| end;
 | ||
| 
 | ||
| { TvList }
 | ||
| 
 | ||
| constructor TvList.Create(APage: TvPage);
 | ||
| begin
 | ||
|   inherited Create(APage);
 | ||
| 
 | ||
|   Parent := Nil;
 | ||
| end;
 | ||
| 
 | ||
| destructor TvList.Destroy;
 | ||
| begin
 | ||
|   inherited Destroy;
 | ||
| end;
 | ||
| 
 | ||
| function TvList.AddParagraph(ASimpleText: string): TvParagraph;
 | ||
| begin
 | ||
|   Result := TvParagraph.Create(FPage);
 | ||
|   // TODO:
 | ||
| //  if FPage <> nil then
 | ||
| //    Result.ListStyle := FPage.FOwner.GetListStyleByLevel(ALevel);
 | ||
|   if ASimpleText <> '' then
 | ||
|     Result.AddText(ASimpleText);
 | ||
|   AddEntity(Result);
 | ||
| end;
 | ||
| 
 | ||
| function TvList.AddList: TvList;
 | ||
| begin
 | ||
|   Result := TvList.Create(FPage);
 | ||
| 
 | ||
|   Result.Style := Style;
 | ||
|   Result.ListStyle := ListStyle;
 | ||
|   Result.Parent := Self;
 | ||
| 
 | ||
|   AddEntity(Result);
 | ||
| end;
 | ||
| 
 | ||
| function TvList.GetLevel: Integer;
 | ||
| var
 | ||
|   oListItem : TvList;
 | ||
| begin
 | ||
|   Result := 0;
 | ||
| 
 | ||
|   oListItem := Parent;
 | ||
| 
 | ||
|   while (oListItem<>Nil) do
 | ||
|   begin
 | ||
|     oListItem := oListItem.Parent;
 | ||
| 
 | ||
|     inc(Result);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvList.GetBulletSize: Double;
 | ||
| begin
 | ||
|   Result := Font.Size;
 | ||
|   if Result = 0 then Result := 10;
 | ||
|   Result := Result * 1.5; // for upper/lower spacing
 | ||
| end;
 | ||
| 
 | ||
| procedure TvList.DrawBullet(ADest: TFPCustomCanvas;
 | ||
|   var ARenderInfo: TvRenderInfo; ALevel: Integer; AX, AY: Double;
 | ||
|   ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double;
 | ||
|   ADoDraw: Boolean);
 | ||
| 
 | ||
|   function CoordToCanvasX(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestX + AmulX * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CoordToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestY + AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   lBulletSpacing: Double;
 | ||
|   lLevel: Integer;
 | ||
| begin
 | ||
|   lBulletSpacing := GetBulletSize() / 2;
 | ||
|   ADest.Pen.Style := psSolid;
 | ||
|   ADest.Pen.FPColor := colBlack;
 | ||
|   ADest.Brush.Style := bsSolid;
 | ||
|   ADest.Brush.FPColor := colBlack;
 | ||
|   lLevel := GetLevel();
 | ||
| 
 | ||
|   // level 0  - filled circle
 | ||
|   // level 1  - circle with empty filling
 | ||
|   // lebel 2+ - filled square
 | ||
|   case lLevel of
 | ||
|     1: ADest.Brush.Style := bsClear;
 | ||
|   end;
 | ||
| 
 | ||
|   case lLevel of
 | ||
|   0, 1:
 | ||
|   begin
 | ||
|     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
 | ||
|       CoordToCanvasX(AX + lBulletSpacing*2), CoordToCanvasY(AY + lBulletSpacing*5));
 | ||
|   end;
 | ||
|   else
 | ||
|     ADest.Rectangle(CoordToCanvasX(AX + lBulletSpacing), CoordToCanvasY(AY + lBulletSpacing*4),
 | ||
|       CoordToCanvasX(AX + lBulletSpacing*2), CoordToCanvasY(AY + lBulletSpacing*5));
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvList.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
 | ||
|       ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True);
 | ||
| 
 | ||
|   function CoordToCanvasX(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestX + AmulX * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CoordToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestY + AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   lEntity: TvEntity;
 | ||
|   lPara: TvParagraph absolute lEntity;
 | ||
|   lList: TvList absolute lEntity;
 | ||
|   lEntityRenderInfo: TvRenderInfo;
 | ||
|   CurX, CurY, lBulletSize, lItemHeight: Double;
 | ||
|   lHeight_px: Integer;
 | ||
| begin
 | ||
|   InitializeRenderInfo(ARenderInfo, Self);
 | ||
| 
 | ||
|   // Don't call inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
| 
 | ||
|   lBulletSize := GetBulletSize() * Abs(AMulX);
 | ||
|   CurX := X + lBulletSize;
 | ||
|   CurY := Y;
 | ||
| 
 | ||
|   lEntity := GetFirstEntity();
 | ||
|   while lEntity <> nil do
 | ||
|   begin
 | ||
|     // handle both directions of drawing
 | ||
|     lHeight_px := 0;
 | ||
|     lEntity.CalculateHeightInCanvas(ADest, AMulX, AMulY, lHeight_px);
 | ||
| 
 | ||
|     // draw the bullet (if necessary)
 | ||
|     if lEntity is TvParagraph then
 | ||
|     begin
 | ||
|       DrawBullet(ADest, lEntityRenderInfo, GetLevel(),
 | ||
|         X, CurY, ADestX, ADestY+lHeight_px, AMulX, AMulY, ADoDraw);
 | ||
|     end;
 | ||
| 
 | ||
|     // attempt to centralize the item
 | ||
|     lEntity.X := CurX;
 | ||
|     lEntity.Y := CurY;
 | ||
|     lItemHeight := lEntity.GetHeight(ADest);
 | ||
|     if lItemHeight < lBulletSize then
 | ||
|     begin
 | ||
|       lItemHeight := lBulletSize;
 | ||
|       lEntity.Y := lEntity.CentralizeY_InHeight(ADest, lBulletSize);
 | ||
|     end;
 | ||
| 
 | ||
|     // draw the item
 | ||
|     lEntity.Render(ADest, lEntityRenderInfo, ADestX, ADestY+lHeight_px, AMulX, AMulY, ADoDraw);
 | ||
| 
 | ||
|     // prepare next loop iteration
 | ||
|     MergeRenderInfo(lEntityRenderInfo, ARenderInfo);
 | ||
|     CurY := CurY + lItemHeight;
 | ||
|     lEntity := GetNextEntity();
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| { TvRichText }
 | ||
| 
 | ||
| constructor TvRichText.Create(APage: TvPage);
 | ||
| begin
 | ||
|   inherited Create(APage);
 | ||
| end;
 | ||
| 
 | ||
| destructor TvRichText.Destroy;
 | ||
| begin
 | ||
|   inherited Destroy;
 | ||
| end;
 | ||
| 
 | ||
| function TvRichText.AddParagraph: TvParagraph;
 | ||
| begin
 | ||
|   Result := TvParagraph.Create(FPage);
 | ||
|   AddEntity(Result);
 | ||
| end;
 | ||
| 
 | ||
| function TvRichText.AddList: TvList;
 | ||
| begin
 | ||
|   Result := TvList.Create(FPage);
 | ||
|   AddEntity(Result);
 | ||
| end;
 | ||
| 
 | ||
| function TvRichText.AddTable: TvTable;
 | ||
| begin
 | ||
|   Result := TvTable.Create(FPage);
 | ||
|   AddEntity(Result);
 | ||
| end;
 | ||
| 
 | ||
| function TvRichText.AddEmbeddedVectorialDoc: TvEmbeddedVectorialDoc;
 | ||
| begin
 | ||
|   Result := TvEmbeddedVectorialDoc.Create(FPage);
 | ||
|   AddEntity(Result);
 | ||
| end;
 | ||
| 
 | ||
| function TvRichText.AddRasterImage: TvRasterImage;
 | ||
| begin
 | ||
|   Result := TvRasterImage.Create(FPage);
 | ||
|   AddEntity(Result);
 | ||
| end;
 | ||
| 
 | ||
| // this function is for descendents to override with a different behavior such as TvTableCell
 | ||
| procedure TvRichText.GetEffectiveCellSpacing(out ATopSpacing, ALeftSpacing, ARightSpacing, ABottomSpacing: Double);
 | ||
| begin
 | ||
|   ATopSpacing := SpacingTop;
 | ||
|   ALeftSpacing := SpacingLeft;
 | ||
|   ARightSpacing := SpacingRight;
 | ||
|   ABottomSpacing := SpacingBottom;
 | ||
| end;
 | ||
| 
 | ||
| function TvRichText.CalculateCellHeight_ForWidth(ADest: TFPCustomCanvas; AWidth: Double): Double;
 | ||
| var
 | ||
|   lCurHeight: Double = 0.0;
 | ||
|   lLeft, lTop, lRight, lBottom, lSpacingTop, lSpacingBottom, lTmp: Double;
 | ||
|   lEntity: TvEntity;
 | ||
|   //lParagraph: TvParagraph absolute lEntity;
 | ||
| begin
 | ||
|   Result := 0;
 | ||
|   lEntity := GetFirstEntity();
 | ||
|   while lEntity <> nil do
 | ||
|   begin
 | ||
|     lEntity.X := X;
 | ||
|     lEntity.Y := Y + Result;
 | ||
|     lEntity.CalculateBoundingBox(ADest, lLeft, lTop, lRight, lBottom);
 | ||
|     Result := Result + (lBottom - lTop);
 | ||
| 
 | ||
|     lEntity := GetNextEntity();
 | ||
|   end;
 | ||
| 
 | ||
|   GetEffectiveCellSpacing(lTmp, lSpacingTop, lTmp, lSpacingBottom);
 | ||
|   Result := Result + lSpacingTop + lSpacingBottom;
 | ||
| end;
 | ||
| 
 | ||
| function TvRichText.CalculateMaxNeededWidth(ADest: TFPCustomCanvas): Double;
 | ||
| var
 | ||
|   lLeft, lTop, lRight, lBottom: Double;
 | ||
|   lEntity: TvEntity;
 | ||
|   //lParagraph: TvParagraph absolute lEntity;
 | ||
| begin
 | ||
|   Result := 0;
 | ||
| 
 | ||
|   // if the width is not yet known, calculate it
 | ||
|   if Width <= 0 then
 | ||
|   begin
 | ||
|     lEntity := GetFirstEntity();
 | ||
|     while lEntity <> nil do
 | ||
|     begin
 | ||
|       lEntity.X := X;
 | ||
|       lEntity.Y := Y + Result;
 | ||
|       lEntity.CalculateBoundingBox(ADest, lLeft, lTop, lRight, lBottom);
 | ||
|       Result := Max(Result, (lRight - lLeft));
 | ||
| 
 | ||
|       lEntity := GetNextEntity();
 | ||
|     end;
 | ||
|   end;
 | ||
| 
 | ||
|   Result := Result + SpacingLeft + SpacingRight;
 | ||
| end;
 | ||
| 
 | ||
| function TvRichText.TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult;
 | ||
| begin
 | ||
|   Result:=inherited TryToSelect(APos, ASubpart, ASnapFlexibility);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvRichText.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
 | ||
|   ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
 | ||
| var
 | ||
|   lCurHeight: Double = 0.0;
 | ||
|   lLeft, lTop, lRight, lBottom: Double;
 | ||
|   lHeight_px: Integer;
 | ||
|   lEntity: TvEntity;
 | ||
|   //lParagraph: TvParagraph absolute lEntity;
 | ||
|   lEntityRenderInfo: TvRenderInfo;
 | ||
| begin
 | ||
|   InitializeRenderInfo(ARenderInfo, Self);
 | ||
| 
 | ||
|   // Don't call inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
|   lEntity := GetFirstEntity();
 | ||
|   while lEntity <> nil do
 | ||
|   begin
 | ||
|     lEntity.X := X;
 | ||
|     lEntity.Y := Y + lCurHeight;
 | ||
|     lHeight_px := lEntity.GetEntityFeatures(ADest, AMulX, AMulY).DrawsUpwardHeightAdjustment;
 | ||
|     CopyAndInitDocumentRenderInfo(lEntityRenderInfo, ARenderInfo);
 | ||
|     lEntity.Render(ADest, lEntityRenderInfo, ADestX, ADestY + lHeight_px, AMulX, AMulY, ADoDraw);
 | ||
|     lEntity.CalculateBoundingBox(ADest, lLeft, lTop, lRight, lBottom);
 | ||
|     lCurHeight := lCurHeight + (lBottom - lTop);
 | ||
| 
 | ||
|     lEntity := GetNextEntity();
 | ||
|     MergeRenderInfo(lEntityRenderInfo, ARenderInfo);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvRichText.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer): Pointer;
 | ||
| begin
 | ||
|   Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
 | ||
| end;
 | ||
| 
 | ||
| { TvPage }
 | ||
| 
 | ||
| constructor TvPage.Create(AOwner: TvVectorialDocument);
 | ||
| begin
 | ||
|   inherited Create;
 | ||
|   FOwner := AOwner;
 | ||
|   AdjustPenColorToBackground := true;
 | ||
|   System.FillChar(RenderInfo, SizeOf(RenderInfo), #0);
 | ||
|   TvEntity.InitializeRenderInfo(RenderInfo, nil, True);
 | ||
| end;
 | ||
| 
 | ||
| destructor TvPage.Destroy;
 | ||
| begin
 | ||
|   TvEntity.FinalizeRenderInfo(RenderInfo);
 | ||
|   inherited Destroy;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvPage.Assign(ASource: TvPage);
 | ||
| begin
 | ||
| 
 | ||
| end;
 | ||
| 
 | ||
| procedure TvPage.SetPageFormat(AFormat: TvPageFormat);
 | ||
| begin
 | ||
|   case AFormat of
 | ||
|   vpA4:
 | ||
|   begin
 | ||
|     Width := 210;
 | ||
|     Height := 297;
 | ||
|   end;
 | ||
|   else
 | ||
|     Width := 210;
 | ||
|     Height := 297;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvPage.CalculateDocumentSize;
 | ||
| var
 | ||
|   i: Integer;
 | ||
|   lCurEntity: TvEntity;
 | ||
|   lLeft, lTop, lRight, lBottom: Double;
 | ||
|   lBmp: TBitmap;
 | ||
| begin
 | ||
|   MinX := 0;
 | ||
|   MinY := 0;
 | ||
|   MinZ := 0;
 | ||
|   MaxX := 0;
 | ||
|   MaxY := 0;
 | ||
|   MaxZ := 0;
 | ||
|   lBmp := TBitmap.Create;
 | ||
|   for i := 0 to GetEntitiesCount() -1 do
 | ||
|   begin
 | ||
|     lCurEntity := GetEntity(i);
 | ||
|     lCurEntity.CalculateBoundingBox(lBmp.Canvas, lLeft, lTop, lRight, lBottom);
 | ||
|     MinX := Min(MinX, lLeft);
 | ||
|     MinY := Min(MinY, lTop);
 | ||
|     MaxX := Max(MaxX, lRight);
 | ||
|     MaxY := Max(MaxY, lBottom);
 | ||
|   end;
 | ||
|   lBmp.Free;
 | ||
|   Width := MaxX - MinX;
 | ||
|   Height := MaxY - MinY;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvPage.AutoFit(ADest: TFPCustomCanvas; AWidth, AHeight, ARenderHeight: Integer;
 | ||
|   out ADeltaX, ADeltaY: Integer; out AZoom: Double);
 | ||
| var
 | ||
|   lCurEntity: TvEntity;
 | ||
|   lLeft, lTop, lWidth, lHeight: Integer;
 | ||
|   lMinX, lMinY, lMaxX, lMaxY, lNaturalHeightDiff: Integer;
 | ||
|   lZoomFitX, lZoomFitY, lNaturalMulY: Double;
 | ||
| 
 | ||
|   function CalculateAllEntitySizes(): Boolean;
 | ||
|   var
 | ||
|     i: Integer;
 | ||
|   begin
 | ||
|     Result := True;
 | ||
| 
 | ||
|     lMinX := High(Integer);
 | ||
|     lMinY := High(Integer);
 | ||
|     lMaxX := Low(Integer);
 | ||
|     lMaxY := Low(Integer);
 | ||
| 
 | ||
|     if Self is TvVectorialPage then
 | ||
|     begin
 | ||
|       for i := 0 to GetEntitiesCount() - 1 do
 | ||
|       begin
 | ||
|         lCurEntity := TvEntity(GetEntity(i));
 | ||
|         if lCurEntity.CalculateSizeInCanvas(ADest, Self, ARenderHeight, AZoom, lLeft, lTop, lWidth, lHeight) then
 | ||
|         begin
 | ||
|           lMinX := Min(lMinX, lLeft);
 | ||
|           lMinY := Min(lMinY, lTop);
 | ||
|           lMaxX := Max(lMaxX, lLeft + lWidth);
 | ||
|           lMaxY := Max(lMaxY, lTop  + lHeight);
 | ||
|         end;
 | ||
|         {$ifdef FPVECTORIAL_AUTOFIT_DEBUG}
 | ||
|         AutoFitDebug.Add(Format('[%s] MinX=%d MinY=%d MaxX=%d MaxY=%D', [lCurEntity.ClassName, lMinX, lMinY, lMaxX, lMaxY]));
 | ||
|         {$endif}
 | ||
|       end;
 | ||
| 
 | ||
|       lMinX := Min(lMinX, lLeft);
 | ||
|       lMinY := Min(lMinY, lTop);
 | ||
|       lMaxX := Max(lMaxX, lLeft + lWidth);
 | ||
|       lMaxY := Max(lMaxY, lTop  + lHeight);
 | ||
|     end
 | ||
|     else
 | ||
|     begin
 | ||
|       Render(ADest, 0, 0, AZoom, AZoom * lNaturalMulY, False);
 | ||
|       lMinX := RenderInfo.EntityCanvasMinXY.X;
 | ||
|       lMinY := RenderInfo.EntityCanvasMinXY.Y;
 | ||
|       lMaxX := RenderInfo.EntityCanvasMaxXY.X;
 | ||
|       lMaxY := RenderInfo.EntityCanvasMaxXY.Y;
 | ||
|     end;
 | ||
| 
 | ||
|     if (lMinX = High(Integer)) or (lMinY = High(Integer)) or
 | ||
|        (lMaxX = Low(Integer)) or(lMaxY = Low(Integer)) then
 | ||
|        Exit(False);
 | ||
| 
 | ||
|     lWidth := lMaxX - lMinX;
 | ||
|     lHeight := lMaxY - lMinY;
 | ||
|     if (lWidth = 0) or (lHeight = 0) then Exit(False);
 | ||
|   end;
 | ||
| 
 | ||
| begin
 | ||
|   {$ifdef FPVECTORIAL_AUTOFIT_DEBUG}
 | ||
|   AutoFitDebug := TStringList.Create;
 | ||
|   try
 | ||
|   {$endif}
 | ||
|   ADeltaX := 0;
 | ||
|   ADeltaY := 0;
 | ||
|   GetNaturalRenderPos(lNaturalHeightDiff, lNaturalMulY);
 | ||
| 
 | ||
|   // First Calculate the zoom
 | ||
| 
 | ||
|   AZoom := 1;
 | ||
|   if not CalculateAllEntitySizes() then Exit;
 | ||
| 
 | ||
|   lZoomFitX := AWidth / lWidth;
 | ||
|   lZoomFitY := AHeight / lHeight;
 | ||
|   AZoom := Min(lZoomFitX, lZoomFitY) * 0.9;
 | ||
| 
 | ||
|   // Now DeltaX, DeltaY
 | ||
| 
 | ||
|   if not CalculateAllEntitySizes() then Exit;
 | ||
|   ADeltaX := Round(-1 * lMinX) + AWidth div 2 - lWidth div 2;
 | ||
|   ADeltaY := Round(-1 * lMinY) + (AHeight div 2 - lHeight div 2);
 | ||
| 
 | ||
|   {$ifdef FPVECTORIAL_RENDERINFO_VISUALDEBUG}
 | ||
|   ADest.Brush.Style := bsClear;
 | ||
|   ADest.Pen.FPColor := colRed;
 | ||
|   ADest.Pen.Style := psSolid;
 | ||
|   ADest.Rectangle(lMinX+ADeltaX, lMinY+ADeltaY, lMaxX+ADeltaX, lMaxY+ADeltaY);
 | ||
|   {$endif}
 | ||
| 
 | ||
|   {$ifdef FPVECTORIAL_AUTOFIT_DEBUG}
 | ||
|   finally
 | ||
|     {$ifdef Windows}
 | ||
|     AutoFitDebug.SaveToFile('C:\Programas\autofit.txt');
 | ||
|     {$else}
 | ||
|     AutoFitDebug.SaveToFile('/Users/felipe/autofit.txt');
 | ||
|     {$endif}
 | ||
|     AutoFitDebug.Free;
 | ||
|     AutoFitDebug := nil;
 | ||
|   end;
 | ||
|   {$endif}
 | ||
| end;
 | ||
| 
 | ||
| procedure TvPage.SetNaturalRenderPos(AUseTopLeftCoords: Boolean);
 | ||
| begin
 | ||
|   FUseTopLeftCoordinates := AUseTopLeftCoords;
 | ||
| end;
 | ||
| 
 | ||
| function TvPage.HasNaturalRenderPos: Boolean;
 | ||
| begin
 | ||
|   Result := FUseTopLeftCoordinates;
 | ||
| end;
 | ||
| 
 | ||
| function TvPage.GetTopLeftCoords_Adjustment: Double;
 | ||
| begin
 | ||
|   if UseTopLeftCoordinates then
 | ||
|     Result := 1
 | ||
|   else
 | ||
|     Result := -1;
 | ||
| end;
 | ||
| 
 | ||
| 
 | ||
| { TvVectorialPage }
 | ||
| 
 | ||
| procedure TvVectorialPage.ClearTmpPath;
 | ||
| begin
 | ||
|   FTmpPath.Points := nil;
 | ||
|   FTmpPath.PointsEnd := nil;
 | ||
|   FTmpPath.Len := 0;
 | ||
|   FTmpPath.Brush.Color := colBlue;
 | ||
|   FTmpPath.Brush.Style := bsClear;
 | ||
|   FTmpPath.Pen.Color := colBlack;
 | ||
|   FTmpPath.Pen.Style := psSolid;
 | ||
|   FTmpPath.Pen.Width := 1;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.AppendSegmentToTmpPath(ASegment: TPathSegment);
 | ||
| begin
 | ||
|   FTmpPath.AppendSegment(ASegment);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.CallbackDeleteEntity(data, arg: pointer);
 | ||
| begin
 | ||
|   if (data <> nil) then
 | ||
|     TvEntity(data).Free;
 | ||
| end;
 | ||
| 
 | ||
| constructor TvVectorialPage.Create(AOwner: TvVectorialDocument);
 | ||
| begin
 | ||
|   inherited Create(AOwner);
 | ||
| 
 | ||
|   FEntities := TFPList.Create;
 | ||
|   FTmpPath := TPath.Create(Self);
 | ||
|   Owner := AOwner;
 | ||
|   Clear();
 | ||
|   BackgroundColor := colWhite;
 | ||
|   RenderInfo.BackgroundColor := colWhite;
 | ||
| end;
 | ||
| 
 | ||
| destructor TvVectorialPage.Destroy;
 | ||
| begin
 | ||
|   Clear;
 | ||
| 
 | ||
|   if FTmpPath <> nil then
 | ||
|   begin
 | ||
|     FTmpPath.Free;
 | ||
|     FTmpPath := nil;
 | ||
|   end;
 | ||
| 
 | ||
|   FEntities.Free;
 | ||
|   FEntities := nil;
 | ||
| 
 | ||
|   inherited Destroy;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.Assign(ASource: TvPage);
 | ||
| var
 | ||
|   i: Integer;
 | ||
|   AVecSource: TvVectorialPage absolute ASource;
 | ||
| begin
 | ||
|   if not (ASource is TvVectorialPage) then Exit;
 | ||
|   Clear;
 | ||
| 
 | ||
|   for i := 0 to AVecSource.GetEntitiesCount - 1 do
 | ||
|     Self.AddEntity(AVecSource.GetEntity(i));
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.GetEntity(ANum: Cardinal): TvEntity;
 | ||
| begin
 | ||
|   if ANum >= FEntities.Count then raise Exception.Create('TvVectorialDocument.GetEntity: Entity number out of bounds');
 | ||
| 
 | ||
|   Result := TvEntity(FEntities.Items[ANum]);
 | ||
| 
 | ||
|   if Result = nil then raise Exception.Create(Format('TvVectorialDocument.GetEntity: Invalid Entity number ANum=%d', [ANum]));
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.GetEntitiesCount: Integer;
 | ||
| begin
 | ||
|   Result := FEntities.Count;
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.GetLastEntity(): TvEntity;
 | ||
| begin
 | ||
|   Result:=TvEntity(FEntities.Last);
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.GetEntityIndex(AEntity: TvEntity): Integer;
 | ||
| var
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   Result := -1;
 | ||
|   for i := 0 to GetEntitiesCount()-1 do
 | ||
|     if TvEntity(FEntities.Items[i]) = AEntity then Exit(i);
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.FindAndSelectEntity(Pos: TPoint): TvFindEntityResult;
 | ||
| var
 | ||
|   lEntity: TvEntity;
 | ||
|   i: Integer;
 | ||
|   lSubpart: Cardinal;
 | ||
| begin
 | ||
|   Result := vfrNotFound;
 | ||
| 
 | ||
|   for i := 0 to GetEntitiesCount() - 1 do
 | ||
|   begin
 | ||
|     lEntity := GetEntity(i);
 | ||
| 
 | ||
|     Result := lEntity.TryToSelect(Pos, lSubpart);
 | ||
| 
 | ||
|     if Result <> vfrNotFound then
 | ||
|     begin
 | ||
|       Owner.SelectedElement := lEntity;
 | ||
|       Exit;
 | ||
|     end;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.FindEntityWithNameAndType(AName: string;
 | ||
|   AType: TvEntityClass; ARecursively: Boolean): TvEntity;
 | ||
| var
 | ||
|   i: Integer;
 | ||
|   lCurEntity: TvEntity;
 | ||
|   lCurName: String;
 | ||
| begin
 | ||
|   Result := nil;
 | ||
|   for i := 0 to GetEntitiesCount()-1 do
 | ||
|   begin
 | ||
|     lCurEntity := GetEntity(i);
 | ||
| 
 | ||
|     if (lCurEntity is TvNamedEntity) then
 | ||
|       lCurName := TvNamedEntity(lCurEntity).Name
 | ||
|     else
 | ||
|       lCurName := '';
 | ||
| 
 | ||
|     if (lCurEntity is AType) and
 | ||
|       (lCurEntity is TvNamedEntity) and (lCurName = AName) then
 | ||
|     begin
 | ||
|       Result := lCurEntity;
 | ||
|       Exit;
 | ||
|     end;
 | ||
| 
 | ||
|     if ARecursively and (lCurEntity is TvEntityWithSubEntities) then
 | ||
|     begin
 | ||
|       Result := TvEntityWithSubEntities(lCurEntity).FindEntityWithNameAndType(AName, AType, True);
 | ||
|       if Result <> nil then Exit;
 | ||
|     end;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.Clear;
 | ||
| begin
 | ||
|   FEntities.ForEachCall(@CallbackDeleteEntity, nil);
 | ||
|   FEntities.Clear();
 | ||
|   ClearTmpPath();
 | ||
|   ClearLayerSelection();
 | ||
| end;
 | ||
| 
 | ||
| {@@
 | ||
|   Returns if the entity was really deleted or false if there is no entity with this index
 | ||
| }
 | ||
| function TvVectorialPage.DeleteEntity(AIndex: Cardinal): Boolean;
 | ||
| var
 | ||
|   lEntity: TvEntity;
 | ||
| begin
 | ||
|   Result := False;
 | ||
|   if AIndex >= GetEntitiesCount() then Exit;;
 | ||
|   lEntity := GetEntity(AIndex);
 | ||
|   if lEntity = nil then Exit;
 | ||
|   FEntities.Delete(AIndex);
 | ||
|   lEntity.Free;
 | ||
|   Result := True;
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.RemoveEntity(AEntity: TvEntity; AFreeAfterRemove: Boolean = True): Boolean;
 | ||
| begin
 | ||
|   Result := False;
 | ||
|   if AEntity = nil then Exit;
 | ||
|   FEntities.Remove(AEntity);
 | ||
|   if AFreeAfterRemove then AEntity.Free;
 | ||
|   Result := True;
 | ||
| end;
 | ||
| 
 | ||
| {@@
 | ||
|   Adds an entity to the document and returns it's current index
 | ||
| }
 | ||
| function TvVectorialPage.AddEntity(AEntity: TvEntity): Integer;
 | ||
| begin
 | ||
|   AEntity.SetPage(Self);
 | ||
|   if FCurrentLayer = nil then
 | ||
|   begin
 | ||
|     Result := FEntities.Count;
 | ||
|     //AEntity.Parent := nil;
 | ||
|     FEntities.Add(Pointer(AEntity));
 | ||
|   end
 | ||
|   // If a layer is selected as current, add elements to it instead
 | ||
|   else
 | ||
|   begin
 | ||
|     Result := FCurrentLayer.GetSubpartCount();
 | ||
|     //AEntity.Parent := FCurrentLayer;
 | ||
|     FCurrentLayer.AddEntity(AEntity);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.AddPathCopyMem(APath: TPath; AOnlyCreate: Boolean = False): TPath;
 | ||
| var
 | ||
|   lPath: TPath;
 | ||
|   //Len: Integer;
 | ||
| begin
 | ||
|   lPath := TPath.Create(Self);
 | ||
|   lPath.Assign(APath);
 | ||
|   Result := lPath;
 | ||
|   if not AOnlyCreate then AddEntity(lPath);
 | ||
|   //WriteLn(':>TvVectorialDocument.AddPath 1 Len = ', Len);
 | ||
| end;
 | ||
| 
 | ||
| {@@
 | ||
|   Starts writing a Path in multiple steps.
 | ||
|   Should be followed by zero or more calls to AddPointToPath
 | ||
|   and by a call to EndPath to effectively add the data.
 | ||
| 
 | ||
|   @see    EndPath, AddPointToPath
 | ||
| }
 | ||
| procedure TvVectorialPage.StartPath(AX, AY: Double);
 | ||
| var
 | ||
|   segment: T2DSegment;
 | ||
| begin
 | ||
|   ClearTmpPath();
 | ||
| 
 | ||
|   FTmpPath.Len := 1;
 | ||
|   segment := T2DSegment.Create;
 | ||
|   segment.SegmentType := stMoveTo;
 | ||
|   segment.X := AX;
 | ||
|   segment.Y := AY;
 | ||
| 
 | ||
|   FTmpPath.Points := segment;
 | ||
|   FTmpPath.PointsEnd := segment;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.StartPath;
 | ||
| begin
 | ||
|   ClearTmpPath();
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.AddMoveToPath(AX, AY: Double);
 | ||
| var
 | ||
|   segment: T2DSegment;
 | ||
| begin
 | ||
|   segment := T2DSegment.Create;
 | ||
|   segment.SegmentType := stMoveTo;
 | ||
|   segment.X := AX;
 | ||
|   segment.Y := AY;
 | ||
| 
 | ||
|   AppendSegmentToTmpPath(segment);
 | ||
| end;
 | ||
| 
 | ||
| {@@
 | ||
|   Adds one more point to the end of a Path being
 | ||
|   writing in multiple steps.
 | ||
| 
 | ||
|   Does nothing if not called between StartPath and EndPath.
 | ||
| 
 | ||
|   Can be called multiple times to add multiple points.
 | ||
| 
 | ||
|   @see    StartPath, EndPath
 | ||
| }
 | ||
| procedure TvVectorialPage.AddLineToPath(AX, AY: Double);
 | ||
| var
 | ||
|   segment: T2DSegment;
 | ||
| begin
 | ||
|   segment := T2DSegment.Create;
 | ||
|   segment.SegmentType := st2DLine;
 | ||
|   segment.X := AX;
 | ||
|   segment.Y := AY;
 | ||
| 
 | ||
|   AppendSegmentToTmpPath(segment);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.AddLineToPath(AX, AY: Double; AColor: TFPColor);
 | ||
| var
 | ||
|   segment: T2DSegmentWithPen;
 | ||
| begin
 | ||
|   segment := T2DSegmentWithPen.Create;
 | ||
|   segment.SegmentType := st2DLineWithPen;
 | ||
|   segment.X := AX;
 | ||
|   segment.Y := AY;
 | ||
|   segment.Pen.Color := AColor;
 | ||
| 
 | ||
|   AppendSegmentToTmpPath(segment);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.AddLineToPath(AX, AY, AZ: Double);
 | ||
| var
 | ||
|   segment: T3DSegment;
 | ||
| begin
 | ||
|   segment := T3DSegment.Create;
 | ||
|   segment.SegmentType := st3DLine;
 | ||
|   segment.X := AX;
 | ||
|   segment.Y := AY;
 | ||
|   segment.Z := AZ;
 | ||
| 
 | ||
|   AppendSegmentToTmpPath(segment);
 | ||
| end;
 | ||
| 
 | ||
| {@@
 | ||
|   Gets the current Pen Pos in the temporary path
 | ||
| }
 | ||
| procedure TvVectorialPage.GetCurrentPathPenPos(var AX, AY: Double);
 | ||
| begin
 | ||
|   // Check if we are the first segment in the tmp path
 | ||
|   if FTmpPath.PointsEnd = nil then raise Exception.Create('[TvVectorialDocument.GetCurrentPathPenPos] One cannot obtain the Pen Pos if there are no segments in the temporary path');
 | ||
| 
 | ||
|   AX := T2DSegment(FTmpPath.PointsEnd).X;
 | ||
|   AY := T2DSegment(FTmpPath.PointsEnd).Y;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.GetTmpPathStartPos(var AX, AY: Double);
 | ||
| begin
 | ||
|   AX := 0;
 | ||
|   AY := 0;
 | ||
|   if (FTmpPath = nil) or (FTmpPath.GetSubpartCount() <= 0) or (FTmpPath.Points = nil) then Exit;
 | ||
|   if FTmpPath.Points is T2DSegment then
 | ||
|   begin
 | ||
|     AX := T2DSegment(FTmpPath.Points).X;
 | ||
|     AY := T2DSegment(FTmpPath.Points).Y;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| {@@
 | ||
|   Adds a bezier element to the path. It starts where the previous element ended
 | ||
|   and it goes throw the control points [AX1, AY1] and [AX2, AY2] and ends
 | ||
|   in [AX3, AY3].
 | ||
| }
 | ||
| procedure TvVectorialPage.AddBezierToPath(AX1, AY1, AX2, AY2, AX3, AY3: Double);
 | ||
| var
 | ||
|   segment: T2DBezierSegment;
 | ||
| begin
 | ||
|   segment := T2DBezierSegment.Create;
 | ||
|   segment.SegmentType := st2DBezier;
 | ||
|   segment.X := AX3;
 | ||
|   segment.Y := AY3;
 | ||
|   segment.X2 := AX1;
 | ||
|   segment.Y2 := AY1;
 | ||
|   segment.X3 := AX2;
 | ||
|   segment.Y3 := AY2;
 | ||
| 
 | ||
|   AppendSegmentToTmpPath(segment);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.AddBezierToPath(AX1, AY1, AZ1, AX2, AY2, AZ2, AX3, AY3, AZ3: Double);
 | ||
| var
 | ||
|   segment: T3DBezierSegment;
 | ||
| begin
 | ||
|   segment := T3DBezierSegment.Create;
 | ||
|   segment.SegmentType := st3DBezier;
 | ||
|   segment.X := AX3;
 | ||
|   segment.Y := AY3;
 | ||
|   segment.Z := AZ3;
 | ||
|   segment.X2 := AX1;
 | ||
|   segment.Y2 := AY1;
 | ||
|   segment.Z2 := AZ1;
 | ||
|   segment.X3 := AX2;
 | ||
|   segment.Y3 := AY2;
 | ||
|   segment.Z3 := AZ2;
 | ||
| 
 | ||
|   AppendSegmentToTmpPath(segment);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.AddEllipticalArcToPath(ARadX, ARadY, AXAxisRotation,
 | ||
|   ADestX, ADestY: Double; ALeftmostEllipse, AClockwiseArcFlag: Boolean);
 | ||
| var
 | ||
|   segment: T2DEllipticalArcSegment;
 | ||
| begin
 | ||
|   segment := T2DEllipticalArcSegment.Create;
 | ||
|   segment.SegmentType := st2DEllipticalArc;
 | ||
|   segment.X := ADestX;
 | ||
|   segment.Y := ADestY;
 | ||
|   segment.RX := ARadX;
 | ||
|   segment.RY := ARadY;
 | ||
|   segment.XRotation := AXAxisRotation;
 | ||
|   segment.LeftmostEllipse := ALeftmostEllipse;
 | ||
|   segment.ClockwiseArcFlag := AClockwiseArcFlag;
 | ||
| 
 | ||
|   AppendSegmentToTmpPath(segment);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.AddEllipticalArcWithCenterToPath(ARadX, ARadY,
 | ||
|   AXAxisRotation, ADestX, ADestY, ACenterX, ACenterY: Double;
 | ||
|   AClockwiseArcFlag: Boolean);
 | ||
| var
 | ||
|   segment: T2DEllipticalArcSegment;
 | ||
| begin
 | ||
|   segment := T2DEllipticalArcSegment.Create;
 | ||
|   segment.SegmentType := st2DEllipticalArc;
 | ||
|   segment.X := ADestX;
 | ||
|   segment.Y := ADestY;
 | ||
|   segment.RX := ARadX;
 | ||
|   segment.RY := ARadY;
 | ||
|   segment.XRotation := AXAxisRotation;
 | ||
|   segment.CX := ACenterX;
 | ||
|   segment.CY := ACenterY;
 | ||
|   segment.ClockwiseArcFlag := AClockwiseArcFlag;
 | ||
|   segment.CenterSetByUser := true;
 | ||
| 
 | ||
|   AppendSegmentToTmpPath(segment);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.SetBrushColor(AColor: TFPColor);
 | ||
| begin
 | ||
|   FTmPPath.Brush.Color := AColor;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.SetBrushStyle(AStyle: TFPBrushStyle);
 | ||
| begin
 | ||
|   FTmPPath.Brush.Style := AStyle;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.SetPenColor(AColor: TFPColor);
 | ||
| begin
 | ||
|   FTmPPath.Pen.Color := AColor;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.SetPenStyle(AStyle: TFPPenStyle);
 | ||
| begin
 | ||
|   FTmPPath.Pen.Style := AStyle;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.SetPenWidth(AWidth: Integer);
 | ||
| begin
 | ||
|   FTmPPath.Pen.Width := AWidth;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.SetClipPath(AClipPath: TPath; AClipMode: TvClipMode);
 | ||
| begin
 | ||
|   FTmPPath.ClipPath := AClipPath;
 | ||
|   FTmPPath.ClipMode := AClipMode;
 | ||
| end;
 | ||
| 
 | ||
| {@@
 | ||
|   Finishes writing a Path, which was created in multiple
 | ||
|   steps using StartPath and AddPointToPath,
 | ||
|   to the document.
 | ||
| 
 | ||
|   Does nothing if there wasn't a previous correspondent call to
 | ||
|   StartPath.
 | ||
| 
 | ||
|   @see    StartPath, AddPointToPath
 | ||
| }
 | ||
| function  TvVectorialPage.EndPath(AOnlyCreate: Boolean = False): TPath;
 | ||
| begin
 | ||
|   if FTmpPath.Len = 0 then Exit;
 | ||
|   Result := AddPathCopyMem(FTmpPath, AOnlyCreate);
 | ||
|   Result.FPage := self;
 | ||
|   ClearTmpPath();
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.AddText(AX, AY, AZ: Double; FontName: string;
 | ||
|   FontSize: integer; AText: utf8string; AOnlyCreate: Boolean = False): TvText;
 | ||
| var
 | ||
|   lText: TvText;
 | ||
| begin
 | ||
|   lText := TvText.Create(Self);
 | ||
|   lText.Value.Text := AText;
 | ||
|   lText.X := AX;
 | ||
|   lText.Y := AY;
 | ||
|   lText.Z := AZ;
 | ||
|   lText.Font.Name := FontName;
 | ||
|   lText.Font.Size := FontSize;
 | ||
|   if not AOnlyCreate then AddEntity(lText);
 | ||
|   Result := lText;
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.AddText(AX, AY: Double; AStr: utf8string; AOnlyCreate: Boolean = False): TvText;
 | ||
| begin
 | ||
|   Result := AddText(AX, AY, 0, '', 10, AStr, AOnlyCreate);
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.AddText(AX, AY, AZ: Double; AStr: utf8string; AOnlyCreate: Boolean = False): TvText;
 | ||
| begin
 | ||
|   Result := AddText(AX, AY, AZ, '', 10, AStr, AOnlyCreate);
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.AddCircle(ACenterX, ACenterY, ARadius: Double; AOnlyCreate: Boolean = False): TvCircle;
 | ||
| var
 | ||
|   lCircle: TvCircle;
 | ||
| begin
 | ||
|   lCircle := TvCircle.Create(Self);
 | ||
|   lCircle.X := ACenterX;
 | ||
|   lCircle.Y := ACenterY;
 | ||
|   lCircle.Radius := ARadius;
 | ||
|   Result := lCircle;
 | ||
|   if not AOnlyCreate then AddEntity(lCircle);
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.AddCircularArc(ACenterX, ACenterY, ARadius,
 | ||
|   AStartAngle, AEndAngle: Double; AColor: TFPColor; AOnlyCreate: Boolean = False): TvCircularArc;
 | ||
| var
 | ||
|   lCircularArc: TvCircularArc;
 | ||
| begin
 | ||
|   lCircularArc := TvCircularArc.Create(Self);
 | ||
|   lCircularArc.X := ACenterX;
 | ||
|   lCircularArc.Y := ACenterY;
 | ||
|   lCircularArc.Radius := ARadius;
 | ||
|   lCircularArc.StartAngle := AStartAngle;
 | ||
|   lCircularArc.EndAngle := AEndAngle;
 | ||
|   lCircularArc.Pen.Color := AColor;
 | ||
|   Result := lCircularArc;
 | ||
|   if not AOnlyCreate then AddEntity(lCircularArc);
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.AddEllipse(CenterX, CenterY, HorzHalfAxis,
 | ||
|   VertHalfAxis, Angle: Double; AOnlyCreate: Boolean = False): TvEllipse;
 | ||
| var
 | ||
|   lEllipse: TvEllipse;
 | ||
| begin
 | ||
|   lEllipse := TvEllipse.Create(Self);
 | ||
|   lEllipse.X := CenterX;
 | ||
|   lEllipse.Y := CenterY;
 | ||
|   lEllipse.HorzHalfAxis := HorzHalfAxis;
 | ||
|   lEllipse.VertHalfAxis := VertHalfAxis;
 | ||
|   lEllipse.Angle := Angle;
 | ||
|   Result := lEllipse;
 | ||
|   if not AOnlyCreate then AddEntity(lEllipse);
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.AddBlock(AName: string; AX, AY, AZ: Double): TvBlock;
 | ||
| var
 | ||
|   lBlock: TvBlock;
 | ||
| begin
 | ||
|   lBlock := TvBlock.Create(Self);
 | ||
|   lBlock.X := AX;
 | ||
|   lBlock.Y := AY;
 | ||
|   lBlock.Name := AName;
 | ||
|   AddEntity(lBlock);
 | ||
|   Result := lBlock;
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.AddInsert(AX, AY, AZ: Double; AInsertEntity: TvEntity): TvInsert;
 | ||
| var
 | ||
|   lInsert: TvInsert;
 | ||
| begin
 | ||
|   lInsert := TvInsert.Create(Self);
 | ||
|   lInsert.X := AX;
 | ||
|   lInsert.Y := AY;
 | ||
|   lInsert.InsertEntity := AInsertEntity;
 | ||
|   AddEntity(lInsert);
 | ||
|   Result := lInsert;
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.AddLayer(AName: string): TvLayer;
 | ||
| begin
 | ||
|   Result := TvLayer.Create(Self);
 | ||
|   Result.Name := AName;
 | ||
|   AddEntity(Result);
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.AddLayerAndSetAsCurrent(AName: string): TvLayer;
 | ||
| begin
 | ||
|   Result := AddLayer(AName);
 | ||
|   FCurrentLayer := Result;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.ClearLayerSelection;
 | ||
| begin
 | ||
|   FCurrentLayer := nil;
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.SetCurrentLayer(ALayer: TvEntityWithSubEntities): Boolean;
 | ||
| begin
 | ||
|   Result := True;
 | ||
|   FCurrentLayer := ALayer;
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.GetCurrentLayer: TvEntityWithSubEntities;
 | ||
| begin
 | ||
|   Result := FCurrentLayer;
 | ||
| end;
 | ||
| 
 | ||
| 
 | ||
| function TvVectorialPage.AddAlignedDimension(BaseLeft, BaseRight, DimLeft,
 | ||
|   DimRight: T3DPoint; AOnlyCreate: Boolean = False): TvAlignedDimension;
 | ||
| var
 | ||
|   lDim: TvAlignedDimension;
 | ||
| begin
 | ||
|   lDim := TvAlignedDimension.Create(Self);
 | ||
|   lDim.BaseLeft := BaseLeft;
 | ||
|   lDim.BaseRight := BaseRight;
 | ||
|   lDim.DimensionLeft := DimLeft;
 | ||
|   lDim.DimensionRight := DimRight;
 | ||
|   Result := lDim;
 | ||
|   if not AOnlyCreate then AddEntity(lDim);
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.AddRadialDimension(AIsDiameter: Boolean; ACenter,
 | ||
|   ADimLeft, ADimRight: T3DPoint; AOnlyCreate: Boolean = False): TvRadialDimension;
 | ||
| var
 | ||
|   lDim: TvRadialDimension;
 | ||
| begin
 | ||
|   lDim := TvRadialDimension.Create(Self);
 | ||
|   lDim.IsDiameter := AIsDiameter;
 | ||
|   lDim.Center := ACenter;
 | ||
|   lDim.DimensionLeft := ADimLeft;
 | ||
|   lDim.DimensionRight := ADimRight;
 | ||
|   Result := lDim;
 | ||
|   if not AOnlyCreate then AddEntity(lDim);
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.AddArcDimension(AArcValue, AArcRadius: Double; ABaseLeft, ABaseRight, ADimLeft, ADimRight, ATextPos: T3DPoint; AOnlyCreate: Boolean): TvArcDimension;
 | ||
| var
 | ||
|   lDim: TvArcDimension;
 | ||
| begin
 | ||
|   lDim := TvArcDimension.Create(Self);
 | ||
|   lDim.BaseLeft := ABaseLeft;
 | ||
|   lDim.BaseRight := ABaseRight;
 | ||
|   lDim.DimensionLeft := ADimLeft;
 | ||
|   lDim.DimensionRight := ADimRight;
 | ||
|   lDim.ArcRadius := AArcRadius;
 | ||
|   lDim.ArcValue := AArcValue;
 | ||
|   lDim.TextPos := ATextPos;
 | ||
|   Result := lDim;
 | ||
|   if not AOnlyCreate then AddEntity(lDim);
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialPage.AddPoint(AX, AY, AZ: Double): TvPoint;
 | ||
| var
 | ||
|   lPoint: TvPoint;
 | ||
| begin
 | ||
|   lPoint := TvPoint.Create(Self);
 | ||
|   lPoint.X := AX;
 | ||
|   lPoint.Y := AY;
 | ||
|   lPoint.Z := AZ;
 | ||
|   AddEntity(lPoint);
 | ||
|   Result := lPoint;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.PositionEntitySubparts(ADest: TFPCustomCanvas; ABaseX,
 | ||
|   ABaseY: Double);
 | ||
| var
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   for i := 0 to GetEntitiesCount()-1 do
 | ||
|     GetEntity(i).PositionSubparts(ADest, ABaseX, ABaseY);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.DrawBackground(ADest: TFPCustomCanvas);
 | ||
| begin
 | ||
|   ADest.Pen.Style := psClear;
 | ||
|   ADest.Brush.Style := bsSolid;
 | ||
|   ADest.Brush.FPColor := BackgroundColor;
 | ||
|   ADest.FillRect(0, 0, ADest.Width, ADest.Height);
 | ||
|   ADest.Pen.Style := psSolid;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.RenderPageBorder(ADest: TFPCustomCanvas;
 | ||
|   ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double);
 | ||
| 
 | ||
|   function CoordToCanvasX(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestX + AmulX * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CoordToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestY + AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   lLeft, lTop, lRight, lBottom: Integer;
 | ||
| begin
 | ||
|   // Fix the min/max values
 | ||
|   if MinX = MaxX then MaxX := MinX + Width;
 | ||
|   if MinY = MaxY then MaxY := MinY + Height;
 | ||
| 
 | ||
|   lLeft := CoordToCanvasX(MinX);
 | ||
|   lTop := CoordToCanvasY(MaxY);
 | ||
|   lRight := CoordToCanvasX(MaxX);
 | ||
|   lBottom := CoordToCanvasY(MinY);
 | ||
| 
 | ||
|   ADest.Brush.Style := bsClear;
 | ||
|   ADest.Pen.FPColor := colBlack;
 | ||
|   ADest.Pen.Style := psSolid;
 | ||
|   ADest.Pen.Width := 1;
 | ||
|   ADest.Rectangle(lLeft, lTop, lRight, lBottom);
 | ||
| end;
 | ||
| 
 | ||
| {@@
 | ||
|   This function draws a FPVectorial vectorial page to a TFPCustomCanvas
 | ||
|   descendent, such as TCanvas from the LCL.
 | ||
| 
 | ||
|   Be careful that by default this routine does not execute coordinate transformations,
 | ||
|   and that FPVectorial works with a start point in the bottom-left corner, with
 | ||
|   the X growing to the right and the Y growing to the top. This will result in
 | ||
|   an image in TFPCustomCanvas mirrored in the Y axis in relation with the document
 | ||
|   as seen in a PDF viewer, for example. This can be easily changed with the
 | ||
|   provided parameters. To have the standard view of an image viewer one could
 | ||
|   use this function like this:
 | ||
| 
 | ||
|   ASource.Render(ADest, 0, ASource.Height, 1.0, -1.0);
 | ||
| 
 | ||
|   Set ADoDraw to falses in order to just get the bounding box of all entities
 | ||
|   on the page in RenderInfo.EnitityCanvasMinXY/EntityCanvasMaxXY.
 | ||
| }
 | ||
| procedure TvVectorialPage.Render(ADest: TFPCustomCanvas;
 | ||
|   ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double;
 | ||
|   ADoDraw: Boolean = true);
 | ||
| var
 | ||
|   i: Integer;
 | ||
|   CurEntity: TvEntity;
 | ||
|   rinfo: TvRenderInfo;
 | ||
| begin
 | ||
|   {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 | ||
|   WriteLn(':>DrawFPVectorialToCanvas');
 | ||
|   {$endif}
 | ||
| 
 | ||
|   TvEntity.InitializeRenderInfo(RenderInfo, nil);
 | ||
|   TvEntity.InitializeRenderInfo(rInfo, nil);
 | ||
|   TvEntity.CopyAndInitDocumentRenderInfo(rInfo, RenderInfo);
 | ||
| 
 | ||
|   for i := 0 to GetEntitiesCount - 1 do
 | ||
|   begin
 | ||
|     {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 | ||
|     Write(Format('[Path] ID=%d', [i]));
 | ||
|     {$endif}
 | ||
| 
 | ||
|     CurEntity := GetEntity(i);
 | ||
| 
 | ||
|     RenderInfo.BackgroundColor := BackgroundColor;
 | ||
|     RenderInfo.AdjustPenColorToBackground := AdjustPenColorToBackground;
 | ||
| 
 | ||
|     CurEntity.Render(ADest, RenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
 | ||
| 
 | ||
|     if i = 0 then
 | ||
|       rInfo := RenderInfo
 | ||
|     else
 | ||
|     begin
 | ||
|       rInfo.EntityCanvasMinXY.X := Min(rInfo.EntityCanvasMinXY.X, RenderInfo.EntityCanvasMinXY.X);
 | ||
|       rInfo.EntityCanvasMinXY.Y := Min(rInfo.EntityCanvasMinXY.Y, RenderInfo.EntityCanvasMinXY.Y);
 | ||
|       rInfo.EntityCanvasMaxXY.X := Max(rInfo.EntityCanvasMaxXY.X, RenderInfo.EntityCanvasMaxXY.X);
 | ||
|       rInfo.EntityCanvasMaxXY.Y := Max(rInfo.EntityCanvasMaxXY.Y, RenderInfo.EntityCanvasMaxXY.Y);
 | ||
|     end;
 | ||
|   end;
 | ||
| 
 | ||
|   TvEntity.CopyAndInitDocumentRenderInfo(RenderInfo, rInfo, True);
 | ||
| 
 | ||
|   {$ifdef FPVECTORIAL_RENDERINFO_VISUALDEBUG}
 | ||
|   ADest.Brush.Style := bsClear;
 | ||
|   ADest.Pen.FPColor := colRed;
 | ||
|   ADest.Rectangle(rInfo.EntityCanvasMinXY.X, RenderInfo.EntityCanvasMinXY.Y,
 | ||
|     rInfo.EntityCanvasMaxXY.X, rInfo.EntityCanvasMaxXY.Y);
 | ||
|   {$endif}
 | ||
|   {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 | ||
|   WriteLn(':<DrawFPVectorialToCanvas');
 | ||
|   {$endif}
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.GetNaturalRenderPos(var APageHeight: Integer; out AMulY: Double);
 | ||
| begin
 | ||
|   if FUseTopLeftCoordinates then
 | ||
|   begin
 | ||
|     APageHeight := 0;
 | ||
|     AMulY := 1.0;
 | ||
|   end
 | ||
|   else
 | ||
|   begin
 | ||
|     AMulY := -1.0;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialPage.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
 | ||
|   APageItem: Pointer);
 | ||
| var
 | ||
|   lCurEntity: TvEntity;
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   for i := 0 to FEntities.Count - 1 do
 | ||
|   begin
 | ||
|     lCurEntity := TvEntity(FEntities.Items[i]);
 | ||
|     lCurEntity.GenerateDebugTree(ADestRoutine, APageItem);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| { TvTextPageSequence }
 | ||
| 
 | ||
| constructor TvTextPageSequence.Create(AOwner: TvVectorialDocument);
 | ||
| begin
 | ||
|   inherited Create(AOwner);
 | ||
| 
 | ||
|   FUseTopLeftCoordinates := True;
 | ||
|   Footer := TvRichText.Create(Self);
 | ||
|   Header := TvRichText.Create(Self);
 | ||
|   MainText := TvRichText.Create(Self);
 | ||
| end;
 | ||
| 
 | ||
| destructor TvTextPageSequence.Destroy;
 | ||
| begin
 | ||
|   Footer.Free;
 | ||
|   Header.Free;
 | ||
|   MainText.Free;
 | ||
| 
 | ||
|   inherited Destroy;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvTextPageSequence.Assign(ASource: TvPage);
 | ||
| begin
 | ||
|   inherited Assign(ASource);
 | ||
| end;
 | ||
| 
 | ||
| function TvTextPageSequence.GetEntity(ANum: Cardinal): TvEntity;
 | ||
| begin
 | ||
|   Result := MainText.GetEntity(ANum);
 | ||
| end;
 | ||
| 
 | ||
| function TvTextPageSequence.GetEntitiesCount: Integer;
 | ||
| begin
 | ||
|   Result := MainText.GetEntitiesCount();
 | ||
| end;
 | ||
| 
 | ||
| function TvTextPageSequence.GetLastEntity: TvEntity;
 | ||
| begin
 | ||
|   Result := MainText.GetEntity(MainText.GetEntitiesCount()-1);
 | ||
| end;
 | ||
| 
 | ||
| function TvTextPageSequence.GetEntityIndex(AEntity: TvEntity): Integer;
 | ||
| begin
 | ||
|   Result := MainText.GetEntityIndex(AEntity);
 | ||
| end;
 | ||
| 
 | ||
| function TvTextPageSequence.FindAndSelectEntity(Pos: TPoint
 | ||
|   ): TvFindEntityResult;
 | ||
| begin
 | ||
| 
 | ||
| end;
 | ||
| 
 | ||
| function TvTextPageSequence.FindEntityWithNameAndType(AName: string;
 | ||
|   AType: TvEntityClass; ARecursively: Boolean): TvEntity;
 | ||
| begin
 | ||
| 
 | ||
| end;
 | ||
| 
 | ||
| procedure TvTextPageSequence.Clear;
 | ||
| begin
 | ||
|   MainText.Clear;
 | ||
| end;
 | ||
| 
 | ||
| function TvTextPageSequence.DeleteEntity(AIndex: Cardinal): Boolean;
 | ||
| begin
 | ||
|   Result := MainText.DeleteEntity(AIndex);
 | ||
| end;
 | ||
| 
 | ||
| function TvTextPageSequence.RemoveEntity(AEntity: TvEntity;
 | ||
|   AFreeAfterRemove: Boolean): Boolean;
 | ||
| begin
 | ||
|   Result := True;
 | ||
|   MainText.Clear;
 | ||
| end;
 | ||
| 
 | ||
| function TvTextPageSequence.AddEntity(AEntity: TvEntity): Integer;
 | ||
| begin
 | ||
|   AEntity.SetPage(Self);
 | ||
|   Result := MainText.AddEntity(AEntity);
 | ||
| end;
 | ||
| 
 | ||
| function TvTextPageSequence.AddParagraph: TvParagraph;
 | ||
| begin
 | ||
|   Result := MainText.AddParagraph();
 | ||
| end;
 | ||
| 
 | ||
| function TvTextPageSequence.AddList: TvList;
 | ||
| begin
 | ||
|   Result := MainText.AddList();
 | ||
| end;
 | ||
| 
 | ||
| function TvTextPageSequence.AddTable: TvTable;
 | ||
| begin
 | ||
|   Result := MainText.AddTable;
 | ||
| end;
 | ||
| 
 | ||
| function TvTextPageSequence.AddEmbeddedVectorialDoc: TvEmbeddedVectorialDoc;
 | ||
| begin
 | ||
|   Result := MainText.AddEmbeddedVectorialDoc;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvTextPageSequence.DrawBackground(ADest: TFPCustomCanvas);
 | ||
| begin
 | ||
| 
 | ||
| end;
 | ||
| 
 | ||
| procedure TvTextPageSequence.RenderPageBorder(ADest: TFPCustomCanvas;
 | ||
|   ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double);
 | ||
| begin
 | ||
| 
 | ||
| end;
 | ||
| 
 | ||
| procedure TvTextPageSequence.Render(ADest: TFPCustomCanvas; ADestX: Integer;
 | ||
|   ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean = true);
 | ||
| 
 | ||
|   function CoordToCanvasX(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestX + AmulX * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
|   function CoordToCanvasY(ACoord: Double): Integer;
 | ||
|   begin
 | ||
|     Result := Round(ADestY + AmulY * ACoord);
 | ||
|   end;
 | ||
| 
 | ||
| var
 | ||
|   i: Integer;
 | ||
|   CurEntity: TvEntity;
 | ||
|   CurY_px: Integer = 0;
 | ||
|   lHeight_px: Integer;
 | ||
|   lBoundsLeft, lBoundsTop, lBoundsRight, lBoundsBottom: Double;
 | ||
|   lSumRenderInfo: TvRenderInfo;
 | ||
| begin
 | ||
|   {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 | ||
|   WriteLn(':>TvTextPageSequence.Render');
 | ||
|   {$endif}
 | ||
|   CurY_px := ADestY;
 | ||
|   TvEntity.InitializeRenderInfo(lSumRenderInfo, nil, False);
 | ||
|   TvEntity.CopyAndInitDocumentRenderInfo(lSumRenderInfo, RenderInfo);
 | ||
| 
 | ||
|   for i := 0 to GetEntitiesCount - 1 do
 | ||
|   begin
 | ||
|     {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 | ||
|     Write(Format('[Path] ID=%d', [i]));
 | ||
|     {$endif}
 | ||
| 
 | ||
|     CurEntity := GetEntity(i);
 | ||
| 
 | ||
|     CurEntity.X := 0;
 | ||
|     CurEntity.Y := 0;
 | ||
|     lHeight_px := CurEntity.GetEntityFeatures(ADest, AMulX, AMulY).TotalHeight;
 | ||
|     RenderInfo.BackgroundColor := BackgroundColor;
 | ||
|     CurEntity.Render(ADest, RenderInfo, ADestX, CurY_px + lHeight_px, AMulX, AMulY, ADoDraw);
 | ||
|     // Store the old position in X/Y but don't use it, we use this to debug out the position
 | ||
|     CurEntity.X := ADestX;
 | ||
|     CurEntity.Y := CurY_px;
 | ||
|     lHeight_px := Abs(RenderInfo.EntityCanvasMaxXY.Y - RenderInfo.EntityCanvasMinXY.Y);
 | ||
|     CurY_px := CurY_px + lHeight_px;
 | ||
| 
 | ||
|     TvEntity.CalcEntityCanvasMinMaxXY_With2Points(lSumRenderInfo,
 | ||
|       RenderInfo.EntityCanvasMinXY.X, RenderInfo.EntityCanvasMinXY.Y,
 | ||
|       RenderInfo.EntityCanvasMaxXY.X, RenderInfo.EntityCanvasMaxXY.Y);
 | ||
|   end;
 | ||
| 
 | ||
|   TvEntity.CopyAndInitDocumentRenderInfo(RenderInfo, lSumRenderInfo, True);
 | ||
| 
 | ||
|   {$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
 | ||
|   WriteLn(':<TvTextPageSequence.Render');
 | ||
|   {$endif}
 | ||
| end;
 | ||
| 
 | ||
| procedure TvTextPageSequence.GetNaturalRenderPos(var APageHeight: Integer; out AMulY: Double);
 | ||
| begin
 | ||
|   APageHeight := 0;
 | ||
|   AMulY := 1.0;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvTextPageSequence.GenerateDebugTree(
 | ||
|   ADestRoutine: TvDebugAddItemProc; APageItem: Pointer);
 | ||
| var
 | ||
|   lCurEntity: TvEntity;
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   for i := 0 to MainText.GetEntitiesCount() - 1 do
 | ||
|   begin
 | ||
|     lCurEntity := MainText.GetEntity(i);
 | ||
|     lCurEntity.GenerateDebugTree(ADestRoutine, APageItem);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| (*
 | ||
| function TvTextPageSequence.AddImage: TvImage;
 | ||
| begin
 | ||
|   Result := MainText.AddImage;
 | ||
| end;
 | ||
| *)
 | ||
| { TvVectorialDocument }
 | ||
| 
 | ||
| {@@
 | ||
|   Constructor.
 | ||
| }
 | ||
| constructor TvVectorialDocument.Create;
 | ||
| begin
 | ||
|   inherited Create;
 | ||
| 
 | ||
|   FPages := TFPList.Create;
 | ||
|   FCurrentPageIndex := -1;
 | ||
|   FStyles := TFPList.Create;
 | ||
|   FListStyles := TFPList.Create;
 | ||
| end;
 | ||
| 
 | ||
| {@@
 | ||
|   Destructor.
 | ||
| }
 | ||
| destructor TvVectorialDocument.Destroy;
 | ||
| begin
 | ||
|   Clear;
 | ||
| 
 | ||
|   FPages.Free;
 | ||
|   FPages := nil;
 | ||
|   FStyles.Free;
 | ||
|   FStyles := nil;
 | ||
|   FListStyles.Free;
 | ||
|   FListStyles := nil;
 | ||
| 
 | ||
|   inherited Destroy;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialDocument.Assign(ASource: TvVectorialDocument);
 | ||
| //var
 | ||
| //  i: Integer;
 | ||
| begin
 | ||
| //  Clear;
 | ||
| //
 | ||
| //  for i := 0 to ASource.GetEntitiesCount - 1 do
 | ||
| //    Self.AddEntity(ASource.GetEntity(i));
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialDocument.AssignTo(ADest: TvVectorialDocument);
 | ||
| begin
 | ||
|   ADest.Assign(Self);
 | ||
| end;
 | ||
| 
 | ||
| {@@
 | ||
|   Convenience method which creates the correct
 | ||
|   writer object for a given vector graphics document format.
 | ||
| }
 | ||
| function TvVectorialDocument.CreateVectorialWriter(AFormat: TvVectorialFormat): TvCustomVectorialWriter;
 | ||
| var
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   Result := nil;
 | ||
| 
 | ||
|   for i := 0 to Length(GvVectorialFormats) - 1 do
 | ||
|     if GvVectorialFormats[i].Format = AFormat then
 | ||
|     begin
 | ||
|       if GvVectorialFormats[i].WriterClass <> nil then
 | ||
|         Result := GvVectorialFormats[i].WriterClass.Create;
 | ||
| 
 | ||
|       Break;
 | ||
|     end;
 | ||
| 
 | ||
|   if Result = nil then raise Exception.Create('Unsupported vector graphics format.');
 | ||
| end;
 | ||
| 
 | ||
| {@@
 | ||
|   Convenience method which creates the correct
 | ||
|   reader object for a given vector graphics document format.
 | ||
| }
 | ||
| function TvVectorialDocument.CreateVectorialReader(AFormat: TvVectorialFormat): TvCustomVectorialReader;
 | ||
| var
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   Result := nil;
 | ||
| 
 | ||
|   for i := 0 to Length(GvVectorialFormats) - 1 do
 | ||
|     if GvVectorialFormats[i].Format = AFormat then
 | ||
|     begin
 | ||
|       if GvVectorialFormats[i].ReaderClass <> nil then
 | ||
|         Result := GvVectorialFormats[i].ReaderClass.Create;
 | ||
| 
 | ||
|       Break;
 | ||
|     end;
 | ||
| 
 | ||
|   if Result = nil then raise Exception.Create('Unsupported vector graphics format.');
 | ||
| end;
 | ||
| 
 | ||
| {@@
 | ||
|   Writes the document to a file.
 | ||
| 
 | ||
|   If the file doesn't exist, it will be created.
 | ||
| }
 | ||
| procedure TvVectorialDocument.WriteToFile(AFileName: string; AFormat: TvVectorialFormat);
 | ||
| var
 | ||
|   AWriter: TvCustomVectorialWriter;
 | ||
| begin
 | ||
|   AWriter := CreateVectorialWriter(AFormat);
 | ||
| 
 | ||
|   try
 | ||
|     AWriter.WriteToFile(AFileName, Self);
 | ||
|   finally
 | ||
|     AWriter.Free;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialDocument.WriteToFile(AFileName: string);
 | ||
| var
 | ||
|   lFormat: TvVectorialFormat;
 | ||
| begin
 | ||
|   lFormat := GetFormatFromExtension(AFileName);
 | ||
|   WriteToFile(AFileName, lFormat);
 | ||
| end;
 | ||
| 
 | ||
| {@@
 | ||
|   Writes the document to a stream
 | ||
| }
 | ||
| procedure TvVectorialDocument.WriteToStream(AStream: TStream; AFormat: TvVectorialFormat);
 | ||
| var
 | ||
|   AWriter: TvCustomVectorialWriter;
 | ||
| begin
 | ||
|   AWriter := CreateVectorialWriter(AFormat);
 | ||
| 
 | ||
|   try
 | ||
|     AWriter.WriteToStream(AStream, Self);
 | ||
|   finally
 | ||
|     AWriter.Free;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialDocument.WriteToStrings(AStrings: TStrings;
 | ||
|   AFormat: TvVectorialFormat);
 | ||
| var
 | ||
|   AWriter: TvCustomVectorialWriter;
 | ||
| begin
 | ||
|   AWriter := CreateVectorialWriter(AFormat);
 | ||
| 
 | ||
|   try
 | ||
|     AWriter.WriteToStrings(AStrings, Self);
 | ||
|   finally
 | ||
|     AWriter.Free;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| {@@
 | ||
|   Reads the document from a file.
 | ||
| 
 | ||
|   Any current contents in this object will be removed.
 | ||
| }
 | ||
| procedure TvVectorialDocument.ReadFromFile(AFileName: string;
 | ||
|   AFormat: TvVectorialFormat);
 | ||
| var
 | ||
|   AReader: TvCustomVectorialReader;
 | ||
| begin
 | ||
|   Self.Clear;
 | ||
| 
 | ||
|   AReader := CreateVectorialReader(AFormat);
 | ||
|   try
 | ||
|     AReader.Settings := ReaderSettings;
 | ||
|     AReader.ReadFromFile(AFileName, Self);
 | ||
|   finally
 | ||
|     AReader.Free;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| {@@
 | ||
|   Reads the document from a file.  A variant that auto-detects the format from the extension and other factors.
 | ||
| }
 | ||
| procedure TvVectorialDocument.ReadFromFile(AFileName: string);
 | ||
| var
 | ||
|   lFormat: TvVectorialFormat;
 | ||
| begin
 | ||
|   lFormat := GetFormatFromExtension(AFileName);
 | ||
|   ReadFromFile(AFileName, lFormat);
 | ||
| end;
 | ||
| 
 | ||
| {@@
 | ||
|   Reads the document from a stream.
 | ||
| 
 | ||
|   Any current contents in this object will be removed.
 | ||
| }
 | ||
| procedure TvVectorialDocument.ReadFromStream(AStream: TStream;
 | ||
|   AFormat: TvVectorialFormat);
 | ||
| var
 | ||
|   AReader: TvCustomVectorialReader;
 | ||
| begin
 | ||
|   Self.Clear;
 | ||
| 
 | ||
|   AReader := CreateVectorialReader(AFormat);
 | ||
|   try
 | ||
|     AReader.Settings := ReaderSettings;
 | ||
|     AReader.ReadFromStream(AStream, Self);
 | ||
|   finally
 | ||
|     AReader.Free;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialDocument.ReadFromStrings(AStrings: TStrings;
 | ||
|   AFormat: TvVectorialFormat);
 | ||
| var
 | ||
|   AReader: TvCustomVectorialReader;
 | ||
| begin
 | ||
|   Self.Clear;
 | ||
| 
 | ||
|   AReader := CreateVectorialReader(AFormat);
 | ||
|   try
 | ||
|     AReader.Settings := ReaderSettings;
 | ||
|     AReader.ReadFromStrings(AStrings, Self);
 | ||
|   finally
 | ||
|     AReader.Free;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialDocument.ReadFromXML(ADoc: TXMLDocument; AFormat: TvVectorialFormat);
 | ||
| var
 | ||
|   AReader: TvCustomVectorialReader;
 | ||
| begin
 | ||
|   Self.Clear;
 | ||
| 
 | ||
|   AReader := CreateVectorialReader(AFormat);
 | ||
|   try
 | ||
|     AReader.ReadFromXML(ADoc, Self);
 | ||
|   finally
 | ||
|     AReader.Free;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| class function TvVectorialDocument.GetFormatFromExtension(AFileName: string;
 | ||
|   ARaiseException: Boolean = True): TvVectorialFormat;
 | ||
| var
 | ||
|   lExt: string;
 | ||
| begin
 | ||
|   lExt := ExtractFileExt(AFileName);
 | ||
|   if AnsiCompareText(lExt, STR_PDF_EXTENSION) = 0 then Result := vfPDF
 | ||
|   else if AnsiCompareText(lExt, STR_POSTSCRIPT_EXTENSION) = 0 then Result := vfPostScript
 | ||
|   else if AnsiCompareText(lExt, STR_SVG_EXTENSION) = 0 then Result := vfSVG
 | ||
|   else if AnsiCompareText(lExt, STR_SVGZ_EXTENSION) = 0 then Result := vfSVGZ
 | ||
|   else if AnsiCompareText(lExt, STR_CORELDRAW_EXTENSION) = 0 then Result := vfCorelDrawCDR
 | ||
|   else if AnsiCompareText(lExt, STR_WINMETAFILE_EXTENSION) = 0 then Result := vfWindowsMetafileWMF
 | ||
|   else if AnsiCompareText(lExt, STR_AUTOCAD_EXCHANGE_EXTENSION) = 0 then Result := vfDXF
 | ||
|   else if AnsiCompareText(lExt, STR_ENCAPSULATEDPOSTSCRIPT_EXTENSION) = 0 then Result := vfEncapsulatedPostScript
 | ||
|   else if AnsiCompareText(lExt, STR_LAS_EXTENSION) = 0 then Result := vfLAS
 | ||
|   else if AnsiCompareText(lExt, STR_LAZ_EXTENSION) = 0 then Result := vfLAZ
 | ||
|   else if AnsiCompareText(lExt, STR_RAW_EXTENSION) = 0 then Result := vfRAW
 | ||
|   else if AnsiCompareText(lExt, STR_MATHML_EXTENSION) = 0 then Result := vfMathML
 | ||
|   else if AnsiCompareText(lExt, STR_ODG_EXTENSION) = 0 then Result := vfODG
 | ||
|   else if AnsiCompareText(lExt, STR_DOCX_EXTENSION) = 0 then Result := vfDOCX
 | ||
|   else if AnsiCompareText(lExt, STR_HTML_EXTENSION) = 0 then Result := vfHTML
 | ||
|   else if ARaiseException then
 | ||
|     raise Exception.Create('TvVectorialDocument.GetFormatFromExtension: The extension (' + lExt + ') doesn''t match any supported formats.')
 | ||
|   else
 | ||
|     Result := vfUnknown;
 | ||
| end;
 | ||
| 
 | ||
| function  TvVectorialDocument.GetDetailedFileFormat(): string;
 | ||
| begin
 | ||
| 
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialDocument.GuessDocumentSize();
 | ||
| var
 | ||
|   i, j: Integer;
 | ||
|   lEntity: TvEntity;
 | ||
|   lLeft, lTop, lRight, lBottom: Double;
 | ||
|   CurPage: TvPage;
 | ||
| begin
 | ||
|   lLeft := 0;
 | ||
|   lTop := 0;
 | ||
|   lRight := 0;
 | ||
|   lBottom := 0;
 | ||
| 
 | ||
|   for j := 0 to GetPageCount()-1 do
 | ||
|   begin
 | ||
|     CurPage := GetPage(j);
 | ||
|     for i := 0 to CurPage.GetEntitiesCount() - 1 do
 | ||
|     begin
 | ||
|       lEntity := CurPage.GetEntity(I);
 | ||
|       lEntity.ExpandBoundingBox(nil, lLeft, lTop, lRight, lBottom);
 | ||
|     end;
 | ||
|   end;
 | ||
| 
 | ||
|   Width := lRight - lLeft;
 | ||
|   Height := lBottom - lTop;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialDocument.GuessGoodZoomLevel(AScreenSize: Integer);
 | ||
| begin
 | ||
|   If Height<>0 Then
 | ||
|     ZoomLevel := AScreenSize / Height;
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialDocument.GetPage(AIndex: Integer): TvPage;
 | ||
| begin
 | ||
|   Result := TvPage(FPages.Items[AIndex]);
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialDocument.GetPageIndex(APage: TvPage): Integer;
 | ||
| var
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   Result := -1;
 | ||
|   for i := 0 to FPages.Count-1 do
 | ||
|     if TvPage(FPages.Items[i]) = APage then Exit(i);
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialDocument.GetPageAsVectorial(AIndex: Integer): TvVectorialPage;
 | ||
| var
 | ||
|   lPage: TvPage;
 | ||
| begin
 | ||
|   lPage := GetPage(AIndex);
 | ||
|   if (Assigned(lPage) and (lPage is TvVectorialPage)) then
 | ||
|     Result := TvVectorialPage(lPage)
 | ||
|   else
 | ||
|     Result := nil;
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialDocument.GetPageAsText(AIndex: Integer): TvTextPageSequence;
 | ||
| var
 | ||
|   lPage: TvPage;
 | ||
| begin
 | ||
|   lPage := GetPage(AIndex);
 | ||
|   if (Assigned(lPage) and (lPage is TvTextPageSequence)) then
 | ||
|     Result := TvTextPageSequence(lPage)
 | ||
|   else
 | ||
|     Result := nil;
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialDocument.GetPageCount: Integer;
 | ||
| begin
 | ||
|   Result := FPages.Count;
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialDocument.GetCurrentPage: TvPage;
 | ||
| begin
 | ||
|   if FCurrentPageIndex >= 0 then
 | ||
|     Result := GetPage(FCurrentPageIndex)
 | ||
|   else
 | ||
|     Result := nil;
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialDocument.GetCurrentPageAsVectorial: TvVectorialPage;
 | ||
| var
 | ||
|   lCurPage: TvPage;
 | ||
| begin
 | ||
|   lCurPage := GetCurrentPage();
 | ||
|   if (lCurPage <> nil) and (lCurPage is TvVectorialPage) then
 | ||
|     Result := TvVectorialPage(lCurPage)
 | ||
|   else
 | ||
|     Result := nil
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialDocument.SetCurrentPage(AIndex: Integer);
 | ||
| begin
 | ||
|   FCurrentPageIndex := AIndex;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialDocument.SetDefaultPageFormat(AFormat: TvPageFormat);
 | ||
| begin
 | ||
|   case AFormat of
 | ||
|   vpA4:
 | ||
|   begin
 | ||
|     Width := 210;
 | ||
|     Height := 297;
 | ||
|   end;
 | ||
|   else
 | ||
|     Width := 210;
 | ||
|     Height := 297;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialDocument.AddPage(AUseTopLeftCoords: Boolean = False): TvVectorialPage;
 | ||
| begin
 | ||
|   Result := TvVectorialPage.Create(Self);
 | ||
|   Result.Width := Width;
 | ||
|   Result.Height := Height;
 | ||
|   Result.SetNaturalRenderPos(AUseTopLeftCoords);
 | ||
|   FPages.Add(Result);
 | ||
|   if FCurrentPageIndex < 0 then FCurrentPageIndex := FPages.Count-1;
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialDocument.AddTextPageSequence: TvTextPageSequence;
 | ||
| begin
 | ||
|   Result := TvTextPageSequence.Create(Self);
 | ||
|   Result.Width := Width;
 | ||
|   Result.Height := Height;
 | ||
|   FPages.Add(Result);
 | ||
|   if FCurrentPageIndex < 0 then FCurrentPageIndex := FPages.Count-1;
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialDocument.AddStyle: TvStyle;
 | ||
| begin
 | ||
|   Result := TvStyle.Create;
 | ||
|   FStyles.Add(Result);
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialDocument.AddListStyle: TvListStyle;
 | ||
| begin
 | ||
|   Result := TvListStyle.Create;
 | ||
|   FListStyles.Add(Result);
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialDocument.AddStandardTextDocumentStyles(AFormat: TvVectorialFormat);
 | ||
| var
 | ||
|   lTextBody, lBaseHeading, lCurStyle: TvStyle;
 | ||
|   lCurListStyle : TvListStyle;
 | ||
|   i: Integer;
 | ||
|   lCurListLevelStyle: TvListLevelStyle;
 | ||
| begin
 | ||
|   lTextBody := AddStyle();
 | ||
|   lTextBody.Name := 'Text Body';
 | ||
|   lTextBody.Kind := vskTextBody;
 | ||
|   lTextBody.Font.Size := 12;
 | ||
|   lTextBody.Font.Name := 'Times New Roman';
 | ||
|   lTextBody.Brush.Style := bsClear;
 | ||
|   lTextBody.Alignment := vsaJustifed;
 | ||
|   lTextBody.MarginTop := 0;
 | ||
|   lTextBody.MarginBottom := 2.12;
 | ||
|   lTextBody.SetElements := [spbfFontSize, spbfFontName, spbfAlignment,
 | ||
|     sseMarginTop, sseMarginBottom, spbfBrushStyle];
 | ||
|   StyleTextBody := lTextBody;
 | ||
| 
 | ||
|   // Headings
 | ||
|   lBaseHeading := AddStyle();
 | ||
|   lBaseHeading.Name := 'Heading';
 | ||
|   lBaseHeading.Kind := vskHeading;
 | ||
|   lBaseHeading.Font.Size := 14;
 | ||
|   lBaseHeading.Font.Name := 'Arial';
 | ||
|   lBaseHeading.Brush.Style := bsClear;
 | ||
|   lBaseHeading.MarginTop := 4.23;
 | ||
|   lBaseHeading.MarginBottom := 2.12;
 | ||
|   lBaseHeading.SetElements := [spbfFontSize, spbfFontName, sseMarginTop, sseMarginBottom];
 | ||
| 
 | ||
|   lCurStyle := AddStyle();
 | ||
|   lCurStyle.Name := 'Heading 1';
 | ||
|   lCurStyle.Parent := lBaseHeading;
 | ||
|   lCurStyle.HeadingLevel := 1;
 | ||
|   lCurStyle.Font.Bold := True;
 | ||
|   case AFormat of
 | ||
|     vfHTML: lCurStyle.Font.Size := 20;
 | ||
|   else
 | ||
|     lCurStyle.Font.Size := Round(1.15 * lBaseHeading.Font.Size);
 | ||
|   end;
 | ||
|   lCurStyle.Brush.Style := bsClear;
 | ||
|   lCurStyle.SetElements := [spbfFontSize, spbfFontBold];
 | ||
|   StyleHeading1 := lCurStyle;
 | ||
| 
 | ||
|   lCurStyle := AddStyle();
 | ||
|   lCurStyle.Name := 'Heading 2';
 | ||
|   lCurStyle.Parent := lBaseHeading;
 | ||
|   lCurStyle.HeadingLevel := 2;
 | ||
|   lCurStyle.Font.Bold := True;
 | ||
|   case AFormat of
 | ||
|     vfHTML: lCurStyle.Font.Size := 16;
 | ||
|   else
 | ||
|     lCurStyle.Font.Size := 14;
 | ||
|     lCurStyle.Font.Italic := True;
 | ||
|   end;
 | ||
|   lCurStyle.Brush.Style := bsClear;
 | ||
|   lCurStyle.SetElements := [spbfFontSize, spbfFontBold, spbfFontItalic];
 | ||
|   StyleHeading2 := lCurStyle;
 | ||
| 
 | ||
|   lCurStyle := AddStyle();
 | ||
|   lCurStyle.Name := 'Heading 3';
 | ||
|   lCurStyle.Parent := lBaseHeading;
 | ||
|   lCurStyle.HeadingLevel := 3;
 | ||
|   lCurStyle.Font.Bold := True;
 | ||
|   lCurStyle.Font.Size := 14;
 | ||
|   lCurStyle.Brush.Style := bsClear;
 | ||
|   lCurStyle.SetElements := [spbfFontSize, spbfFontName, spbfFontBold];
 | ||
|   StyleHeading3 := lCurStyle;
 | ||
| 
 | ||
|   lCurStyle := AddStyle();
 | ||
|   lCurStyle.Name := 'Heading 4';
 | ||
|   lCurStyle.Parent := lBaseHeading;
 | ||
|   lCurStyle.HeadingLevel := 4;
 | ||
|   lCurStyle.Font.Size := 12;
 | ||
|   lCurStyle.Font.Bold := True;
 | ||
|   lCurStyle.Brush.Style := bsClear;
 | ||
|   lCurStyle.SetElements := [spbfFontSize, spbfFontName, spbfFontBold];
 | ||
|   StyleHeading4 := lCurStyle;
 | ||
| 
 | ||
|   lCurStyle := AddStyle();
 | ||
|   lCurStyle.Name := 'Heading 5';
 | ||
|   lCurStyle.Parent := lBaseHeading;
 | ||
|   lCurStyle.HeadingLevel := 5;
 | ||
|   lCurStyle.Font.Size := 10;
 | ||
|   lCurStyle.Font.Bold := True;
 | ||
|   lCurStyle.Brush.Style := bsClear;
 | ||
|   lCurStyle.SetElements := [spbfFontSize, spbfFontName, spbfFontBold];
 | ||
|   StyleHeading5 := lCurStyle;
 | ||
| 
 | ||
|   lCurStyle := AddStyle();
 | ||
|   lCurStyle.Name := 'Heading 6';
 | ||
|   lCurStyle.Parent := lBaseHeading;
 | ||
|   lCurStyle.HeadingLevel := 6;
 | ||
|   lCurStyle.Font.Size := 8;
 | ||
|   lCurStyle.Font.Bold := True;
 | ||
|   lCurStyle.Brush.Style := bsClear;
 | ||
|   lCurStyle.SetElements := [spbfFontSize, spbfFontName, spbfFontBold];
 | ||
|   StyleHeading6 := lCurStyle;
 | ||
| 
 | ||
|   // ---------------------------------
 | ||
|   // Centralized paragraph styles
 | ||
|   // ---------------------------------
 | ||
| 
 | ||
|   StyleTextBodyCentralized := AddStyle();
 | ||
|   StyleTextBodyCentralized.ApplyOver(StyleTextBody);
 | ||
|   StyleTextBodyCentralized.Name := 'Text Body Centered';
 | ||
|   StyleTextBodyCentralized.Alignment := vsaCenter;
 | ||
|   StyleTextBodyCentralized.SetElements := StyleTextBodyCentralized.SetElements + [spbfAlignment];
 | ||
| 
 | ||
|   StyleTextBodyBold := AddStyle();
 | ||
|   StyleTextBodyBold.ApplyOver(StyleTextBody);
 | ||
|   StyleTextBodyBold.Name := 'Text Body Bold';
 | ||
|   StyleTextBodyBold.Font.Bold := True;
 | ||
|   StyleTextBodyBold.SetElements := StyleTextBodyCentralized.SetElements + [spbfFontBold];
 | ||
| 
 | ||
|   StyleHeading1Centralized := AddStyle();
 | ||
|   StyleHeading1Centralized.ApplyOver(StyleHeading1);
 | ||
|   StyleHeading1Centralized.Name := 'Heading 1 Centered';
 | ||
|   StyleHeading1Centralized.Alignment := vsaCenter;
 | ||
|   StyleHeading1Centralized.SetElements := StyleHeading1Centralized.SetElements + [spbfAlignment];
 | ||
| 
 | ||
|   StyleHeading2Centralized := AddStyle();
 | ||
|   StyleHeading2Centralized.ApplyOver(StyleHeading2);
 | ||
|   StyleHeading2Centralized.Name := 'Heading 2 Centered';
 | ||
|   StyleHeading2Centralized.Alignment := vsaCenter;
 | ||
|   StyleHeading2Centralized.SetElements := StyleHeading2Centralized.SetElements + [spbfAlignment];
 | ||
| 
 | ||
|   StyleHeading3Centralized := AddStyle();
 | ||
|   StyleHeading3Centralized.ApplyOver(StyleHeading3);
 | ||
|   StyleHeading3Centralized.Name := 'Heading 3 Centered';
 | ||
|   StyleHeading3Centralized.Alignment := vsaCenter;
 | ||
|   StyleHeading3Centralized.SetElements := StyleHeading3Centralized.SetElements + [spbfAlignment];
 | ||
| 
 | ||
|   // ---------------------------------
 | ||
|   // Bullet List Items
 | ||
|   // ---------------------------------
 | ||
| 
 | ||
|   lCurListStyle := AddListStyle();
 | ||
|   lCurListStyle.Name := 'Bullet List Style';
 | ||
|   StyleBulletList := lCurListStyle;
 | ||
| 
 | ||
|   for i := 0 To NUM_MAX_LISTSTYLES-1 Do
 | ||
|   begin
 | ||
|     lCurListLevelStyle := StyleBulletList.AddListLevelStyle;
 | ||
|     lCurListLevelStyle.Kind := vlskBullet;
 | ||
|     lCurListLevelStyle.Level := i;
 | ||
| 
 | ||
|     // Bullet is positioned at MarginLeft - HangingIndent
 | ||
|     lCurListLevelStyle.MarginLeft := 16.35*(i + 1);
 | ||
|     lCurListLevelStyle.HangingIndent := 6.35;
 | ||
|   end;
 | ||
| 
 | ||
|   lCurListStyle := AddListStyle();
 | ||
|   lCurListStyle.Name := 'Numbered List Style';
 | ||
|   StyleNumberList := lCurListStyle;
 | ||
| 
 | ||
|   for i := 0 To NUM_MAX_LISTSTYLES-1 Do
 | ||
|   begin
 | ||
|     lCurListLevelStyle := StyleNumberList.AddListLevelStyle;
 | ||
|     lCurListLevelStyle.Kind := vlskNumeric;
 | ||
|     lCurListLevelStyle.NumberFormat := vnfDecimal;
 | ||
|     lCurListLevelStyle.Level := i;
 | ||
| 
 | ||
|     lCurListLevelStyle.Prefix := '';
 | ||
|     lCurListLevelStyle.Suffix := '.';
 | ||
|     lCurListLevelStyle.DisplayLevels := True;  // 1.1.1.1.
 | ||
|     lCurListLevelStyle.LeaderFontName := 'Arial';
 | ||
| 
 | ||
|     // For MS Word
 | ||
|     // Bullet is positioned at MarginLeft - HangingIndent
 | ||
|     lCurListLevelStyle.MarginLeft := 16.35*(i + 1);
 | ||
|     lCurListLevelStyle.HangingIndent := 6.35 + 3*i;
 | ||
|   end;
 | ||
| 
 | ||
|   // ---------------------------------
 | ||
|   // Text Span Items
 | ||
|   // ---------------------------------
 | ||
|   StyleTextSpanBold := AddStyle();
 | ||
|   StyleTextSpanBold.Kind := vskTextSpan; // This implies this style should not be applied to Paragraphs
 | ||
|   StyleTextSpanBold.Name := 'Bold';
 | ||
|   StyleTextSpanBold.Font.Bold := True;
 | ||
|   StyleTextSpanBold.Brush.Style := bsClear;
 | ||
|   StyleTextSpanBold.SetElements := StyleTextSpanBold.SetElements + [spbfFontBold];
 | ||
| 
 | ||
|   StyleTextSpanItalic := AddStyle();
 | ||
|   StyleTextSpanItalic.Kind := vskTextSpan; // This implies this style should not be applied to Paragraphs
 | ||
|   StyleTextSpanItalic.Name := 'Italic';
 | ||
|   StyleTextSpanItalic.Font.Italic := True;
 | ||
|   StyleTextSpanItalic.Brush.Style := bsClear;
 | ||
|   StyleTextSpanItalic.SetElements := StyleTextSpanItalic.SetElements + [spbfFontItalic];
 | ||
| 
 | ||
|   StyleTextSpanUnderline := AddStyle();
 | ||
|   StyleTextSpanUnderline.Kind := vskTextSpan; // This implies this style should not be applied to Paragraphs
 | ||
|   StyleTextSpanUnderline.Name := 'Underline';
 | ||
|   StyleTextSpanUnderline.Font.Underline := True;
 | ||
|   StyleTextSpanUnderline.Brush.Style := bsClear;
 | ||
|   StyleTextSpanUnderline.SetElements := StyleTextSpanUnderline.SetElements + [spbfFontUnderline];
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialDocument.GetStyleCount: Integer;
 | ||
| begin
 | ||
|   Result := FStyles.Count;
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialDocument.GetStyle(AIndex: Integer): TvStyle;
 | ||
| begin
 | ||
|   Result := TvStyle(FStyles.Items[AIndex]);
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialDocument.FindStyleIndex(AStyle: TvStyle): Integer;
 | ||
| var
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   Result := -1;
 | ||
|   for i := 0 to GetStyleCount()-1 do
 | ||
|     if GetStyle(i) = AStyle then Exit(i);
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialDocument.GetListStyleCount: Integer;
 | ||
| begin
 | ||
|   Result := FListStyles.Count;
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialDocument.GetListStyle(AIndex: Integer): TvListStyle;
 | ||
| begin
 | ||
|   Result := TvListStyle(FListStyles.Items[AIndex]);
 | ||
| end;
 | ||
| 
 | ||
| function TvVectorialDocument.FindListStyleIndex(AListStyle: TvListStyle): Integer;
 | ||
| var
 | ||
|   i: Integer;
 | ||
| begin
 | ||
|   Result := -1;
 | ||
|   for i := 0 to GetListStyleCount()-1 do
 | ||
|     if GetListStyle(i) = AListStyle then Exit(i);
 | ||
| end;
 | ||
| 
 | ||
| 
 | ||
| {@@
 | ||
|   Clears all data in the document
 | ||
| }
 | ||
| // GM: Release memory for each page
 | ||
| procedure TvVectorialDocument.Clear;
 | ||
| var
 | ||
|   i: integer;
 | ||
|   p: TvPage;
 | ||
| begin
 | ||
|   for i:=FPages.Count-1 downto 0 do
 | ||
|   begin
 | ||
|     p := TvPage(FPages[i]);
 | ||
|     p.Clear;
 | ||
|     FreeAndNil(p);
 | ||
|   end;
 | ||
|   FPages.Clear;
 | ||
|   FCurrentPageIndex:=-1;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvVectorialDocument.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer);
 | ||
| var
 | ||
|   i, lTmpInt: integer;
 | ||
|   p: TvPage;
 | ||
|   lPageItem: Pointer;
 | ||
|   lDebugStr: string;
 | ||
|   lTmpY: Double;
 | ||
| begin
 | ||
|   for i:=0 to FPages.Count-1 do
 | ||
|   begin
 | ||
|     p := TvPage(FPages[i]);
 | ||
| 
 | ||
|     lDebugStr := 'Origin=';
 | ||
|     p.GetNaturalRenderPos(lTmpInt, lTmpY);
 | ||
|     if lTmpY > 0 then
 | ||
|       lDebugStr += 'top-left'
 | ||
|     else
 | ||
|       lDebugStr += 'bottom-left';
 | ||
| 
 | ||
| 
 | ||
|     lPageItem := ADestRoutine(Format('Page %d : %s %s Width=%f Height=%f MinX=%f MaxX=%f MinY=%f MaxY=%f',
 | ||
|       [i, p.ClassName, lDebugStr, p.Width, p.Height, p.MinX, p.MaxX, p.MinY, p.MaxY]), APageItem);
 | ||
|     p.GenerateDebugTree(ADestRoutine, lPageItem);
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| { TvCustomVectorialReader }
 | ||
| 
 | ||
| class function TvCustomVectorialReader.GetTextContentsFromNode(ANode: TDOMNode): DOMString;
 | ||
| var
 | ||
|   lNodeTextTmp: DOMString;
 | ||
|   lContentNode: TDOMNode;
 | ||
| begin
 | ||
|   Result := '';
 | ||
| 
 | ||
|   for lContentNode in ANode.GetEnumeratorAllChildren() do
 | ||
|   begin
 | ||
|     if lContentNode is TDOMText then
 | ||
|       lNodeTextTmp := TDOMText(lContentNode).TextContent
 | ||
|     else if lContentNode is TDOMEntityReference then
 | ||
|     begin
 | ||
|       lNodeTextTmp := UTF8LowerCase(lContentNode.NodeName);
 | ||
|       case lNodeTextTmp of
 | ||
|       'pi': lNodeTextTmp := 'π';
 | ||
|       'invisibletimes': lNodeTextTmp := '';
 | ||
|       else
 | ||
|         lNodeTextTmp := '';//lContentNode.NodeName;
 | ||
|       end;
 | ||
|     end
 | ||
|     else
 | ||
|       lNodeTextTmp := lContentNode.NodeName;
 | ||
| 
 | ||
|     Result := Result + lNodeTextTmp;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| class function TvCustomVectorialReader.RemoveLineEndingsAndTrim(AStr: string): string;
 | ||
| begin
 | ||
|   Result := Trim(AStr);
 | ||
|   Result := StringReplace(Result, #13, '', [rfReplaceAll]);
 | ||
|   Result := StringReplace(Result, #10, '', [rfReplaceAll]);
 | ||
| end;
 | ||
| 
 | ||
| constructor TvCustomVectorialReader.Create;
 | ||
| begin
 | ||
|   inherited Create;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvCustomVectorialReader.ReadFromFile(AFileName: string; AData: TvVectorialDocument);
 | ||
| var
 | ||
|   FileStream: TFileStream;
 | ||
| begin
 | ||
|   FFilename := AFilename;
 | ||
|   FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
 | ||
|   try
 | ||
|     ReadFromStream(FileStream, AData);
 | ||
|   finally
 | ||
|     FileStream.Free;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvCustomVectorialReader.ReadFromStream(AStream: TStream;
 | ||
|   AData: TvVectorialDocument);
 | ||
| var
 | ||
|   AStringStream: TStringStream;
 | ||
|   AStrings: TStringList;
 | ||
| begin
 | ||
|   AStringStream := TStringStream.Create('');
 | ||
|   AStrings := TStringList.Create;
 | ||
|   try
 | ||
|     AStringStream.CopyFrom(AStream, AStream.Size);
 | ||
|     AStringStream.Seek(0, soFromBeginning);
 | ||
|     AStrings.Text := AStringStream.DataString;
 | ||
|     ReadFromStrings(AStrings, AData);
 | ||
|   finally
 | ||
|     AStringStream.Free;
 | ||
|     AStrings.Free;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvCustomVectorialReader.ReadFromStrings(AStrings: TStrings;
 | ||
|   AData: TvVectorialDocument);
 | ||
| var
 | ||
|   AStringStream: TStringStream;
 | ||
| begin
 | ||
|   AStringStream := TStringStream.Create('');
 | ||
|   try
 | ||
|     AStringStream.WriteString(AStrings.Text);
 | ||
|     AStringStream.Seek(0, soFromBeginning);
 | ||
|     ReadFromStream(AStringStream, AData);
 | ||
|   finally
 | ||
|     AStringStream.Free;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvCustomVectorialReader.ReadFromXML(ADoc: TXMLDocument; AData: TvVectorialDocument);
 | ||
| begin
 | ||
| end;
 | ||
| 
 | ||
| { TsCustomSpreadWriter }
 | ||
| 
 | ||
| constructor TvCustomVectorialWriter.Create;
 | ||
| begin
 | ||
|   inherited Create;
 | ||
| end;
 | ||
| 
 | ||
| {@@
 | ||
|   Default file writting method.
 | ||
| 
 | ||
|   Opens the file and calls WriteToStream
 | ||
| 
 | ||
|   @param  AFileName The output file name.
 | ||
|                    If the file already exists it will be replaced.
 | ||
|   @param  AData     The Workbook to be saved.
 | ||
| 
 | ||
|   @see    TsWorkbook
 | ||
| }
 | ||
| procedure TvCustomVectorialWriter.WriteToFile(AFileName: string; AData: TvVectorialDocument);
 | ||
| var
 | ||
|   OutputFile: TFileStream;
 | ||
| begin
 | ||
|   OutputFile := TFileStream.Create(AFileName, fmCreate or fmOpenWrite);
 | ||
|   try
 | ||
|     WriteToStream(OutputFile, AData);
 | ||
|   finally
 | ||
|     OutputFile.Free;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| {@@
 | ||
|   The default stream writer just uses WriteToStrings
 | ||
| }
 | ||
| procedure TvCustomVectorialWriter.WriteToStream(AStream: TStream;
 | ||
|   AData: TvVectorialDocument);
 | ||
| var
 | ||
|   lStringList: TStringList;
 | ||
| begin
 | ||
|   lStringList := TStringList.Create;
 | ||
|   try
 | ||
|     WriteToStrings(lStringList, AData);
 | ||
|     lStringList.SaveToStream(AStream);
 | ||
|   finally
 | ||
|     lStringList.Free;
 | ||
|   end;
 | ||
| end;
 | ||
| 
 | ||
| procedure TvCustomVectorialWriter.WriteToStrings(AStrings: TStrings;
 | ||
|   AData: TvVectorialDocument);
 | ||
| begin
 | ||
| 
 | ||
| end;
 | ||
| 
 | ||
| finalization
 | ||
| 
 | ||
|   SetLength(GvVectorialFormats, 0);
 | ||
| 
 | ||
| end.
 | ||
| 
 | 
