source: trunk/Packages/bgrabitmap/bgrasvgtype.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 46.9 KB
Line 
1unit BGRASVGType;
2
3{$mode objfpc}{$H+}
4{$MODESWITCH ADVANCEDRECORDS}
5
6interface
7
8uses
9 Classes, SysUtils, BGRATransform, BGRABitmapTypes, BGRAUnits,
10 laz2_DOM, BGRACanvas2D, fgl, BGRAGraphics;
11
12type
13 ArrayOfFloat = array of single;
14
15 TSVGElement = class;
16 TSVGElementList = specialize TFPGList<TSVGElement>;
17 TSVGFactory = class of TSVGElement;
18
19 TSVGFillMode = (
20 sfmEvenOdd = Ord(fmAlternate),
21 sfmNonZero = Ord(fmWinding)
22 );
23
24 TFindStyleState = (fssNotSearch,
25 fssNotFind,
26 fssFind);
27 TStyleAttribute = record
28 attr : string;
29 pos : integer;
30 end;
31 ArrayOfTStyleAttribute = array of TStyleAttribute;
32
33 { TSVGPreserveAspectRatio }
34
35 TSVGPreserveAspectRatio = record
36 Preserve, Slice: boolean;
37 HorizAlign: TAlignment;
38 VertAlign: TTextLayout;
39 function ToString: string;
40 class function Parse(AValue: string): TSVGPreserveAspectRatio; static;
41 class function DefaultValue: TSVGPreserveAspectRatio; static;
42 end;
43
44 TSVGRecomputeEvent = procedure(Sender: TObject) of object;
45
46 { TSVGDataLink }
47
48 TSVGDataLink = class
49 private
50 FElements,
51 FGradients,
52 FStyles,
53 FRootElements: TSVGElementList;
54 function IsValidID(const id: integer; list: TSVGElementList): boolean;
55 function GetElement(id: integer): TSVGElement;
56 function GetGradient(id: integer): TSVGElement;
57 function GetStyle(id: integer): TSVGElement;
58 function GetRootElement(id: integer): TSVGElement;
59 function FindElement(el: TSVGElement; list: TSVGElementList): integer;
60 function Find(el: TSVGElement): integer;//(find on FElements)
61 procedure InternalLink(const id: integer; parent: TSVGElement);
62 procedure InternalUnLink(const id: integer);
63 procedure InternalReLink(const id: integer; parent: TSVGElement);
64 public
65 constructor Create;
66 destructor Destroy; override;
67
68 function ElementCount: integer;
69 function GradientCount: integer;
70 function StyleCount: integer;
71 //contains the elements at the root of the link tree (having parent = nil)
72 function RootElementCount: integer;
73 function IsLink(el: TSVGElement): boolean;
74 //(Note: assumes that the valid parent is present in the list or added later)
75 function Link(el: TSVGElement; parent: TSVGElement = nil): integer;
76 //excludes el from the list (+ restores validity of links)
77 procedure Unlink(el: TSVGElement);
78 //(faster method than a "for.. Unlink()")
79 procedure UnlinkAll;
80 //Method needed to change the parent of an item without removing it
81 function ReLink(el: TSVGElement; parent: TSVGElement): boolean;
82
83 //(useful for testing support)
84 function GetInternalState: TStringList;
85
86 property Elements[ID: integer]: TSVGElement read GetElement;
87 property Gradients[ID: integer]: TSVGElement read GetGradient;
88 property Styles[ID: integer]: TSVGElement read GetStyle;
89 property RootElements[ID: integer]: TSVGElement read GetRootElement;
90 end;
91
92 { TSVGElement }
93
94 TSVGElement = class
95 private
96 findStyleState: TFindStyleState;
97 styleAttributes: ArrayOfTStyleAttribute;
98 FDataParent: TSVGElement;
99 FDataChildList: TSVGElementList;
100 function GetAttributeOrStyle(AName,ADefault: string): string; overload;
101 function GetAttributeOrStyle(AName: string): string; overload;
102 function GetFill: string;
103 function GetFillColor: TBGRAPixel;
104 function GetFillOpacity: single;
105 function GetFillRule: string;
106 function GetHorizAttributeOrStyleWithUnit(AName: string;
107 ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
108 function GetIsFillNone: boolean;
109 function GetIsStrokeNone: boolean;
110 function GetMatrix(AUnit: TCSSUnit): TAffineMatrix;
111 function GetOpacity: single;
112 function GetOrthoAttributeOrStyleWithUnit(AName: string;
113 ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
114 function GetStroke: string;
115 function GetStrokeColor: TBGRAPixel;
116 function GetStrokeLineCap: string;
117 function GetStrokeLineJoin: string;
118 function GetStrokeMiterLimit: single;
119 function GetStrokeOpacity: single;
120 function GetStrokeWidth: TFloatWithCSSUnit;
121 function GetStrokeDashArray: string;
122 function GetStrokeDashArrayF: ArrayOfFloat;
123 function GetStrokeDashOffset: TFloatWithCSSUnit;
124 function GetStyle(const AName,ADefault: string): string; overload;
125 function GetStyle(const AName: string): string; overload;
126 function GetTransform: string;
127 function GetUnits: TCSSUnitConverter;
128 function GetAttribute(AName,ADefault: string; ACanInherit: boolean): string; overload;
129 function GetAttribute(AName,ADefault: string): string; overload;
130 function GetAttribute(AName: string): string; overload;
131 function GetVerticalAttributeOrStyleWithUnit(AName: string;
132 ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
133 procedure SetAttribute(AName: string; AValue: string);
134 function GetAttributeWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload;
135 function GetAttributeWithUnit(AName: string): TFloatWithCSSUnit; overload;
136 function GetAttributeOrStyleWithUnit(AName: string;
137 ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload;
138 function GetAttributeOrStyleWithUnit(AName: string): TFloatWithCSSUnit; overload;
139 function GetOrthoAttributeWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload;
140 function GetOrthoAttributeWithUnit(AName: string): TFloatWithCSSUnit; overload;
141 function GetHorizAttributeWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload;
142 function GetHorizAttributeWithUnit(AName: string): TFloatWithCSSUnit; overload;
143 function GetVerticalAttributeWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload;
144 function GetVerticalAttributeWithUnit(AName: string): TFloatWithCSSUnit; overload;
145 function GetID: string;
146 function GetClassAt: string;
147 procedure SetAttributeWithUnit(AName: string; AValue: TFloatWithCSSUnit);
148 procedure SetFill(AValue: string);
149 procedure SetFillColor(AValue: TBGRAPixel);
150 procedure SetFillOpacity(AValue: single);
151 procedure SetFillRule(AValue: string);
152 procedure SetHorizAttributeWithUnit(AName: string; AValue: TFloatWithCSSUnit);
153 procedure SetMatrix(AUnit: TCSSUnit; const AValue: TAffineMatrix);
154 procedure SetOpacity(AValue: single);
155 procedure SetStroke(AValue: string);
156 procedure SetStrokeColor(AValue: TBGRAPixel);
157 procedure SetStrokeLineCap(AValue: string);
158 procedure SetStrokeLineJoin(AValue: string);
159 procedure SetStrokeMiterLimit(AValue: single);
160 procedure SetStrokeOpacity(AValue: single);
161 procedure SetStrokeWidth(AValue: TFloatWithCSSUnit);
162 procedure SetStrokeDashArray(AValue: string);
163 procedure SetStrokeDashArrayF(AValue: ArrayOfFloat);
164 procedure SetStrokeDashOffset(AValue: TFloatWithCSSUnit);
165 procedure SetStyle(AName: string; AValue: string);
166 procedure SetTransform(AValue: string);
167 procedure SetVerticalAttributeWithUnit(AName: string; AValue: TFloatWithCSSUnit);
168 procedure SetOrthoAttributeWithUnit(AName: string; AValue: TFloatWithCSSUnit);
169 procedure SetID(AValue: string);
170 procedure SetClassAt(AValue: string);
171 function FindStyleElementInternal(const classStr: string;
172 out attributesStr: string): integer;
173 procedure FindStyleElement;
174 protected
175 FDataLink: TSVGDataLink;
176 FDomElem: TDOMElement;
177 FUnits: TCSSUnitConverter;
178 function GetDOMElement: TDOMElement; virtual;
179 procedure Init(ADocument: TXMLDocument; ATag: string; AUnits: TCSSUnitConverter); overload;
180 procedure Init({%H-}ADocument: TXMLDocument; AElement: TDOMElement; AUnits: TCSSUnitConverter); overload;
181 procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); virtual;
182 procedure LocateStyleDeclaration(AText: string; AProperty: string; out AStartPos,AColonPos,AValueLength: integer);
183 procedure ApplyFillStyle(ACanvas2D: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); virtual;
184 procedure ApplyStrokeStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit);
185 procedure Initialize; virtual;
186 public
187 constructor Create({%H-}ADocument: TXMLDocument; AElement: TDOMElement; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); overload; virtual;
188 constructor Create({%H-}ADocument: TXMLDocument; {%H-}AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); overload; virtual;
189 destructor Destroy; override;
190 procedure Recompute; virtual;
191 procedure Draw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit);
192 procedure fillNone;
193 procedure strokeNone;
194 procedure transformNone;
195 procedure RemoveStyle(const AName: string);
196 function HasAttribute(AName: string): boolean;
197 function fillMode: TSVGFillMode;
198 function DataChildList: TSVGElementList;
199 property DataLink: TSVGDataLink read FDataLink write FDataLink;
200 property AttributeDef[AName,ADefault: string]: string read GetAttribute;
201 property Attribute[AName: string]: string read GetAttribute write SetAttribute;
202 property AttributeOrStyleDef[AName,ADefault: string]: string read GetAttributeOrStyle;
203 property AttributeOrStyle[AName: string]: string read GetAttributeOrStyle;
204 property StyleDef[AName,ADefault: string]: string read GetStyle;
205 property Style[AName: string]: string read GetStyle write SetStyle;
206 property AttributeWithUnitDef[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetAttributeWithUnit;
207 property AttributeWithUnit[AName: string]: TFloatWithCSSUnit read GetAttributeWithUnit write SetAttributeWithUnit;
208 property OrthoAttributeWithUnitDef[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetOrthoAttributeWithUnit;
209 property OrthoAttributeWithUnit[AName: string]: TFloatWithCSSUnit read GetOrthoAttributeWithUnit write SetOrthoAttributeWithUnit;
210 property HorizAttributeWithUnitDef[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetHorizAttributeWithUnit;
211 property HorizAttributeWithUnit[AName: string]: TFloatWithCSSUnit read GetHorizAttributeWithUnit write SetHorizAttributeWithUnit;
212 property VerticalAttributeWithUnitDef[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetVerticalAttributeWithUnit;
213 property VerticalAttributeWithUnit[AName: string]: TFloatWithCSSUnit read GetVerticalAttributeWithUnit write SetVerticalAttributeWithUnit;
214 property OrthoAttributeOrStyleWithUnit[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetOrthoAttributeOrStyleWithUnit;
215 property HorizAttributeOrStyleWithUnit[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetHorizAttributeOrStyleWithUnit;
216 property VerticalAttributeOrStyleWithUnit[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetVerticalAttributeOrStyleWithUnit;
217 property DOMElement: TDOMElement read GetDOMElement;
218 property Units: TCSSUnitConverter read GetUnits;
219 property transform: string read GetTransform write SetTransform;
220 property matrix[AUnit: TCSSUnit]: TAffineMatrix read GetMatrix write SetMatrix;
221 property isFillNone: boolean read GetIsFillNone;
222 property isStrokeNone: boolean read GetIsStrokeNone;
223 property stroke: string read GetStroke write SetStroke;
224 property strokeWidth: TFloatWithCSSUnit read GetStrokeWidth write SetStrokeWidth;
225 property strokeColor: TBGRAPixel read GetStrokeColor write SetStrokeColor;
226 property strokeOpacity: single read GetStrokeOpacity write SetStrokeOpacity;
227 property strokeMiterLimit: single read GetStrokeMiterLimit write SetStrokeMiterLimit;
228 property strokeLineJoin: string read GetStrokeLineJoin write SetStrokeLineJoin;
229 property strokeLineCap: string read GetStrokeLineCap write SetStrokeLineCap;
230 property strokeDashArray: string read GetStrokeDashArray write SetStrokeDashArray;
231 property strokeDashArrayF: ArrayOfFloat read GetStrokeDashArrayF write SetStrokeDashArrayF;
232 property strokeDashOffset: TFloatWithCSSUnit read GetStrokeDashOffset write SetStrokeDashOffset;
233 property fill: string read GetFill write SetFill;
234 property fillColor: TBGRAPixel read GetFillColor write SetFillColor;
235 property fillOpacity: single read GetFillOpacity write SetFillOpacity;
236 property fillRule: string read GetFillRule write SetFillRule;
237 property opacity: single read GetOpacity write SetOpacity;
238 property ID: string read GetID write SetID;
239 property classAt: string read GetClassAt write SetClassAt;//Attribute "class"
240 property DataParent: TSVGElement read FDataParent write FDataParent;
241 end;
242
243 { TSVGParser }
244
245 TSVGParser = class
246 private
247 function GetDone: boolean;
248 protected
249 FPos: integer;
250 FNumberError: boolean;
251 FText: string;
252 public
253 constructor Create(AText: string);
254 function ParseFloat: single;
255 function ParseId: string;
256 function ParseSymbol: char;
257 function ParseTransform: TAffineMatrix;
258 procedure SkipSymbol(ASymbol: char);
259 procedure SkipUpToSymbol(ASymbol:char);
260 procedure ClearError;
261 property Position: integer read FPos write FPos;
262 property NumberError: boolean read FNumberError;
263 property Text: string read FText;
264 property Done: boolean read GetDone;
265 end;
266
267 resourcestring
268 rsInvalidId = 'invalid id';
269
270implementation
271
272uses BGRASVGShapes;
273
274{ TSVGPreserveAspectRatio }
275
276function TSVGPreserveAspectRatio.ToString: string;
277begin
278 if not Preserve then result := 'none' else
279 begin
280 result := '';
281 case HorizAlign of
282 taCenter: result += 'xMid';
283 taRightJustify: result += 'xMax';
284 else result += 'xMin';
285 end;
286 case VertAlign of
287 tlCenter: result += 'YMid';
288 tlBottom: result += 'YMax';
289 else result += 'YMin';
290 end;
291 if Slice then result += ' slice' else result += ' meet';
292 end;
293end;
294
295class function TSVGPreserveAspectRatio.Parse(AValue: string
296 ): TSVGPreserveAspectRatio;
297var p: TSVGParser;
298 id: string;
299begin
300 p := TSVGParser.Create(AValue);
301 result := DefaultValue;
302 repeat
303 id := p.ParseId;
304 if id = 'none' then
305 begin
306 result.Preserve := false;
307 //set other parameters for intermediate value of ViewSize (before stretching non-proportionaly)
308 result.Slice := false;
309 result.HorizAlign := taCenter;
310 result.VertAlign := tlCenter;
311 exit;
312 end else
313 if id = 'slice' then result.Slice := true
314 else if (length(id)=8) and (id[1] = 'x') and (id[5] = 'Y') then
315 begin
316 case copy(id,2,3) of
317 'Min': result.HorizAlign := taLeftJustify;
318 'Mid': result.HorizAlign := taCenter;
319 'Max': result.HorizAlign := taRightJustify;
320 end;
321 case copy(id,6,3) of
322 'Min': result.VertAlign := tlTop;
323 'Mid': result.VertAlign := tlCenter;
324 'Max': result.VertAlign := tlBottom;
325 end;
326 end;
327 until id = '';
328 p.Free;
329end;
330
331class function TSVGPreserveAspectRatio.DefaultValue: TSVGPreserveAspectRatio;
332begin
333 result.Preserve := true;
334 result.Slice := false;
335 result.HorizAlign := taCenter;
336 result.VertAlign := tlCenter;
337end;
338
339{ TSVGParser }
340
341function TSVGParser.GetDone: boolean;
342begin
343 result := FPos>length(FText)
344end;
345
346constructor TSVGParser.Create(AText: string);
347begin
348 FNumberError:= false;
349 FPos := 1;
350 FText := AText;
351end;
352
353function TSVGParser.ParseFloat: single;
354var numberStart: integer;
355 errPos: integer;
356begin
357 while (FPos <= length(FText)) and (FText[FPos] in[#0..#32,',']) do inc(FPos);
358 numberStart:= FPos;
359 if (FPos <= length(FText)) and (FText[FPos] in['+','-']) then inc(FPos);
360 while (FPos <= length(FText)) and (FText[FPos] in['0'..'9','.']) do inc(FPos);
361 if (FPos <= length(FText)) and (FText[FPos] in['e','E']) then inc(FPos);
362 if (FPos <= length(FText)) and (FText[FPos] in['+','-']) then inc(FPos);
363 while (FPos <= length(FText)) and (FText[FPos] in['0'..'9','.']) do inc(FPos);
364 if FPos = numberStart then
365 begin
366 FNumberError := true;
367 result := 0;
368 end
369 else
370 begin
371 val(copy(FText,numberStart,FPos-numberStart),result,errPos);
372 if errPos <> 0 then FNumberError := true;
373 end;
374end;
375
376function TSVGParser.ParseId: string;
377var idStart: integer;
378begin
379 while (FPos <= length(FText)) and (FText[FPos] in[#0..#32,',']) do inc(FPos);
380 idStart:= FPos;
381 if (FPos <= length(FText)) and (FText[FPos] in['A'..'Z','a'..'z']) then inc(FPos);
382 while (FPos <= length(FText)) and (FText[FPos] in['0'..'9','A'..'Z','a'..'z','_']) do inc(FPos);
383 result := copy(FText,idStart,FPos-idStart);
384end;
385
386function TSVGParser.ParseSymbol: char;
387begin
388 while (FPos <= length(FText)) and (FText[FPos] in[#0..#32,',']) do inc(FPos);
389 if (FPos <= length(FText)) and not (FText[FPos] in['A'..'Z','a'..'z','0'..'9']) then
390 begin
391 result := FText[FPos];
392 inc(FPos);
393 end else
394 result := #0;
395end;
396
397function TSVGParser.ParseTransform: TAffineMatrix;
398var
399 kind: String;
400 m : TAffineMatrix;
401 angle,tx,ty: single;
402begin
403 result := AffineMatrixIdentity;
404 while not Done do
405 begin
406 kind := ParseId;
407 if kind = '' then break;
408 if ParseSymbol <> '(' then break;
409 if compareText(kind,'matrix')=0 then
410 begin
411 m[1,1] := ParseFloat;
412 SkipSymbol(',');
413 m[2,1] := ParseFloat;
414 SkipSymbol(',');
415 m[1,2] := ParseFloat;
416 SkipSymbol(',');
417 m[2,2] := ParseFloat;
418 SkipSymbol(',');
419 m[1,3] := ParseFloat;
420 SkipSymbol(',');
421 m[2,3] := ParseFloat;
422 result *= m;
423 end else
424 if compareText(kind,'translate')=0 then
425 begin
426 tx := ParseFloat;
427 SkipSymbol(',');
428 ty := ParseFloat;
429 result *= AffineMatrixTranslation(tx,ty);
430 end else
431 if compareText(kind,'scale')=0 then
432 begin
433 tx := ParseFloat;
434 SkipSymbol(',');
435 ClearError;
436 ty := ParseFloat;
437 if NumberError then ty := tx;
438 result *= AffineMatrixScale(tx,ty);
439 end else
440 if compareText(kind,'rotate')=0 then
441 begin
442 angle := ParseFloat;
443 SkipSymbol(',');
444 tx := ParseFloat;
445 SkipSymbol(',');
446 ty := ParseFloat;
447 result *= AffineMatrixTranslation(tx,ty)*AffineMatrixRotationDeg(angle)*
448 AffineMatrixTranslation(-tx,-ty);
449 end else
450 if compareText(kind,'skewx')=0 then
451 begin
452 angle := ParseFloat;
453 result *= AffineMatrixSkewXDeg(angle);
454 end else
455 if compareText(kind,'skewy')=0 then
456 begin
457 angle := ParseFloat;
458 result *= AffineMatrixSkewYDeg(angle);
459 end;
460 SkipUpToSymbol(')');
461 end;
462end;
463
464procedure TSVGParser.SkipSymbol(ASymbol: char);
465begin
466 while (FPos <= length(FText)) and (FText[FPos] in[#0..#32,',']) do inc(FPos);
467 if (FPos <= length(FText)) and (FText[FPos] = ASymbol) then inc(FPos);
468end;
469
470procedure TSVGParser.SkipUpToSymbol(ASymbol: char);
471begin
472 while (FPos <= length(FText)) and (FText[FPos]<>ASymbol) do inc(FPos);
473 if (FPos <= length(FText)) and (FText[FPos]=ASymbol) then inc(FPos);
474end;
475
476procedure TSVGParser.ClearError;
477begin
478 FNumberError:= false;
479end;
480
481{ TSVGDataLink }
482
483constructor TSVGDataLink.Create;
484begin
485 FElements:= TSVGElementList.Create;
486 FGradients:= TSVGElementList.Create;
487 FStyles:= TSVGElementList.Create;
488 FRootElements:= TSVGElementList.Create;
489end;
490
491destructor TSVGDataLink.Destroy;
492begin
493 FreeAndNil(FRootElements);
494 FreeAndNil(FGradients);
495 FreeAndNil(FElements);
496 FreeAndNil(FStyles);
497 inherited Destroy;
498end;
499
500function TSVGDataLink.IsValidID(const id: integer; list: TSVGElementList): boolean;
501begin
502 result:= (id >= 0) and (id < list.Count);
503end;
504
505function TSVGDataLink.GetElement(id: integer): TSVGElement;
506begin
507 if not IsValidID(id,FElements) then
508 raise exception.Create(rsInvalidId);
509 result:= FElements[id];
510end;
511
512function TSVGDataLink.GetGradient(id: integer): TSVGElement;
513begin
514 if not IsValidID(id,FGradients) then
515 raise exception.Create(rsInvalidId);
516 result:= FGradients[id];
517end;
518
519function TSVGDataLink.GetStyle(id: integer): TSVGElement;
520begin
521 if not IsValidID(id,FStyles) then
522 raise exception.Create(rsInvalidId);
523 result:= FStyles[id];
524end;
525
526function TSVGDataLink.GetRootElement(id: integer): TSVGElement;
527begin
528 if not IsValidID(id,FRootElements) then
529 raise exception.Create(rsInvalidId);
530 result:= FRootElements[id];
531end;
532
533function TSVGDataLink.FindElement(el: TSVGElement; list: TSVGElementList): integer;
534var
535 i: integer;
536begin
537 for i:= 0 to list.Count-1 do
538 if list[i] = el then
539 begin
540 result:= i;
541 Exit;
542 end;
543 result:= -1;
544end;
545
546function TSVGDataLink.Find(el: TSVGElement): integer;
547begin
548 result:= FindElement(el,FElements);
549end;
550
551procedure TSVGDataLink.InternalLink(const id: integer; parent: TSVGElement);
552var
553 el: TSVGElement;
554begin
555 el:= FElements.Items[id];
556 with el do
557 begin
558 DataParent:= parent;
559 if parent = nil then
560 FRootElements.Add(el);
561 //Update DataChildList of "parent" before add it
562 //(not use el.DataChildList.Clear here!!)
563 if parent <> nil then
564 parent.DataChildList.Add(el);
565 end;
566end;
567
568procedure TSVGDataLink.InternalUnLink(const id: integer);
569var
570 i,pos_root: integer;
571 el: TSVGElement;
572begin
573 el:= FElements.Items[id];
574 with el do
575 begin
576 //se root need remove (use pos for add child as new root)
577 if DataParent = nil then
578 pos_root:= FRootElements.Remove(el)
579 else
580 pos_root:= FRootElements.Count;
581 //i have to assign a parent of a upper level
582 //and update child list of new parent (if not nil)
583 with DataChildList do
584 begin
585 for i:= 0 to Count-1 do
586 begin
587 Items[i].DataParent:= el.DataParent;
588 if el.DataParent = nil then
589 //with parent nil = new root
590 FRootElements.Insert(pos_root+i, Items[i])
591 else
592 el.DataParent.DataChildList.Add( Items[i] );
593 end;
594 Clear;
595 end;
596 //if he has a parent, I have to remove his reference as a child
597 if DataParent <> nil then
598 begin
599 DataParent.DataChildList.Remove(el);
600 DataParent:= nil;
601 end;
602 end;
603end;
604
605procedure TSVGDataLink.InternalReLink(const id: integer; parent: TSVGElement);
606begin
607 InternalUnLink(id);
608 InternalLink(id,parent);
609end;
610
611function TSVGDataLink.ElementCount: integer;
612begin
613 result:= FElements.Count;
614end;
615
616function TSVGDataLink.GradientCount: integer;
617begin
618 result:= FGradients.Count;
619end;
620
621function TSVGDataLink.StyleCount: integer;
622begin
623 result:= FStyles.Count;
624end;
625
626function TSVGDataLink.RootElementCount: integer;
627begin
628 result:= FRootElements.Count;
629end;
630
631function TSVGDataLink.IsLink(el: TSVGElement): boolean;
632begin
633 result:= Find(el) <> -1;
634end;
635
636function TSVGDataLink.Link(el: TSVGElement; parent: TSVGElement = nil): integer;
637begin
638 FElements.Add(el);
639 result:= FElements.Count-1;
640 InternalLink(result,parent);
641 if el is TSVGGradient then
642 FGradients.Add(el)
643 else if el is TSVGStyle then
644 FStyles.Add(el);
645end;
646
647procedure TSVGDataLink.Unlink(el: TSVGElement);
648var
649 id: integer;
650begin
651 id:= FindElement(el,FElements);
652 if id <> -1 then
653 begin
654 if el is TSVGGradient then
655 FGradients.Remove(el)
656 else if el is TSVGStyle then
657 FStyles.Remove(el);
658 InternalUnLink(id);
659 FElements.Delete(id);
660 end
661 else
662 raise exception.Create('element not find');
663end;
664
665procedure TSVGDataLink.UnlinkAll;
666var
667 i: integer;
668begin
669 FGradients.Clear;
670 FStyles.Clear;
671
672 for i:= 0 to FElements.Count-1 do
673 InternalUnLink(i);
674 FRootElements.Clear;
675 FElements.Clear;
676end;
677
678function TSVGDataLink.ReLink(el: TSVGElement; parent: TSVGElement): boolean;
679var
680 id: integer;
681begin
682 id:= FindElement(el,FElements);
683 if id <> -1 then
684 begin
685 result:= true;
686 if el.DataParent <> parent then
687 InternalReLink(id,parent);
688 end
689 else
690 result:= false;
691end;
692
693function TSVGDataLink.GetInternalState: TStringList;
694var
695 nid: integer;
696 sl: TStringList;
697
698 function SpaceStr(const level: integer): string;
699 var
700 i: integer;
701 begin
702 result:= '';
703 for i:= 1 to level do
704 result:= result + ' ';
705 end;
706
707 procedure AddStr(s: string; const level: integer);
708 begin
709 sl.Add( SpaceStr(level) + s );
710 end;
711
712 function ElementIdentity(el: TSVGElement): string;
713 begin
714 if el = nil then
715 result:= 'nil'
716 else
717 begin
718 result:= el.ID;
719 if Trim(Result) = '' then
720 result:= 'unknow';
721 result:= result + ' - ' + el.ClassName +
722 //(slow: for test ok)
723 ' | (pos: ' + IntToStr( Find(el) ) + ')';
724 end;
725 end;
726
727 procedure ElementToInfo(el: TSVGElement; const level: integer);
728 Var
729 i: integer;
730 sep: string;
731 begin
732 if el.DataParent = nil then
733 sep:= '###'
734 else
735 sep:= '***';
736 AddStr('{'+sep+' '+ElementIdentity(el)+' '+sep+'}', level);
737 AddStr('[Parent: ' + ElementIdentity(el.DataParent) + ']', level);
738 for i:= 0 to el.DataChildList.Count-1 do
739 AddStr('[Child: ' + ElementIdentity(el.DataChildList[i]) + ']', level);
740 end;
741
742 procedure BuildInfo(el: TSVGElement; const level: integer = 1);
743 const
744 kspace = 5;
745 var
746 i: Integer;
747 begin
748 ElementToInfo(el,level);
749 Inc(nid);
750 for i:= 0 to el.DataChildList.Count-1 do
751 BuildInfo(el.DataChildList[i],level+kspace);
752 end;
753
754var
755 i: integer;
756begin
757 nid:= 0;
758 sl:= TStringList.Create;
759 for i:= 0 to FRootElements.Count-1 do
760 BuildInfo( FRootElements[i] );
761 result:= sl;
762end;
763
764{ TSVGElement }
765
766function TSVGElement.GetAttribute(AName,ADefault: string; ACanInherit: boolean): string;
767var
768 curNode: TDOMElement;
769begin
770 curNode := FDomElem;
771 repeat
772 result := Trim(curNode.GetAttribute(AName));
773 if (result = 'currentColor') and (AName <> 'color') then
774 begin
775 AName := 'color';
776 curNode := FDomElem; //get from the current element
777 ACanInherit:= true;
778 result := Trim(curNode.GetAttribute(AName));
779 end;
780 if ((result = '') or (result = 'inherit')) and ACanInherit and
781 (curNode.ParentNode is TDOMElement) then
782 curNode := curNode.ParentNode as TDOMElement
783 else
784 curNode := nil;
785 until curNode = nil;
786
787 if (result = '') or (result = 'inherit') then
788 result:= ADefault;
789end;
790
791function TSVGElement.GetAttribute(AName, ADefault: string): string;
792begin
793 result := GetAttribute(AName, ADefault, False);
794end;
795
796function TSVGElement.GetAttribute(AName: string): string;
797begin
798 result:= GetAttribute(AName,'');
799end;
800
801function TSVGElement.GetVerticalAttributeOrStyleWithUnit(AName: string;
802 ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
803begin
804 result := GetAttributeOrStyleWithUnit(AName,ADefault);
805 if result.CSSUnit <> cuCustom then
806 if units.DpiScaleY = 0 then
807 result.value := 0
808 else
809 result.value /= Units.DpiScaleY;
810end;
811
812function TSVGElement.GetAttributeWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
813begin
814 result := TCSSUnitConverter.parseValue(Attribute[AName],ADefault);
815end;
816
817function TSVGElement.GetAttributeWithUnit(AName: string): TFloatWithCSSUnit;
818begin
819 result := GetAttributeWithUnit(AName,FloatWithCSSUnit(0,cuCustom));
820end;
821
822function TSVGElement.GetAttributeOrStyleWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
823var
824 valueText: string;
825begin
826 valueText := Style[AName];
827 if valueText = '' then
828 valueText := GetAttribute(AName,'',True);
829 result := TCSSUnitConverter.parseValue(valueText,ADefault);
830end;
831
832function TSVGElement.GetAttributeOrStyleWithUnit(AName: string): TFloatWithCSSUnit;
833begin
834 result := GetAttributeOrStyleWithUnit(AName,FloatWithCSSUnit(0,cuCustom));
835end;
836
837function TSVGElement.GetOrthoAttributeWithUnit(AName: string;
838 ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
839begin
840 result := GetHorizAttributeWithUnit(AName,ADefault);
841 //value will be inconsistent if scaling is inconsistent
842end;
843
844function TSVGElement.GetOrthoAttributeWithUnit(AName: string): TFloatWithCSSUnit;
845begin
846 result := GetOrthoAttributeWithUnit(AName,FloatWithCSSUnit(0,cuCustom));
847end;
848
849function TSVGElement.GetHorizAttributeWithUnit(AName: string;
850 ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
851begin
852 result := GetAttributeWithUnit(AName,ADefault);
853 if result.value <> EmptySingle then
854 begin
855 if result.CSSUnit <> cuCustom then
856 if units.DpiScaleX = 0 then
857 result.value := 0
858 else
859 result.value /= Units.DpiScaleX;
860 end;
861end;
862
863function TSVGElement.GetHorizAttributeWithUnit(AName: string): TFloatWithCSSUnit;
864begin
865 result := GetHorizAttributeWithUnit(AName,FloatWithCSSUnit(0,cuCustom));
866end;
867
868function TSVGElement.GetAttributeOrStyle(AName,ADefault: string): string;
869begin
870 result := GetStyle(AName,ADefault);
871 if result = '' then
872 result := GetAttribute(AName,ADefault,True);
873end;
874
875function TSVGElement.GetAttributeOrStyle(AName: string): string;
876begin
877 result:= GetAttributeOrStyle(AName,'');
878end;
879
880function TSVGElement.GetFill: string;
881begin
882 result := AttributeOrStyleDef['fill','black'];
883end;
884
885function TSVGElement.GetFillColor: TBGRAPixel;
886begin
887 result := StrToBGRA(fill,BGRABlack);
888 result.alpha := round(result.alpha*fillOpacity*opacity);
889 if result.alpha = 0 then result := BGRAPixelTransparent;
890end;
891
892function TSVGElement.GetFillOpacity: single;
893var errPos: integer;
894begin
895 val(AttributeOrStyleDef['fill-opacity','1'], result, errPos);
896 if errPos <> 0 then result := 1 else
897 if result < 0 then result := 0 else
898 if result > 1 then result := 1;
899end;
900
901function TSVGElement.GetFillRule: string;
902begin
903 result := AttributeOrStyleDef['fill-rule','nonzero'];
904end;
905
906function TSVGElement.GetHorizAttributeOrStyleWithUnit(AName: string;
907 ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
908begin
909 result := GetAttributeOrStyleWithUnit(AName,ADefault);
910 if result.CSSUnit <> cuCustom then
911 if units.DpiScaleX = 0 then
912 result.value := 0
913 else
914 result.value /= Units.DpiScaleX;
915end;
916
917function TSVGElement.GetIsFillNone: boolean;
918begin
919 result := compareText(trim(fill),'none')=0;
920end;
921
922function TSVGElement.GetIsStrokeNone: boolean;
923var strokeStr: string;
924begin
925 strokeStr := stroke;
926 result := (trim(strokeStr)='') or (compareText(trim(strokeStr),'none')=0);
927end;
928
929function TSVGElement.GetMatrix(AUnit: TCSSUnit): TAffineMatrix;
930var parser: TSVGParser;
931 s: string;
932begin
933 s := transform;
934 if s='' then
935 begin
936 result := AffineMatrixIdentity;
937 exit;
938 end;
939 parser := TSVGParser.Create(s);
940 result := parser.ParseTransform;
941 result[1,3] := Units.ConvertWidth(result[1,3],cuCustom,AUnit);
942 result[2,3] := Units.ConvertHeight(result[2,3],cuCustom,AUnit);
943 parser.Free;
944end;
945
946function TSVGElement.GetOpacity: single;
947var errPos: integer;
948begin
949 val(AttributeOrStyleDef['opacity','1'], result, errPos);
950 if errPos <> 0 then result := 1 else
951 if result < 0 then result := 0 else
952 if result > 1 then result := 1;
953end;
954
955function TSVGElement.GetOrthoAttributeOrStyleWithUnit(AName: string;
956 ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
957begin
958 result := GetHorizAttributeOrStyleWithUnit(AName,ADefault);
959 //value will be inconsistent if scaling is inconsistent
960end;
961
962function TSVGElement.GetStroke: string;
963begin
964 result := AttributeOrStyleDef['stroke','none'];
965end;
966
967function TSVGElement.GetStrokeColor: TBGRAPixel;
968begin
969 result := StrToBGRA(stroke);
970 result.alpha := round(result.alpha*strokeOpacity*opacity);
971 if result.alpha = 0 then result := BGRAPixelTransparent;
972end;
973
974function TSVGElement.GetStrokeLineCap: string;
975begin
976 result := AttributeOrStyleDef['stroke-linecap','butt'];
977end;
978
979function TSVGElement.GetStrokeLineJoin: string;
980begin
981 result := AttributeOrStyleDef['stroke-linejoin','miter'];
982end;
983
984function TSVGElement.GetStrokeMiterLimit: single;
985var errPos: integer;
986begin
987 val(AttributeOrStyleDef['stroke-miterlimit','4'], result, errPos);
988 if errPos <> 0 then result := 4 else
989 if result < 1 then result := 1;
990end;
991
992function TSVGElement.GetStrokeOpacity: single;
993var errPos: integer;
994begin
995 val(AttributeOrStyleDef['stroke-opacity','1'], result, errPos);
996 if errPos <> 0 then result := 1 else
997 if result < 0 then result := 0 else
998 if result > 1 then result := 1;
999end;
1000
1001function TSVGElement.GetStrokeWidth: TFloatWithCSSUnit;
1002begin
1003 result := OrthoAttributeOrStyleWithUnit['stroke-width',FloatWithCSSUnit(1,cuCustom)];
1004end;
1005
1006function TSVGElement.GetStrokeDashArray: string;
1007begin
1008 result := AttributeDef['stroke-dasharray','none'];
1009end;
1010
1011function TSVGElement.GetStrokeDashArrayF: ArrayOfFloat;
1012var
1013 parser: TSVGParser;
1014 nvalue,i: integer;
1015 s_array: String;
1016begin
1017 s_array:= strokeDashArray;
1018 if s_array = 'none' then
1019 begin
1020 setlength(Result,0);
1021 exit;
1022 end;
1023 parser:=TSVGParser.Create(s_array);
1024 nvalue := 0;
1025 repeat
1026 parser.ParseFloat;
1027 if not parser.NumberError then
1028 inc(nvalue);
1029 until parser.NumberError or parser.Done;
1030 parser.ClearError;
1031 setlength(Result,nvalue);
1032 parser.Position := 1;
1033 for i := 0 to high(result) do
1034 result[i] := parser.ParseFloat;
1035 parser.Free;
1036end;
1037
1038function TSVGElement.GetStrokeDashOffset: TFloatWithCSSUnit;
1039begin
1040 result := OrthoAttributeWithUnit['stroke-dashoffset'];
1041end;
1042
1043function TSVGElement.GetStyle(const AName,ADefault: string): string;
1044
1045 function GetInternal(const ruleset: string): string;
1046 var
1047 startPos, colonPos, valueLength: integer;
1048 begin
1049 LocateStyleDeclaration(ruleset, AName, startPos,colonPos, valueLength);
1050 if valueLength <> -1 then
1051 result := trim(copy(ruleset, colonPos+1, valueLength))
1052 else
1053 result := '';
1054 end;
1055
1056var
1057 i: integer;
1058begin
1059 result:= '';
1060
1061 //Find on <style> block (priority!)
1062 //if "not search"..search
1063 if findStyleState = fssNotSearch then
1064 FindStyleElement;
1065 //if "find"..use
1066 if findStyleState <> fssNotFind then
1067 for i:= Length(styleAttributes)-1 downto 0 do
1068 begin
1069 result:= GetInternal(styleAttributes[i].attr);
1070 if result <> '' then
1071 Break;
1072 end;
1073
1074 if result = '' then
1075 result:= GetInternal( Attribute['style',ADefault] );
1076end;
1077
1078function TSVGElement.GetStyle(const AName: string): string;
1079begin
1080 result:= GetStyle(AName,'');
1081end;
1082
1083function TSVGElement.GetTransform: string;
1084begin
1085 result := Attribute['transform'];
1086end;
1087
1088function TSVGElement.GetUnits: TCSSUnitConverter;
1089begin
1090 result := FUnits;
1091end;
1092
1093function TSVGElement.GetVerticalAttributeWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
1094begin
1095 result := GetAttributeWithUnit(AName,ADefault);
1096 if result.value <> EmptySingle then
1097 begin
1098 if result.CSSUnit <> cuCustom then
1099 if units.DpiScaleY = 0 then
1100 result.value := 0
1101 else
1102 result.value /= Units.DpiScaleY;
1103 end;
1104end;
1105
1106function TSVGElement.GetVerticalAttributeWithUnit(AName: string): TFloatWithCSSUnit;
1107begin
1108 result := GetVerticalAttributeWithUnit(AName,FloatWithCSSUnit(0,cuCustom));
1109end;
1110
1111function TSVGElement.GetDOMElement: TDOMElement;
1112begin
1113 result := FDomElem;
1114end;
1115
1116function TSVGElement.GetID: string;
1117begin
1118 result := Attribute['id'];
1119end;
1120
1121function TSVGElement.GetClassAt: string;
1122begin
1123 result := Attribute['class'];
1124end;
1125
1126procedure TSVGElement.SetAttribute(AName: string; AValue: string);
1127begin
1128 FDomElem.SetAttribute(AName,AValue);
1129end;
1130
1131procedure TSVGElement.SetAttributeWithUnit(AName: string;
1132 AValue: TFloatWithCSSUnit);
1133begin
1134 Attribute[AName] := TCSSUnitConverter.formatValue(AValue);
1135end;
1136
1137procedure TSVGElement.SetFill(AValue: string);
1138begin
1139 Attribute['fill'] := AValue;
1140 RemoveStyle('fill');
1141end;
1142
1143procedure TSVGElement.SetFillColor(AValue: TBGRAPixel);
1144begin
1145 fillOpacity:= AValue.alpha/255;
1146 AValue.alpha:= 255;
1147 fill := BGRAToStr(AValue, CSSColors);
1148end;
1149
1150procedure TSVGElement.SetFillOpacity(AValue: single);
1151begin
1152 Attribute['fill-opacity'] := Units.formatValue(AValue);
1153 RemoveStyle('fill-opacity');
1154end;
1155
1156procedure TSVGElement.SetFillRule(AValue: string);
1157begin
1158 Attribute['fill-rule'] := AValue;
1159 RemoveStyle('fill-rule');
1160end;
1161
1162procedure TSVGElement.SetHorizAttributeWithUnit(AName: string;
1163 AValue: TFloatWithCSSUnit);
1164begin
1165 if Units.DpiScaled then
1166 SetAttribute(AName, TCSSUnitConverter.formatValue(Units.ConvertWidth(AValue,cuCustom)))
1167 else
1168 if AValue.CSSUnit <> cuCustom then
1169 SetAttributeWithUnit(AName, FloatWithCSSUnit(AValue.value*Units.DpiScaleX,AValue.CSSUnit))
1170 else
1171 SetAttributeWithUnit(AName, AValue);
1172end;
1173
1174procedure TSVGElement.SetMatrix(AUnit: TCSSUnit; const AValue: TAffineMatrix);
1175var m: TAffineMatrix;
1176 s: string;
1177 translateStr: string;
1178begin
1179 translateStr := 'translate('+Units.formatValue(Units.ConvertWidth(AValue[1,3],AUnit,cuCustom))+' '+
1180 Units.formatValue(Units.ConvertHeight(AValue[2,3],AUnit,cuCustom))+')';
1181 if IsAffineMatrixTranslation(AValue) then
1182 begin
1183 if IsAffineMatrixIdentity(AValue) then
1184 begin
1185 transformNone;
1186 exit;
1187 end;
1188 transform := translateStr;
1189 end else
1190 begin
1191 m := AValue;
1192 if (m[1,3] <> 0) or (m[2,3] <> 0) then
1193 begin
1194 s := translateStr;
1195 m[1,3] := 0;
1196 m[2,3] := 0;
1197 end else
1198 s := '';
1199 if IsAffineMatrixScale(AValue) then
1200 begin
1201 transform := trim(s+' scale('+Units.formatValue(m[1,1])+' '+Units.formatValue(m[2,2])+')');
1202 exit;
1203 end;
1204 transform := trim(s+' matrix('+Units.formatValue(m[1,1])+' '+Units.formatValue(m[2,1])+' '+
1205 Units.formatValue(m[1,2])+' '+Units.formatValue(m[2,2])+' ' +
1206 Units.formatValue(m[1,3])+' '+Units.formatValue(m[2,3]));
1207 end;
1208end;
1209
1210procedure TSVGElement.SetOpacity(AValue: single);
1211begin
1212 Attribute['opacity'] := Units.formatValue(AValue);
1213 RemoveStyle('opacity');
1214end;
1215
1216procedure TSVGElement.SetStroke(AValue: string);
1217begin
1218 Attribute['stroke'] := AValue;
1219 RemoveStyle('stroke');
1220end;
1221
1222procedure TSVGElement.SetStrokeColor(AValue: TBGRAPixel);
1223begin
1224 strokeOpacity:= AValue.alpha/255;
1225 AValue.alpha:= 255;
1226 stroke := BGRAToStr(AValue, CSSColors);
1227end;
1228
1229procedure TSVGElement.SetStrokeLineCap(AValue: string);
1230begin
1231 Attribute['stroke-linecap'] := AValue;
1232 RemoveStyle('stroke-linecap');
1233end;
1234
1235procedure TSVGElement.SetStrokeLineJoin(AValue: string);
1236begin
1237 Attribute['stroke-linejoin'] := AValue;
1238 RemoveStyle('stroke-linejoin');
1239end;
1240
1241procedure TSVGElement.SetStrokeMiterLimit(AValue: single);
1242begin
1243 if AValue < 1 then AValue := 1;
1244 Attribute['stroke-miterlimit'] := Units.formatValue(AValue);
1245 RemoveStyle('stroke-miterlimit');
1246end;
1247
1248procedure TSVGElement.SetStrokeOpacity(AValue: single);
1249begin
1250 Attribute['stroke-opacity'] := Units.formatValue(AValue);
1251 RemoveStyle('stroke-opacity');
1252end;
1253
1254procedure TSVGElement.SetStrokeWidth(AValue: TFloatWithCSSUnit);
1255begin
1256 HorizAttributeWithUnit['stroke-width'] := AValue;
1257 RemoveStyle('stroke-width');
1258end;
1259
1260procedure TSVGElement.SetStrokeDashArray(AValue: string);
1261begin
1262 Attribute['stroke-dasharray'] := AValue;
1263end;
1264
1265procedure TSVGElement.SetStrokeDashArrayF(AValue: ArrayOfFloat);
1266var
1267 s: string;
1268 i: integer;
1269begin
1270 s:= '';
1271 for i := 0 to high(AValue) do
1272 begin
1273 if s <> '' then s += ' ';
1274 s += TCSSUnitConverter.formatValue(AValue[i])+' ';
1275 end;
1276 strokeDashArray := s;
1277end;
1278
1279procedure TSVGElement.SetStrokeDashOffset(AValue: TFloatWithCSSUnit);
1280begin
1281 OrthoAttributeWithUnit['stroke-dashoffset'] := AValue;
1282end;
1283
1284procedure TSVGElement.SetStyle(AName: string; AValue: string);
1285var
1286 startPos, colonPos, valueLength: integer;
1287 ruleset: string;
1288begin
1289 if pos(';',AValue)<>0 then
1290 raise exception.Create('Invalid character in value');
1291 if pos(':',AName)<>0 then
1292 raise exception.Create('Invalid character in name');
1293 ruleset := Attribute['style'];
1294 LocateStyleDeclaration(ruleset, AName, startPos,colonPos, valueLength);
1295 if valueLength <> -1 then
1296 begin
1297 delete(ruleset, colonPos+1, valueLength);
1298 insert(' '+Trim(AValue), ruleset, colonPos+1);
1299 end else
1300 begin
1301 while (length(ruleset) > 0) and (ruleset[length(ruleset)] in[' ',#9,#10,#12,#13]) do
1302 delete(ruleset, length(ruleset), 1);
1303 if length(ruleset)>0 then
1304 begin
1305 if ruleset[length(ruleset)] <> ';' then ruleset += '; ';
1306 end;
1307 ruleset += AName+': '+AValue;
1308 end;
1309 Attribute['style'] := ruleset;
1310end;
1311
1312procedure TSVGElement.SetTransform(AValue: string);
1313begin
1314 Attribute['transform'] := AValue;
1315end;
1316
1317procedure TSVGElement.SetVerticalAttributeWithUnit(AName: string;
1318 AValue: TFloatWithCSSUnit);
1319begin
1320 if Units.DpiScaled then
1321 SetAttribute(AName, TCSSUnitConverter.formatValue(Units.ConvertHeight(AValue,cuCustom)))
1322 else
1323 if AValue.CSSUnit <> cuCustom then
1324 SetAttributeWithUnit(AName, FloatWithCSSUnit(AValue.value*Units.DpiScaleY,AValue.CSSUnit))
1325 else
1326 SetAttributeWithUnit(AName, AValue);
1327end;
1328
1329procedure TSVGElement.SetOrthoAttributeWithUnit(AName: string;
1330 AValue: TFloatWithCSSUnit);
1331begin
1332 if (AValue.CSSUnit <> cuCustom) and (Units.DpiScaleX<>Units.DpiScaleY) then
1333 raise exception.Create('Impossible to set value with inconsistent scaling');
1334 if Units.DpiScaled then
1335 SetAttribute(AName, TCSSUnitConverter.formatValue(Units.ConvertWidth(AValue,cuCustom)))
1336 else
1337 SetHorizAttributeWithUnit(AName,AValue);
1338end;
1339
1340procedure TSVGElement.SetID(AValue: string);
1341begin
1342 Attribute['id'] := AValue;
1343end;
1344
1345procedure TSVGElement.SetClassAt(AValue: string);
1346begin
1347 Attribute['class'] := AValue;
1348end;
1349
1350procedure TSVGElement.Init(ADocument: TXMLDocument; ATag: string;
1351 AUnits: TCSSUnitConverter);
1352begin
1353 FDomElem := ADocument.CreateElement(ATag);
1354 FUnits := AUnits;
1355end;
1356
1357procedure TSVGElement.Init(ADocument: TXMLDocument; AElement: TDOMElement;
1358 AUnits: TCSSUnitConverter);
1359begin
1360 FDomElem := AElement;
1361 FUnits := AUnits;
1362end;
1363
1364procedure TSVGElement.InternalDraw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
1365begin
1366 //nothing
1367end;
1368
1369procedure TSVGElement.LocateStyleDeclaration(AText: string; AProperty: string; out AStartPos,
1370 AColonPos, AValueLength: integer);
1371var i: integer;
1372 curStart,curColon,curValueLength: integer;
1373
1374 function CheckShouldReturnResult: boolean;
1375 begin
1376 if Trim(Copy(AText,curStart,curColon-curStart)) = AProperty then
1377 begin
1378 AStartPos:= curStart;
1379 AColonPos:= curColon;
1380 AValueLength:= curValueLength;
1381 result := true
1382 end
1383 else
1384 result := false
1385 end;
1386
1387begin
1388 AProperty := Trim(AProperty);
1389 AStartPos := -1;
1390 AColonPos := -1;
1391 AValueLength:= -1;
1392 curStart := -1;
1393 curColon := -1;
1394 curValueLength := -1;
1395 for i := 1 to length(AText) do
1396 begin
1397 if curStart = -1 then
1398 begin
1399 if AText[i] in['-','_','a'..'z','A'..'Z','\'] then
1400 begin
1401 curStart := i;
1402 curColon := -1;
1403 end;
1404 end else
1405 if curColon = -1 then
1406 begin
1407 if AText[i] = ':' then
1408 begin
1409 curColon := i;
1410 curValueLength:= -1;
1411 end;
1412 end else
1413 if AText[i] = ';' then
1414 begin
1415 curValueLength := i-(curColon+1);
1416 if CheckShouldReturnResult then exit;
1417 curStart := -1;
1418 curColon := -1;
1419 curValueLength:= -1;
1420 end;
1421 end;
1422 if curColon <> -1 then
1423 begin
1424 curValueLength:= length(AText)-(curColon+1)+1;
1425 if CheckShouldReturnResult then exit;
1426 end;
1427end;
1428
1429procedure TSVGElement.ApplyFillStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit);
1430begin
1431 ACanvas2D.fillStyle(fillColor);
1432
1433 ACanvas2D.fillMode := TFillMode(fillMode);
1434end;
1435
1436procedure TSVGElement.ApplyStrokeStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit);
1437var
1438 a: ArrayOfFloat;
1439 lw: single;
1440 i: Integer;
1441begin
1442 ACanvas2d.strokeStyle(strokeColor);
1443 lw := Units.ConvertWidth(strokeWidth,AUnit).value;
1444 ACanvas2d.lineWidth := lw;
1445 ACanvas2d.lineCap := strokeLineCap;
1446 ACanvas2d.lineJoin := strokeLineJoin;
1447 ACanvas2d.miterLimit := strokeMiterLimit;
1448
1449 a:= strokeDashArrayF;
1450 if (Length(a) <> 0) and (lw > 0) then
1451 begin
1452 for i := 0 to high(a) do
1453 a[i] /= lw;
1454 ACanvas2d.lineStyle(a);
1455 end
1456 else
1457 ACanvas2d.lineStyle(psSolid);
1458end;
1459
1460procedure TSVGElement.Initialize;
1461begin
1462 SetLength(styleAttributes,0);
1463 findStyleState := fssNotSearch;
1464 FDataParent := nil;
1465 FDataChildList := TSVGElementList.Create;
1466end;
1467
1468constructor TSVGElement.Create(ADocument: TXMLDocument; AElement: TDOMElement;
1469 AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink);
1470begin
1471 FDataLink:= ADataLink;
1472 Initialize;
1473 Init(ADocument,AElement,AUnits);
1474end;
1475
1476constructor TSVGElement.Create(ADocument: TXMLDocument;
1477 AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink);
1478begin
1479 FDataLink:= ADataLink;
1480 Initialize;
1481 //raise exception.Create('Cannot create a generic element');
1482end;
1483
1484destructor TSVGElement.Destroy;
1485begin
1486 SetLength(styleAttributes,0);
1487 FreeAndNil(FDataChildList);
1488 inherited Destroy;
1489end;
1490
1491procedure TSVGElement.Recompute;
1492begin
1493
1494end;
1495
1496procedure TSVGElement.Draw(ACanvas2d: TBGRACanvas2D; AUnit: TCSSUnit);
1497var prevMatrix: TAffineMatrix;
1498begin
1499 prevMatrix := ACanvas2d.matrix;
1500 ACanvas2d.transform(matrix[AUnit]);
1501 InternalDraw(ACanvas2d,AUnit);
1502 ACanvas2d.matrix := prevMatrix;
1503end;
1504
1505procedure TSVGElement.fillNone;
1506begin
1507 fill := 'none';
1508end;
1509
1510procedure TSVGElement.strokeNone;
1511begin
1512 stroke := 'none';
1513end;
1514
1515procedure TSVGElement.transformNone;
1516begin
1517 FDomElem.RemoveAttribute('transform');
1518end;
1519
1520procedure TSVGElement.RemoveStyle(const AName: string);
1521var
1522 startPos, colonPos, valueLength: integer;
1523 ruleset: string;
1524begin
1525 ruleset := Attribute['style'];
1526 LocateStyleDeclaration(ruleset, AName, startPos,colonPos, valueLength);
1527 if valueLength <> -1 then
1528 begin
1529 delete(ruleset, startPos, colonPos+valueLength-startPos);
1530 while (length(ruleset)>=startPos) and (ruleset[startPos] in[' ',#9,#10,#12,#13]) do delete(ruleset,startPos,1);
1531 if (length(ruleset)>=startPos) and (ruleset[startPos] = ';') then delete(ruleset,startPos,1);
1532 Attribute['style'] := ruleset;
1533 end;
1534end;
1535
1536function TSVGElement.HasAttribute(AName: string): boolean;
1537begin
1538 result := FDomElem.hasAttribute(AName);
1539end;
1540
1541function TSVGElement.fillMode: TSVGFillMode;
1542begin
1543 if fillRule = 'evenodd' then
1544 result := sfmEvenOdd
1545 else
1546 result := sfmNonZero;
1547end;
1548
1549function TSVGElement.DataChildList: TSVGElementList;
1550begin
1551 result:= FDataChildList;
1552end;
1553
1554function TSVGElement.FindStyleElementInternal(const classStr: string;
1555 out attributesStr: string): integer;
1556var
1557 i: integer;
1558begin
1559 attributesStr:= '';
1560 with FDataLink do
1561 for i:= 0 to StyleCount-1 do
1562 begin
1563 result:= (Styles[i] as TSVGStyle).Find(classStr);
1564 if result <> -1 then
1565 begin
1566 attributesStr:= (Styles[i] as TSVGStyle).Styles[result].attribute;
1567 Exit;
1568 end;
1569 end;
1570 result:= -1;
1571end;
1572
1573procedure TSVGElement.FindStyleElement;
1574
1575 procedure AddStyle(const s: string; const id: integer);
1576 var
1577 l: integer;
1578 begin
1579 findStyleState:= fssFind;
1580 l:= Length(styleAttributes);
1581 SetLength(styleAttributes,l+1);
1582 with styleAttributes[l] do
1583 begin
1584 attr:= s;
1585 pos:= id;
1586 end;
1587 end;
1588
1589var
1590 fid: integer;
1591 tag,styleC,s: string;
1592begin
1593 findStyleState:= fssNotFind;
1594 SetLength(styleAttributes,0);
1595 tag:= FDomElem.TagName;
1596 styleC:= classAt;
1597 (*
1598 if style element is:
1599 <style>
1600 circle.test{fill:red; fill-opacity: 0.8;}
1601 circle{fill:blue; fill-opacity: 0.4;}
1602 circle.style1{fill:yellow;}
1603 </style>
1604 and circle declare:
1605 <circle class = "style1" cx="160" cy="160" r="35" stroke="black" />
1606
1607 styleAttributes[0] = 'fill:blue; fill-opacity: 0.4;'
1608 styleAttributes[1] = 'fill:yellow;'
1609
1610 fill-opacity for "style1" = 0.4 not default 1!
1611 *)
1612
1613 //Find as: "[tag]" example "circle"
1614 fid:= FindStyleElementInternal(tag,s);
1615 if fid <> -1 then
1616 AddStyle(s,fid);
1617 if styleC <> '' then
1618 begin
1619 //Find as: "[tag].[class]" example "circle.style1"
1620 fid:= FindStyleElementInternal(tag+'.'+styleC,s);
1621 if fid <> -1 then
1622 AddStyle(s,fid)
1623 else
1624 begin
1625 //Find as: ".[class]" example ".style1"
1626 fid:= FindStyleElementInternal('.'+styleC,s);
1627 if fid <> -1 then
1628 AddStyle(s,fid);
1629 end;
1630 end;
1631end;
1632
1633end.
1634
Note: See TracBrowser for help on using the repository browser.