1 // SPDX-License-Identifier: LGPL-3.0-linking-exception
2 unit BGRASVGShapes;
3
4 {$mode objfpc}{$H+}
5
6 interface
7
8 uses
9 BGRAClasses, SysUtils, BGRAUnits, DOM, BGRAPath, BGRABitmapTypes,
10 BGRACanvas2D, BGRASVGType, BGRAGraphics;
11
12 type
13 TSVGContent = class;
14
15 { TSVGElementWithContent }
16
17 TSVGElementWithContent = class(TSVGElement)
18 protected
19 FContent: TSVGContent;
20 FSubDatalink: TSVGDataLink;
OwnDatalinknull21 class function OwnDatalink: boolean; virtual;
22 procedure SetDatalink(AValue: TSVGDataLink); override;
23 public
24 constructor Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); override;
25 constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); override;
26 procedure ListIdentifiers(AResult: TStringList); override;
27 procedure RenameIdentifiers(AFrom, ATo: TStringList); override;
28 procedure ConvertToUnit(AUnit: TCSSUnit); override;
29 destructor Destroy; override;
30 procedure Recompute; override;
31 property Content: TSVGContent read FContent;
32 end;
33
34 TSVGGradient = class;
35
36 { TSVGElementWithGradient }
37
38 TSVGElementWithGradient = class(TSVGElement)
39 private
40 FFillGradientElement, FStrokeGradientElement: TSVGGradient;
41 FGradientElementsDefined, FRegisteredToDatalink: boolean;
42 FFillCanvasGradient, FStrokeCanvasGradient: IBGRACanvasGradient2D;
43 procedure DatalinkOnLink(Sender: TObject; AElement: TSVGElement;
44 ALink: boolean);
EvaluatePercentagenull45 function EvaluatePercentage(fu: TFloatWithCSSUnit): single; { fu is a percentage of a number [0.0..1.0] }
GetFillGradientElementnull46 function GetFillGradientElement: TSVGGradient;
GetStrokeGradientElementnull47 function GetStrokeGradientElement: TSVGGradient;
48 procedure ResetGradients;
49 procedure FindGradientElements;
50 protected
51 procedure Initialize; override;
52 procedure AddStopElements(ASVGGradient: TSVGGradient; canvas: IBGRACanvasGradient2D);
CreateCanvasLinearGradientnull53 function CreateCanvasLinearGradient(ACanvas2d: TBGRACanvas2D; ASVGGradient: TSVGGradient;
54 const origin: TPointF; const w,h: single; AUnit: TCSSUnit): IBGRACanvasGradient2D;
CreateCanvasRadialGradientnull55 function CreateCanvasRadialGradient(ACanvas2d: TBGRACanvas2D; ASVGGradient: TSVGGradient;
56 const origin: TPointF; const w,h: single; AUnit: TCSSUnit): IBGRACanvasGradient2D;
57 procedure ApplyFillStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit); override;
58 procedure ApplyStrokeStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit); override;
59 procedure SetDatalink(AValue: TSVGDataLink); override;
60 procedure SetFill(AValue: string); override;
61 procedure SetStroke(AValue: string); override;
62 public
63 destructor Destroy; override;
64 procedure InitializeGradient(ACanvas2d: TBGRACanvas2D;
65 const origin: TPointF; const w,h: single; AUnit: TCSSUnit);
66 property FillGradientElement: TSVGGradient read GetFillGradientElement;
67 property StrokeGradientElement: TSVGGradient read GetStrokeGradientElement;
68 end;
69
70 { TSVGLine }
71
72 TSVGLine = class(TSVGElement)
73 private
GetX1null74 function GetX1: TFloatWithCSSUnit;
GetX2null75 function GetX2: TFloatWithCSSUnit;
GetY1null76 function GetY1: TFloatWithCSSUnit;
GetY2null77 function GetY2: TFloatWithCSSUnit;
78 procedure SetX1(AValue: TFloatWithCSSUnit);
79 procedure SetX2(AValue: TFloatWithCSSUnit);
80 procedure SetY1(AValue: TFloatWithCSSUnit);
81 procedure SetY2(AValue: TFloatWithCSSUnit);
82 protected
83 procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override;
84 public
GetDOMTagnull85 class function GetDOMTag: string; override;
86 procedure ConvertToUnit(AUnit: TCSSUnit); override;
87 property x1: TFloatWithCSSUnit read GetX1 write SetX1;
88 property y1: TFloatWithCSSUnit read GetY1 write SetY1;
89 property x2: TFloatWithCSSUnit read GetX2 write SetX2;
90 property y2: TFloatWithCSSUnit read GetY2 write SetY2;
91 end;
92
93 { TSVGRectangle }
94
95 TSVGRectangle = class(TSVGElementWithGradient)
96 private
GetXnull97 function GetX: TFloatWithCSSUnit;
GetYnull98 function GetY: TFloatWithCSSUnit;
GetWidthnull99 function GetWidth: TFloatWithCSSUnit;
GetHeightnull100 function GetHeight: TFloatWithCSSUnit;
GetRXnull101 function GetRX: TFloatWithCSSUnit;
GetRYnull102 function GetRY: TFloatWithCSSUnit;
103 procedure SetX(AValue: TFloatWithCSSUnit);
104 procedure SetY(AValue: TFloatWithCSSUnit);
105 procedure SetWidth(AValue: TFloatWithCSSUnit);
106 procedure SetHeight(AValue: TFloatWithCSSUnit);
107 procedure SetRX(AValue: TFloatWithCSSUnit);
108 procedure SetRY(AValue: TFloatWithCSSUnit);
109 protected
110 procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override;
111 public
GetDOMTagnull112 class function GetDOMTag: string; override;
113 procedure ConvertToUnit(AUnit: TCSSUnit); override;
114 property x: TFloatWithCSSUnit read GetX write SetX;
115 property y: TFloatWithCSSUnit read GetY write SetY;
116 property width: TFloatWithCSSUnit read GetWidth write SetWidth;
117 property height: TFloatWithCSSUnit read GetHeight write SetHeight;
118 property rx: TFloatWithCSSUnit read GetRX write SetRX;
119 property ry: TFloatWithCSSUnit read GetRY write SetRY;
120 end;
121
122 { TSVGCircle }
123
124 TSVGCircle = class(TSVGElementWithGradient)
125 private
GetCXnull126 function GetCX: TFloatWithCSSUnit;
GetCYnull127 function GetCY: TFloatWithCSSUnit;
GetRnull128 function GetR: TFloatWithCSSUnit;
129 procedure SetCX(AValue: TFloatWithCSSUnit);
130 procedure SetCY(AValue: TFloatWithCSSUnit);
131 procedure SetR(AValue: TFloatWithCSSUnit);
132 protected
133 procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override;
134 public
GetDOMTagnull135 class function GetDOMTag: string; override;
136 procedure ConvertToUnit(AUnit: TCSSUnit); override;
137 property cx: TFloatWithCSSUnit read GetCX write SetCX;
138 property cy: TFloatWithCSSUnit read GetCY write SetCY;
139 property r: TFloatWithCSSUnit read GetR write SetR;
140 end;
141
142 { TSVGEllipse }
143
144 TSVGEllipse = class(TSVGElementWithGradient)
145 private
GetCXnull146 function GetCX: TFloatWithCSSUnit;
GetCYnull147 function GetCY: TFloatWithCSSUnit;
GetRXnull148 function GetRX: TFloatWithCSSUnit;
GetRYnull149 function GetRY: TFloatWithCSSUnit;
150 procedure SetCX(AValue: TFloatWithCSSUnit);
151 procedure SetCY(AValue: TFloatWithCSSUnit);
152 procedure SetRX(AValue: TFloatWithCSSUnit);
153 procedure SetRY(AValue: TFloatWithCSSUnit);
154 protected
155 procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override;
156 public
GetDOMTagnull157 class function GetDOMTag: string; override;
158 procedure ConvertToUnit(AUnit: TCSSUnit); override;
159 property cx: TFloatWithCSSUnit read GetCX write SetCX;
160 property cy: TFloatWithCSSUnit read GetCY write SetCY;
161 property rx: TFloatWithCSSUnit read GetRX write SetRX;
162 property ry: TFloatWithCSSUnit read GetRY write SetRY;
163 end;
164
165 { TSVGPath }
166
167 TSVGPath = class(TSVGElementWithGradient)
168 private
169 FPath: TBGRAPath;
170 FBoundingBox: TRectF;
171 FBoundingBoxComputed: boolean;
GetBoundingBoxFnull172 function GetBoundingBoxF: TRectF;
GetPathnull173 function GetPath: TBGRAPath;
GetPathLengthnull174 function GetPathLength: TFloatWithCSSUnit;
GetDatanull175 function GetData: string;
176 procedure SetPathLength(AValue: TFloatWithCSSUnit);
177 procedure SetData(AValue: string);
178 protected
GetDOMElementnull179 function GetDOMElement: TDOMElement; override;
180 procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override;
181 public
GetDOMTagnull182 class function GetDOMTag: string; override;
183 constructor Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); override;
184 constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); override;
185 destructor Destroy; override;
186 property d: string read GetData write SetData;
187 property path: TBGRAPath read GetPath;
188 property pathLength: TFloatWithCSSUnit read GetPathLength write SetPathLength;
189 property boundingBoxF: TRectF read GetBoundingBoxF;
190 end;
191
192 { TSVGPolypoints }
193
194 TSVGPolypoints = class(TSVGElementWithGradient)
195 private
196 FBoundingBox: TRectF;
197 FBoundingBoxComputed: boolean;
GetBoundingBoxFnull198 function GetBoundingBoxF: TRectF;
GetClosednull199 function GetClosed: boolean;
GetPointsnull200 function GetPoints: string;
GetPointsFnull201 function GetPointsF: ArrayOfTPointF;
202 procedure SetPoints(AValue: string);
203 procedure SetPointsF(AValue: ArrayOfTPointF);
204 procedure ComputeBoundingBox(APoints: ArrayOfTPointF);
205 protected
206 procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override;
207 public
208 constructor Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter; AClosed: boolean; ADataLink: TSVGDataLink); overload;
209 destructor Destroy; override;
210 property points: string read GetPoints write SetPoints;
211 property pointsF: ArrayOfTPointF read GetPointsF write SetPointsF;
212 property closed: boolean read GetClosed;
213 property boundingBoxF: TRectF read GetBoundingBoxF;
214 end;
215
216 { TSVGTextElement }
217
218 TSVGTextElement = class(TSVGElementWithGradient);
219
220 { TSVGTextElementWithContent }
221
222 TSVGTextElementWithContent = class(TSVGTextElement)
223 protected
224 FContent: TSVGContent;
225 public
226 constructor Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); override;
227 constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); override;
228 destructor Destroy; override;
229 procedure ConvertToUnit(AUnit: TCSSUnit); override;
230 property Content: TSVGContent read FContent;
231 end;
232
233 { TSVGTextPositioning }
234
235 TSVGTextPositioning = class(TSVGTextElementWithContent)
236 private
GetXnull237 function GetX: ArrayOfTFloatWithCSSUnit;
GetYnull238 function GetY: ArrayOfTFloatWithCSSUnit;
GetDXnull239 function GetDX: ArrayOfTFloatWithCSSUnit;
GetDYnull240 function GetDY: ArrayOfTFloatWithCSSUnit;
GetRotatenull241 function GetRotate: ArrayOfTSVGNumber;
242 procedure SetX(AValue: ArrayOfTFloatWithCSSUnit);
243 procedure SetY(AValue: ArrayOfTFloatWithCSSUnit);
244 procedure SetDX(AValue: ArrayOfTFloatWithCSSUnit);
245 procedure SetDY(AValue: ArrayOfTFloatWithCSSUnit);
246 procedure SetRotate(AValue: ArrayOfTSVGNumber);
247 public
248 procedure ConvertToUnit(AUnit: TCSSUnit); override;
249 property x: ArrayOfTFloatWithCSSUnit read GetX write SetX;
250 property y: ArrayOfTFloatWithCSSUnit read GetY write SetY;
251 property dx: ArrayOfTFloatWithCSSUnit read GetDX write SetDX;
252 property dy: ArrayOfTFloatWithCSSUnit read GetDY write SetDY;
253 property rotate: ArrayOfTSVGNumber read GetRotate write SetRotate;
254 end;
255
256 { TSVGTRef }
257
258 TSVGTRef = class(TSVGTextElement)
259 private
GetXlinkHrefnull260 function GetXlinkHref: string;
261 procedure SetXlinkHref(AValue: string);
262 public
GetDOMTagnull263 class function GetDOMTag: string; override;
264 property xlinkHref: string read GetXlinkHref write SetXlinkHref;
265 end;
266
267 ArrayOfTextParts = array of record
268 Level: integer;
269 BaseElement: TSVGElement;
270 Text: string;
271 SplitPos: integer;
272 AbsoluteCoord: TPointF;
273 PartStartCoord, PartEndCoord: TPointF;
274 Bounds: TRectF;
275 PosUnicode: integer;
276 InheritedRotation: single;
277 end;
278
279 { TSVGText }
280
281 TSVGText = class(TSVGTextPositioning)
282 private
283 FInGetSimpleText: boolean;
GetFontBoldnull284 function GetFontBold: boolean;
GetFontFamilynull285 function GetFontFamily: string;
GetFontFamilyListnull286 function GetFontFamilyList: ArrayOfString;
GetFontItalicnull287 function GetFontItalic: boolean;
GetFontSizenull288 function GetFontSize: TFloatWithCSSUnit;
GetFontStylenull289 function GetFontStyle: string;
GetFontStyleLCLnull290 function GetFontStyleLCL: TFontStyles;
GetFontWeightnull291 function GetFontWeight: string;
GetSimpleTextnull292 function GetSimpleText: string;
GetTextAnchornull293 function GetTextAnchor: TSVGTextAnchor;
GetTextDirectionnull294 function GetTextDirection: TSVGTextDirection;
GetTextDecorationnull295 function GetTextDecoration: string;
GetTextLengthnull296 function GetTextLength: TFloatWithCSSUnit;
GetLengthAdjustnull297 function GetLengthAdjust: TSVGLengthAdjust;
298 procedure SetFontBold(AValue: boolean);
299 procedure SetFontFamily(AValue: string);
300 procedure SetFontFamilyList(AValue: ArrayOfString);
301 procedure SetFontItalic(AValue: boolean);
302 procedure SetFontSize(AValue: TFloatWithCSSUnit);
303 procedure SetFontStyle(AValue: string);
304 procedure SetFontStyleLCL(AValue: TFontStyles);
305 procedure SetFontWeight(AValue: string);
306 procedure SetSimpleText(AValue: string);
307 procedure SetTextAnchor(AValue: TSVGTextAnchor);
308 procedure SetTextDirection(AValue: TSVGTextDirection);
309 procedure SetTextDecoration(AValue: string);
310 procedure SetTextLength(AValue: TFloatWithCSSUnit);
311 procedure SetLengthAdjust(AValue: TSVGLengthAdjust);
312 protected
313 procedure InternalDrawOrCompute(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit;
314 ADraw: boolean; AAllTextBounds: TRectF;
315 var APosition: TPointF;
316 var ATextParts: ArrayOfTextParts); overload;
317 procedure InternalDrawOrCompute(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit;
318 ADraw: boolean; AAllTextBounds: TRectF;
319 var APosition: TPointF;
320 var ATextParts: ArrayOfTextParts; ALevel: integer;
321 AStartPart, AEndPart: integer); overload;
322 procedure InternalDrawOrComputePart(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit;
323 AText: string; APosUnicode: integer; AInheritedRotation: single;
324 ADraw: boolean; AAllTextBounds: TRectF;
325 var APosition: TPointF; out ABounds: TRectF);
326 procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override;
327 procedure CleanText(var ATextParts: ArrayOfTextParts);
GetTRefContentnull328 function GetTRefContent(AElement: TSVGTRef): string;
GetAllTextnull329 function GetAllText(AInheritedRotation: single): ArrayOfTextParts;
330 public
GetDOMTagnull331 class function GetDOMTag: string; override;
332 procedure ConvertToUnit(AUnit: TCSSUnit); override;
333 property textLength: TFloatWithCSSUnit read GetTextLength write SetTextLength;
334 property lengthAdjust: TSVGLengthAdjust read GetLengthAdjust write SetLengthAdjust;
335 property SimpleText: string read GetSimpleText write SetSimpleText;
336 property fontSize: TFloatWithCSSUnit read GetFontSize write SetFontSize;
337 property fontFamily: string read GetFontFamily write SetFontFamily;
338 property fontFamilyList: ArrayOfString read GetFontFamilyList write SetFontFamilyList;
339 property fontWeight: string read GetFontWeight write SetFontWeight;
340 property fontStyle: string read GetFontStyle write SetFontStyle;
341 property fontStyleLCL: TFontStyles read GetFontStyleLCL write SetFontStyleLCL;
342 property textDecoration: string read GetTextDecoration write SetTextDecoration;
343 property fontBold: boolean read GetFontBold write SetFontBold;
344 property fontItalic: boolean read GetFontItalic write SetFontItalic;
345 property textAnchor: TSVGTextAnchor read GetTextAnchor write SetTextAnchor;
346 property textDirection: TSVGTextDirection read GetTextDirection write SetTextDirection;
347 end;
348
349 { TSVGTSpan }
350
351 TSVGTSpan = class(TSVGText)
352 public
GetDOMTagnull353 class function GetDOMTag: string; override;
354 end;
355
356 { TSVGTextPath }
357
358 TSVGTextPath = class(TSVGTextElementWithContent)
359 private
GetStartOffsetnull360 function GetStartOffset: TFloatWithCSSUnit;
GetMethodnull361 function GetMethod: TSVGTextPathMethod;
GetSpacingnull362 function GetSpacing: TSVGTextPathSpacing;
GetXlinkHrefnull363 function GetXlinkHref: string;
364 procedure SetStartOffset(AValue: TFloatWithCSSUnit);
365 procedure SetMethod(AValue: TSVGTextPathMethod);
366 procedure SetSpacing(AValue: TSVGTextPathSpacing);
367 procedure SetXlinkHref(AValue: string);
368 protected
369 procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override;
370 public
GetDOMTagnull371 class function GetDOMTag: string; override;
372 procedure ConvertToUnit(AUnit: TCSSUnit); override;
373 property startOffset: TFloatWithCSSUnit read GetStartOffset write SetStartOffset;
374 property method: TSVGTextPathMethod read GetMethod write SetMethod;
375 property spacing: TSVGTextPathSpacing read GetSpacing write SetSpacing;
376 property xlinkHref: string read GetXlinkHref write SetXlinkHref;
377 end;
378
379 { TSVGAltGlyph }
380
381 TSVGAltGlyph = class(TSVGTextElementWithContent)
382 private
GetGlyphRefnull383 function GetGlyphRef: string;
GetFormatnull384 function GetFormat: string;
GetXlinkHrefnull385 function GetXlinkHref: string;
386 procedure SetGlyphRef(AValue: string);
387 procedure SetFormat(AValue: string);
388 procedure SetXlinkHref(AValue: string);
389 protected
390 procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override;
391 public
GetDOMTagnull392 class function GetDOMTag: string; override;
393 property glyphRef: string read GetGlyphRef write SetGlyphRef;
394 property format: string read GetFormat write SetFormat;
395 property xlinkHref: string read GetXlinkHref write SetXlinkHref;
396 end;
397
398 { TSVGAltGlyphDef }
399
400 TSVGAltGlyphDef = class(TSVGTextElementWithContent)
401 public
GetDOMTagnull402 class function GetDOMTag: string; override;
403 end;
404
405 { TSVGAltGlyphItem }
406
407 TSVGAltGlyphItem = class(TSVGTextElementWithContent)
408 public
GetDOMTagnull409 class function GetDOMTag: string; override;
410 end;
411
412 { TSVGGlyphRef }
413
414 TSVGGlyphRef = class(TSVGTextElement)
415 private
GetXnull416 function GetX: TSVGNumber;
GetYnull417 function GetY: TSVGNumber;
GetDxnull418 function GetDx: TSVGNumber;
GetDynull419 function GetDy: TSVGNumber;
GetGlyphRefnull420 function GetGlyphRef: string;
GetFormatnull421 function GetFormat: string;
GetXlinkHrefnull422 function GetXlinkHref: string;
423 procedure SetX(AValue: TSVGNumber);
424 procedure SetY(AValue: TSVGNumber);
425 procedure SetDx(AValue: TSVGNumber);
426 procedure SetDy(AValue: TSVGNumber);
427 procedure SetGlyphRef(AValue: string);
428 procedure SetFormat(AValue: string);
429 procedure SetXlinkHref(AValue: string);
430 protected
431 procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override;
432 public
GetDOMTagnull433 class function GetDOMTag: string; override;
434 property x: TSVGNumber read GetX write SetX;
435 property y: TSVGNumber read GetY write SetY;
436 property dx: TSVGNumber read GetDx write SetDx;
437 property dy: TSVGNumber read GetDy write SetDy;
438 property glyphRef: string read GetGlyphRef write SetGlyphRef;
439 property format: string read GetFormat write SetFormat;
440 property xlinkHref: string read GetXlinkHref write SetXlinkHref;
441 end;
442
443 { TSVGClipPath }
444
445 TSVGClipPath = class(TSVGElement)
446 private
GetExternalResourcesRequirednull447 function GetExternalResourcesRequired: boolean;
GetClipPathUnitsnull448 function GetClipPathUnits: TSVGObjectUnits;
449 procedure SetExternalResourcesRequired(AValue: boolean);
450 procedure SetClipPathUnits(AValue: TSVGObjectUnits);
451 protected
452 procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override;
453 public
GetDOMTagnull454 class function GetDOMTag: string; override;
455 property externalResourcesRequired: boolean
456 read GetExternalResourcesRequired write SetExternalResourcesRequired;
457 property clipPathUnits: TSVGObjectUnits read GetClipPathUnits write SetClipPathUnits;
458 end;
459
460 { TSVGColorProfile }
461
462 TSVGColorProfile = class(TSVGElement)
463 private
GetLocalnull464 function GetLocal: string;
GetNamenull465 function GetName: string;
GetRenderingIntentnull466 function GetRenderingIntent: TSVGRenderingIntent;
GetXlinkHrefnull467 function GetXlinkHref: string;
468 procedure SetLocal(AValue: string);
469 procedure SetName(AValue: string);
470 procedure SetRenderingIntent(AValue: TSVGRenderingIntent);
471 procedure SetXlinkHref(AValue: string);
472 protected
473 procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override;
474 public
GetDOMTagnull475 class function GetDOMTag: string; override;
476 property local: string read GetLocal write SetLocal;
477 property name: string read GetName write SetName;
478 property renderingIntent: TSVGRenderingIntent read GetRenderingIntent write SetRenderingIntent;
479 property xlinkHref: string read GetXlinkHref write SetXlinkHref;
480 end;
481
482 { TSVGImage }
483
484 TSVGImage = class(TSVGElement)
485 private
GetBitmapnull486 function GetBitmap: TBGRACustomBitmap;
GetExternalResourcesRequirednull487 function GetExternalResourcesRequired: boolean;
GetImageRenderingnull488 function GetImageRendering: TSVGImageRendering;
GetXnull489 function GetX: TFloatWithCSSUnit;
GetYnull490 function GetY: TFloatWithCSSUnit;
GetWidthnull491 function GetWidth: TFloatWithCSSUnit;
GetHeightnull492 function GetHeight: TFloatWithCSSUnit;
GetPreserveAspectRationull493 function GetPreserveAspectRatio: TSVGPreserveAspectRatio;
GetXlinkHrefnull494 function GetXlinkHref: string;
495 procedure SetExternalResourcesRequired(AValue: boolean);
496 procedure SetImageRendering(AValue: TSVGImageRendering);
497 procedure SetX(AValue: TFloatWithCSSUnit);
498 procedure SetY(AValue: TFloatWithCSSUnit);
499 procedure SetWidth(AValue: TFloatWithCSSUnit);
500 procedure SetHeight(AValue: TFloatWithCSSUnit);
501 procedure SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio);
502 procedure SetXlinkHref(AValue: string);
503 protected
504 FBitmap: TBGRACustomBitmap;
505 procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override;
506 public
507 constructor Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter;
508 ADataLink: TSVGDataLink); overload; override;
509 constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter;
510 ADataLink: TSVGDataLink); overload; override;
511 destructor Destroy; override;
GetDOMTagnull512 class function GetDOMTag: string; override;
513 procedure ConvertToUnit(AUnit: TCSSUnit); override;
514 procedure SetBitmap(AValue: TBGRACustomBitmap; AOwned: boolean); overload;
515 procedure SetBitmap(AStream: TStream; AMimeType: string); overload;
516 property externalResourcesRequired: boolean
517 read GetExternalResourcesRequired write SetExternalResourcesRequired;
518 property x: TFloatWithCSSUnit read GetX write SetX;
519 property y: TFloatWithCSSUnit read GetY write SetY;
520 property width: TFloatWithCSSUnit read GetWidth write SetWidth;
521 property height: TFloatWithCSSUnit read GetHeight write SetHeight;
522 property imageRendering: TSVGImageRendering read GetImageRendering write SetImageRendering;
523 property preserveAspectRatio: TSVGPreserveAspectRatio
524 read GetPreserveAspectRatio write SetPreserveAspectRatio;
525 property xlinkHref: string read GetXlinkHref write SetXlinkHref;
526 property Bitmap: TBGRACustomBitmap read GetBitmap;
527 end;
528
529 { TSVGPattern }
530
531 TSVGPattern = class(TSVGImage)
532 private
GetPatternUnitsnull533 function GetPatternUnits: TSVGObjectUnits;
GetPatternContentUnitsnull534 function GetPatternContentUnits: TSVGObjectUnits;
GetPatternTransformnull535 function GetPatternTransform: string;
GetViewBoxnull536 function GetViewBox: TSVGViewBox;
537 procedure SetPatternUnits(AValue: TSVGObjectUnits);
538 procedure SetPatternContentUnits(AValue: TSVGObjectUnits);
539 procedure SetPatternTransform(AValue: string);
540 procedure SetViewBox(AValue: TSVGViewBox);
541 protected
542 procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override;
543 public
GetDOMTagnull544 class function GetDOMTag: string; override;
545 property patternUnits: TSVGObjectUnits read GetPatternUnits write SetPatternUnits;
546 property patternContentUnits: TSVGObjectUnits
547 read GetPatternContentUnits write SetPatternContentUnits;
548 property patternTransform: string read GetPatternTransform write SetPatternTransform;
549 property viewBox: TSVGViewBox read GetViewBox write SetViewBox;
550 end;
551
552 { TSVGMarker }
553
554 TSVGMarker = class(TSVGElement)
555 private
GetExternalResourcesRequirednull556 function GetExternalResourcesRequired: boolean;
GetViewBoxnull557 function GetViewBox: TSVGViewBox;
GetPreserveAspectRationull558 function GetPreserveAspectRatio: TSVGPreserveAspectRatio;
GetRefXnull559 function GetRefX: TFloatWithCSSUnit;
GetRefYnull560 function GetRefY: TFloatWithCSSUnit;
GetMarkerWidthnull561 function GetMarkerWidth: TFloatWithCSSUnit;
GetMarkerHeightnull562 function GetMarkerHeight: TFloatWithCSSUnit;
GetMarkerUnitsnull563 function GetMarkerUnits: TSVGMarkerUnits;
GetOrientnull564 function GetOrient: TSVGOrient;
565 procedure SetExternalResourcesRequired(AValue: boolean);
566 procedure SetViewBox(AValue: TSVGViewBox);
567 procedure SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio);
568 procedure SetRefX(AValue: TFloatWithCSSUnit);
569 procedure SetRefY(AValue: TFloatWithCSSUnit);
570 procedure SetMarkerWidth(AValue: TFloatWithCSSUnit);
571 procedure SetMarkerHeight(AValue: TFloatWithCSSUnit);
572 procedure SetMarkerUnits(AValue: TSVGMarkerUnits);
573 procedure SetOrient(AValue: TSVGOrient);
574 protected
575 procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override;
576 public
GetDOMTagnull577 class function GetDOMTag: string; override;
578 procedure ConvertToUnit(AUnit: TCSSUnit); override;
579 property externalResourcesRequired: boolean
580 read GetExternalResourcesRequired write SetExternalResourcesRequired;
581 property viewBox: TSVGViewBox read GetViewBox write SetViewBox;
582 property preserveAspectRatio: TSVGPreserveAspectRatio
583 read GetPreserveAspectRatio write SetPreserveAspectRatio;
584 property refX: TFloatWithCSSUnit read GetRefX write SetRefX;
585 property refY: TFloatWithCSSUnit read GetRefY write SetRefY;
586 property markerWidth: TFloatWithCSSUnit read GetMarkerWidth write SetMarkerWidth;
587 property markerHeight: TFloatWithCSSUnit read GetMarkerHeight write SetMarkerHeight;
588 property markerUnits: TSVGMarkerUnits read GetMarkerUnits write SetMarkerUnits;
589 property orient: TSVGOrient read GetOrient write SetOrient;
590 end;
591
592 { TSVGMask }
593
594 TSVGMask = class(TSVGElement)
595 private
GetExternalResourcesRequirednull596 function GetExternalResourcesRequired: boolean;
GetXnull597 function GetX: TFloatWithCSSUnit;
GetYnull598 function GetY: TFloatWithCSSUnit;
GetWidthnull599 function GetWidth: TFloatWithCSSUnit;
GetHeightnull600 function GetHeight: TFloatWithCSSUnit;
GetMaskUnitsnull601 function GetMaskUnits: TSVGObjectUnits;
GetMaskContentUnitsnull602 function GetMaskContentUnits: TSVGObjectUnits;
603 procedure SetExternalResourcesRequired(AValue: boolean);
604 procedure SetX(AValue: TFloatWithCSSUnit);
605 procedure SetY(AValue: TFloatWithCSSUnit);
606 procedure SetWidth(AValue: TFloatWithCSSUnit);
607 procedure SetHeight(AValue: TFloatWithCSSUnit);
608 procedure SetMaskUnits(AValue: TSVGObjectUnits);
609 procedure SetMaskContentUnits(AValue: TSVGObjectUnits);
610 protected
611 procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); override;
612 public
GetDOMTagnull613 class function GetDOMTag: string; override;
614 procedure ConvertToUnit(AUnit: TCSSUnit); override;
615 property externalResourcesRequired: boolean
616 read GetExternalResourcesRequired write SetExternalResourcesRequired;
617 property x: TFloatWithCSSUnit read GetX write SetX;
618 property y: TFloatWithCSSUnit read GetY write SetY;
619 property width: TFloatWithCSSUnit read GetWidth write SetWidth;
620 property height: TFloatWithCSSUnit read GetHeight write SetHeight;
621 property maskUnits: TSVGObjectUnits read GetMaskUnits write SetMaskUnits;
622 property maskContentUnits: TSVGObjectUnits
623 read GetMaskContentUnits write SetMaskContentUnits;
624 end;
625
626 TConvMethod = (cmNone,cmHoriz,cmVertical,cmOrtho);
627
628 { TSVGGradient }
629
630 TSVGGradient = class(TSVGElementWithContent)
631 private
GetColorInterpolationnull632 function GetColorInterpolation: TSVGColorInterpolation;
GetGradientMatrixnull633 function GetGradientMatrix(AUnit: TCSSUnit): TAffineMatrix;
GetGradientTransformnull634 function GetGradientTransform: string;
GetGradientUnitsnull635 function GetGradientUnits: TSVGObjectUnits;
GetHRefnull636 function GetHRef: string;
GetSpreadMethodnull637 function GetSpreadMethod: TSVGSpreadMethod;
638 procedure SetColorInterpolation(AValue: TSVGColorInterpolation);
639 procedure SetGradientMatrix(AUnit: TCSSUnit; AValue: TAffineMatrix);
640 procedure SetGradientTransform(AValue: string);
641 procedure SetGradientUnits(AValue: TSVGObjectUnits);
642 procedure SetHRef(AValue: string);
643 procedure SetSpreadMethod(AValue: TSVGSpreadMethod);
644 protected
645 InheritedGradients: TSVGElementList;//(for HRef)
646 procedure Initialize; override;
GetInheritedAttributenull647 function GetInheritedAttribute(AValue: string;
648 AConvMethod: TConvMethod; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
649 public
650 destructor Destroy; override;
651 procedure ScanInheritedGradients(const forceScan: boolean = false);
652 property hRef: string read GetHRef write SetHRef;
653 property gradientUnits: TSVGObjectUnits read GetGradientUnits write SetGradientUnits;
654 property gradientTransform: string read GetGradientTransform write SetGradientTransform;
655 property gradientMatrix[AUnit: TCSSUnit]: TAffineMatrix read GetGradientMatrix write SetGradientMatrix;
656 property spreadMethod: TSVGSpreadMethod read GetSpreadMethod write SetSpreadMethod;
657 property colorInterpolation: TSVGColorInterpolation read GetColorInterpolation write SetColorInterpolation;
658 end;
659
660 { TSVGGradientLinear }
661
662 { TSVGLinearGradient }
663
664 TSVGLinearGradient = class(TSVGGradient)
665 private
GetX1null666 function GetX1: TFloatWithCSSUnit;
GetX2null667 function GetX2: TFloatWithCSSUnit;
GetY1null668 function GetY1: TFloatWithCSSUnit;
GetY2null669 function GetY2: TFloatWithCSSUnit;
670 procedure SetX1(AValue: TFloatWithCSSUnit);
671 procedure SetX2(AValue: TFloatWithCSSUnit);
672 procedure SetY1(AValue: TFloatWithCSSUnit);
673 procedure SetY2(AValue: TFloatWithCSSUnit);
674 public
GetDOMTagnull675 class function GetDOMTag: string; override;
676 procedure ConvertToUnit(AUnit: TCSSUnit); override;
677 property x1: TFloatWithCSSUnit read GetX1 write SetX1;
678 property y1: TFloatWithCSSUnit read GetY1 write SetY1;
679 property x2: TFloatWithCSSUnit read GetX2 write SetX2;
680 property y2: TFloatWithCSSUnit read GetY2 write SetY2;
681 end;
682
683 { TSVGRadialGradient }
684
685 TSVGRadialGradient = class(TSVGGradient)
686 private
GetCXnull687 function GetCX: TFloatWithCSSUnit;
GetCYnull688 function GetCY: TFloatWithCSSUnit;
GetRnull689 function GetR: TFloatWithCSSUnit;
GetFXnull690 function GetFX: TFloatWithCSSUnit;
GetFYnull691 function GetFY: TFloatWithCSSUnit;
GetFRnull692 function GetFR: TFloatWithCSSUnit;
693 procedure SetCX(AValue: TFloatWithCSSUnit);
694 procedure SetCY(AValue: TFloatWithCSSUnit);
695 procedure SetR(AValue: TFloatWithCSSUnit);
696 procedure SetFX(AValue: TFloatWithCSSUnit);
697 procedure SetFY(AValue: TFloatWithCSSUnit);
698 procedure SetFR(AValue: TFloatWithCSSUnit);
699 public
GetDOMTagnull700 class function GetDOMTag: string; override;
701 procedure ConvertToUnit(AUnit: TCSSUnit); override;
702 property cx: TFloatWithCSSUnit read GetCX write SetCX;
703 property cy: TFloatWithCSSUnit read GetCY write SetCY;
704 property r: TFloatWithCSSUnit read GetR write SetR;
705 property fx: TFloatWithCSSUnit read GetFX write SetFX;
706 property fy: TFloatWithCSSUnit read GetFY write SetFY;
707 property fr: TFloatWithCSSUnit read GetFR write SetFR;
708 end;
709
710 { TSVGStopGradient }
711
712 TSVGStopGradient = class(TSVGElement)
713 private
GetOffsetnull714 function GetOffset: TFloatWithCSSUnit;
GetStopColornull715 function GetStopColor: TBGRAPixel;
GetStopOpacitynull716 function GetStopOpacity: single;
717 procedure SetOffset(AValue: TFloatWithCSSUnit);
718 procedure SetStopColor(AValue: TBGRAPixel);
719 procedure SetStopOpacity(AValue: single);
720 public
GetDOMTagnull721 class function GetDOMTag: string; override;
722 property offset: TFloatWithCSSUnit read GetOffset write SetOffset;
723 property stopColor: TBGRAPixel read GetStopColor write SetStopColor;
724 property stopOpacity: single read GetStopOpacity write SetStopOpacity;
725 end;
726
727 { TSVGDefine }
728
729 TSVGDefine = class(TSVGElementWithContent)
730 public
GetDOMTagnull731 class function GetDOMTag: string; override;
732 end;
733
734 { TSVGGroup }
735
736 TSVGGroup = class(TSVGElementWithContent)
737 private
GetFontSizenull738 function GetFontSize: TFloatWithCSSUnit;
GetIsLayernull739 function GetIsLayer: boolean;
GetNamenull740 function GetName: string;
741 procedure SetFontSize(AValue: TFloatWithCSSUnit);
742 procedure SetIsLayer(AValue: boolean);
743 procedure SetName(AValue: string);
744 protected
745 procedure InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); override;
OwnDatalinknull746 class function OwnDatalink: boolean; override;
747 property fontSize: TFloatWithCSSUnit read GetFontSize write SetFontSize;
748 public
GetDOMTagnull749 class function GetDOMTag: string; override;
750 procedure ConvertToUnit(AUnit: TCSSUnit); override;
751 property IsLayer: boolean read GetIsLayer write SetIsLayer;
752 property Name: string read GetName write SetName;
753 end;
754
755 { TSVGLink }
756
757 TSVGLink = class(TSVGGroup)
758 private
GetTargetnull759 function GetTarget: string;
GetXlinkHrefnull760 function GetXlinkHref: string;
GetXlinkTitlenull761 function GetXlinkTitle: string;
762 procedure SetTarget(AValue: string);
763 procedure SetXlinkHref(AValue: string);
764 procedure SetXlinkTitle(AValue: string);
765 public
GetDOMTagnull766 class function GetDOMTag: string; override;
767 property XlinkHref: string read GetXlinkHref write SetXlinkHref;
768 property XlinkTitle: string read GetXlinkTitle write SetXlinkTitle;
769 property Target: string read GetTarget write SetTarget;
770 end;
771
772 { TSVGStyle }
773
774 TSVGRuleset = record
775 selector,
776 declarations: string;
777 end;
778 ArrayOfTSVGStyleItem = packed array of TSVGRuleset;
779
780 TSVGStyle = class(TSVGElement)
781 private
782 FRulesets: ArrayOfTSVGStyleItem;
GetRulesetCountnull783 function GetRulesetCount: integer;
784 procedure Parse(const s: String);
IsValidRulesetIndexnull785 function IsValidRulesetIndex(const AIndex: integer): boolean;
GetRulesetnull786 function GetRuleset(const AIndex: integer): TSVGRuleset;
787 procedure SetRuleset(const AIndex: integer; sr: TSVGRuleset);
Findnull788 function Find(ARuleset: TSVGRuleset): integer; overload;
789 protected
790 procedure Initialize; override;
791 public
GetDOMTagnull792 class function GetDOMTag: string; override;
793 constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); overload; override;
794 destructor Destroy; override;
795 procedure ConvertToUnit(AUnit: TCSSUnit); override;
Countnull796 function Count: Integer;
Findnull797 function Find(const AName: string): integer; overload;
Addnull798 function Add(ARuleset: TSVGRuleset): integer;
799 procedure Remove(ARuleset: TSVGRuleset);
800 procedure Clear;
801 procedure ReParse;
802 property Ruleset[AIndex: integer]: TSVGRuleset read GetRuleset write SetRuleset;
803 property RulesetCount: integer read GetRulesetCount;
804 end;
805
806 { TSVGContent }
807
808 TSVGContent = class
809 protected
810 FDataLink: TSVGDataLink;
811 FDomElem: TDOMElement;
812 FDoc: TDOMDocument;
813 FElements: TFPList;
814 FUnits: TCSSUnitConverter;
GetDOMNodenull815 function GetDOMNode(AElement: TObject): TDOMNode;
GetElementDOMNodenull816 function GetElementDOMNode(AIndex: integer): TDOMNode;
817 procedure AppendElement(AElement: TObject); overload;
ExtractElementAtnull818 function ExtractElementAt(AIndex: integer): TObject;
819 procedure InsertElementBefore(AElement: TSVGElement; ASuccessor: TSVGElement);
GetElementnull820 function GetElement(AIndex: integer): TSVGElement;
GetElementObjectnull821 function GetElementObject(AIndex: integer): TObject;
GetIsSVGElementnull822 function GetIsSVGElement(AIndex: integer): boolean;
GetElementCountnull823 function GetElementCount: integer;
GetUnitsnull824 function GetUnits: TCSSUnitConverter;
TryCreateElementFromNodenull825 function TryCreateElementFromNode(ANode: TDOMNode): TObject; virtual;
826 public
827 constructor Create(AElement: TDOMElement; AUnits: TCSSUnitConverter;
828 ADataLink: TSVGDataLink);
829 destructor Destroy; override;
830 procedure Clear;
831 procedure ConvertToUnit(AUnit: TCSSUnit);
832 procedure Recompute;
833 procedure Draw(ACanvas2d: TBGRACanvas2D; x,y: single; AUnit: TCSSUnit); overload;
834 procedure Draw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit); overload;
AppendElementnull835 function AppendElement(ASVGType: TSVGFactory): TSVGElement; overload;
836 procedure BringElement(AElement: TObject; AFromContent: TSVGContent); overload;
837 procedure CopyElement(AElement: TObject);
838 procedure RemoveElement(AElement: TObject);
AppendDOMTextnull839 function AppendDOMText(AText: string): TDOMText;
AppendDefinenull840 function AppendDefine: TSVGDefine;
AppendLinearGradientnull841 function AppendLinearGradient(x1,y1,x2,y2: single; AIsPercent: boolean): TSVGLinearGradient; overload;
AppendLinearGradientnull842 function AppendLinearGradient(x1,y1,x2,y2: single; AUnit: TCSSUnit): TSVGLinearGradient; overload;
AppendRadialGradientnull843 function AppendRadialGradient(cx,cy,r,fx,fy,fr: single; AIsPercent: boolean): TSVGRadialGradient; overload;
AppendRadialGradientnull844 function AppendRadialGradient(cx,cy,r,fx,fy,fr: single; AUnit: TCSSUnit): TSVGRadialGradient; overload;
AppendStopnull845 function AppendStop(AColor: TBGRAPixel; AOffset: single; AIsPercent: boolean): TSVGStopGradient;
AppendLinenull846 function AppendLine(x1,y1,x2,y2: single; AUnit: TCSSUnit = cuCustom): TSVGLine; overload;
AppendLinenull847 function AppendLine(p1,p2: TPointF; AUnit: TCSSUnit = cuCustom): TSVGLine; overload;
AppendCirclenull848 function AppendCircle(cx,cy,r: single; AUnit: TCSSUnit = cuCustom): TSVGCircle; overload;
AppendCirclenull849 function AppendCircle(c: TPointF; r: single; AUnit: TCSSUnit = cuCustom): TSVGCircle; overload;
AppendEllipsenull850 function AppendEllipse(cx,cy,rx,ry: single; AUnit: TCSSUnit = cuCustom): TSVGEllipse; overload;
AppendEllipsenull851 function AppendEllipse(c,r: TPointF; AUnit: TCSSUnit = cuCustom): TSVGEllipse; overload;
AppendPathnull852 function AppendPath(data: string; AUnit: TCSSUnit = cuCustom): TSVGPath; overload;
AppendPathnull853 function AppendPath(path: TBGRAPath; AUnit: TCSSUnit = cuCustom): TSVGPath; overload;
AppendPolygonnull854 function AppendPolygon(const points: array of single; AUnit: TCSSUnit = cuCustom): TSVGPolypoints; overload;
AppendPolygonnull855 function AppendPolygon(const points: array of TPointF; AUnit: TCSSUnit = cuCustom): TSVGPolypoints; overload;
AppendRectnull856 function AppendRect(x,y,width,height: single; AUnit: TCSSUnit = cuCustom): TSVGRectangle; overload;
AppendRectnull857 function AppendRect(origin,size: TPointF; AUnit: TCSSUnit = cuCustom): TSVGRectangle; overload;
AppendImagenull858 function AppendImage(x,y,width,height: single; ABitmap: TBGRACustomBitmap; ABitmapOwned: boolean; AUnit: TCSSUnit = cuCustom): TSVGImage; overload;
AppendImagenull859 function AppendImage(origin,size: TPointF; ABitmap: TBGRACustomBitmap; ABitmapOwned: boolean; AUnit: TCSSUnit = cuCustom): TSVGImage; overload;
AppendImagenull860 function AppendImage(x,y,width,height: single; ABitmapStream: TStream; AMimeType: string; AUnit: TCSSUnit = cuCustom): TSVGImage; overload;
AppendImagenull861 function AppendImage(origin,size: TPointF; ABitmapStream: TStream; AMimeType: string; AUnit: TCSSUnit = cuCustom): TSVGImage; overload;
AppendTextnull862 function AppendText(x,y: single; AText: string; AUnit: TCSSUnit = cuCustom): TSVGText; overload;
AppendTextnull863 function AppendText(origin: TPointF; AText: string; AUnit: TCSSUnit = cuCustom): TSVGText; overload;
AppendTextSpannull864 function AppendTextSpan(AText: string): TSVGTSpan;
AppendRoundRectnull865 function AppendRoundRect(x,y,width,height,rx,ry: single; AUnit: TCSSUnit = cuCustom): TSVGRectangle; overload;
AppendRoundRectnull866 function AppendRoundRect(origin,size,radius: TPointF; AUnit: TCSSUnit = cuCustom): TSVGRectangle; overload;
AppendGroupnull867 function AppendGroup: TSVGGroup;
IndexOfElementnull868 function IndexOfElement(AElement: TObject): integer;
869 property ElementCount: integer read GetElementCount;
870 property Element[AIndex: integer]: TSVGElement read GetElement;
871 property ElementObject[AIndex: integer]: TObject read GetElementObject;
872 property ElementDOMNode[AIndex: integer]: TDOMNode read GetElementDOMNode;
873 property IsSVGElement[AIndex: integer]: boolean read GetIsSVGElement;
874 property Units: TCSSUnitConverter read GetUnits;
875 end;
876
GetSVGFactorynull877 function GetSVGFactory(ATagName: string): TSVGFactory;
CreateSVGElementFromNodenull878 function CreateSVGElementFromNode(AElement: TDOMElement; AUnits: TCSSUnitConverter;
879 ADataLink: TSVGDataLink): TSVGElement;
880
881 implementation
882
883 uses BGRATransform, BGRAUTF8, base64, BGRAGradientScanner;
884
GetSVGFactorynull885 function GetSVGFactory(ATagName: string): TSVGFactory;
886 var tag: string;
887 begin
888 tag := LowerCase(ATagName);
889 if tag='line' then
890 result := TSVGLine else
891 if tag='rect' then
892 result := TSVGRectangle else
893 if tag='circle' then
894 result := TSVGCircle else
895 if tag='ellipse' then
896 result := TSVGEllipse else
897 if tag='path' then
898 result := TSVGPath else
899 if (tag='polygon') or (tag='polyline') then
900 result := TSVGPolypoints else
901 if tag='text' then
902 result := TSVGText else
903 if tag='tspan' then
904 result := TSVGTSpan else
905 if tag='tref' then
906 result := TSVGTRef else
907 if tag='textpath' then
908 result := TSVGTextPath else
909 if tag='altglyph' then
910 result := TSVGAltGlyph else
911 if tag='altglyphdef' then
912 result := TSVGAltGlyphDef else
913 if tag='altglyphitem' then
914 result := TSVGAltGlyphItem else
915 if tag='glyphref' then
916 result := TSVGGlyphRef else
917 if tag='clippath' then
918 result := TSVGClipPath else
919 if tag='colorprofile' then
920 result := TSVGColorProfile else
921 if tag='image' then
922 result := TSVGImage else
923 if tag='pattern' then
924 result := TSVGPattern else
925 if tag='marker' then
926 result := TSVGMarker else
927 if tag='mask' then
928 result := TSVGMask else
929 if tag='lineargradient' then
930 result := TSVGLinearGradient else
931 if tag='radialgradient' then
932 result := TSVGRadialGradient else
933 if tag='stop' then
934 result := TSVGStopGradient else
935 if tag='defs' then
936 result := TSVGDefine else
937 if tag='g' then
938 result := TSVGGroup else
939 if tag='a' then
940 result := TSVGLink else
941 if tag='style' then
942 result := TSVGStyle else
943 result := TSVGElement;
944 end;
945
CreateSVGElementFromNodenull946 function CreateSVGElementFromNode(AElement: TDOMElement; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink): TSVGElement;
947 var
948 factory: TSVGFactory;
949 begin
950 factory := GetSVGFactory(AElement.TagName);
951 result := factory.Create(AElement,AUnits,ADataLink);
952 end;
953
954 { TSVGDefine }
955
TSVGDefine.GetDOMTagnull956 class function TSVGDefine.GetDOMTag: string;
957 begin
958 Result:= 'defs';
959 end;
960
961 { TSVGLink }
962
GetTargetnull963 function TSVGLink.GetTarget: string;
964 begin
965 result := Attribute['target'];
966 end;
967
GetXlinkHrefnull968 function TSVGLink.GetXlinkHref: string;
969 begin
970 result := Attribute['xlink:href'];
971 end;
972
GetXlinkTitlenull973 function TSVGLink.GetXlinkTitle: string;
974 begin
975 result := Attribute['xlink:title'];
976 end;
977
978 procedure TSVGLink.SetTarget(AValue: string);
979 begin
980 Attribute['target'] := AValue;
981 end;
982
983 procedure TSVGLink.SetXlinkHref(AValue: string);
984 begin
985 Attribute['xlink:href'] := AValue;
986 end;
987
988 procedure TSVGLink.SetXlinkTitle(AValue: string);
989 begin
990 Attribute['xlink:title'] := AValue;
991 end;
992
TSVGLink.GetDOMTagnull993 class function TSVGLink.GetDOMTag: string;
994 begin
995 Result:= 'a';
996 end;
997
998 { TSVGElementWithContent }
999
TSVGElementWithContent.OwnDatalinknull1000 class function TSVGElementWithContent.OwnDatalink: boolean;
1001 begin
1002 result := false;
1003 end;
1004
1005 procedure TSVGElementWithContent.SetDatalink(AValue: TSVGDataLink);
1006 var
1007 i: Integer;
1008 begin
1009 inherited SetDatalink(AValue);
1010 if not OwnDatalink then
1011 begin
1012 for i := 0 to FContent.ElementCount-1 do
1013 if FContent.IsSVGElement[i] then
1014 FContent.Element[i].DataLink := AValue;
1015 FContent.FDataLink := AValue;
1016 end else
1017 FSubDatalink.Parent := AValue;
1018 end;
1019
1020 constructor TSVGElementWithContent.Create(ADocument: TDOMDocument;
1021 AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink);
1022 begin
1023 inherited Create(ADocument, AUnits, ADataLink);
1024 if OwnDatalink then
1025 FSubDataLink := TSVGDataLink.Create(ADataLink)
1026 else FSubDatalink := ADataLink;
1027 FContent := TSVGContent.Create(FDomElem,AUnits,FSubDataLink);
1028 end;
1029
1030 constructor TSVGElementWithContent.Create(AElement: TDOMElement;
1031 AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink);
1032 begin
1033 inherited Create(AElement, AUnits, ADataLink);
1034 if OwnDatalink then
1035 FSubDataLink := TSVGDataLink.Create(ADataLink)
1036 else FSubDatalink := ADataLink;
1037 FContent := TSVGContent.Create(AElement,AUnits,FSubDataLink);
1038 end;
1039
1040 procedure TSVGElementWithContent.ListIdentifiers(AResult: TStringList);
1041 var
1042 i: Integer;
1043 begin
1044 inherited ListIdentifiers(AResult);
1045 for i := 0 to Content.ElementCount-1 do
1046 if Content.IsSVGElement[i] then
1047 Content.Element[i].ListIdentifiers(AResult);
1048 end;
1049
1050 procedure TSVGElementWithContent.RenameIdentifiers(AFrom, ATo: TStringList);
1051 var
1052 i: Integer;
1053 begin
1054 inherited RenameIdentifiers(AFrom, ATo);
1055 for i := 0 to Content.ElementCount-1 do
1056 if Content.IsSVGElement[i] then
1057 Content.Element[i].RenameIdentifiers(AFrom, ATo);
1058 end;
1059
1060 procedure TSVGElementWithContent.ConvertToUnit(AUnit: TCSSUnit);
1061 begin
1062 inherited ConvertToUnit(AUnit);
1063 Content.ConvertToUnit(AUnit);
1064 end;
1065
1066 destructor TSVGElementWithContent.Destroy;
1067 begin
1068 FreeAndNil(FContent);
1069 if OwnDatalink then FreeAndNil(FSubDatalink);
1070 inherited Destroy;
1071 end;
1072
1073 procedure TSVGElementWithContent.Recompute;
1074 begin
1075 FContent.Recompute;
1076 inherited Recompute;
1077 end;
1078
1079 { TSVGElementWithGradient }
1080
1081 procedure TSVGElementWithGradient.Initialize;
1082 begin
1083 inherited Initialize;
1084 FRegisteredToDatalink:= false;
1085 ResetGradients;
1086 end;
1087
1088 procedure TSVGElementWithGradient.ResetGradients;
1089 begin
1090 if FGradientElementsDefined then
1091 begin
1092 if Assigned(DataLink) and FRegisteredToDatalink then
1093 begin
1094 DataLink.RegisterLinkListener(@DatalinkOnLink, false);
1095 FRegisteredToDatalink := false;
1096 end;
1097 FGradientElementsDefined := false;
1098 end;
1099 FFillGradientElement := nil;
1100 FStrokeGradientElement := nil;
1101 FFillCanvasGradient := nil;
1102 FStrokeCanvasGradient := nil;
1103 end;
1104
1105 procedure TSVGElementWithGradient.FindGradientElements;
1106 var
1107 fillNotFound, strokeNotFound: boolean;
1108 begin
1109 if Assigned(FDataLink) then
1110 begin
1111 if FRegisteredToDatalink then
1112 begin
1113 FDataLink.RegisterLinkListener(@DatalinkOnLink, false);
1114 FRegisteredToDatalink := false;
1115 end;
1116 FFillGradientElement := TSVGGradient(FDataLink.FindElementByRef(fill, true, TSVGGradient, fillNotFound));
1117 FStrokeGradientElement := TSVGGradient(FDataLink.FindElementByRef(stroke, true, TSVGGradient, strokeNotFound));
1118 if Assigned(FFillGradientElement) or fillNotFound or
1119 Assigned(FStrokeGradientElement) or strokeNotFound then
1120 begin
1121 FDatalink.RegisterLinkListener(@DatalinkOnLink, true);
1122 FRegisteredToDatalink := true;
1123 end;
1124 end else
1125 begin
1126 FFillGradientElement := nil;
1127 FStrokeGradientElement := nil;
1128 end;
1129 if FFillGradientElement <> nil then
1130 FFillGradientElement.ScanInheritedGradients;
1131 if FStrokeGradientElement <> nil then
1132 FStrokeGradientElement.ScanInheritedGradients;
1133 FGradientElementsDefined:= true;
1134 end;
1135
EvaluatePercentagenull1136 function TSVGElementWithGradient.EvaluatePercentage(fu: TFloatWithCSSUnit): single;
1137 begin
1138 Result:= fu.value;
1139 if fu.CSSUnit <> cuPercent then
1140 begin
1141 if Result < 0 then
1142 Result:= 0
1143 else if Result > 1 then
1144 Result:= 1;
1145 Result:= Result * 100;
1146 end;
1147 end;
1148
1149 procedure TSVGElementWithGradient.DatalinkOnLink(Sender: TObject;
1150 AElement: TSVGElement; ALink: boolean);
1151 begin
1152 if not ALink then
1153 begin
1154 if (AElement = FFillGradientElement) or (AElement = FStrokeGradientElement) then
1155 ResetGradients;
1156 end else
1157 if ALink then
1158 if FGradientElementsDefined and ((FFillGradientElement = nil) or (FStrokeGradientElement = nil)) then
1159 ResetGradients;
1160 end;
1161
GetFillGradientElementnull1162 function TSVGElementWithGradient.GetFillGradientElement: TSVGGradient;
1163 begin
1164 if not FGradientElementsDefined then
1165 FindGradientElements;
1166 result := FFillGradientElement;
1167 end;
1168
TSVGElementWithGradient.GetStrokeGradientElementnull1169 function TSVGElementWithGradient.GetStrokeGradientElement: TSVGGradient;
1170 begin
1171 if not FGradientElementsDefined then
1172 FindGradientElements;
1173 result := FStrokeGradientElement;
1174 end;
1175
1176 procedure TSVGElementWithGradient.AddStopElements(ASVGGradient: TSVGGradient; canvas: IBGRACanvasGradient2D);
1177
AddStopElementFromnull1178 function AddStopElementFrom(el: TSVGElement): integer;
1179 var
1180 i: integer;
1181 begin
1182 if el is TSVGGradient then
1183 begin
1184 if el.HasAttribute('color-interpolation') then
1185 canvas.gammaCorrection:= TSVGGradient(el).colorInterpolation = sciLinearRGB;
1186 if el.HasAttribute('spreadMethod') then
1187 case TSVGGradient(el).spreadMethod of
1188 ssmReflect: canvas.repetition := grReflect;
1189 ssmRepeat: canvas.repetition := grRepeat;
1190 else canvas.repetition:= grPad;
1191 end;
1192 end;
1193 result:= 0;
1194 with (el as TSVGGradient).Content do
1195 for i:= 0 to ElementCount-1 do
1196 if IsSVGElement[i] and (Element[i] is TSVGStopGradient) then
1197 with TSVGStopGradient(Element[i]) do
1198 begin
1199 canvas.addColorStop(EvaluatePercentage(offset)/100, stopColor);
1200 Inc(result);
1201 end;
1202 end;
1203
1204 var
1205 i: integer;
1206 begin
1207 if not Assigned(ASVGGradient) then exit;
1208 with ASVGGradient.InheritedGradients do
1209 for i:= 0 to Count-1 do
1210 AddStopElementFrom(Items[i]);
1211 end;
1212
TSVGElementWithGradient.CreateCanvasLinearGradientnull1213 function TSVGElementWithGradient.CreateCanvasLinearGradient(
1214 ACanvas2d: TBGRACanvas2D; ASVGGradient: TSVGGradient;
1215 const origin: TPointF; const w,h: single; AUnit: TCSSUnit): IBGRACanvasGradient2D;
1216 var p1,p2: TPointF;
1217 g: TSVGLinearGradient;
1218 m: TAffineMatrix;
1219 begin
1220 g := ASVGGradient as TSVGLinearGradient;
1221 if g.gradientUnits = souObjectBoundingBox then
1222 begin
1223 p1.x:= EvaluatePercentage(g.x1)/100;
1224 p1.y:= EvaluatePercentage(g.y1)/100;
1225 p2.x:= EvaluatePercentage(g.x2)/100;
1226 p2.y:= EvaluatePercentage(g.y2)/100;
1227 m := ACanvas2d.matrix;
1228 ACanvas2d.translate(origin.x,origin.y);
1229 ACanvas2d.scale(w,h);
1230 ACanvas2d.transform(g.gradientMatrix[cuCustom]);
1231 result:= ACanvas2d.createLinearGradient(p1,p2);
1232 ACanvas2d.matrix := m;
1233 end else
1234 begin
1235 p1.x:= Units.ConvertWidth(g.x1,AUnit,w).value;
1236 p1.y:= Units.ConvertHeight(g.y1,AUnit,h).value;
1237 p2.x:= Units.ConvertWidth(g.x2,AUnit,w).value;
1238 p2.y:= Units.ConvertHeight(g.y2,AUnit,h).value;
1239 m := ACanvas2d.matrix;
1240 ACanvas2d.transform(g.gradientMatrix[AUnit]);
1241 result:= ACanvas2d.createLinearGradient(p1,p2);
1242 ACanvas2d.matrix := m;
1243 end;
1244
1245 AddStopElements(ASVGGradient, result);
1246 end;
1247
TSVGElementWithGradient.CreateCanvasRadialGradientnull1248 function TSVGElementWithGradient.CreateCanvasRadialGradient(
1249 ACanvas2d: TBGRACanvas2D; ASVGGradient: TSVGGradient; const origin: TPointF;
1250 const w, h: single; AUnit: TCSSUnit): IBGRACanvasGradient2D;
1251 var c,f: TPointF;
1252 r,fr: single;
1253 g: TSVGRadialGradient;
1254 m: TAffineMatrix;
1255
1256 procedure CheckFocalAndCreate(c: TPointF; r: single; f: TPointF; fr: single);
1257 var u: TPointF;
1258 d: single;
1259 begin
1260 u := f-c;
1261 d := VectLen(u);
1262 if d >= r then
1263 begin
1264 u.Scale( (r/d)*0.99999 );
1265 f := c+u;
1266 end;
1267 result:= ACanvas2d.createRadialGradient(c,r,f,fr,true);
1268 AddStopElements(ASVGGradient, result);
1269 end;
1270
1271 begin
1272 g := ASVGGradient as TSVGRadialGradient;
1273 if g.gradientUnits = souObjectBoundingBox then
1274 begin
1275 c.x:= EvaluatePercentage(g.cx)/100;
1276 c.y:= EvaluatePercentage(g.cy)/100;
1277 r:= abs(EvaluatePercentage(g.r))/100;
1278 f.x:= EvaluatePercentage(g.fx)/100;
1279 f.y:= EvaluatePercentage(g.fy)/100;
1280 fr:= abs(EvaluatePercentage(g.fr))/100;
1281
1282 m := ACanvas2d.matrix;
1283 ACanvas2d.translate(origin.x,origin.y);
1284 ACanvas2d.scale(w,h);
1285 ACanvas2d.transform(g.gradientMatrix[cuCustom]);
1286 CheckFocalAndCreate(c,r,f,fr);
1287 ACanvas2d.matrix := m;
1288 end else
1289 begin
1290 c.x:= Units.ConvertWidth(g.cx, AUnit, w).value;
1291 c.y:= Units.ConvertHeight(g.cy, AUnit, h).value;
1292 r:= abs(Units.ConvertOrtho(g.r, AUnit, w, h).value);
1293 f.x:= Units.ConvertWidth(g.fx, AUnit, w).value;
1294 f.y:= Units.ConvertHeight(g.fy, AUnit, h).value;
1295 fr:= abs(Units.ConvertOrtho(g.fr, AUnit, w, h).value);
1296
1297 m := ACanvas2d.matrix;
1298 ACanvas2d.transform(g.gradientMatrix[AUnit]);
1299 CheckFocalAndCreate(c,r,f,fr);
1300 ACanvas2d.matrix := m;
1301 end;
1302 end;
1303
1304 procedure TSVGElementWithGradient.InitializeGradient(ACanvas2d: TBGRACanvas2D;
1305 const origin: TPointF; const w,h: single; AUnit: TCSSUnit);
1306 begin
1307 if FillGradientElement <> nil then
1308 begin
1309 if FillGradientElement is TSVGLinearGradient then
1310 FFillCanvasGradient := CreateCanvasLinearGradient(ACanvas2d, FillGradientElement, origin, w,h, AUnit)
1311 else if FillGradientElement is TSVGRadialGradient then
1312 FFillCanvasGradient := CreateCanvasRadialGradient(ACanvas2d, FillGradientElement, origin, w,h, AUnit);
1313 end;
1314 if StrokeGradientElement <> nil then
1315 begin
1316 if StrokeGradientElement is TSVGLinearGradient then
1317 FStrokeCanvasGradient := CreateCanvasLinearGradient(ACanvas2d, StrokeGradientElement, origin, w,h, AUnit)
1318 else if StrokeGradientElement is TSVGRadialGradient then
1319 FStrokeCanvasGradient := CreateCanvasRadialGradient(ACanvas2d, StrokeGradientElement, origin, w,h, AUnit);
1320 end;
1321 end;
1322
1323 procedure TSVGElementWithGradient.ApplyFillStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit);
1324 begin
1325 inherited ApplyFillStyle(ACanvas2D,AUnit);
1326 if Assigned(FFillCanvasGradient) then
1327 ACanvas2D.fillStyle(FFillCanvasGradient);
1328 end;
1329
1330 procedure TSVGElementWithGradient.ApplyStrokeStyle(ACanvas2D: TBGRACanvas2D;
1331 AUnit: TCSSUnit);
1332 begin
1333 inherited ApplyStrokeStyle(ACanvas2D,AUnit);
1334 if Assigned(FStrokeCanvasGradient) then
1335 ACanvas2D.strokeStyle(FStrokeCanvasGradient);
1336 end;
1337
1338 procedure TSVGElementWithGradient.SetDatalink(AValue: TSVGDataLink);
1339 begin
1340 ResetGradients;
1341 inherited SetDatalink(AValue);
1342 end;
1343
1344 procedure TSVGElementWithGradient.SetFill(AValue: string);
1345 begin
1346 ResetGradients;
1347 inherited SetFill(AValue);
1348 end;
1349
1350 procedure TSVGElementWithGradient.SetStroke(AValue: string);
1351 begin
1352 ResetGradients;
1353 inherited SetStroke(AValue);
1354 end;
1355
1356 destructor TSVGElementWithGradient.Destroy;
1357 begin
1358 ResetGradients;
1359 inherited Destroy;
1360 end;
1361
1362 { TSVGTextElementWithContent }
1363
1364 constructor TSVGTextElementWithContent.Create(ADocument: TDOMDocument;
1365 AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink);
1366 begin
1367 inherited Create(ADocument, AUnits, ADataLink);
1368 FContent := TSVGContent.Create(FDomElem,AUnits,ADataLink);
1369 end;
1370
1371 constructor TSVGTextElementWithContent.Create(AElement: TDOMElement;
1372 AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink);
1373 begin
1374 inherited Create(AElement, AUnits, ADataLink);
1375 FContent := TSVGContent.Create(AElement,AUnits,ADataLink);
1376 end;
1377
1378 destructor TSVGTextElementWithContent.Destroy;
1379 begin
1380 FreeAndNil(FContent);
1381 inherited Destroy;
1382 end;
1383
1384 procedure TSVGTextElementWithContent.ConvertToUnit(AUnit: TCSSUnit);
1385 begin
1386 inherited ConvertToUnit(AUnit);
1387 Content.ConvertToUnit(AUnit);
1388 end;
1389
1390 { TSVGTextPositioning }
1391
GetXnull1392 function TSVGTextPositioning.GetX: ArrayOfTFloatWithCSSUnit;
1393 begin
1394 result := ArrayOfHorizAttributeWithUnitInherit['x',False];
1395 end;
1396
GetYnull1397 function TSVGTextPositioning.GetY: ArrayOfTFloatWithCSSUnit;
1398 begin
1399 result := ArrayOfVerticalAttributeWithUnitInherit['y',False];
1400 end;
1401
TSVGTextPositioning.GetDxnull1402 function TSVGTextPositioning.GetDx: ArrayOfTFloatWithCSSUnit;
1403 begin
1404 result := ArrayOfHorizAttributeWithUnitInherit['dx',False];
1405 end;
1406
TSVGTextPositioning.GetDynull1407 function TSVGTextPositioning.GetDy: ArrayOfTFloatWithCSSUnit;
1408 begin
1409 result := ArrayOfVerticalAttributeWithUnitInherit['dy',False];
1410 end;
1411
TSVGTextPositioning.GetRotatenull1412 function TSVGTextPositioning.GetRotate: ArrayOfTSVGNumber;
1413 begin
1414 result := ArrayOfAttributeNumberInherit['rotate',False];
1415 end;
1416
1417 procedure TSVGTextPositioning.SetX(AValue: ArrayOfTFloatWithCSSUnit);
1418 begin
1419 ArrayOfHorizAttributeWithUnit['x'] := AValue;
1420 end;
1421
1422 procedure TSVGTextPositioning.SetY(AValue: ArrayOfTFloatWithCSSUnit);
1423 begin
1424 ArrayOfVerticalAttributeWithUnit['y'] := AValue;
1425 end;
1426
1427 procedure TSVGTextPositioning.SetDx(AValue: ArrayOfTFloatWithCSSUnit);
1428 begin
1429 ArrayOfHorizAttributeWithUnit['dx'] := AValue;
1430 end;
1431
1432 procedure TSVGTextPositioning.SetDy(AValue: ArrayOfTFloatWithCSSUnit);
1433 begin
1434 ArrayOfVerticalAttributeWithUnit['dy'] := AValue;
1435 end;
1436
1437 procedure TSVGTextPositioning.SetRotate(AValue: ArrayOfTSVGNumber);
1438 begin
1439 ArrayOfAttributeNumber['rotate'] := AValue;
1440 end;
1441
1442 procedure TSVGTextPositioning.ConvertToUnit(AUnit: TCSSUnit);
1443 begin
1444 inherited ConvertToUnit(AUnit);
1445 if HasAttribute('x') then x := Units.ConvertWidth(x, AUnit);
1446 if HasAttribute('y') then y := Units.ConvertHeight(y, AUnit);
1447 if HasAttribute('dx') then dx := Units.ConvertWidth(dx, AUnit);
1448 if HasAttribute('dy') then dy := Units.ConvertHeight(dy, AUnit);
1449 end;
1450
1451 { TSVGText }
1452
TSVGText.GetFontBoldnull1453 function TSVGText.GetFontBold: boolean;
1454 var valueText: string;
1455 begin
1456 valueText := trim(fontWeight);
1457 result := (valueText = 'bold') or (valueText = 'bolder') or
1458 (valueText = '600') or (valueText = '700') or (valueText = '800') or
1459 (valueText = '900');
1460 end;
1461
GetFontFamilynull1462 function TSVGText.GetFontFamily: string;
1463 begin
1464 result := AttributeOrStyleDef['font-family', 'sans-serif'];
1465 end;
1466
GetFontFamilyListnull1467 function TSVGText.GetFontFamilyList: ArrayOfString;
1468 begin
1469 result := TBGRACanvas2D.StrToFontNameList(AttributeOrStyle['font-family']);
1470 end;
1471
GetFontItalicnull1472 function TSVGText.GetFontItalic: boolean;
1473 var valueText: string;
1474 begin
1475 valueText := trim(fontStyle);
1476 result := (valueText = 'oblique') or (valueText = 'italic');
1477 end;
1478
TSVGText.GetFontSizenull1479 function TSVGText.GetFontSize: TFloatWithCSSUnit;
1480 begin
1481 result:= GetVerticalAttributeOrStyleWithUnit('font-size',Units.CurrentFontEmHeight,false);
1482 end;
1483
GetFontStylenull1484 function TSVGText.GetFontStyle: string;
1485 begin
1486 result := AttributeOrStyleDef['font-style','normal'];
1487 end;
1488
TSVGText.GetFontStyleLCLnull1489 function TSVGText.GetFontStyleLCL: TFontStyles;
1490 var
1491 s: String;
1492 begin
1493 result := [];
1494 if fontBold then include(result, fsBold);
1495 if fontItalic then include(result, fsItalic);
1496 s := ' '+textDecoration+' ';
1497 if pos('underline',s) <> 0 then include(result, fsUnderline);
1498 if pos('line-through',s) <> 0 then include(result, fsStrikeOut);
1499 end;
1500
GetFontWeightnull1501 function TSVGText.GetFontWeight: string;
1502 begin
1503 result := AttributeOrStyleDef['font-weight','normal'];
1504 end;
1505
TSVGText.GetSimpleTextnull1506 function TSVGText.GetSimpleText: string;
1507 var
1508 i: Integer;
1509 begin
1510 if FInGetSimpleText then exit(''); //avoid reentrance
1511 FInGetSimpleText := true;
1512 result := '';
1513 for i := 0 to FContent.ElementCount-1 do
1514 if FContent.IsSVGElement[i] then
1515 begin
1516 if FContent.Element[i] is TSVGTRef then
1517 AppendStr(result, GetTRefContent(TSVGTRef(FContent.Element[i])) )
1518 else
1519 if FContent.Element[i] is TSVGText then
1520 AppendStr(result, TSVGText(FContent.Element[i]).SimpleText);
1521 end else
1522 begin
1523 if FContent.ElementDOMNode[i] is TDOMText then
1524 AppendStr(result, UTF16ToUTF8(TDOMText(FContent.ElementDOMNode[i]).Data));
1525 end;
1526 FInGetSimpleText := false;
1527 end;
1528
GetTextAnchornull1529 function TSVGText.GetTextAnchor: TSVGTextAnchor;
1530 begin
1531 case AttributeOrStyleDef['text-anchor','start'] of
1532 'middle': result := staMiddle;
1533 'end': result := staEnd;
1534 else result := staStart;
1535 end;
1536 end;
1537
TSVGText.GetTextDirectionnull1538 function TSVGText.GetTextDirection: TSVGTextDirection;
1539 begin
1540 if AttributeOrStyle['direction'] = 'rtl' then
1541 result := stdRtl
1542 else
1543 result := stdLtr;
1544 end;
1545
GetTextDecorationnull1546 function TSVGText.GetTextDecoration: string;
1547 begin
1548 result := AttributeOrStyleDef['text-decoration','none'];
1549 end;
1550
GetTextLengthnull1551 function TSVGText.GetTextLength: TFloatWithCSSUnit;
1552 begin
1553 result := HorizAttributeWithUnitDef['textLength'];
1554 end;
1555
TSVGText.GetLengthAdjustnull1556 function TSVGText.GetLengthAdjust: TSVGLengthAdjust;
1557 var
1558 valueText: string;
1559 begin
1560 valueText := trim(Attribute['lengthAdjust','spacing']);
1561 if valueText = 'spacing' then
1562 result := slaSpacing
1563 else
1564 result := slaSpacingAndGlyphs;
1565 end;
1566
1567 procedure TSVGText.SetFontBold(AValue: boolean);
1568 begin
1569 if AValue then fontWeight:= 'bold' else fontWeight:= 'normal';
1570 end;
1571
1572 procedure TSVGText.SetFontFamily(AValue: string);
1573 begin
1574 Attribute['font-family'] := AValue;
1575 RemoveStyle('font-family');
1576 end;
1577
1578 procedure TSVGText.SetFontFamilyList(AValue: ArrayOfString);
1579 begin
1580 fontFamily := TBGRACanvas2D.FontNameListToStr(AValue);
1581 end;
1582
1583 procedure TSVGText.SetFontItalic(AValue: boolean);
1584 begin
1585 if AValue then fontStyle:= 'italic' else fontStyle:= 'normal';
1586 end;
1587
1588 procedure TSVGText.SetFontSize(AValue: TFloatWithCSSUnit);
1589 begin
1590 VerticalAttributeWithUnit['font-size'] := AValue;
1591 end;
1592
1593 procedure TSVGText.SetFontStyle(AValue: string);
1594 begin
1595 Attribute['font-style'] := AValue;
1596 RemoveStyle('font-style');
1597 end;
1598
1599 procedure TSVGText.SetFontStyleLCL(AValue: TFontStyles);
1600 var
1601 s: String;
1602 begin
1603 fontItalic:= fsItalic in AValue;
1604 fontBold:= fsBold in AValue;
1605 s := '';
1606 if fsUnderline in AValue then AppendStr(s, 'underline ');
1607 if fsStrikeOut in AValue then AppendStr(s, 'line-through ');
1608 textDecoration:= trim(s);
1609 end;
1610
1611 procedure TSVGText.SetFontWeight(AValue: string);
1612 begin
1613 Attribute['font-weight'] := AValue;
1614 RemoveStyle('font-weight');
1615 end;
1616
1617 procedure TSVGText.SetTextAnchor(AValue: TSVGTextAnchor);
1618 begin
1619 case AValue of
1620 staMiddle: Attribute['text-anchor'] := 'middle';
1621 staEnd: Attribute['text-anchor'] := 'end';
1622 else {staStart} Attribute['text-anchor'] := 'start';
1623 end;
1624 end;
1625
1626 procedure TSVGText.SetTextDirection(AValue: TSVGTextDirection);
1627 begin
1628 if AValue = stdLtr then
1629 Attribute['direction'] := 'ltr'
1630 else
1631 Attribute['direction'] := 'rtl';
1632 end;
1633
1634 procedure TSVGText.SetSimpleText(AValue: string);
1635 begin
1636 Content.Clear;
1637 if AValue = '' then exit;
1638 Content.appendDOMText(AValue);
1639 end;
1640
1641 procedure TSVGText.SetTextDecoration(AValue: string);
1642 begin
1643 Attribute['text-decoration'] := AValue;
1644 RemoveStyle('text-decoration');
1645 end;
1646
1647 procedure TSVGText.SetTextLength(AValue: TFloatWithCSSUnit);
1648 begin
1649 HorizAttributeWithUnit['textLength'] := AValue;
1650 RemoveStyle('textLength');
1651 end;
1652
1653 procedure TSVGText.SetLengthAdjust(AValue: TSVGLengthAdjust);
1654 begin
1655 if AValue = slaSpacing then
1656 Attribute['lengthAdjust'] := 'spacing'
1657 else
1658 Attribute['lengthAdjust'] := 'spacingAndGlyphs';
1659 RemoveStyle('lengthAdjust');
1660 end;
1661
1662 procedure TSVGText.InternalDrawOrCompute(ACanvas2d: TBGRACanvas2D;
1663 AUnit: TCSSUnit; ADraw: boolean; AAllTextBounds: TRectF;
1664 var APosition: TPointF; var ATextParts: ArrayOfTextParts);
1665 begin
1666 if not ADraw then ATextParts[0].AbsoluteCoord := APosition;
1667 InternalDrawOrCompute(ACanvas2d, AUnit, ADraw, AAllTextBounds, APosition, ATextParts, 0,0,high(ATextParts));
1668 end;
1669
1670 procedure TSVGText.InternalDrawOrCompute(ACanvas2d: TBGRACanvas2D;
1671 AUnit: TCSSUnit; ADraw: boolean; AAllTextBounds: TRectF;
1672 var APosition: TPointF; var ATextParts: ArrayOfTextParts;
1673 ALevel: integer; AStartPart, AEndPart: integer);
1674 var
1675 prevFontSize: TFloatWithCSSUnit;
1676 ax, ay, adx, ady: ArrayOfTFloatWithCSSUnit;
1677 i, subStartPart, subEndPart, subLevel: integer;
1678 subElem: TSVGText;
1679 partBounds: TRectF;
1680 begin
1681 if AStartPart > AEndPart then exit;
1682
1683 prevFontSize := EnterFontSize;
1684
1685 if not ADraw then
1686 begin
1687 ax := Units.ConvertWidth(x,AUnit);
1688 ay := Units.ConvertHeight(y,AUnit);
1689 if length(ax)>0 then APosition.x := ax[0].value;
1690 if length(ay)>0 then APosition.y := ay[0].value;
1691 if (length(ax)>0) or (length(ay)>0) then
1692 ATextParts[AStartPart].AbsoluteCoord := APosition;
1693 end else
1694 APosition := ATextParts[AStartPart].AbsoluteCoord;
1695
1696 adx := Units.ConvertWidth(dx,AUnit);
1697 ady := Units.ConvertHeight(dy,AUnit);
1698 if length(adx)>0 then IncF(APosition.x, adx[0].value);
1699 if length(ady)>0 then IncF(APosition.y, ady[0].value);
1700
1701 i := AStartPart;
1702 while i <= AEndPart do
1703 begin
1704 if ATextParts[i].Level > ALevel then
1705 begin
1706 subStartPart := i;
1707 subEndPart := i;
1708 subElem := TSVGText(ATextParts[subStartPart].BaseElement);
1709 subLevel := ATextParts[subStartPart].Level;
1710 while (subEndPart < AEndPart) and
1711 ( ((ATextParts[subEndPart+1].Level = subLevel) and (ATextParts[subEndPart+1].BaseElement = subElem)) or
1712 (ATextParts[subEndPart+1].Level > subLevel) ) do
1713 inc(subEndPart);
1714 subElem.InternalDrawOrCompute(
1715 ACanvas2d, AUnit, ADraw, AAllTextBounds, APosition,
1716 ATextParts, subLevel, subStartPart, subEndPart);
1717 i := subEndPart+1;
1718 end
1719 else
1720 begin
1721 if not ADraw then
1722 ATextParts[i].PartStartCoord := APosition
1723 else
1724 APosition := ATextParts[i].PartStartCoord;
1725
1726 if ATextParts[i].Text <>'' then
1727 InternalDrawOrComputePart(ACanvas2d, AUnit, ATextParts[i].Text, ATextParts[i].PosUnicode,
1728 ATextParts[i].InheritedRotation, ADraw, AAllTextBounds, APosition, partBounds)
1729 else
1730 partBounds := EmptyRectF;
1731
1732 if not ADraw then
1733 begin
1734 ATextParts[i].PartEndCoord := APosition;
1735 ATextParts[i].Bounds := partBounds;
1736 end
1737 else
1738 APosition := ATextParts[i].PartEndCoord;
1739
1740 inc(i);
1741 end;
1742 end;
1743
1744 ExitFontSize(prevFontSize);
1745 end;
1746
1747 procedure TSVGText.InternalDrawOrComputePart(ACanvas2d: TBGRACanvas2D;
1748 AUnit: TCSSUnit; AText: string; APosUnicode: integer; AInheritedRotation: single;
1749 ADraw: boolean; AAllTextBounds: TRectF; var APosition: TPointF; out ABounds: TRectF);
1750 var
1751 ts: TCanvas2dTextSize;
1752 fs: TFontStyles;
1753 dir: TSVGTextDirection;
1754 deco: String;
1755 fh: TFloatWithCSSUnit;
1756 rotations: ArrayOfTSVGNumber;
1757 glyphSizes: array of single;
1758 glyphByGlyph: Boolean;
1759 cursor: TGlyphCursorUtf8;
1760 glyph: TGlyphUtf8;
1761 posGlyph: integer;
1762 curPos: TPointF;
1763 curRotation, firstRotation: single;
1764 posUnicode, i: integer;
1765 adx, ady, ax, ay: ArrayOfTFloatWithCSSUnit;
1766 begin
1767 fh := Units.CurrentFontEmHeight;
1768 ACanvas2d.fontEmHeight := Units.ConvertHeight(fh, AUnit).value;
1769 ACanvas2d.fontName := fontFamily;
1770 fs := [];
1771 if fontBold then include(fs, fsBold);
1772 if fontItalic then include(fs, fsItalic);
1773 deco := ' '+textDecoration+' ';
1774 if pos(' line-through ',deco)<>0 then include(fs, fsStrikeOut);
1775 if pos(' underline ',deco)<>0 then include(fs, fsUnderline);
1776 ACanvas2d.fontStyle := fs;
1777 dir := textDirection;
1778 case dir of
1779 stdRtl: ACanvas2d.direction:= fbmRightToLeft;
1780 else {stdLtr} ACanvas2d.direction:= fbmLeftToRight;
1781 end;
1782 ACanvas2d.textBaseline:= 'alphabetic';
1783
1784 rotations := rotate;
1785 if (length(rotations) <> 0) and
1786 (APosUnicode >= length(rotations)) then
1787 begin
1788 firstRotation := rotations[high(rotations)];
1789 glyphByGlyph:= true;
1790 end else
1791 begin
1792 firstRotation:= AInheritedRotation;
1793 glyphByGlyph:= firstRotation <> 0;
1794 end;
1795 for i := APosUnicode to APosUnicode + UTF8Length(AText) - 1 do
1796 if i >= length(rotations) then break else
1797 if rotations[i] <> 0 then glyphByGlyph := true;
1798 ax := x;
1799 ay := y;
1800 adx := dx;
1801 ady := dy;
1802 for i := APosUnicode + 1 to APosUnicode + UTF8Length(AText) - 1 do
1803 begin
1804 if (i < length(ax)) or (i < length(ay)) then glyphByGlyph:= true;
1805 if (i < length(adx)) and (adx[i].value <> 0) then glyphByGlyph := true;
1806 if (i < length(ady)) and (ady[i].value <> 0) then glyphByGlyph := true;
1807 end;
1808
1809 if glyphByGlyph then
1810 begin
1811 ts.width:= 0;
1812 ts.height := 0;
1813 cursor := TGlyphCursorUtf8.New(AText, ACanvas2d.direction);
1814 setlength(glyphSizes, length(AText)); //more than enough
1815 posGlyph := 0;
1816 repeat
1817 glyph := cursor.GetNextGlyph;
1818 if glyph.Empty then break;
1819 with ACanvas2d.measureText(glyph.GlyphUtf8) do
1820 begin
1821 incF(ts.Width, width);
1822 if height > ts.Height then ts.Height := height;
1823 glyphSizes[posGlyph] := width;
1824 end;
1825 inc(posGlyph);
1826 until false;
1827 end else
1828 begin
1829 ts := ACanvas2d.measureText(AText);
1830 glyphSizes := nil;
1831 end;
1832
1833 if dir = stdRtl then DecF(APosition.x, ts.width);
1834
1835 ABounds := RectF(APosition.x,APosition.y,APosition.x+ts.width,APosition.y+ts.height);
1836 if ADraw then
1837 begin
1838 ACanvas2d.beginPath;
1839 InitializeGradient(ACanvas2d, AAllTextBounds.TopLeft, AAllTextBounds.Width,AAllTextBounds.Height,AUnit);
1840 if glyphByGlyph then
1841 begin
1842 curPos := APosition;
1843 curRotation := firstRotation;
1844 posGlyph := 0;
1845 cursor := TGlyphCursorUtf8.New(AText, ACanvas2d.direction);
1846 repeat
1847 glyph := cursor.GetNextGlyph;
1848 if glyph.Empty then break;
1849 posUnicode := APosUnicode + UTF8Length(copy(AText, 1, glyph.ByteOffset));
1850 if posUnicode < length(rotations) then
1851 curRotation := rotations[posUnicode];
1852 ACanvas2d.save;
1853 ACanvas2d.translate(curPos.x, curPos.y);
1854 ACanvas2d.rotate(curRotation*Pi/180);
1855 if glyph.Mirrored then
1856 begin
1857 if glyph.MirroredGlyphUtf8 <> '' then
1858 ACanvas2d.text(glyph.GlyphUtf8, 0, 0) else
1859 begin
1860 ACanvas2d.translate(glyphSizes[posGlyph], 0);
1861 ACanvas2d.scale(-1,0);
1862 ACanvas2d.text(glyph.GlyphUtf8, 0, 0);
1863 end;
1864 end else
1865 ACanvas2d.text(glyph.GlyphUtf8, 0, 0);
1866 ACanvas2d.restore;
1867 IncF(curPos.x, glyphSizes[posGlyph]);
1868 for i := 1 to UTF8Length(copy(AText, glyph.ByteOffset+1, glyph.ByteSize)) do
1869 begin
1870 if posUnicode + i < length(ax) then curPos.x := Units.ConvertWidth(ax[posUnicode + i], AUnit).value;
1871 if posUnicode + i < length(ay) then curPos.y := Units.ConvertHeight(ay[posUnicode + i], AUnit).value;
1872 if posUnicode + i < length(adx) then incF(curPos.x, Units.ConvertWidth(adx[posUnicode + i], AUnit).value);
1873 if posUnicode + i < length(ady) then incF(curPos.y, Units.ConvertHeight(ady[posUnicode + i], AUnit).value);
1874 end;
1875 inc(posGlyph);
1876 until false;
1877 end else
1878 ACanvas2d.text(AText,APosition.x,APosition.y);
1879 Paint(ACanvas2D, AUnit);
1880 end;
1881
1882 if dir = stdLtr then IncF(APosition.x, ts.width);
1883 end;
1884
1885 procedure TSVGText.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
1886 var
1887 allTextBounds: TRectF;
1888 textParts: ArrayOfTextParts;
1889 anchor: TSVGTextAnchor;
1890
1891 procedure DoAlignText(AStartPart,AEndPart: integer);
1892 var
1893 advance,ofs: single;
1894 j: Integer;
1895 begin
1896 advance := textParts[AEndPart].PartEndCoord.x - textParts[AStartPart].AbsoluteCoord.x;
1897 ofs := 0;
1898
1899 case anchor of
1900 staMiddle: ofs := (-1/2)*advance;
1901 staEnd: ofs := -advance;
1902 else ofs := 0;
1903 end;
1904
1905 for j := AStartPart to AEndPart do
1906 begin
1907 if not isEmptyPointF(textParts[j].AbsoluteCoord) then IncF(textParts[j].AbsoluteCoord.x, ofs);
1908 if not isEmptyPointF(textParts[j].PartStartCoord) then IncF(textParts[j].PartStartCoord.x, ofs);
1909 if not isEmptyPointF(textParts[j].PartEndCoord) then IncF(textParts[j].PartEndCoord.x, ofs);
1910 if not IsEmptyRectF(textParts[j].Bounds) then textParts[j].Bounds.Offset(ofs,0);
1911 end;
1912 end;
1913
1914 var
1915 i, absStartIndex: Integer;
1916 pos: TPointF;
1917 begin
1918 textParts := GetAllText(0);
1919 CleanText(textParts);
1920 if length(textParts)>0 then
1921 begin
1922 pos := PointF(0,0);
1923 InternalDrawOrCompute(ACanvas2d, AUnit, False, EmptyRectF, pos, textParts);
1924
1925 anchor := textAnchor;
1926
1927 absStartIndex := -1;
1928 for i := 0 to high(textParts) do
1929 begin
1930 if not IsEmptyPointF(textParts[i].AbsoluteCoord) then
1931 begin
1932 if absStartIndex <> -1 then DoAlignText(absStartIndex,i-1);
1933 absStartIndex := i;
1934 end;
1935 end;
1936 if absStartIndex <> -1 then DoAlignText(absStartIndex,high(textParts));
1937
1938 allTextBounds := EmptyRectF;
1939 for i := 0 to high(textParts) do
1940 allTextBounds := allTextBounds.Union(textParts[i].Bounds);
1941
1942 pos := PointF(0,0);
1943 InternalDrawOrCompute(ACanvas2d, AUnit, True, allTextBounds, pos, textParts);
1944 end;
1945 end;
1946
1947 procedure TSVGText.CleanText(var ATextParts: ArrayOfTextParts);
1948 var wasSpace: boolean;
1949 wasSpaceBeforePartIdx: integer;
1950 i,j: integer;
1951 k,l, startPos, endPosP1: integer;
1952 fullText, cleanedText: string;
1953 begin
1954 wasSpace := false;
1955 wasSpaceBeforePartIdx:= -1;
1956 fullText := '';
1957 for k := 0 to high(ATextParts) do
1958 AppendStr(fullText, ATextParts[k].Text);
1959
1960 setlength(cleanedText, length(fullText));
1961 j := 0;
1962 k := 0;
1963 for i := 1 to length(fullText) do
1964 begin
1965 if not (fullText[i] in[#0..#32]) and wasSpace and (j>0) then
1966 begin
1967 inc(j);
1968 cleanedText[j] := ' ';
1969 if wasSpaceBeforePartIdx <> -1 then
1970 for l := wasSpaceBeforePartIdx to k-1 do
1971 inc(ATextParts[l].SplitPos);
1972 wasSpace:= false;
1973 end;
1974 while (k < length(ATextParts)) and (i = ATextParts[k].SplitPos) do
1975 begin
1976 if wasSpace and (wasSpaceBeforePartIdx = -1) then
1977 wasSpaceBeforePartIdx:= k;
1978 ATextParts[k].SplitPos := j+1;
1979 inc(k);
1980 end;
1981 if fullText[i] in[#0..#32] then
1982 wasSpace := true
1983 else
1984 begin
1985 inc(j);
1986 cleanedText[j] := fullText[i];
1987 wasSpace := false;
1988 wasSpaceBeforePartIdx := -1;
1989 end;
1990 end;
1991 while k < length(ATextParts) do
1992 begin
1993 ATextParts[k].SplitPos := j+1;
1994 inc(k);
1995 end;
1996 setlength(cleanedText, j);
1997
1998 for k := 0 to high(ATextParts) do
1999 begin
2000 startPos := ATextParts[k].SplitPos;
2001 if k = high(ATextParts) then endPosP1 := j+1 else
2002 endPosP1 := ATextParts[k+1].SplitPos;
2003 ATextParts[k].Text:= copy(cleanedText, startPos, endPosP1 - startPos);
2004 end;
2005 end;
2006
TSVGText.GetTRefContentnull2007 function TSVGText.GetTRefContent(AElement: TSVGTRef): string;
2008 var
2009 refText: TSVGText;
2010 begin
2011 if Assigned(FDataLink) then
2012 refText := TSVGText(FDataLink.FindElementByRef(AElement.xlinkHref, TSVGText))
2013 else refText := nil;
2014 if Assigned(refText) then result := refText.SimpleText else result := '';
2015 end;
2016
TSVGText.GetAllTextnull2017 function TSVGText.GetAllText(AInheritedRotation: single): ArrayOfTextParts;
2018 var
2019 idxOut,curLen: Integer;
2020 posUnicode: integer;
2021
2022 procedure AppendPart(AText: string);
2023 begin
2024 if (idxOut > 0) and (result[idxOut-1].Text = '')
2025 and (result[idxOut-1].BaseElement = self) then dec(idxOut);
2026 result[idxOut].Level := 0;
2027 result[idxOut].BaseElement:= self;
2028 result[idxOut].Text := AText;
2029 result[idxOut].SplitPos:= curLen+1;
2030 result[idxOut].AbsoluteCoord := EmptyPointF;
2031 result[idxOut].PartStartCoord := EmptyPointF;
2032 result[idxOut].Bounds := EmptyRectF;
2033 result[idxOut].PosUnicode := posUnicode;
2034 result[idxOut].InheritedRotation:= AInheritedRotation;
2035 inc(curLen, length(AText));
2036 inc(idxOut);
2037 inc(posUnicode, UTF8Length(AText));
2038 end;
2039
2040 var
2041 i,j: integer;
2042 svgElem: TSVGElement;
2043 subParts: ArrayOfTextParts;
2044 node: TDOMNode;
2045 rotations: ArrayOfTSVGNumber;
2046 inheritedRotation: TSVGNumber;
2047
2048 begin
2049 setlength(result, Content.ElementCount+1);
2050 idxOut := 0;
2051 curLen := 0;
2052 posUnicode := 0;
2053 AppendPart(''); //needed when there is a sub part to know the base element
2054 for i := 0 to Content.ElementCount-1 do
2055 begin
2056 if Content.IsSVGElement[i] then
2057 begin
2058 svgElem := Content.Element[i];
2059 if svgElem is TSVGTRef then
2060 AppendPart(GetTRefContent(TSVGTRef(svgElem)))
2061 else
2062 if svgElem is TSVGText then
2063 begin
2064 rotations := rotate;
2065 if posUnicode = 0 then inheritedRotation:= AInheritedRotation else
2066 if posUnicode-1 >= length(rotations) then
2067 begin
2068 if rotations <> nil then
2069 inheritedRotation:= rotations[high(rotations)]
2070 else inheritedRotation := 0;
2071 end else
2072 inheritedRotation := rotations[posUnicode-1];
2073 subParts := TSVGText(svgElem).GetAllText(inheritedRotation);
2074 if length(subParts) > 0 then
2075 begin
2076 setlength(result, length(result)+length(subParts)-1);
2077 for j := 0 to high(subParts) do
2078 begin
2079 result[idxOut] := subParts[j];
2080 inc(result[idxOut].Level);
2081 result[idxOut].SplitPos:= curLen+1;
2082 inc(curLen, length(result[idxOut].Text));
2083 inc(idxOut);
2084 end;
2085 end else
2086 AppendPart('');
2087 end;
2088 end else
2089 begin
2090 node := Content.ElementDOMNode[i];
2091 if node is TDOMText then
2092 AppendPart(UTF16ToUTF8(TDOMText(node).Data));
2093 end;
2094 end;
2095 setlength(result, idxOut);
2096 end;
2097
TSVGText.GetDOMTagnull2098 class function TSVGText.GetDOMTag: string;
2099 begin
2100 Result:= 'text';
2101 end;
2102
2103 procedure TSVGText.ConvertToUnit(AUnit: TCSSUnit);
2104 var
2105 prevFontSize: TFloatWithCSSUnit;
2106 begin
2107 prevFontSize := EnterFontSize;
2108 inherited ConvertToUnit(AUnit);
2109 if HasAttribute('textLength') then textLength := Units.ConvertWidth(textLength, AUnit);
2110 if HasAttribute('font-size') then
2111 SetVerticalAttributeWithUnit('font-size', Units.ConvertHeight(GetVerticalAttributeWithUnit('font-size'), AUnit));
2112 ExitFontSize(prevFontSize);
2113 end;
2114
2115 { TSVGTSpan }
2116
TSVGTSpan.GetDOMTagnull2117 class function TSVGTSpan.GetDOMTag: string;
2118 begin
2119 Result:= 'tspan';
2120 end;
2121
2122 { TSVGTRef }
2123
GetXlinkHrefnull2124 function TSVGTRef.GetXlinkHref: string;
2125 begin
2126 result := Attribute['xlink:href'];
2127 end;
2128
2129 procedure TSVGTRef.SetXlinkHref(AValue: string);
2130 begin
2131 Attribute['xlink:href'] := AValue;
2132 end;
2133
TSVGTRef.GetDOMTagnull2134 class function TSVGTRef.GetDOMTag: string;
2135 begin
2136 Result:= 'tref';
2137 end;
2138
2139 { TSVGTextPath }
2140
TSVGTextPath.GetStartOffsetnull2141 function TSVGTextPath.GetStartOffset: TFloatWithCSSUnit;
2142 begin
2143 result := HorizAttributeWithUnitDef['startOffset'];
2144 end;
2145
GetMethodnull2146 function TSVGTextPath.GetMethod: TSVGTextPathMethod;
2147 var
2148 valueText: string;
2149 begin
2150 valueText := trim(Attribute['method','align']);
2151 if valueText = 'align' then
2152 result := stpmAlign
2153 else
2154 result := stpmStretch;
2155 end;
2156
GetSpacingnull2157 function TSVGTextPath.GetSpacing: TSVGTextPathSpacing;
2158 var
2159 valueText: string;
2160 begin
2161 valueText := trim(Attribute['spacing','exact']);
2162 if valueText = 'exact' then
2163 result := stpsExact
2164 else
2165 result := stpsAuto;
2166 end;
2167
GetXlinkHrefnull2168 function TSVGTextPath.GetXlinkHref: string;
2169 begin
2170 result := Attribute['xlink:href'];
2171 end;
2172
2173 procedure TSVGTextPath.SetStartOffset(AValue: TFloatWithCSSUnit);
2174 begin
2175 HorizAttributeWithUnit['startOffset'] := AValue;
2176 RemoveStyle('startOffset');
2177 end;
2178
2179 procedure TSVGTextPath.SetMethod(AValue: TSVGTextPathMethod);
2180 begin
2181 if AValue = stpmAlign then
2182 Attribute['method'] := 'align'
2183 else
2184 Attribute['method'] := 'stretch';
2185 RemoveStyle('method');
2186 end;
2187
2188 procedure TSVGTextPath.SetSpacing(AValue: TSVGTextPathSpacing);
2189 begin
2190 if AValue = stpsExact then
2191 Attribute['spacing'] := 'exact'
2192 else
2193 Attribute['spacing'] := 'auto';
2194 RemoveStyle('spacing');
2195 end;
2196
2197 procedure TSVGTextPath.SetXlinkHref(AValue: string);
2198 begin
2199 Attribute['xlink:href'] := AValue;
2200 end;
2201
2202 procedure TSVGTextPath.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
2203 begin
2204 //todo
2205 end;
2206
TSVGTextPath.GetDOMTagnull2207 class function TSVGTextPath.GetDOMTag: string;
2208 begin
2209 Result:= 'textpath';
2210 end;
2211
2212 procedure TSVGTextPath.ConvertToUnit(AUnit: TCSSUnit);
2213 begin
2214 inherited ConvertToUnit(AUnit);
2215 if HasAttribute('startOffset') then startOffset := Units.ConvertWidth(startOffset, AUnit);
2216 end;
2217
2218 { TSVGAltGlyph }
2219
TSVGAltGlyph.GetGlyphRefnull2220 function TSVGAltGlyph.GetGlyphRef: string;
2221 begin
2222 result := Attribute['glyphRef',''];
2223 end;
2224
GetFormatnull2225 function TSVGAltGlyph.GetFormat: string;
2226 begin
2227 result := Attribute['format',''];
2228 end;
2229
GetXlinkHrefnull2230 function TSVGAltGlyph.GetXlinkHref: string;
2231 begin
2232 result := Attribute['xlink:href'];
2233 end;
2234
2235 procedure TSVGAltGlyph.SetGlyphRef(AValue: string);
2236 begin
2237 Attribute['glyphRef'] := AValue;
2238 end;
2239
2240 procedure TSVGAltGlyph.SetFormat(AValue: string);
2241 begin
2242 Attribute['format'] := AValue;
2243 end;
2244
2245 procedure TSVGAltGlyph.SetXlinkHref(AValue: string);
2246 begin
2247 Attribute['xlink:href'] := AValue;
2248 end;
2249
2250 procedure TSVGAltGlyph.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
2251 begin
2252 //todo
2253 end;
2254
TSVGAltGlyph.GetDOMTagnull2255 class function TSVGAltGlyph.GetDOMTag: string;
2256 begin
2257 Result:= 'altglyph';
2258 end;
2259
2260 { TSVGAltGlyphDef }
2261
TSVGAltGlyphDef.GetDOMTagnull2262 class function TSVGAltGlyphDef.GetDOMTag: string;
2263 begin
2264 Result:= 'altglyphdef';
2265 end;
2266
2267 { TSVGAltGlyphItem }
2268
TSVGAltGlyphItem.GetDOMTagnull2269 class function TSVGAltGlyphItem.GetDOMTag: string;
2270 begin
2271 Result:= 'altglyphitem';
2272 end;
2273
2274 { TSVGGlyphRef }
2275
GetXnull2276 function TSVGGlyphRef.GetX: TSVGNumber;
2277 begin
2278 result := HorizAttribute['x'];
2279 end;
2280
GetYnull2281 function TSVGGlyphRef.GetY: TSVGNumber;
2282 begin
2283 result := VerticalAttribute['y'];
2284 end;
2285
GetDxnull2286 function TSVGGlyphRef.GetDx: TSVGNumber;
2287 begin
2288 result := HorizAttribute['dx'];
2289 end;
2290
TSVGGlyphRef.GetDynull2291 function TSVGGlyphRef.GetDy: TSVGNumber;
2292 begin
2293 result := VerticalAttribute['dy'];
2294 end;
2295
TSVGGlyphRef.GetGlyphRefnull2296 function TSVGGlyphRef.GetGlyphRef: string;
2297 begin
2298 result := Attribute['glyphRef',''];
2299 end;
2300
GetFormatnull2301 function TSVGGlyphRef.GetFormat: string;
2302 begin
2303 result := Attribute['format',''];
2304 end;
2305
GetXlinkHrefnull2306 function TSVGGlyphRef.GetXlinkHref: string;
2307 begin
2308 result := Attribute['xlink:href'];
2309 end;
2310
2311 procedure TSVGGlyphRef.SetX(AValue: TSVGNumber);
2312 begin
2313 HorizAttribute['x'] := AValue;
2314 end;
2315
2316 procedure TSVGGlyphRef.SetY(AValue: TSVGNumber);
2317 begin
2318 VerticalAttribute['y'] := AValue;
2319 end;
2320
2321 procedure TSVGGlyphRef.SetDx(AValue: TSVGNumber);
2322 begin
2323 HorizAttribute['dx'] := AValue;
2324 end;
2325
2326 procedure TSVGGlyphRef.SetDy(AValue: TSVGNumber);
2327 begin
2328 HorizAttribute['dy'] := AValue;
2329 end;
2330
2331 procedure TSVGGlyphRef.SetGlyphRef(AValue: string);
2332 begin
2333 Attribute['glyphRef'] := AValue;
2334 end;
2335
2336 procedure TSVGGlyphRef.SetFormat(AValue: string);
2337 begin
2338 Attribute['format'] := AValue;
2339 end;
2340
2341 procedure TSVGGlyphRef.SetXlinkHref(AValue: string);
2342 begin
2343 Attribute['xlink:href'] := AValue;
2344 end;
2345
2346 procedure TSVGGlyphRef.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
2347 begin
2348 //todo
2349 end;
2350
TSVGGlyphRef.GetDOMTagnull2351 class function TSVGGlyphRef.GetDOMTag: string;
2352 begin
2353 Result:= 'glyphref';
2354 end;
2355
2356 { TSVGClipPath }
2357
GetExternalResourcesRequirednull2358 function TSVGClipPath.GetExternalResourcesRequired: boolean;
2359 begin
2360 if Attribute['externalResourcesRequired'] = 'true' then
2361 result := true
2362 else
2363 result := false;
2364 end;
2365
GetClipPathUnitsnull2366 function TSVGClipPath.GetClipPathUnits: TSVGObjectUnits;
2367 begin
2368 if Attribute['clipPathUnits'] = 'objectBoundingBox' then
2369 result := souObjectBoundingBox
2370 else
2371 result := souUserSpaceOnUse;
2372 end;
2373
2374 procedure TSVGClipPath.SetExternalResourcesRequired(AValue: boolean);
2375 begin
2376 if AValue then
2377 Attribute['ExternalResourcesRequired'] := 'true'
2378 else
2379 Attribute['ExternalResourcesRequired'] := 'false';
2380 end;
2381
2382 procedure TSVGClipPath.SetClipPathUnits(AValue: TSVGObjectUnits);
2383 begin
2384 if AValue = souUserSpaceOnUse then
2385 Attribute['clipPathUnits'] := 'userSpaceOnUse'
2386 else
2387 Attribute['clipPathUnits'] := 'objectBoundingBox';
2388 end;
2389
2390 procedure TSVGClipPath.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
2391 begin
2392 //todo
2393 end;
2394
TSVGClipPath.GetDOMTagnull2395 class function TSVGClipPath.GetDOMTag: string;
2396 begin
2397 Result:= 'clippath';
2398 end;
2399
2400 { TSVGColorProfile }
2401
TSVGColorProfile.GetLocalnull2402 function TSVGColorProfile.GetLocal: string;
2403 begin
2404 result := Attribute['local'];
2405 end;
2406
TSVGColorProfile.GetNamenull2407 function TSVGColorProfile.GetName: string;
2408 begin
2409 result := Attribute['name'];
2410 end;
2411
GetRenderingIntentnull2412 function TSVGColorProfile.GetRenderingIntent: TSVGRenderingIntent;
2413 var
2414 s: string;
2415 begin
2416 s := Attribute['rendering-intent','auto'];
2417 if s = 'auto' then
2418 result := sriAuto
2419 else if s = 'perceptual' then
2420 result := sriPerceptual
2421 else if s = 'relative-colorimetric' then
2422 result := sriRelativeColorimetric
2423 else if s = 'saturation' then
2424 result := sriSaturation
2425 else { 'absolute-colorimetric' }
2426 result := sriAbsoluteColorimetric;
2427 end;
2428
GetXlinkHrefnull2429 function TSVGColorProfile.GetXlinkHref: string;
2430 begin
2431 result := Attribute['xlink:href'];
2432 end;
2433
2434 procedure TSVGColorProfile.SetLocal(AValue: string);
2435 begin
2436 Attribute['local'] := AValue;
2437 end;
2438
2439 procedure TSVGColorProfile.SetName(AValue: string);
2440 begin
2441 Attribute['name'] := AValue;
2442 end;
2443
2444 procedure TSVGColorProfile.SetRenderingIntent(AValue: TSVGRenderingIntent);
2445 begin
2446 if AValue = sriAuto then
2447 Attribute['rendering-intent'] := 'auto'
2448 else if AValue = sriPerceptual then
2449 Attribute['rendering-intent'] := 'perceptual'
2450 else if AValue = sriRelativeColorimetric then
2451 Attribute['rendering-intent'] := 'relative-colorimetric'
2452 else if AValue = sriSaturation then
2453 Attribute['rendering-intent'] := 'saturation'
2454 else { sriAbsoluteColorimetric }
2455 Attribute['rendering-intent'] := 'absolute-colorimetric'
2456 end;
2457
2458 procedure TSVGColorProfile.SetXlinkHref(AValue: string);
2459 begin
2460 Attribute['xlink:href'] := AValue;
2461 end;
2462
2463 procedure TSVGColorProfile.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
2464 begin
2465 //todo
2466 end;
2467
TSVGColorProfile.GetDOMTagnull2468 class function TSVGColorProfile.GetDOMTag: string;
2469 begin
2470 Result:= 'colorprofile';
2471 end;
2472
2473 { TSVGImage }
2474
TSVGImage.GetBitmapnull2475 function TSVGImage.GetBitmap: TBGRACustomBitmap;
2476 var
2477 s: String;
2478 posDelim: SizeInt;
2479 stream64: TStringStream;
2480 decoder: TBase64DecodingStream;
2481 byteStream: TMemoryStream;
2482 begin
2483 if FBitmap = nil then
2484 begin
2485 FBitmap := BGRABitmapFactory.Create;
2486 s := xlinkHref;
2487 if copy(s,1,5) = 'data:' then
2488 begin
2489 posDelim := pos(';', s);
2490 if posDelim > 0 then
2491 begin
2492 if copy(s, posDelim+1, 7) = 'base64,' then
2493 begin
2494 byteStream := TMemoryStream.Create;
2495 try
2496 stream64 := TStringStream.Create(s);
2497 try
2498 stream64.Position:= posDelim+7;
2499 decoder := TBase64DecodingStream.Create(stream64, bdmMIME);
2500 try
2501 byteStream.CopyFrom(decoder, decoder.Size);
2502 byteStream.Position:= 0;
2503 finally
2504 decoder.Free;
2505 end;
2506 finally
2507 stream64.Free;
2508 end;
2509 try
2510 FBitmap.LoadFromStream(byteStream);
2511 except
2512 on ex: exception do
2513 begin
2514 //image discarded if error
2515 FBitmap.SetSize(0, 0);
2516 end;
2517 end;
2518 finally
2519 byteStream.Free;
2520 end;
2521 end;
2522 end;
2523 end;
2524 end;
2525 result := FBitmap;
2526 end;
2527
TSVGImage.GetExternalResourcesRequirednull2528 function TSVGImage.GetExternalResourcesRequired: boolean;
2529 begin
2530 if Attribute['externalResourcesRequired'] = 'true' then
2531 result := true
2532 else
2533 result := false;
2534 end;
2535
GetImageRenderingnull2536 function TSVGImage.GetImageRendering: TSVGImageRendering;
2537 var s: string;
2538 begin
2539 s := AttributeOrStyle['image-rendering'];
2540 if (s = 'smooth') or (s = 'optimizeQuality') then result := sirSmooth
2541 else if s = 'high-quality' then result := sirHighQuality
2542 else if s = 'crisp-edges' then result := sirCrispEdges
2543 else if (s = 'pixelated') or (s = 'optimizeSpeed') then result := sirPixelated
2544 else result := sirAuto;
2545 end;
2546
GetXnull2547 function TSVGImage.GetX: TFloatWithCSSUnit;
2548 begin
2549 result := HorizAttributeWithUnit['x'];
2550 end;
2551
GetYnull2552 function TSVGImage.GetY: TFloatWithCSSUnit;
2553 begin
2554 result := VerticalAttributeWithUnit['y'];
2555 end;
2556
TSVGImage.GetWidthnull2557 function TSVGImage.GetWidth: TFloatWithCSSUnit;
2558 begin
2559 result := HorizAttributeWithUnit['width'];
2560 end;
2561
GetHeightnull2562 function TSVGImage.GetHeight: TFloatWithCSSUnit;
2563 begin
2564 result := VerticalAttributeWithUnit['height'];
2565 end;
2566
GetPreserveAspectRationull2567 function TSVGImage.GetPreserveAspectRatio: TSVGPreserveAspectRatio;
2568 begin
2569 result := TSVGPreserveAspectRatio.Parse(Attribute['preserveAspectRatio','xMidYMid']);
2570 end;
2571
GetXlinkHrefnull2572 function TSVGImage.GetXlinkHref: string;
2573 begin
2574 result := Attribute['xlink:href'];
2575 end;
2576
2577 procedure TSVGImage.SetBitmap(AValue: TBGRACustomBitmap; AOwned: boolean);
2578 var
2579 byteStream: TMemoryStream;
2580 begin
2581 if AValue = FBitmap then exit;
2582 FreeAndNil(FBitmap);
2583 if AOwned then
2584 FBitmap := AValue
2585 else FBitmap := AValue.Duplicate;
2586 if FBitmap = nil then
2587 begin
2588 FDomElem.RemoveAttribute('xlink:href');
2589 FDomElem.RemoveAttribute('href');
2590 exit;
2591 end;
2592 byteStream := TMemoryStream.Create;
2593 try
2594 FBitmap.SaveToStreamAsPng(byteStream);
2595 SetBitmap(byteStream, 'image/png');
2596 finally
2597 byteStream.Free;
2598 end;
2599 end;
2600
2601 procedure TSVGImage.SetBitmap(AStream: TStream; AMimeType: string);
2602 var
2603 s: TStringStream;
2604 encoder: TBase64EncodingStream;
2605 begin
2606 s := TStringStream.Create('data:'+AMimeType+';base64,');
2607 encoder := nil;
2608 try
2609 encoder := TBase64EncodingStream.Create(s);
2610 s.Position:= s.Size;
2611 AStream.Position := 0;
2612 encoder.CopyFrom(AStream, AStream.Size);
2613 encoder.Flush;
2614 xlinkHref:= s.DataString;
2615 finally
2616 encoder.Free;
2617 s.Free;
2618 end;
2619 end;
2620
2621 procedure TSVGImage.SetExternalResourcesRequired(AValue: boolean);
2622 begin
2623 if AValue then
2624 Attribute['ExternalResourcesRequired'] := 'true'
2625 else
2626 Attribute['ExternalResourcesRequired'] := 'false';
2627 end;
2628
2629 procedure TSVGImage.SetImageRendering(AValue: TSVGImageRendering);
2630 var s: string;
2631 begin
2632 case AValue of
2633 sirSmooth: s := 'smooth';
2634 sirHighQuality: s := 'high-quality';
2635 sirCrispEdges: s := 'crisp-edges';
2636 sirPixelated: s := 'pixelated';
2637 else {sirAuto} s := 'auto';
2638 end;
2639 end;
2640
2641 procedure TSVGImage.SetX(AValue: TFloatWithCSSUnit);
2642 begin
2643 HorizAttributeWithUnit['x'] := AValue;
2644 end;
2645
2646 procedure TSVGImage.SetY(AValue: TFloatWithCSSUnit);
2647 begin
2648 VerticalAttributeWithUnit['y'] := AValue;
2649 end;
2650
2651 procedure TSVGImage.SetWidth(AValue: TFloatWithCSSUnit);
2652 begin
2653 HorizAttributeWithUnit['width'] := AValue;
2654 end;
2655
2656 procedure TSVGImage.SetHeight(AValue: TFloatWithCSSUnit);
2657 begin
2658 VerticalAttributeWithUnit['height'] := AValue;
2659 end;
2660
2661 procedure TSVGImage.SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio);
2662 begin
2663 Attribute['preserveAspectRatio'] := AValue.ToString;
2664 end;
2665
2666 procedure TSVGImage.SetXlinkHref(AValue: string);
2667 begin
2668 if xlinkHref = AValue then exit;
2669 Attribute['xlink:href'] := AValue;
2670 FreeAndNil(FBitmap);
2671 end;
2672
2673 procedure TSVGImage.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
2674 var
2675 aspect: TSVGPreserveAspectRatio;
2676 coord: TPointF;
2677 w, h: single;
2678 ratioBitmap: single;
2679 ratioPresentation: Single;
2680 visualW, visualH: single;
2681 filter: TResampleFilter;
2682 begin
2683 coord := PointF(Units.ConvertWidth(x, AUnit).value,
2684 Units.ConvertHeight(y, AUnit).value);
2685 w := Units.ConvertWidth(width, AUnit).value;
2686 h := Units.ConvertHeight(height, AUnit).value;
2687 if (w = 0) or (h = 0) or Bitmap.Empty then exit;
2688 case imageRendering of
2689 sirAuto, sirCrispEdges: filter := rfHalfCosine;
2690 sirPixelated: filter := rfBox;
2691 else filter := rfLinear;
2692 end;
2693 aspect := preserveAspectRatio;
2694 if not aspect.Preserve then
2695 ACanvas2d.drawImage(Bitmap, coord.x, coord.y, w, h, filter)
2696 else
2697 begin
2698 ratioBitmap := Bitmap.Width/Bitmap.Height;
2699 ratioPresentation := w/h;
2700 if (ratioBitmap >= ratioPresentation) xor aspect.Slice then
2701 begin
2702 visualW := w;
2703 visualH := visualW / ratioBitmap;
2704 end else
2705 begin
2706 visualH := h;
2707 visualW := visualH * ratioBitmap;
2708 end;
2709 case aspect.HorizAlign of
2710 taRightJustify: IncF(coord.x, w - visualW);
2711 taCenter: IncF(coord.x, (w - visualW)/2);
2712 end;
2713 case aspect.VertAlign of
2714 tlBottom: IncF(coord.y, h - visualH);
2715 tlCenter: IncF(coord.y, (h - visualH)/2);
2716 end;
2717 ACanvas2d.drawImage(FBitmap, coord.x, coord.y, visualW, visualH, filter);
2718 end;
2719 end;
2720
2721 constructor TSVGImage.Create(ADocument: TDOMDocument;
2722 AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink);
2723 begin
2724 inherited Create(ADocument, AUnits, ADataLink);
2725 FBitmap:= nil;
2726 end;
2727
2728 constructor TSVGImage.Create(AElement: TDOMElement; AUnits: TCSSUnitConverter;
2729 ADataLink: TSVGDataLink);
2730 begin
2731 inherited Create(AElement, AUnits, ADataLink);
2732 FBitmap:= nil;
2733 end;
2734
2735 destructor TSVGImage.Destroy;
2736 begin
2737 FBitmap.Free;
2738 inherited Destroy;
2739 end;
2740
TSVGImage.GetDOMTagnull2741 class function TSVGImage.GetDOMTag: string;
2742 begin
2743 Result:= 'image';
2744 end;
2745
2746 procedure TSVGImage.ConvertToUnit(AUnit: TCSSUnit);
2747 begin
2748 inherited ConvertToUnit(AUnit);
2749 if HasAttribute('x') then x := Units.ConvertWidth(x, AUnit);
2750 if HasAttribute('y') then y := Units.ConvertHeight(y, AUnit);
2751 if HasAttribute('width') then width := Units.ConvertWidth(width, AUnit);
2752 if HasAttribute('height') then height := Units.ConvertHeight(height, AUnit);
2753 end;
2754
2755 { TSVGPattern }
2756
GetPatternUnitsnull2757 function TSVGPattern.GetPatternUnits: TSVGObjectUnits;
2758 begin
2759 if Attribute['patternUnits'] = 'userSpaceOnUse' then
2760 result := souUserSpaceOnUse
2761 else
2762 result := souObjectBoundingBox;
2763 end;
2764
GetPatternContentUnitsnull2765 function TSVGPattern.GetPatternContentUnits: TSVGObjectUnits;
2766 begin
2767 if Attribute['patternContentUnits'] = 'objectBoundingBox' then
2768 result := souObjectBoundingBox
2769 else
2770 result := souUserSpaceOnUse;
2771 end;
2772
GetPatternTransformnull2773 function TSVGPattern.GetPatternTransform: string;
2774 begin
2775 result := Attribute['patternTransform'];
2776 end;
2777
GetViewBoxnull2778 function TSVGPattern.GetViewBox: TSVGViewBox;
2779 begin
2780 result := TSVGViewBox.Parse(Attribute['viewBox']);
2781 end;
2782
2783 procedure TSVGPattern.SetPatternUnits(AValue: TSVGObjectUnits);
2784 begin
2785 if AValue = souUserSpaceOnUse then
2786 Attribute['patternUnits'] := 'userSpaceOnUse'
2787 else
2788 Attribute['patternUnits'] := 'objectBoundingBox';
2789 end;
2790
2791 procedure TSVGPattern.SetPatternContentUnits(AValue: TSVGObjectUnits);
2792 begin
2793 if AValue = souUserSpaceOnUse then
2794 Attribute['patternContentUnits'] := 'userSpaceOnUse'
2795 else
2796 Attribute['patternContentUnits'] := 'objectBoundingBox';
2797 end;
2798
2799 procedure TSVGPattern.SetPatternTransform(AValue: string);
2800 begin
2801 Attribute['patternTransform'] := AValue;
2802 end;
2803
2804 procedure TSVGPattern.SetViewBox(AValue: TSVGViewBox);
2805 begin
2806 Attribute['viewBox'] := AValue.ToString;
2807 end;
2808
2809 procedure TSVGPattern.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
2810 begin
2811 //todo
2812 end;
2813
TSVGPattern.GetDOMTagnull2814 class function TSVGPattern.GetDOMTag: string;
2815 begin
2816 Result:= 'pattern';
2817 end;
2818
2819 { TSVGMarker }
2820
TSVGMarker.GetExternalResourcesRequirednull2821 function TSVGMarker.GetExternalResourcesRequired: boolean;
2822 begin
2823 if Attribute['externalResourcesRequired'] = 'true' then
2824 result := true
2825 else
2826 result := false;
2827 end;
2828
GetViewBoxnull2829 function TSVGMarker.GetViewBox: TSVGViewBox;
2830 begin
2831 result := TSVGViewBox.Parse(Attribute['viewBox']);
2832 end;
2833
TSVGMarker.GetPreserveAspectRationull2834 function TSVGMarker.GetPreserveAspectRatio: TSVGPreserveAspectRatio;
2835 begin
2836 result := TSVGPreserveAspectRatio.Parse(Attribute['preserveAspectRatio','xMidYMid']);
2837 end;
2838
GetRefXnull2839 function TSVGMarker.GetRefX: TFloatWithCSSUnit;
2840 begin
2841 result := HorizAttributeWithUnit['refX'];
2842 end;
2843
GetRefYnull2844 function TSVGMarker.GetRefY: TFloatWithCSSUnit;
2845 begin
2846 result := VerticalAttributeWithUnit['refY'];
2847 end;
2848
TSVGMarker.GetMarkerWidthnull2849 function TSVGMarker.GetMarkerWidth: TFloatWithCSSUnit;
2850 begin
2851 result := HorizAttributeWithUnit['markerWidth'];
2852 end;
2853
TSVGMarker.GetMarkerHeightnull2854 function TSVGMarker.GetMarkerHeight: TFloatWithCSSUnit;
2855 begin
2856 result := VerticalAttributeWithUnit['markerHeight'];
2857 end;
2858
TSVGMarker.GetMarkerUnitsnull2859 function TSVGMarker.GetMarkerUnits: TSVGMarkerUnits;
2860 begin
2861 if Attribute['markerUnits','strokeWidth'] = 'strokeWidth' then
2862 result := smuStrokeWidth
2863 else
2864 result := smuUserSpaceOnUse;
2865 end;
2866
GetOrientnull2867 function TSVGMarker.GetOrient: TSVGOrient;
2868 var
2869 err: integer;
2870 s: string;
2871 begin
2872 s := Attribute['orient','0'];
2873 result.angle := 0;
2874 if s = 'auto' then
2875 result.auto := soaAuto
2876 else if s = 'auto-start-reverse' then
2877 result.auto := soaAutoReverse
2878 else
2879 begin
2880 result.auto := soaNone;
2881 Val(s, result.angle, err);
2882 if err <> 0 then
2883 raise Exception('conversion error: '+IntToStr(err)+#13+'"'+s+'"');
2884 end;
2885 end;
2886
2887 procedure TSVGMarker.SetExternalResourcesRequired(AValue: boolean);
2888 begin
2889 if AValue then
2890 Attribute['ExternalResourcesRequired'] := 'true'
2891 else
2892 Attribute['ExternalResourcesRequired'] := 'false';
2893 end;
2894
2895 procedure TSVGMarker.SetViewBox(AValue: TSVGViewBox);
2896 begin
2897 Attribute['viewBox'] := AValue.ToString;
2898 end;
2899
2900 procedure TSVGMarker.SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio);
2901 begin
2902 Attribute['preserveAspectRatio'] := AValue.ToString;
2903 end;
2904
2905 procedure TSVGMarker.SetRefX(AValue: TFloatWithCSSUnit);
2906 begin
2907 HorizAttributeWithUnit['refX'] := AValue;
2908 end;
2909
2910 procedure TSVGMarker.SetRefY(AValue: TFloatWithCSSUnit);
2911 begin
2912 VerticalAttributeWithUnit['refY'] := AValue;
2913 end;
2914
2915 procedure TSVGMarker.SetMarkerWidth(AValue: TFloatWithCSSUnit);
2916 begin
2917 HorizAttributeWithUnit['markerWidth'] := AValue;
2918 end;
2919
2920 procedure TSVGMarker.SetMarkerHeight(AValue: TFloatWithCSSUnit);
2921 begin
2922 VerticalAttributeWithUnit['markerHeight'] := AValue;
2923 end;
2924
2925 procedure TSVGMarker.SetMarkerUnits(AValue: TSVGMarkerUnits);
2926 begin
2927 if AValue = smuStrokeWidth then
2928 Attribute['markerUnits'] := 'strokeWidth'
2929 else
2930 Attribute['markerUnits'] := 'useSpaceOnUse';
2931 end;
2932
2933 procedure TSVGMarker.SetOrient(AValue: TSVGOrient);
2934 var
2935 s: string;
2936 begin
2937 if AValue.auto = soaAuto then
2938 s := 'auto'
2939 else if AValue.auto = soaAutoReverse then
2940 s := 'auto-start-reverse'
2941 else
2942 s := FloatToStr(AValue.angle);
2943 Attribute['orient'] := s;
2944 end;
2945
2946 procedure TSVGMarker.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
2947 begin
2948 //todo
2949 end;
2950
TSVGMarker.GetDOMTagnull2951 class function TSVGMarker.GetDOMTag: string;
2952 begin
2953 Result:= 'marker';
2954 end;
2955
2956 procedure TSVGMarker.ConvertToUnit(AUnit: TCSSUnit);
2957 begin
2958 inherited ConvertToUnit(AUnit);
2959 if HasAttribute('refX') then refX := Units.ConvertWidth(refX, AUnit);
2960 if HasAttribute('refY') then refY := Units.ConvertHeight(refY, AUnit);
2961 if HasAttribute('markerWidth') then markerWidth := Units.ConvertWidth(markerWidth, AUnit);
2962 if HasAttribute('markerHeight') then markerHeight := Units.ConvertHeight(markerHeight, AUnit);
2963 end;
2964
2965 { TSVGMask }
2966
TSVGMask.GetExternalResourcesRequirednull2967 function TSVGMask.GetExternalResourcesRequired: boolean;
2968 begin
2969 if Attribute['externalResourcesRequired'] = 'true' then
2970 result := true
2971 else
2972 result := false;
2973 end;
2974
GetXnull2975 function TSVGMask.GetX: TFloatWithCSSUnit;
2976 begin
2977 result := HorizAttributeWithUnit['x'];
2978 end;
2979
GetYnull2980 function TSVGMask.GetY: TFloatWithCSSUnit;
2981 begin
2982 result := VerticalAttributeWithUnit['y'];
2983 end;
2984
GetWidthnull2985 function TSVGMask.GetWidth: TFloatWithCSSUnit;
2986 begin
2987 result := HorizAttributeWithUnit['width'];
2988 end;
2989
TSVGMask.GetHeightnull2990 function TSVGMask.GetHeight: TFloatWithCSSUnit;
2991 begin
2992 result := VerticalAttributeWithUnit['height'];
2993 end;
2994
TSVGMask.GetMaskUnitsnull2995 function TSVGMask.GetMaskUnits: TSVGObjectUnits;
2996 begin
2997 if Attribute['maskUnits'] = 'objectBoundingBox' then
2998 result := souObjectBoundingBox
2999 else
3000 result := souUserSpaceOnUse;
3001 end;
3002
GetMaskContentUnitsnull3003 function TSVGMask.GetMaskContentUnits: TSVGObjectUnits;
3004 begin
3005 if Attribute['maskContentUnits'] = 'objectBoundingBox' then
3006 result := souObjectBoundingBox
3007 else
3008 result := souUserSpaceOnUse;
3009 end;
3010
3011 procedure TSVGMask.SetExternalResourcesRequired(AValue: boolean);
3012 begin
3013 if AValue then
3014 Attribute['ExternalResourcesRequired'] := 'true'
3015 else
3016 Attribute['ExternalResourcesRequired'] := 'false';
3017 end;
3018
3019 procedure TSVGMask.SetX(AValue: TFloatWithCSSUnit);
3020 begin
3021 HorizAttributeWithUnit['x'] := AValue;
3022 end;
3023
3024 procedure TSVGMask.SetY(AValue: TFloatWithCSSUnit);
3025 begin
3026 VerticalAttributeWithUnit['y'] := AValue;
3027 end;
3028
3029 procedure TSVGMask.SetWidth(AValue: TFloatWithCSSUnit);
3030 begin
3031 HorizAttributeWithUnit['width'] := AValue;
3032 end;
3033
3034 procedure TSVGMask.SetHeight(AValue: TFloatWithCSSUnit);
3035 begin
3036 VerticalAttributeWithUnit['height'] := AValue;
3037 end;
3038
3039 procedure TSVGMask.SetMaskUnits(AValue: TSVGObjectUnits);
3040 begin
3041 if AValue = souUserSpaceOnUse then
3042 Attribute['maskUnits'] := 'userSpaceOnUse'
3043 else
3044 Attribute['maskUnits'] := 'objectBoundingBox';
3045 end;
3046
3047 procedure TSVGMask.SetMaskContentUnits(AValue: TSVGObjectUnits);
3048 begin
3049 if AValue = souUserSpaceOnUse then
3050 Attribute['maskContentUnits'] := 'userSpaceOnUse'
3051 else
3052 Attribute['maskContentUnits'] := 'objectBoundingBox';
3053 end;
3054
3055 procedure TSVGMask.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
3056 begin
3057 //todo
3058 end;
3059
TSVGMask.GetDOMTagnull3060 class function TSVGMask.GetDOMTag: string;
3061 begin
3062 Result:= 'mask';
3063 end;
3064
3065 procedure TSVGMask.ConvertToUnit(AUnit: TCSSUnit);
3066 begin
3067 inherited ConvertToUnit(AUnit);
3068 if HasAttribute('x') then x := Units.ConvertWidth(x, AUnit);
3069 if HasAttribute('y') then y := Units.ConvertHeight(y, AUnit);
3070 if HasAttribute('width') then width := Units.ConvertWidth(width, AUnit);
3071 if HasAttribute('height') then height := Units.ConvertHeight(height, AUnit);
3072 end;
3073
3074 { TSVGGroup }
3075
GetFontSizenull3076 function TSVGGroup.GetFontSize: TFloatWithCSSUnit;
3077 begin
3078 result:= GetVerticalAttributeOrStyleWithUnit('font-size',Units.CurrentFontEmHeight,false);
3079 end;
3080
TSVGGroup.GetIsLayernull3081 function TSVGGroup.GetIsLayer: boolean;
3082 begin
3083 result := (Attribute['inkscape:groupmode'] = 'layer')
3084 end;
3085
GetNamenull3086 function TSVGGroup.GetName: string;
3087 begin
3088 result := Attribute['inkscape:label'];
3089 end;
3090
3091 procedure TSVGGroup.SetFontSize(AValue: TFloatWithCSSUnit);
3092 begin
3093 VerticalAttributeWithUnit['font-size'] := AValue;
3094 end;
3095
3096 procedure TSVGGroup.SetIsLayer(AValue: boolean);
3097 begin
3098 if AValue = GetIsLayer then exit;
3099 if AValue then
3100 Attribute['inkscape:groupmode'] := 'layer'
3101 else Attribute['inkscape:groupmode'] := '';
3102 end;
3103
3104 procedure TSVGGroup.SetName(AValue: string);
3105 begin
3106 Attribute['inkscape:label'] := AValue;
3107 end;
3108
3109 procedure TSVGGroup.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
3110 var
3111 prevFontSize: TFloatWithCSSUnit;
3112 begin
3113 prevFontSize := EnterFontSize;
3114 FContent.Draw(ACanvas2d, AUnit);
3115 ExitFontSize(prevFontSize);
3116 end;
3117
TSVGGroup.OwnDatalinknull3118 class function TSVGGroup.OwnDatalink: boolean;
3119 begin
3120 Result:= true;
3121 end;
3122
TSVGGroup.GetDOMTagnull3123 class function TSVGGroup.GetDOMTag: string;
3124 begin
3125 Result:= 'g';
3126 end;
3127
3128 procedure TSVGGroup.ConvertToUnit(AUnit: TCSSUnit);
3129 var
3130 prevFontSize: TFloatWithCSSUnit;
3131 begin
3132 if HasAttribute('font-size') then
3133 SetVerticalAttributeWithUnit('font-size', Units.ConvertHeight(GetVerticalAttributeWithUnit('font-size'), AUnit));
3134 prevFontSize := EnterFontSize;
3135 inherited ConvertToUnit(AUnit);
3136 ExitFontSize(prevFontSize);
3137 end;
3138
3139 { TSVGStyle }
3140
3141 constructor TSVGStyle.Create(AElement: TDOMElement;
3142 AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink);
3143 begin
3144 inherited Create(AElement, AUnits, ADataLink);
3145 Parse(AElement.TextContent);
3146 end;
3147
3148 procedure TSVGStyle.Initialize;
3149 begin
3150 inherited Initialize;
3151 Clear;
3152 end;
3153
TSVGStyle.GetDOMTagnull3154 class function TSVGStyle.GetDOMTag: string;
3155 begin
3156 Result:= 'style';
3157 end;
3158
3159 destructor TSVGStyle.Destroy;
3160 begin
3161 Clear;
3162 inherited Destroy;
3163 end;
3164
3165 procedure TSVGStyle.ConvertToUnit(AUnit: TCSSUnit);
3166 var
3167 declarations: String;
3168
GetPropertyValuenull3169 function GetPropertyValue(AName: string; out AValue: TFloatWithCSSUnit): boolean;
3170 var valueStr: string;
3171 begin
3172 valueStr := GetPropertyFromStyleDeclarationBlock(declarations, AName, '');
3173 if valueStr <> '' then
3174 begin
3175 AValue := Units.parseValue(valueStr, FloatWithCSSUnit(0, cuCustom));
3176 result := true;
3177 end else
3178 begin
3179 AValue := FloatWithCSSUnit(0, cuCustom);
3180 result := false;
3181 end;
3182 end;
3183
3184 procedure SetPropertyValue(AName: string; AValue: TFloatWithCSSUnit);
3185 begin
3186 UpdateStyleDeclarationBlock(declarations, AName, Units.formatValue(AValue));
3187 end;
3188
3189 var
3190 i: Integer;
3191 value: TFloatWithCSSUnit;
3192 begin
3193 inherited ConvertToUnit(AUnit);
3194 for i := 0 to RulesetCount-1 do
3195 begin
3196 declarations := Ruleset[i].declarations;
3197 if GetPropertyValue('stroke-width', value) then
3198 SetPropertyValue('stroke-width', Units.ConvertOrtho(value, AUnit));
3199 if GetPropertyValue('stroke-dash-offset', value) then
3200 SetPropertyValue('stroke-dash-offset', Units.ConvertOrtho(value, AUnit));
3201 if GetPropertyValue('font-size', value) then
3202 SetPropertyValue('font-size', Units.ConvertHeight(value, AUnit));
3203 FRulesets[i].declarations := declarations;
3204 end;
3205 end;
3206
3207 procedure TSVGStyle.Parse(const s: String);
3208
IsValidDeclarationBlocknull3209 function IsValidDeclarationBlock(const sa: string): boolean;
3210 var
3211 i: integer;
3212 begin
3213 //(for case example "{ ; ;}")
3214 for i:= 1 to Length(sa) do
3215 if not (sa[i] in [' ',';']) then
3216 exit(true);
3217 result:= false;
3218 end;
3219
3220 const
3221 EmptyRuleset: TSVGRuleset = (selector: ''; declarations: '');
3222 var
3223 i,l,pg: integer;
3224 st: String;
3225 rec: TSVGRuleset;
3226 begin
3227 (*
3228 Example of internal style block
3229 circle {..}
3230 circle.type1 {..}
3231 .pic1 {..}
3232 *)
3233 Clear;
3234 l:= 0;
3235 pg:= 0;
3236 st:= '';
3237 rec:= EmptyRuleset;
3238 for i:= 1 to Length(s) do
3239 begin
3240 if s[i] = '{' then
3241 begin
3242 Inc(pg);
3243 if (pg = 1) and (Length(st) <> 0) then
3244 begin
3245 rec.selector:= Trim(st);
3246 st:= '';
3247 end;
3248 end
3249 else if s[i] = '}' then
3250 begin
3251 Dec(pg);
3252 if (pg = 0) and (Length(st) <> 0) then
3253 begin
3254 if IsValidDeclarationBlock(st) then
3255 begin
3256 rec.declarations:= Trim(st);
3257 Inc(l);
3258 SetLength(FRulesets,l);
3259 FRulesets[l-1]:= rec;
3260 rec:= EmptyRuleset;
3261 end;
3262 st:= '';
3263 end;
3264 end
3265 else
3266 st:= st + s[i];
3267 end;
3268 end;
3269
TSVGStyle.GetRulesetCountnull3270 function TSVGStyle.GetRulesetCount: integer;
3271 begin
3272 result := Length(FRulesets);
3273 end;
3274
IsValidRulesetIndexnull3275 function TSVGStyle.IsValidRulesetIndex(const AIndex: integer): boolean;
3276 begin
3277 result:= (AIndex >= 0) and (AIndex < Length(FRulesets));
3278 end;
3279
TSVGStyle.GetRulesetnull3280 function TSVGStyle.GetRuleset(const AIndex: integer): TSVGRuleset;
3281 begin
3282 if IsValidRulesetIndex(AIndex) then
3283 result:= FRulesets[AIndex]
3284 else
3285 raise exception.Create(rsInvalidIndex);
3286 end;
3287
3288 procedure TSVGStyle.SetRuleset(const AIndex: integer; sr: TSVGRuleset);
3289 begin
3290 if IsValidRulesetIndex(AIndex) then
3291 FRulesets[AIndex]:= sr
3292 else
3293 raise exception.Create(rsInvalidIndex);
3294 end;
3295
Countnull3296 function TSVGStyle.Count: Integer;
3297 begin
3298 result:= Length(FRulesets);
3299 end;
3300
TSVGStyle.Findnull3301 function TSVGStyle.Find(ARuleset: TSVGRuleset): integer;
3302 var
3303 i: integer;
3304 begin
3305 for i:= 0 to Length(FRulesets)-1 do
3306 with FRulesets[i] do
3307 if (selector = ARuleset.selector) and
3308 (declarations = ARuleset.declarations) then
3309 begin
3310 result:= i;
3311 Exit;
3312 end;
3313 result:= -1;
3314 end;
3315
TSVGStyle.Findnull3316 function TSVGStyle.Find(const AName: string): integer;
3317 var
3318 i: integer;
3319 begin
3320 for i:= 0 to Length(FRulesets)-1 do
3321 with FRulesets[i] do
3322 if selector = AName then
3323 begin
3324 result:= i;
3325 Exit;
3326 end;
3327 result:= -1;
3328 end;
3329
Addnull3330 function TSVGStyle.Add(ARuleset: TSVGRuleset): integer;
3331 var
3332 l: integer;
3333 begin
3334 l:= Length(FRulesets);
3335 SetLength(FRulesets,l+1);
3336 FRulesets[l]:= ARuleset;
3337 result:= l;
3338 end;
3339
3340 procedure TSVGStyle.Remove(ARuleset: TSVGRuleset);
3341 var
3342 l,p: integer;
3343 begin
3344 p:= Find(ARuleset);
3345 l:= Length(FRulesets);
3346 if p <> -1 then
3347 begin
3348 Finalize(FRulesets[p]);
3349 System.Move(FRulesets[p+1], FRulesets[p], (l-p)*SizeOf(TSVGRuleset));
3350 SetLength(FRulesets,l-1);
3351 end;
3352 end;
3353
3354 procedure TSVGStyle.Clear;
3355 begin
3356 SetLength(FRulesets,0);
3357 end;
3358
3359 procedure TSVGStyle.ReParse;
3360 begin
3361 Parse(FDomElem.TextContent);
3362 end;
3363
3364 { TSVGRectangle }
3365
GetXnull3366 function TSVGRectangle.GetX: TFloatWithCSSUnit;
3367 begin
3368 result := HorizAttributeWithUnit['x'];
3369 end;
3370
GetYnull3371 function TSVGRectangle.GetY: TFloatWithCSSUnit;
3372 begin
3373 result := VerticalAttributeWithUnit['y'];
3374 end;
3375
GetWidthnull3376 function TSVGRectangle.GetWidth: TFloatWithCSSUnit;
3377 begin
3378 result := HorizAttributeWithUnit['width'];
3379 end;
3380
TSVGRectangle.GetHeightnull3381 function TSVGRectangle.GetHeight: TFloatWithCSSUnit;
3382 begin
3383 result := VerticalAttributeWithUnit['height'];
3384 end;
3385
GetRXnull3386 function TSVGRectangle.GetRX: TFloatWithCSSUnit;
3387 begin
3388 result := HorizAttributeWithUnit['rx'];
3389 end;
3390
GetRYnull3391 function TSVGRectangle.GetRY: TFloatWithCSSUnit;
3392 begin
3393 result := VerticalAttributeWithUnit['ry'];
3394 end;
3395
3396 procedure TSVGRectangle.SetX(AValue: TFloatWithCSSUnit);
3397 begin
3398 HorizAttributeWithUnit['x'] := AValue;
3399 end;
3400
3401 procedure TSVGRectangle.SetY(AValue: TFloatWithCSSUnit);
3402 begin
3403 VerticalAttributeWithUnit['y'] := AValue;
3404 end;
3405
3406 procedure TSVGRectangle.SetWidth(AValue: TFloatWithCSSUnit);
3407 begin
3408 HorizAttributeWithUnit['width'] := AValue;
3409 end;
3410
3411 procedure TSVGRectangle.SetHeight(AValue: TFloatWithCSSUnit);
3412 begin
3413 VerticalAttributeWithUnit['height'] := AValue;
3414 end;
3415
3416 procedure TSVGRectangle.SetRX(AValue: TFloatWithCSSUnit);
3417 begin
3418 HorizAttributeWithUnit['rx'] := AValue;
3419 end;
3420
3421 procedure TSVGRectangle.SetRY(AValue: TFloatWithCSSUnit);
3422 begin
3423 VerticalAttributeWithUnit['ry'] := AValue;
3424 end;
3425
TSVGRectangle.GetDOMTagnull3426 class function TSVGRectangle.GetDOMTag: string;
3427 begin
3428 Result:= 'rect';
3429 end;
3430
3431 procedure TSVGRectangle.ConvertToUnit(AUnit: TCSSUnit);
3432 begin
3433 inherited ConvertToUnit(AUnit);
3434 if HasAttribute('x') then x := Units.ConvertWidth(x, AUnit);
3435 if HasAttribute('y') then y := Units.ConvertHeight(y, AUnit);
3436 if HasAttribute('rx') then rx := Units.ConvertWidth(rx, AUnit);
3437 if HasAttribute('ry') then ry := Units.ConvertHeight(ry, AUnit);
3438 if HasAttribute('width') then width := Units.ConvertWidth(width, AUnit);
3439 if HasAttribute('height') then height := Units.ConvertHeight(height, AUnit);
3440 end;
3441
3442 procedure TSVGRectangle.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
3443 var
3444 vx,vy,vw,vh: Single;
3445 begin
3446 if not isStrokeNone or not isFillNone then
3447 begin
3448 vx:= Units.ConvertWidth(x,AUnit).value;
3449 vy:= Units.ConvertHeight(y,AUnit).value;
3450 vw:= Units.ConvertWidth(width,AUnit).value;
3451 vh:= Units.ConvertHeight(height,AUnit).value;
3452 ACanvas2d.beginPath;
3453 ACanvas2d.roundRect(vx,vy, vw,vh,
3454 Units.ConvertWidth(rx,AUnit).value,Units.ConvertHeight(ry,AUnit).value);
3455 InitializeGradient(ACanvas2d, PointF(vx,vy),vw,vh,AUnit);
3456 Paint(ACanvas2D,AUnit);
3457 end;
3458 end;
3459
3460 { TSVGPolypoints }
3461
GetClosednull3462 function TSVGPolypoints.GetClosed: boolean;
3463 begin
3464 result := FDomElem.TagName = 'polygon';
3465 end;
3466
GetBoundingBoxFnull3467 function TSVGPolypoints.GetBoundingBoxF: TRectF;
3468 begin
3469 if not FBoundingBoxComputed then
3470 ComputeBoundingBox(pointsF);
3471 result := FBoundingBox;
3472 end;
3473
GetPointsnull3474 function TSVGPolypoints.GetPoints: string;
3475 begin
3476 result := Attribute['points'];
3477 end;
3478
GetPointsFnull3479 function TSVGPolypoints.GetPointsF: ArrayOfTPointF;
3480 var parser: TSVGParser;
3481 nbcoord,i: integer;
3482 begin
3483 parser:=TSVGParser.Create(points);
3484 nbcoord := 0;
3485 repeat
3486 parser.ParseFloat;
3487 if not parser.NumberError then
3488 inc(nbcoord);
3489 until parser.NumberError or parser.Done;
3490 parser.ClearError;
3491 setlength(Result,nbcoord div 2);
3492 parser.Position := 1;
3493 for i := 0 to high(result) do
3494 begin
3495 result[i].x := parser.ParseFloat;
3496 result[i].y := parser.ParseFloat;
3497 end;
3498 parser.Free;
3499 end;
3500
3501 procedure TSVGPolypoints.SetPoints(AValue: string);
3502 begin
3503 Attribute['points'] := AValue;
3504 end;
3505
3506 procedure TSVGPolypoints.SetPointsF(AValue: ArrayOfTPointF);
3507 var s: string;
3508 i: integer;
3509 begin
3510 s:= '';
3511 for i := 0 to high(AValue) do
3512 begin
3513 if s <> '' then AppendStr(s, ' ');
3514 with AValue[i] do
3515 AppendStr(s, TCSSUnitConverter.formatValue(x)+' '+TCSSUnitConverter.formatValue(y));
3516 end;
3517 points := s;
3518 ComputeBoundingBox(AValue);
3519 end;
3520
3521 procedure TSVGPolypoints.ComputeBoundingBox(APoints: ArrayOfTPointF);
3522 var
3523 i: Integer;
3524 begin
3525 if length(APoints) > 1 then
3526 begin
3527 with APoints[0] do
3528 FBoundingBox:= RectF(x,y,x,y);
3529 for i:= 1 to high(APoints) do
3530 with APoints[i] do
3531 begin
3532 if x < FBoundingBox.Left then
3533 FBoundingBox.Left:= x
3534 else if x > FBoundingBox.Right then
3535 FBoundingBox.Right:= x;
3536 if y < FBoundingBox.Top then
3537 FBoundingBox.Top:= y
3538 else if y > FBoundingBox.Bottom then
3539 FBoundingBox.Bottom:= y;
3540 end;
3541 FBoundingBoxComputed := true;
3542 end else
3543 begin
3544 FBoundingBox := RectF(0,0,0,0);
3545 FBoundingBoxComputed := true;
3546 end;
3547 end;
3548
3549 constructor TSVGPolypoints.Create(ADocument: TDOMDocument;
3550 AUnits: TCSSUnitConverter; AClosed: boolean; ADataLink: TSVGDataLink);
3551 begin
3552 inherited Create(ADocument, AUnits, ADataLink);
3553 if AClosed then
3554 Init(ADocument, 'polygon', AUnits)
3555 else
3556 Init(ADocument, 'polyline', AUnits);
3557 end;
3558
3559 destructor TSVGPolypoints.Destroy;
3560 begin
3561 inherited Destroy;
3562 end;
3563
3564 procedure TSVGPolypoints.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
3565 var
3566 prevMatrix: TAffineMatrix;
3567 pts: ArrayOfTPointF;
3568 begin
3569 if isFillNone and isStrokeNone then exit;
3570 if AUnit <> cuCustom then
3571 begin
3572 prevMatrix := ACanvas2d.matrix;
3573 ACanvas2d.scale(Units.ConvertWidth(1,cuCustom,AUnit),
3574 Units.ConvertHeight(1,cuCustom,AUnit));
3575 InternalDraw(ACanvas2d, cuCustom);
3576 ACanvas2d.matrix:= prevMatrix;
3577 end else
3578 begin
3579 ACanvas2d.beginPath;
3580 pts := pointsF;
3581 ACanvas2d.polylineTo(pts);
3582 if closed then ACanvas2d.closePath;
3583
3584 with boundingBoxF do
3585 InitializeGradient(ACanvas2d,
3586 PointF(Left,Top),abs(Right-Left),abs(Bottom-Top),AUnit);
3587 Paint(ACanvas2D, AUnit);
3588 end;
3589 end;
3590
3591 { TSVGPath }
3592
GetPathLengthnull3593 function TSVGPath.GetPathLength: TFloatWithCSSUnit;
3594 begin
3595 result := OrthoAttributeWithUnit['pathLength'];
3596 end;
3597
GetPathnull3598 function TSVGPath.GetPath: TBGRAPath;
3599 begin
3600 if FPath = nil then
3601 FPath := TBGRAPath.Create(Attribute['d']);
3602 result := FPath;
3603 end;
3604
GetBoundingBoxFnull3605 function TSVGPath.GetBoundingBoxF: TRectF;
3606 begin
3607 if not FBoundingBoxComputed then
3608 begin
3609 FBoundingBox := path.GetBounds;
3610 FBoundingBoxComputed := true;
3611 end;
3612 result := FBoundingBox;
3613 end;
3614
TSVGPath.GetDatanull3615 function TSVGPath.GetData: string;
3616 begin
3617 if FPath = nil then
3618 result := Attribute['d']
3619 else
3620 result := FPath.SvgString;
3621 end;
3622
3623 procedure TSVGPath.SetPathLength(AValue: TFloatWithCSSUnit);
3624 begin
3625 OrthoAttributeWithUnit['pathLength'] := AValue;
3626 end;
3627
3628 procedure TSVGPath.SetData(AValue: string);
3629 begin
3630 if FPath = nil then
3631 Attribute['d'] := AValue
3632 else
3633 FPath.SvgString := AValue;
3634 FBoundingBoxComputed := false;
3635 end;
3636
TSVGPath.GetDOMElementnull3637 function TSVGPath.GetDOMElement: TDOMElement;
3638 begin
3639 if FPath <> nil then Attribute['d'] := FPath.SvgString;
3640 Result:=inherited GetDOMElement;
3641 end;
3642
3643 constructor TSVGPath.Create(ADocument: TDOMDocument; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink);
3644 begin
3645 inherited Create(ADocument, AUnits, ADataLink);
3646 FPath := nil;
3647 FBoundingBoxComputed := false;
3648 FBoundingBox := rectF(0,0,0,0);
3649 end;
3650
3651 constructor TSVGPath.Create(AElement: TDOMElement;
3652 AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink);
3653 begin
3654 inherited Create(AElement, AUnits, ADataLink);
3655 FPath := nil;
3656 FBoundingBoxComputed := false;
3657 FBoundingBox := rectF(0,0,0,0);
3658 end;
3659
3660 destructor TSVGPath.Destroy;
3661 begin
3662 FreeAndNil(FPath);
3663 inherited Destroy;
3664 end;
3665
3666 procedure TSVGPath.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
3667 var
3668 prevMatrix: TAffineMatrix;
3669 begin
3670 if isFillNone and isStrokeNone then exit;
3671 if AUnit <> cuCustom then
3672 begin
3673 prevMatrix := ACanvas2d.matrix;
3674 ACanvas2d.scale(Units.ConvertWidth(1,cuCustom,AUnit),
3675 Units.ConvertHeight(1,cuCustom,AUnit));
3676 InternalDraw(ACanvas2d, cuCustom);
3677 ACanvas2d.matrix:= prevMatrix;
3678 end else
3679 begin
3680 ACanvas2d.path(path);
3681 if Assigned(FillGradientElement) or Assigned(StrokeGradientElement) then
3682 with boundingBoxF do
3683 InitializeGradient(ACanvas2d,
3684 PointF(Left,Top),abs(Right-Left),abs(Bottom-Top),AUnit);
3685 Paint(ACanvas2D, AUnit);
3686 end;
3687 end;
3688
TSVGPath.GetDOMTagnull3689 class function TSVGPath.GetDOMTag: string;
3690 begin
3691 Result:= 'path';
3692 end;
3693
3694 { TSVGEllipse }
3695
GetCXnull3696 function TSVGEllipse.GetCX: TFloatWithCSSUnit;
3697 begin
3698 result := HorizAttributeWithUnit['cx'];
3699 end;
3700
GetCYnull3701 function TSVGEllipse.GetCY: TFloatWithCSSUnit;
3702 begin
3703 result := VerticalAttributeWithUnit['cy'];
3704 end;
3705
GetRXnull3706 function TSVGEllipse.GetRX: TFloatWithCSSUnit;
3707 begin
3708 result := HorizAttributeWithUnit['rx'];
3709 end;
3710
GetRYnull3711 function TSVGEllipse.GetRY: TFloatWithCSSUnit;
3712 begin
3713 result := VerticalAttributeWithUnit['ry'];
3714 end;
3715
3716 procedure TSVGEllipse.SetCX(AValue: TFloatWithCSSUnit);
3717 begin
3718 HorizAttributeWithUnit['cx'] := AValue;
3719 end;
3720
3721 procedure TSVGEllipse.SetCY(AValue: TFloatWithCSSUnit);
3722 begin
3723 VerticalAttributeWithUnit['cy'] := AValue;
3724 end;
3725
3726 procedure TSVGEllipse.SetRX(AValue: TFloatWithCSSUnit);
3727 begin
3728 HorizAttributeWithUnit['rx'] := AValue;
3729 end;
3730
3731 procedure TSVGEllipse.SetRY(AValue: TFloatWithCSSUnit);
3732 begin
3733 VerticalAttributeWithUnit['ry'] := AValue;
3734 end;
3735
3736 procedure TSVGEllipse.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
3737 var
3738 vcx,vcy,vrx,vry: Single;
3739 begin
3740 if not isFillNone or not isStrokeNone then
3741 begin
3742 vcx:= Units.ConvertWidth(cx,AUnit).value;
3743 vcy:= Units.ConvertHeight(cy,AUnit).value;
3744 vrx:= Units.ConvertWidth(rx,AUnit).value;
3745 vry:= Units.ConvertHeight(ry,AUnit).value;
3746 ACanvas2d.beginPath;
3747 ACanvas2d.ellipse(vcx,vcy,vrx,vry);
3748 InitializeGradient(ACanvas2d, PointF(vcx-vrx,vcy-vry),vrx*2,vry*2,AUnit);
3749 Paint(ACanvas2D, AUnit);
3750 end;
3751 end;
3752
TSVGEllipse.GetDOMTagnull3753 class function TSVGEllipse.GetDOMTag: string;
3754 begin
3755 Result:= 'ellipse';
3756 end;
3757
3758 procedure TSVGEllipse.ConvertToUnit(AUnit: TCSSUnit);
3759 begin
3760 inherited ConvertToUnit(AUnit);
3761 if HasAttribute('cx') then cx := Units.ConvertWidth(cx, AUnit);
3762 if HasAttribute('cy') then cy := Units.ConvertHeight(cy, AUnit);
3763 if HasAttribute('rx') then rx := Units.ConvertWidth(rx, AUnit);
3764 if HasAttribute('ry') then ry := Units.ConvertHeight(ry, AUnit);
3765 end;
3766
3767 { TSVGCircle }
3768
GetCXnull3769 function TSVGCircle.GetCX: TFloatWithCSSUnit;
3770 begin
3771 result := HorizAttributeWithUnit['cx'];
3772 end;
3773
GetCYnull3774 function TSVGCircle.GetCY: TFloatWithCSSUnit;
3775 begin
3776 result := VerticalAttributeWithUnit['cy'];
3777 end;
3778
TSVGCircle.GetRnull3779 function TSVGCircle.GetR: TFloatWithCSSUnit;
3780 begin
3781 result := OrthoAttributeWithUnit['r'];
3782 end;
3783
3784 procedure TSVGCircle.SetCX(AValue: TFloatWithCSSUnit);
3785 begin
3786 HorizAttributeWithUnit['cx'] := AValue;
3787 end;
3788
3789 procedure TSVGCircle.SetCY(AValue: TFloatWithCSSUnit);
3790 begin
3791 VerticalAttributeWithUnit['cy'] := AValue;
3792 end;
3793
3794 procedure TSVGCircle.SetR(AValue: TFloatWithCSSUnit);
3795 begin
3796 OrthoAttributeWithUnit['r'] := AValue;
3797 end;
3798
3799 procedure TSVGCircle.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
3800 var
3801 vcx,vcy,vr: Single;
3802 begin
3803 if not isFillNone or not isStrokeNone then
3804 begin
3805 vcx:= Units.ConvertWidth(cx,AUnit).value;
3806 vcy:= Units.ConvertHeight(cy,AUnit).value;
3807 vr:= Units.ConvertOrtho(r,AUnit).value;
3808 ACanvas2d.beginPath;
3809 ACanvas2d.circle(vcx,vcy,vr);
3810 InitializeGradient(ACanvas2d, PointF(vcx-vr,vcy-vr),vr*2,vr*2,AUnit);
3811 Paint(ACanvas2d, AUnit);
3812 end;
3813 end;
3814
TSVGCircle.GetDOMTagnull3815 class function TSVGCircle.GetDOMTag: string;
3816 begin
3817 Result:= 'circle';
3818 end;
3819
3820 procedure TSVGCircle.ConvertToUnit(AUnit: TCSSUnit);
3821 begin
3822 inherited ConvertToUnit(AUnit);
3823 if HasAttribute('cx') then cx := Units.ConvertWidth(cx, AUnit);
3824 if HasAttribute('cy') then cy := Units.ConvertHeight(cy, AUnit);
3825 if HasAttribute('r') then r := Units.ConvertOrtho(r, AUnit);
3826 end;
3827
3828 { TSVGLine }
3829
GetX1null3830 function TSVGLine.GetX1: TFloatWithCSSUnit;
3831 begin
3832 result := HorizAttributeWithUnit['x1'];
3833 end;
3834
GetX2null3835 function TSVGLine.GetX2: TFloatWithCSSUnit;
3836 begin
3837 result := HorizAttributeWithUnit['x2'];
3838 end;
3839
GetY1null3840 function TSVGLine.GetY1: TFloatWithCSSUnit;
3841 begin
3842 result := VerticalAttributeWithUnit['y1'];
3843 end;
3844
GetY2null3845 function TSVGLine.GetY2: TFloatWithCSSUnit;
3846 begin
3847 result := VerticalAttributeWithUnit['y2'];
3848 end;
3849
3850 procedure TSVGLine.SetX1(AValue: TFloatWithCSSUnit);
3851 begin
3852 HorizAttributeWithUnit['x1'] := AValue;
3853 end;
3854
3855 procedure TSVGLine.SetX2(AValue: TFloatWithCSSUnit);
3856 begin
3857 HorizAttributeWithUnit['x2'] := AValue;
3858 end;
3859
3860 procedure TSVGLine.SetY1(AValue: TFloatWithCSSUnit);
3861 begin
3862 VerticalAttributeWithUnit['y1'] := AValue;
3863 end;
3864
3865 procedure TSVGLine.SetY2(AValue: TFloatWithCSSUnit);
3866 begin
3867 VerticalAttributeWithUnit['y2'] := AValue;
3868 end;
3869
3870 procedure TSVGLine.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
3871 begin
3872 if not isStrokeNone then
3873 begin
3874 ApplyStrokeStyle(ACanvas2D,AUnit);
3875 ACanvas2d.beginPath;
3876 ACanvas2d.moveTo(Units.ConvertWidth(x1,AUnit).value,Units.ConvertHeight(y1,AUnit).value);
3877 ACanvas2d.lineTo(Units.ConvertWidth(x2,AUnit).value,Units.ConvertHeight(y2,AUnit).value);
3878 ACanvas2d.stroke;
3879 end;
3880 end;
3881
TSVGLine.GetDOMTagnull3882 class function TSVGLine.GetDOMTag: string;
3883 begin
3884 Result:= 'line';
3885 end;
3886
3887 procedure TSVGLine.ConvertToUnit(AUnit: TCSSUnit);
3888 begin
3889 inherited ConvertToUnit(AUnit);
3890 if HasAttribute('x1') then x1 := Units.ConvertWidth(x1, AUnit);
3891 if HasAttribute('y1') then y1 := Units.ConvertHeight(y1, AUnit);
3892 if HasAttribute('x2') then x2 := Units.ConvertWidth(x2, AUnit);
3893 if HasAttribute('y2') then y2 := Units.ConvertHeight(y2, AUnit);
3894 end;
3895
3896 { TSVGGradient } //##
3897
GetHRefnull3898 function TSVGGradient.GetHRef: string;
3899 begin
3900 result := Attribute['xlink:href'];
3901 end;
3902
TSVGGradient.GetSpreadMethodnull3903 function TSVGGradient.GetSpreadMethod: TSVGSpreadMethod;
3904 var
3905 s: String;
3906 begin
3907 s := Attribute['spreadMethod'];
3908 if s = 'reflect' then result := ssmReflect
3909 else if s = 'repeat' then result := ssmRepeat
3910 else result := ssmPad;
3911 end;
3912
3913 procedure TSVGGradient.SetColorInterpolation(AValue: TSVGColorInterpolation);
3914 begin
3915 if AValue = sciLinearRGB then
3916 Attribute['color-interpolation'] := 'linearRGB'
3917 else Attribute['color-interpolation'] := 'sRGB';
3918 end;
3919
3920 procedure TSVGGradient.SetGradientMatrix(AUnit: TCSSUnit; AValue: TAffineMatrix);
3921 begin
3922 if not IsAffineMatrixIdentity(AValue) then
3923 gradientTransform := MatrixToTransform(AValue, AUnit)
3924 else FDomElem.RemoveAttribute('gradientTransform');
3925 end;
3926
3927 procedure TSVGGradient.SetGradientTransform(AValue: string);
3928 begin
3929 Attribute['gradientTransform'] := AValue;
3930 end;
3931
GetGradientUnitsnull3932 function TSVGGradient.GetGradientUnits: TSVGObjectUnits;
3933 begin
3934 if Attribute['gradientUnits','objectBoundingBox'] = 'userSpaceOnUse' then
3935 result := souUserSpaceOnUse
3936 else
3937 result := souObjectBoundingBox;
3938 end;
3939
TSVGGradient.GetGradientTransformnull3940 function TSVGGradient.GetGradientTransform: string;
3941 begin
3942 result := Attribute['gradientTransform'];
3943 end;
3944
GetColorInterpolationnull3945 function TSVGGradient.GetColorInterpolation: TSVGColorInterpolation;
3946 begin
3947 if Attribute['color-interpolation'] = 'linearRGB' then
3948 result := sciLinearRGB
3949 else result := sciStdRGB;
3950 end;
3951
GetGradientMatrixnull3952 function TSVGGradient.GetGradientMatrix(AUnit: TCSSUnit): TAffineMatrix;
3953 begin
3954 result := TransformToMatrix(gradientTransform, AUnit);
3955 end;
3956
3957 procedure TSVGGradient.SetGradientUnits(AValue: TSVGObjectUnits);
3958 begin
3959 if AValue = souUserSpaceOnUse then
3960 Attribute['gradientUnits'] := 'userSpaceOnUse'
3961 else
3962 Attribute['gradientUnits'] := 'objectBoundingBox';
3963 end;
3964
3965 procedure TSVGGradient.SetHRef(AValue: string);
3966 begin
3967 Attribute['xlink:href'] := AValue;
3968 end;
3969
3970 procedure TSVGGradient.SetSpreadMethod(AValue: TSVGSpreadMethod);
3971 var
3972 s: String;
3973 begin
3974 case AValue of
3975 ssmReflect: s := 'reflect';
3976 ssmRepeat: s := 'repeat';
3977 else s := 'pad';
3978 end;
3979 Attribute['spreadMethod'] := s;
3980 end;
3981
3982 procedure TSVGGradient.Initialize;
3983 begin
3984 inherited;
3985 InheritedGradients:= TSVGElementList.Create;
3986 end;
3987
GetInheritedAttributenull3988 function TSVGGradient.GetInheritedAttribute(AValue: string;
3989 AConvMethod: TConvMethod; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
3990 var
3991 i: integer;
3992 el: TSVGGradient;
3993 invalidDef: TFloatWithCSSUnit;
3994 begin
3995 invalidDef:= FloatWithCSSUnit(EmptySingle,cuPercent);
3996 //find valid inherited Attribute (start from "self": item[0])
3997 for i:= 0 to InheritedGradients.Count-1 do
3998 begin
3999 el:= TSVGGradient( InheritedGradients[i] );
4000 with el do
4001 begin
4002 if AConvMethod = cmHoriz then
4003 result:= HorizAttributeWithUnitDef[AValue,invalidDef]
4004 else if AConvMethod = cmVertical then
4005 result:= VerticalAttributeWithUnitDef[AValue,invalidDef]
4006 else if AConvMethod = cmOrtho then
4007 result:= OrthoAttributeWithUnitDef[AValue,invalidDef]
4008 else
4009 result:= AttributeWithUnitDef[AValue,invalidDef];
4010
4011 if (result.value <> invalidDef.value) or
4012 (result.CSSUnit <> invalidDef.CSSUnit) then
4013 exit;
4014 end;
4015 end;
4016 result:= ADefault;
4017 end;
4018
4019 destructor TSVGGradient.Destroy;
4020 begin
4021 FreeAndNil(InheritedGradients);
4022 inherited Destroy;
4023 end;
4024
4025 procedure TSVGGradient.ScanInheritedGradients(const forceScan: boolean = false);
4026 var
4027 el: TSVGGradient;
4028 begin
4029 //(if list empty = not scan)
4030 if (InheritedGradients.Count <> 0) and (not forceScan) then
4031 exit;
4032
4033 InheritedGradients.Clear;
4034 InheritedGradients.Add(Self);//(important)
4035 if FDataLink = nil then exit;
4036 el:= Self;
4037 while el.hRef <> '' do
4038 begin
4039 el := TSVGGradient(FDataLink.FindElementByRef(el.hRef, TSVGGradient));
4040 if Assigned(el) then InheritedGradients.Add(el);
4041 end;
4042 end;
4043
4044 { TSVGLinearGradient }
4045
TSVGLinearGradient.GetX1null4046 function TSVGLinearGradient.GetX1: TFloatWithCSSUnit;
4047 begin
4048 result := GetInheritedAttribute('x1',cmNone,FloatWithCSSUnit(0,cuPercent));
4049 end;
4050
TSVGLinearGradient.GetX2null4051 function TSVGLinearGradient.GetX2: TFloatWithCSSUnit;
4052 begin
4053 result := GetInheritedAttribute('x2',cmNone,FloatWithCSSUnit(100,cuPercent));
4054 end;
4055
TSVGLinearGradient.GetY1null4056 function TSVGLinearGradient.GetY1: TFloatWithCSSUnit;
4057 begin
4058 result := GetInheritedAttribute('y1',cmNone,FloatWithCSSUnit(0,cuPercent));
4059 end;
4060
TSVGLinearGradient.GetY2null4061 function TSVGLinearGradient.GetY2: TFloatWithCSSUnit;
4062 begin
4063 result := GetInheritedAttribute('y2',cmNone,FloatWithCSSUnit(0,cuPercent));
4064 end;
4065
4066 procedure TSVGLinearGradient.SetX1(AValue: TFloatWithCSSUnit);
4067 begin
4068 AttributeWithUnit['x1']:= AValue;
4069 end;
4070
4071 procedure TSVGLinearGradient.SetX2(AValue: TFloatWithCSSUnit);
4072 begin
4073 AttributeWithUnit['x2']:= AValue;
4074 end;
4075
4076 procedure TSVGLinearGradient.SetY1(AValue: TFloatWithCSSUnit);
4077 begin
4078 AttributeWithUnit['y1']:= AValue;
4079 end;
4080
4081 procedure TSVGLinearGradient.SetY2(AValue: TFloatWithCSSUnit);
4082 begin
4083 AttributeWithUnit['y2']:= AValue;
4084 end;
4085
TSVGLinearGradient.GetDOMTagnull4086 class function TSVGLinearGradient.GetDOMTag: string;
4087 begin
4088 Result:= 'linearGradient';
4089 end;
4090
4091 procedure TSVGLinearGradient.ConvertToUnit(AUnit: TCSSUnit);
4092 begin
4093 inherited ConvertToUnit(AUnit);
4094 if gradientUnits = souUserSpaceOnUse then
4095 begin
4096 if HasAttribute('x1') then x1 := Units.ConvertWidth(HorizAttributeWithUnit['x1'], AUnit);
4097 if HasAttribute('y1') then y1 := Units.ConvertHeight(VerticalAttributeWithUnit['y1'], AUnit);
4098 if HasAttribute('x2') then x2 := Units.ConvertWidth(HorizAttributeWithUnit['x2'], AUnit);
4099 if HasAttribute('y2') then y2 := Units.ConvertHeight(VerticalAttributeWithUnit['y2'], AUnit);
4100 end;
4101 end;
4102
4103 { TSVGRadialGradient }
4104
GetCXnull4105 function TSVGRadialGradient.GetCX: TFloatWithCSSUnit;
4106 begin
4107 result := GetInheritedAttribute('cx',cmHoriz,FloatWithCSSUnit(50,cuPercent));
4108 end;
4109
GetCYnull4110 function TSVGRadialGradient.GetCY: TFloatWithCSSUnit;
4111 begin
4112 result := GetInheritedAttribute('cy',cmVertical,FloatWithCSSUnit(50,cuPercent));
4113 end;
4114
TSVGRadialGradient.GetRnull4115 function TSVGRadialGradient.GetR: TFloatWithCSSUnit;
4116 begin
4117 result := GetInheritedAttribute('r',cmOrtho,FloatWithCSSUnit(50,cuPercent));
4118 end;
4119
GetFXnull4120 function TSVGRadialGradient.GetFX: TFloatWithCSSUnit;
4121 begin
4122 result := GetInheritedAttribute('fx',cmHoriz,cx);
4123 end;
4124
GetFYnull4125 function TSVGRadialGradient.GetFY: TFloatWithCSSUnit;
4126 begin
4127 result := GetInheritedAttribute('fy',cmVertical,cy);
4128 end;
4129
TSVGRadialGradient.GetFRnull4130 function TSVGRadialGradient.GetFR: TFloatWithCSSUnit;
4131 begin
4132 result := GetInheritedAttribute('fr',cmHoriz,FloatWithCSSUnit(0,cuPercent));
4133 end;
4134
4135 procedure TSVGRadialGradient.SetCX(AValue: TFloatWithCSSUnit);
4136 begin
4137 HorizAttributeWithUnit['cx'] := AValue;
4138 end;
4139
4140 procedure TSVGRadialGradient.SetCY(AValue: TFloatWithCSSUnit);
4141 begin
4142 VerticalAttributeWithUnit['cy'] := AValue;
4143 end;
4144
4145 procedure TSVGRadialGradient.SetR(AValue: TFloatWithCSSUnit);
4146 begin
4147 OrthoAttributeWithUnit['r'] := AValue;
4148 end;
4149
4150 procedure TSVGRadialGradient.SetFX(AValue: TFloatWithCSSUnit);
4151 begin
4152 HorizAttributeWithUnit['fx'] := AValue;
4153 end;
4154
4155 procedure TSVGRadialGradient.SetFY(AValue: TFloatWithCSSUnit);
4156 begin
4157 VerticalAttributeWithUnit['fy'] := AValue;
4158 end;
4159
4160 procedure TSVGRadialGradient.SetFR(AValue: TFloatWithCSSUnit);
4161 begin
4162 OrthoAttributeWithUnit['fr'] := AValue;
4163 end;
4164
TSVGRadialGradient.GetDOMTagnull4165 class function TSVGRadialGradient.GetDOMTag: string;
4166 begin
4167 Result:= 'radialGradient';
4168 end;
4169
4170 procedure TSVGRadialGradient.ConvertToUnit(AUnit: TCSSUnit);
4171 begin
4172 inherited ConvertToUnit(AUnit);
4173 if gradientUnits = souUserSpaceOnUse then
4174 begin
4175 if HasAttribute('cx') then cx := Units.ConvertWidth(HorizAttributeWithUnit['cx'], AUnit);
4176 if HasAttribute('cy') then cy := Units.ConvertHeight(VerticalAttributeWithUnit['cy'], AUnit);
4177 if HasAttribute('fx') then fx := Units.ConvertWidth(HorizAttributeWithUnit['fx'], AUnit);
4178 if HasAttribute('fy') then fy := Units.ConvertHeight(VerticalAttributeWithUnit['fy'], AUnit);
4179 if HasAttribute('r') then r := Units.ConvertOrtho(OrthoAttributeWithUnit['r'], AUnit);
4180 if HasAttribute('fr') then fr := Units.ConvertOrtho(OrthoAttributeWithUnit['fr'], AUnit);
4181 end;
4182 end;
4183
4184 { TSVGStopGradient }
4185
TSVGStopGradient.GetOffsetnull4186 function TSVGStopGradient.GetOffset: TFloatWithCSSUnit;
4187 begin
4188 result := AttributeWithUnit['offset'];
4189 end;
4190
GetStopColornull4191 function TSVGStopGradient.GetStopColor: TBGRAPixel;
4192 begin
4193 result := StrToBGRA(AttributeOrStyleDef['stop-color','black']);
4194 result.alpha := round(result.alpha*stopOpacity);
4195 end;
4196
TSVGStopGradient.GetStopOpacitynull4197 function TSVGStopGradient.GetStopOpacity: single;
4198 var errPos: integer;
4199 begin
4200 val(AttributeOrStyleDef['stop-opacity','1'], result, errPos);
4201 if errPos <> 0 then result := 1 else
4202 if result < 0 then result := 0 else
4203 if result > 1 then result := 1;
4204 end;
4205
4206 procedure TSVGStopGradient.SetOffset(AValue: TFloatWithCSSUnit);
4207 begin
4208 AttributeWithUnit['offset'] := AValue;
4209 end;
4210
4211 procedure TSVGStopGradient.SetStopColor(AValue: TBGRAPixel);
4212 begin
4213 stopOpacity:= AValue.alpha/255;
4214 AValue.alpha:= 255;
4215 Attribute['stop-color'] := Lowercase(BGRAToStr(AValue, CSSColors, 0, true, true));
4216 RemoveStyle('stop-color');
4217 end;
4218
4219 procedure TSVGStopGradient.SetStopOpacity(AValue: single);
4220 begin
4221 Attribute['stop-opacity'] := Units.formatValue(AValue);
4222 RemoveStyle('stop-opacity');
4223 end;
4224
TSVGStopGradient.GetDOMTagnull4225 class function TSVGStopGradient.GetDOMTag: string;
4226 begin
4227 Result:= 'stop';
4228 end;
4229
4230 { TSVGContent }
4231
GetElementnull4232 function TSVGContent.GetElement(AIndex: integer): TSVGElement;
4233 begin
4234 result := TObject(FElements.Items[AIndex]) as TSVGElement;
4235 end;
4236
GetElementObjectnull4237 function TSVGContent.GetElementObject(AIndex: integer): TObject;
4238 begin
4239 result := TObject(FElements.Items[AIndex]);
4240 end;
4241
TSVGContent.GetElementCountnull4242 function TSVGContent.GetElementCount: integer;
4243 begin
4244 result := FElements.Count;
4245 end;
4246
TSVGContent.GetUnitsnull4247 function TSVGContent.GetUnits: TCSSUnitConverter;
4248 begin
4249 result := FUnits;
4250 end;
4251
TryCreateElementFromNodenull4252 function TSVGContent.TryCreateElementFromNode(ANode: TDOMNode): TObject;
4253 begin
4254 if ANode is TDOMElement then
4255 result := CreateSVGElementFromNode(TDOMElement(ANode),FUnits,FDataLink)
4256 else
4257 result := ANode;
4258 end;
4259
GetIsSVGElementnull4260 function TSVGContent.GetIsSVGElement(AIndex: integer): boolean;
4261 begin
4262 result := TObject(FElements[AIndex]) is TSVGElement;
4263 end;
4264
GetElementDOMNodenull4265 function TSVGContent.GetElementDOMNode(AIndex: integer): TDOMNode;
4266 begin
4267 result := GetDOMNode(TObject(FElements[AIndex]));
4268 end;
4269
GetDOMNodenull4270 function TSVGContent.GetDOMNode(AElement: TObject): TDOMNode;
4271 begin
4272 if AElement is TDOMNode then
4273 result := TDOMNode(AElement)
4274 else if AElement is TSVGElement then
4275 result := TSVGElement(AElement).DOMElement
4276 else
4277 raise exception.Create('Unexpected element type');
4278 end;
4279
4280 procedure TSVGContent.AppendElement(AElement: TObject);
4281 begin
4282 FDomElem.AppendChild(GetDOMNode(AElement));
4283 FElements.Add(AElement);
4284 if AElement is TSVGElement then
4285 TSVGElement(AElement).DataLink := FDataLink;
4286 end;
4287
ExtractElementAtnull4288 function TSVGContent.ExtractElementAt(AIndex: integer): TObject;
4289 begin
4290 result := ElementObject[AIndex];
4291 if result is TSVGElement then
4292 begin
4293 TSVGElement(result).DataLink := nil;
4294 FElements.Delete(AIndex);
4295 FDomElem.RemoveChild(TSVGElement(result).DOMElement);
4296 end else
4297 if result is TDOMNode then
4298 FDomElem.RemoveChild(TDOMNode(result))
4299 else
4300 raise exception.Create('Unexpected element type');
4301 end;
4302
4303 procedure TSVGContent.InsertElementBefore(AElement: TSVGElement;
4304 ASuccessor: TSVGElement);
4305 var idx: integer;
4306 begin
4307 idx := FElements.IndexOf(ASuccessor);
4308 if idx <> -1 then
4309 begin
4310 FElements.Insert(idx,AElement);
4311 FDomElem.InsertBefore(GetDOMNode(AElement), GetDOMNode(ASuccessor));
4312 AElement.DataLink := FDataLink;
4313 end
4314 else
4315 AppendElement(AElement);
4316 end;
4317
4318 constructor TSVGContent.Create(AElement: TDOMElement; AUnits: TCSSUnitConverter;
4319 ADataLink: TSVGDataLink);
4320 var cur: TDOMNode;
4321 elem: TObject;
4322 begin
4323 FDoc := AElement.OwnerDocument;
4324 FDomElem := AElement;
4325 FDataLink := ADataLink;
4326 FElements := TFPList.Create;
4327 FUnits := AUnits;
4328 cur := FDomElem.FirstChild;
4329 while cur <> nil do
4330 begin
4331 elem := TryCreateElementFromNode(cur);
4332 if Assigned(elem) then FElements.Add(elem);
4333 cur := cur.NextSibling;
4334 end;
4335 end;
4336
4337 destructor TSVGContent.Destroy;
4338 var i:integer;
4339 begin
4340 for i := ElementCount-1 downto 0 do
4341 if not (ElementObject[i] is TDOMNode) then
4342 ElementObject[i].Free;
4343 FreeAndNil(FElements);
4344 inherited Destroy;
4345 end;
4346
4347 procedure TSVGContent.Clear;
4348 var
4349 i: Integer;
4350 begin
4351 for i := 0 to ElementCount-1 do
4352 if IsSVGElement[i] then Element[i].Free;
4353 FElements.Clear;
4354 while Assigned(FDomElem.FirstChild) do
4355 FDomElem.RemoveChild(FDomElem.FirstChild);
4356 end;
4357
4358 procedure TSVGContent.ConvertToUnit(AUnit: TCSSUnit);
4359 var i: integer;
4360 begin
4361 for i := 0 to ElementCount-1 do
4362 if IsSVGElement[i] then
4363 Element[i].ConvertToUnit(AUnit);
4364 end;
4365
4366 procedure TSVGContent.Recompute;
4367 var
4368 i: Integer;
4369 begin
4370 for i := 0 to ElementCount-1 do
4371 if IsSVGElement[i] then
4372 Element[i].Recompute;
4373 end;
4374
4375 procedure TSVGContent.Draw(ACanvas2d: TBGRACanvas2D; x, y: single; AUnit: TCSSUnit);
4376 var prevMatrix: TAffineMatrix;
4377 begin
4378 if (x<>0) or (y<>0) then
4379 begin
4380 prevMatrix := ACanvas2d.matrix;
4381 ACanvas2d.translate(x,y);
4382 Draw(ACanvas2d, AUnit);
4383 ACanvas2d.matrix := prevMatrix;
4384 end else
4385 Draw(ACanvas2d, AUnit);
4386 end;
4387
4388 procedure TSVGContent.Draw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
4389 var i: integer;
4390 begin
4391 for i := 0 to ElementCount-1 do
4392 if IsSVGElement[i] then
4393 Element[i].Draw(ACanvas2d, AUnit);
4394 end;
4395
TSVGContent.AppendElementnull4396 function TSVGContent.AppendElement(ASVGType: TSVGFactory): TSVGElement;
4397 begin
4398 result := ASVGType.Create(FDoc,Units,FDataLink);
4399 AppendElement(result);
4400 end;
4401
4402 procedure TSVGContent.BringElement(AElement: TObject;
4403 AFromContent: TSVGContent);
4404 var
4405 idx: Integer;
4406 begin
4407 idx := AFromContent.IndexOfElement(AElement);
4408 if idx = -1 then raise exception.Create('Cannot find element in content');
4409 AFromContent.ExtractElementAt(idx);
4410 AppendElement(AElement);
4411 end;
4412
4413 procedure TSVGContent.CopyElement(AElement: TObject);
4414 var
4415 nodeCopy: TDOMNode;
4416 objCopy: TObject;
4417 begin
4418 if AElement is TSVGElement then
4419 nodeCopy := TSVGElement(AElement).DOMElement.CloneNode(true, FDoc)
4420 else if AElement is TDOMNode then
4421 nodeCopy := TDOMNode(AElement).CloneNode(true, FDoc)
4422 else
4423 raise exception.Create('Unexpected element type');
4424
4425 FDomElem.AppendChild(nodeCopy);
4426 objCopy := TryCreateElementFromNode(nodeCopy);
4427 if Assigned(objCopy) then FElements.Add(objCopy);
4428 end;
4429
4430 procedure TSVGContent.RemoveElement(AElement: TObject);
4431 var
4432 idx: Integer;
4433 begin
4434 idx := IndexOfElement(AElement);
4435 if idx = -1 then exit;
4436 if AElement is TSVGElement then
4437 begin
4438 ExtractElementAt(idx);
4439 TSVGElement(AElement).DOMElement.Free;
4440 AElement.Free;
4441 end else
4442 if AElement is TDOMNode then
4443 begin
4444 ExtractElementAt(idx);
4445 TDOMNode(AElement).Free;
4446 end else
4447 raise exception.Create('Unexpected element type');
4448 end;
4449
TSVGContent.AppendDOMTextnull4450 function TSVGContent.AppendDOMText(AText: string): TDOMText;
4451 begin
4452 result := TDOMText.Create(FDomElem.OwnerDocument);
4453 result.Data:= AText;
4454 AppendElement(result);
4455 end;
4456
AppendDefinenull4457 function TSVGContent.AppendDefine: TSVGDefine;
4458 begin
4459 result := TSVGDefine.Create(FDoc,Units,FDataLink);
4460 AppendElement(result);
4461 end;
4462
AppendLinearGradientnull4463 function TSVGContent.AppendLinearGradient(x1, y1, x2, y2: single; AIsPercent: boolean): TSVGLinearGradient;
4464 var
4465 u: TCSSUnit;
4466 begin
4467 result := TSVGLinearGradient.Create(FDoc,Units,FDataLink);
4468 result.gradientUnits:= souObjectBoundingBox;
4469 if AIsPercent then u := cuPercent else u := cuCustom;
4470 result.x1 := FloatWithCSSUnit(x1, u);
4471 result.x2 := FloatWithCSSUnit(x2, u);
4472 result.y1 := FloatWithCSSUnit(y1, u);
4473 result.y2 := FloatWithCSSUnit(y2, u);
4474 AppendElement(result);
4475 end;
4476
AppendLinearGradientnull4477 function TSVGContent.AppendLinearGradient(x1, y1, x2, y2: single;
4478 AUnit: TCSSUnit): TSVGLinearGradient;
4479 begin
4480 result := TSVGLinearGradient.Create(FDoc,Units,FDataLink);
4481 result.gradientUnits:= souUserSpaceOnUse;
4482 result.x1 := FloatWithCSSUnit(x1, AUnit);
4483 result.x2 := FloatWithCSSUnit(x2, AUnit);
4484 result.y1 := FloatWithCSSUnit(y1, AUnit);
4485 result.y2 := FloatWithCSSUnit(y2, AUnit);
4486 AppendElement(result);
4487 end;
4488
TSVGContent.AppendRadialGradientnull4489 function TSVGContent.AppendRadialGradient(cx, cy, r, fx, fy, fr: single;
4490 AIsPercent: boolean): TSVGRadialGradient;
4491 var
4492 u: TCSSUnit;
4493 begin
4494 result := TSVGRadialGradient.Create(FDoc,Units,FDataLink);
4495 result.gradientUnits:= souObjectBoundingBox;
4496 if AIsPercent then u := cuPercent else u := cuCustom;
4497 result.cx := FloatWithCSSUnit(cx, u);
4498 result.cy := FloatWithCSSUnit(cy, u);
4499 result.r := FloatWithCSSUnit(r, u);
4500 result.fx := FloatWithCSSUnit(fx, u);
4501 result.fy := FloatWithCSSUnit(fy, u);
4502 result.fr := FloatWithCSSUnit(fr, u);
4503 AppendElement(result);
4504 end;
4505
TSVGContent.AppendRadialGradientnull4506 function TSVGContent.AppendRadialGradient(cx, cy, r, fx, fy, fr: single;
4507 AUnit: TCSSUnit): TSVGRadialGradient;
4508 begin
4509 result := TSVGRadialGradient.Create(FDoc,Units,FDataLink);
4510 result.gradientUnits:= souUserSpaceOnUse;
4511 result.cx := FloatWithCSSUnit(cx, AUnit);
4512 result.cy := FloatWithCSSUnit(cy, AUnit);
4513 result.r := FloatWithCSSUnit(r, AUnit);
4514 result.fx := FloatWithCSSUnit(fx, AUnit);
4515 result.fy := FloatWithCSSUnit(fy, AUnit);
4516 result.fr := FloatWithCSSUnit(fr, AUnit);
4517 AppendElement(result);
4518 end;
4519
AppendStopnull4520 function TSVGContent.AppendStop(AColor: TBGRAPixel; AOffset: single;
4521 AIsPercent: boolean): TSVGStopGradient;
4522 begin
4523 result := TSVGStopGradient.Create(FDoc,Units,FDataLink);
4524 if AIsPercent then
4525 result.Offset := FloatWithCSSUnit(AOffset, cuPercent)
4526 else result.Offset := FloatWithCSSUnit(AOffset, cuCustom);
4527 result.stopColor := AColor;
4528 AppendElement(result);
4529 end;
4530
AppendLinenull4531 function TSVGContent.AppendLine(x1, y1, x2, y2: single; AUnit: TCSSUnit
4532 ): TSVGLine;
4533 begin
4534 result := TSVGLine.Create(FDoc,Units,FDataLink);
4535 result.x1 := FloatWithCSSUnit(x1,AUnit);
4536 result.y1 := FloatWithCSSUnit(y1,AUnit);
4537 result.x2 := FloatWithCSSUnit(x2,AUnit);
4538 result.y2 := FloatWithCSSUnit(y2,AUnit);
4539 AppendElement(result);
4540 end;
4541
AppendLinenull4542 function TSVGContent.AppendLine(p1, p2: TPointF; AUnit: TCSSUnit): TSVGLine;
4543 begin
4544 result := AppendLine(p1.x,p1.y,p2.x,p2.y,AUnit);
4545 end;
4546
TSVGContent.AppendCirclenull4547 function TSVGContent.AppendCircle(cx, cy, r: single; AUnit: TCSSUnit
4548 ): TSVGCircle;
4549 begin
4550 result := TSVGCircle.Create(FDoc,Units,FDataLink);
4551 result.cx := FloatWithCSSUnit(cx,AUnit);
4552 result.cy := FloatWithCSSUnit(cy,AUnit);
4553 result.r := FloatWithCSSUnit(r,AUnit);
4554 AppendElement(result);
4555 end;
4556
TSVGContent.AppendCirclenull4557 function TSVGContent.AppendCircle(c: TPointF; r: single; AUnit: TCSSUnit
4558 ): TSVGCircle;
4559 begin
4560 result := AppendCircle(c.x,c.y,r,AUnit);
4561 end;
4562
TSVGContent.AppendEllipsenull4563 function TSVGContent.AppendEllipse(cx, cy, rx, ry: single; AUnit: TCSSUnit
4564 ): TSVGEllipse;
4565 begin
4566 result := TSVGEllipse.Create(FDoc,Units,FDataLink);
4567 result.cx := FloatWithCSSUnit(cx,AUnit);
4568 result.cy := FloatWithCSSUnit(cy,AUnit);
4569 result.rx := FloatWithCSSUnit(rx,AUnit);
4570 result.ry := FloatWithCSSUnit(ry,AUnit);
4571 AppendElement(result);
4572 end;
4573
TSVGContent.AppendEllipsenull4574 function TSVGContent.AppendEllipse(c, r: TPointF; AUnit: TCSSUnit): TSVGEllipse;
4575 begin
4576 result := AppendEllipse(c.x,c.y,r.x,r.y,AUnit);
4577 end;
4578
TSVGContent.AppendPathnull4579 function TSVGContent.AppendPath(data: string; AUnit: TCSSUnit): TSVGPath;
4580 var tempPath: TBGRAPath;
4581 begin
4582 if AUnit <> cuCustom then
4583 begin
4584 tempPath := TBGRAPath.Create(data);
4585 result := AppendPath(tempPath, AUnit);
4586 tempPath.Free;
4587 end else
4588 begin
4589 result := TSVGPath.Create(FDoc,Units,FDataLink);
4590 result.d := data;
4591 AppendElement(result);
4592 end;
4593 end;
4594
TSVGContent.AppendPathnull4595 function TSVGContent.AppendPath(path: TBGRAPath; AUnit: TCSSUnit): TSVGPath;
4596 begin
4597 result := TSVGPath.Create(FDoc,Units,FDataLink);
4598 result.path.scale(Units.ConvertWidth(1,AUnit,cuCustom));
4599 path.copyTo(result.path);
4600 AppendElement(result);
4601 end;
4602
AppendPolygonnull4603 function TSVGContent.AppendPolygon(const points: array of single;
4604 AUnit: TCSSUnit): TSVGPolypoints;
4605 var
4606 pts: ArrayOfTPointF;
4607 i: integer;
4608 begin
4609 result := TSVGPolypoints.Create(FDoc,FUnits,true,FDataLink);
4610 setlength(pts, length(points) div 2);
4611 for i := 0 to high(pts) do
4612 pts[i] := Units.ConvertCoord(PointF(points[i shl 1],points[(i shl 1)+1]),AUnit,cuCustom);
4613 result.pointsF := pts;
4614 AppendElement(result);
4615 end;
4616
AppendPolygonnull4617 function TSVGContent.AppendPolygon(const points: array of TPointF;
4618 AUnit: TCSSUnit): TSVGPolypoints;
4619 var
4620 pts: ArrayOfTPointF;
4621 i: integer;
4622 begin
4623 result := TSVGPolypoints.Create(FDoc,FUnits,true,FDataLink);
4624 setlength(pts, length(points));
4625 for i := 0 to high(pts) do
4626 pts[i] := Units.ConvertCoord(points[i],AUnit,cuCustom);
4627 result.pointsF := pts;
4628 AppendElement(result);
4629 end;
4630
AppendRectnull4631 function TSVGContent.AppendRect(x, y, width, height: single; AUnit: TCSSUnit
4632 ): TSVGRectangle;
4633 begin
4634 result := TSVGRectangle.Create(FDoc,Units,FDataLink);
4635 result.x := FloatWithCSSUnit(x,AUnit);
4636 result.y := FloatWithCSSUnit(y,AUnit);
4637 result.width := FloatWithCSSUnit(width,AUnit);
4638 result.height := FloatWithCSSUnit(height,AUnit);
4639 AppendElement(result);
4640 end;
4641
AppendRectnull4642 function TSVGContent.AppendRect(origin, size: TPointF; AUnit: TCSSUnit
4643 ): TSVGRectangle;
4644 begin
4645 result := AppendRect(origin.x,origin.y,size.x,size.y,AUnit);
4646 end;
4647
AppendImagenull4648 function TSVGContent.AppendImage(x, y, width, height: single; ABitmap: TBGRACustomBitmap;
4649 ABitmapOwned: boolean; AUnit: TCSSUnit): TSVGImage;
4650 begin
4651 result := TSVGImage.Create(FDoc,Units,FDataLink);
4652 result.x := FloatWithCSSUnit(x, AUnit);
4653 result.y := FloatWithCSSUnit(y, AUnit);
4654 result.width := FloatWithCSSUnit(width, AUnit);
4655 result.height := FloatWithCSSUnit(height, AUnit);
4656 result.SetBitmap(ABitmap, ABitmapOwned);
4657 AppendElement(result);
4658 end;
4659
AppendImagenull4660 function TSVGContent.AppendImage(origin, size: TPointF; ABitmap: TBGRACustomBitmap;
4661 ABitmapOwned: boolean; AUnit: TCSSUnit): TSVGImage;
4662 begin
4663 result := AppendImage(origin.x,origin.y,size.x,size.y,ABitmap,ABitmapOwned,AUnit);
4664 end;
4665
AppendImagenull4666 function TSVGContent.AppendImage(x, y, width, height: single;
4667 ABitmapStream: TStream; AMimeType: string; AUnit: TCSSUnit): TSVGImage;
4668 begin
4669 result := TSVGImage.Create(FDoc,Units,FDataLink);
4670 result.x := FloatWithCSSUnit(x, AUnit);
4671 result.y := FloatWithCSSUnit(y, AUnit);
4672 result.width := FloatWithCSSUnit(width, AUnit);
4673 result.height := FloatWithCSSUnit(height, AUnit);
4674 result.SetBitmap(ABitmapStream, AMimeType);
4675 AppendElement(result);
4676 end;
4677
AppendImagenull4678 function TSVGContent.AppendImage(origin, size: TPointF; ABitmapStream: TStream;
4679 AMimeType: string; AUnit: TCSSUnit): TSVGImage;
4680 begin
4681 result := AppendImage(origin.x,origin.y,size.x,size.y,ABitmapStream,AMimeType,AUnit);
4682 end;
4683
TSVGContent.AppendTextnull4684 function TSVGContent.AppendText(x, y: single; AText: string; AUnit: TCSSUnit
4685 ): TSVGText;
4686 var
4687 a: ArrayOfTFloatWithCSSUnit;
4688 begin
4689 result := TSVGText.Create(FDoc,Units,FDataLink);
4690 setlength(a,1);
4691 try
4692 a[0] := FloatWithCSSUnit(x,AUnit);
4693 result.x := a;
4694 a[0] := FloatWithCSSUnit(y,AUnit);
4695 result.y := a;
4696 finally
4697 setlength(a,0);
4698 end;
4699 if AText <> '' then
4700 result.SimpleText:= AText;
4701 AppendElement(result);
4702 end;
4703
TSVGContent.AppendTextnull4704 function TSVGContent.AppendText(origin: TPointF; AText: string; AUnit: TCSSUnit
4705 ): TSVGText;
4706 begin
4707 result := AppendText(origin.x,origin.y,AText,AUnit);
4708 end;
4709
AppendTextSpannull4710 function TSVGContent.AppendTextSpan(AText: string): TSVGTSpan;
4711 begin
4712 result := TSVGTSpan.Create(FDoc,Units,FDataLink);
4713 result.SimpleText:= AText;
4714 AppendElement(result);
4715 end;
4716
TSVGContent.AppendRoundRectnull4717 function TSVGContent.AppendRoundRect(x, y, width, height, rx, ry: single;
4718 AUnit: TCSSUnit): TSVGRectangle;
4719 begin
4720 result := TSVGRectangle.Create(FDoc,Units,FDataLink);
4721 result.x := FloatWithCSSUnit(x,AUnit);
4722 result.y := FloatWithCSSUnit(y,AUnit);
4723 result.width := FloatWithCSSUnit(width,AUnit);
4724 result.height := FloatWithCSSUnit(height,AUnit);
4725 result.rx := FloatWithCSSUnit(rx,AUnit);
4726 result.ry := FloatWithCSSUnit(ry,AUnit);
4727 AppendElement(result);
4728 end;
4729
TSVGContent.AppendRoundRectnull4730 function TSVGContent.AppendRoundRect(origin, size, radius: TPointF;
4731 AUnit: TCSSUnit): TSVGRectangle;
4732 begin
4733 result := AppendRoundRect(origin.x,origin.y,size.x,size.y,radius.x,radius.y,AUnit);
4734 end;
4735
TSVGContent.AppendGroupnull4736 function TSVGContent.AppendGroup: TSVGGroup;
4737 begin
4738 result := TSVGGroup.Create(FDoc, Units, FDataLink);
4739 AppendElement(result);
4740 end;
4741
TSVGContent.IndexOfElementnull4742 function TSVGContent.IndexOfElement(AElement: TObject): integer;
4743 begin
4744 result := FElements.IndexOf(AElement);
4745 end;
4746
4747 end.
4748
4749