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