1 {
2 *****************************************************************************
3 See the file COPYING.modifiedLGPL.txt, included in this distribution,
4 for details about the license.
5 *****************************************************************************
6
7 Authors: Alexander Klenin
8
9 }
10 unit TADrawerSVG;
11
12 {$H+}
13
14 interface
15
16 uses
17 Graphics, Classes, FPImage, FPCanvas, EasyLazFreeType,
18 TAFonts, TAChartUtils, TADrawUtils, TAGraph;
19
20 type
21 TSVGDrawer = class(TBasicDrawer, IChartDrawer)
22 strict private
23 FAntialiasingMode: TChartAntialiasingMode;
24 FBrushColor: TFPColor;
25 FBrushStyle: TFPBrushStyle;
26 FClippingPathId: Integer;
27 FFont: TFreeTypeFont;
28 FFontHeight: Integer; // Height of text in pixels
29 FFontOrientation: Integer; // angle*10 (i.e. 90° --> 900, >0 if ccs.
30 FFontColor: TFPColor;
31 FPatterns: TStrings;
32 FPen: TFPCustomPen;
33 FPrevPos: TPoint;
34 FStream: TStream;
35
OpacityStrnull36 function OpacityStr: String;
PointsToStrnull37 function PointsToStr(
38 const APoints: array of TPoint; AStartIndex, ANumPts: Integer): String;
39
40 procedure SetBrush(ABrush: TFPCustomBrush);
41 procedure SetFont(AFont: TFPCustomFont);
42 procedure SetPen(APen: TFPCustomPen);
43
StyleFillnull44 function StyleFill: String;
StyleStrokenull45 function StyleStroke: String;
46
47 procedure WriteFmt(const AFormat: String; AParams: array of const);
48 procedure WriteStr(const AString: String);
49 strict protected
SimpleTextExtentnull50 function SimpleTextExtent(const AText: String): TPoint; override;
51 procedure SimpleTextOut(AX, AY: Integer; const AText: String); override;
52
53 public
54 constructor Create(AStream: TStream; AWriteDocType: Boolean);
55 destructor Destroy; override;
56 public
57 procedure AddToFontOrientation(ADelta: Integer);
58 procedure ClippingStart;
59 procedure ClippingStart(const AClipRect: TRect);
60 procedure ClippingStop;
61 procedure DrawingBegin(const ABoundingBox: TRect); override;
62 procedure DrawingEnd; override;
63 procedure Ellipse(AX1, AY1, AX2, AY2: Integer);
64 procedure FillRect(AX1, AY1, AX2, AY2: Integer);
GetBrushColornull65 function GetBrushColor: TChartColor;
GetFontAnglenull66 function GetFontAngle: Double; override;
GetFontColornull67 function GetFontColor: TFPColor; override;
GetFontNamenull68 function GetFontName: String; override;
GetFontSizenull69 function GetFontSize: Integer; override;
GetFontStylenull70 function GetFontStyle: TChartFontStyles; override;
GetPenColornull71 function GetPenColor: TChartColor;
72 procedure Line(AX1, AY1, AX2, AY2: Integer);
73 procedure Line(const AP1, AP2: TPoint);
74 procedure LineTo(AX, AY: Integer); override;
75 procedure MoveTo(AX, AY: Integer); override;
76 procedure Polygon(
77 const APoints: array of TPoint; AStartIndex, ANumPts: Integer); override;
78 procedure Polyline(
79 const APoints: array of TPoint; AStartIndex, ANumPts: Integer);
80 procedure PrepareSimplePen(AColor: TChartColor);
81 procedure PutImage(AX, AY: Integer; AImage: TFPCustomImage); override;
82 procedure PutPixel(AX, AY: Integer; AColor: TChartColor); override;
83 procedure RadialPie(
84 AX1, AY1, AX2, AY2: Integer;
85 AStartAngle16Deg, AAngleLength16Deg: Integer);
86 procedure Rectangle(const ARect: TRect);
87 procedure Rectangle(AX1, AY1, AX2, AY2: Integer);
88 procedure ResetFont;
89 procedure SetAntialiasingMode(AValue: TChartAntialiasingMode);
90 procedure SetBrushColor(AColor: TChartColor);
91 procedure SetBrushParams(AStyle: TFPBrushStyle; AColor: TChartColor);
92 procedure SetPenColor(AColor: TChartColor);
93 procedure SetPenParams(AStyle: TFPPenStyle; AColor: TChartColor; AWidth: Integer = 1);
94 procedure SetPenWidth(AWidth: Integer);
95 end;
96
97
98 { TSVGChartHelper }
99
100 TSVGChartHelper = class helper for TChart
101 procedure SaveToSVGFile(const AFileName: String);
102 end;
103
104
105 implementation
106
107 uses
108 Base64, FPWritePNG, Math, SysUtils, TAGeometry;
109
110 const
111 RECT_FMT =
112 '<rect x="%d" y="%d" width="%d" height="%d" style="%s"/>';
113
EscapeXMLnull114 function EscapeXML(const AText: String): String;
115 var
116 ch: Char;
117 begin
118 Result := '';
119 for ch in AText do
120 case ch of
121 '<': Result := Result + '<';
122 '>': Result := Result + '>';
123 '"': Result := Result + '"';
124 '''':Result := Result + ''';
125 '&': Result := Result + '&';
126 else Result := Result + ch;
127 end;
128 end;
129
ColorToHexnull130 function ColorToHex(AColor: TFPColor): String;
131 begin
132 if AColor = colBlack then
133 Result := 'black'
134 else if AColor = colWhite then
135 Result := 'white'
136 else
137 with AColor do
138 Result := Format('#%.2x%.2x%.2x', [red shr 8, green shr 8, blue shr 8]);
139 end;
140
DP2Snull141 function DP2S(AValue: TDoublePoint): String;
142 begin
143 Result := Format('%g,%g', [AValue.X, AValue.Y], DefSeparatorSettings);
144 end;
145
F2Snull146 function F2S(AValue: Double): String;
147 begin
148 Result := FloatToStr(AValue, DefSeparatorSettings);
149 end;
150
SVGGetFontOrientationFuncnull151 function SVGGetFontOrientationFunc(AFont: TFPCustomFont): Integer;
152 begin
153 if AFont is TFont then
154 Result := TFont(AFont).Orientation
155 else
156 Result := AFont.Orientation;
157 end;
158
SVGChartColorToFPColornull159 function SVGChartColorToFPColor(AChartColor: TChartColor): TFPColor;
160 begin
161 Result := ChartColorToFPColor(ColorToRGB(AChartColor));
162 end;
163
164
165 { TSVGDrawer }
166
167 procedure TSVGDrawer.AddToFontOrientation(ADelta: Integer);
168 begin
169 FFontOrientation += ADelta;
170 end;
171
172 procedure TSVGDrawer.ClippingStart(const AClipRect: TRect);
173 begin
174 FClippingPathId += 1;
175 WriteFmt('<clipPath id="clip%d">', [FClippingPathId]);
176 with AClipRect do
177 WriteFmt(RECT_FMT, [Left, Top, Right - Left, Bottom - Top, '']);
178 WriteStr('</clipPath>');
179 ClippingStart;
180 end;
181
182 procedure TSVGDrawer.ClippingStart;
183 begin
184 WriteFmt('<g clip-path="url(#clip%d)">', [FClippingPathId]);
185 end;
186
187 procedure TSVGDrawer.ClippingStop;
188 begin
189 WriteStr('</g>');
190 end;
191
192 constructor TSVGDrawer.Create(AStream: TStream; AWriteDocType: Boolean);
193 begin
194 inherited Create;
195 InitFonts;
196 FStream := AStream;
197 FPatterns := TStringList.Create;
198 FPen := TFPCustomPen.Create;
199 FGetFontOrientationFunc := @SVGGetFontOrientationFunc;
200 FChartColorToFPColorFunc := @SVGChartColorToFPColor;
201 if AWriteDocType then begin
202 WriteStr('<?xml version="1.0"?>');
203 WriteStr('<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN"');
204 WriteStr('"http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd">');
205 end;
206 end;
207
208 destructor TSVGDrawer.Destroy;
209 begin
210 FreeAndNil(FFont);
211 FreeAndNil(FPatterns);
212 FreeAndNil(FPen);
213 inherited Destroy;
214 end;
215
216 procedure TSVGDrawer.DrawingBegin(const ABoundingBox: TRect);
217 begin
218 FAntialiasingMode := amDontCare;
219 with ABoundingBox do
220 WriteFmt(
221 '<svg ' +
222 'xmlns="http://www.w3.org/2000/svg" ' +
223 'xmlns:xlink="http://www.w3.org/1999/xlink" ' +
224 'width="%dpx" height="%dpx" viewBox="%d %d %d %d">',
225 [Right - Left, Bottom - Top, Left, Top, Right, Bottom]);
226 FClippingPathId := 0;
227 end;
228
229 procedure TSVGDrawer.DrawingEnd;
230 var
231 i: Integer;
232 begin
233 if FAntialiasingMode <> amDontCare then
234 WriteStr('</g>');
235 if FPatterns.Count > 0 then begin
236 WriteStr('<defs>');
237 for i := 0 to FPatterns.Count - 1 do
238 WriteFmt(
239 '<pattern id="bs%d" width="8" height="8" patternUnits="userSpaceOnUse">' +
240 '%s</pattern>',
241 [i, FPatterns[i]]);
242 WriteStr('</defs>');
243 FPatterns.Clear;
244 end;
245 WriteStr('</svg>');
246 end;
247
248 procedure TSVGDrawer.Ellipse(AX1, AY1, AX2, AY2: Integer);
249 var
250 e: TEllipse;
251 begin
252 e.InitBoundingBox(AX1, AY1, AX2, AY2);
253 WriteFmt(
254 '<ellipse cx="%g" cy="%g" rx="%g" ry="%g" style="%s"/>',
255 [e.FC.X, e.FC.Y, e.FR.X, e.FR.Y, StyleFill + StyleStroke]);
256 end;
257
258 procedure TSVGDrawer.FillRect(AX1, AY1, AX2, AY2: Integer);
259 begin
260 WriteFmt(RECT_FMT, [AX1, AY1, AX2 - AX1, AY2 - AY1, StyleFill]);
261 end;
262
GetBrushColornull263 function TSVGDrawer.GetBrushColor: TChartColor;
264 begin
265 Result := FPColorToChartColor(FBrushColor);
266 end;
267
GetFontAnglenull268 function TSVGDrawer.GetFontAngle: Double;
269 begin
270 Result := OrientToRad(FFontOrientation);
271 end;
272
TSVGDrawer.GetFontColornull273 function TSVGDrawer.GetFontColor: TFPColor;
274 begin
275 Result := FFontColor;
276 end;
277
TSVGDrawer.GetFontNamenull278 function TSVGDrawer.GetFontName: String;
279 begin
280 Result := FFont.Family;
281 end;
282
GetFontSizenull283 function TSVGDrawer.GetFontSize: Integer;
284 begin
285 Result := Round(FFont.SizeInPoints);
286 end;
287
TSVGDrawer.GetFontStylenull288 function TSVGDrawer.GetFontStyle: TChartFontStyles;
289 begin
290 Result := [];
291 if ftsBold in FFont.Style then Include(Result, cfsBold);
292 if ftsItalic in FFont.Style then Include(Result, cfsItalic);
293 if FFont.UnderlineDecoration then Include(Result, cfsUnderline);
294 if FFont.StrikeoutDecoration then Include(Result, cfsStrikeout);
295 end;
296
GetPenColornull297 function TSVGDrawer.GetPenColor: TChartColor;
298 begin
299 Result := FPColorToChartColor(FPen.FPColor);
300 end;
301
302 procedure TSVGDrawer.Line(AX1, AY1, AX2, AY2: Integer);
303 begin
304 WriteFmt(
305 '<line x1="%d" y1="%d" x2="%d" y2="%d" style="%s"/>',
306 [AX1, AY1, AX2, AY2, StyleStroke]);
307 end;
308
309 procedure TSVGDrawer.Line(const AP1, AP2: TPoint);
310 begin
311 Line(AP1.X, AP1.Y, AP2.X, AP2.Y);
312 end;
313
314 procedure TSVGDrawer.LineTo(AX, AY: Integer);
315 begin
316 Line(FPrevPos.X, FPrevPos.Y, AX, AY);
317 FPrevPos := Point(AX, AY);
318 end;
319
320 procedure TSVGDrawer.MoveTo(AX, AY: Integer);
321 begin
322 FPrevPos := Point(AX, AY);
323 end;
324
OpacityStrnull325 function TSVGDrawer.OpacityStr: String;
326 begin
327 if FTransparency = 0 then
328 Result := ''
329 else
330 Result := F2S((255 - FTransparency) / 256);
331 end;
332
PointsToStrnull333 function TSVGDrawer.PointsToStr(
334 const APoints: array of TPoint; AStartIndex, ANumPts: Integer): String;
335 var
336 i: Integer;
337 begin
338 if ANumPts < 0 then
339 ANumPts := Length(APoints) - AStartIndex;
340 Result := '';
341 for i := 0 to ANumPts - 1 do
342 with APoints[i + AStartIndex] do
343 Result += Format('%d %d ', [X, Y]);
344 end;
345
346 procedure TSVGDrawer.Polygon(
347 const APoints: array of TPoint; AStartIndex, ANumPts: Integer);
348 begin
349 WriteFmt(
350 '<polygon points="%s" style="%s"/>',
351 [PointsToStr(APoints, AStartIndex, ANumPts), StyleFill + StyleStroke]);
352 end;
353
354 procedure TSVGDrawer.Polyline(
355 const APoints: array of TPoint; AStartIndex, ANumPts: Integer);
356 begin
357 WriteFmt(
358 '<polyline points="%s" style="fill: none; %s"/>',
359 [PointsToStr(APoints, AStartIndex, ANumPts), StyleStroke]);
360 end;
361
362 procedure TSVGDrawer.PrepareSimplePen(AColor: TChartColor);
363 begin
364 FPen.FPColor := FChartColorToFPColorFunc(ColorOrMono(AColor));
365 FPen.Style := psSolid;
366 FPen.Width := 1;
367 end;
368
369 procedure TSVGDrawer.PutImage(AX, AY: Integer; AImage: TFPCustomImage);
370 var
371 s: TStringStream = nil;
372 w: TFPWriterPNG = nil;
373 b: TBase64EncodingStream = nil;
374 begin
375 s := TStringStream.Create('');
376 b := TBase64EncodingStream.Create(s);
377 w := TFPWriterPNG.Create;
378 try
379 w.Indexed := false;
380 w.UseAlpha := true;
381 AImage.SaveToStream(b, w);
382 b.Flush;
383 WriteFmt(
384 '<image x="%d" y="%d" width="%d" height="%d" ' +
385 'xlink:href="data:image/png;base64,%s"/>',
386 [AX, AY, AImage.Width, AImage.Height, s.DataString]);
387 finally
388 w.Free;
389 s.Free;
390 b.Free;
391 end;
392 end;
393
394 procedure TSVGDrawer.PutPixel(AX, AY: Integer; AColor: TChartColor);
395 var
396 stroke: String;
397 begin
398 stroke := 'stroke:'+ColorToHex(FChartColorToFPColorFunc(ColorOrMono(AColor))) + ';stroke-width:1;';
399 WriteFmt(RECT_FMT, [AX, AY, 1, 1, stroke]);
400 end;
401
402 procedure TSVGDrawer.RadialPie(
403 AX1, AY1, AX2, AY2: Integer; AStartAngle16Deg, AAngleLength16Deg: Integer);
404 var
405 e: TEllipse;
406 p1, p2: TDoublePoint;
407 begin
408 e.InitBoundingBox(AX1, AY1, AX2, AY2);
409 p1 := e.GetPoint(Deg16ToRad(AStartAngle16Deg));
410 p2 := e.GetPoint(Deg16ToRad(AStartAngle16Deg + AAngleLength16Deg));
411 WriteFmt(
412 '<path d="M%s L%s A%s 0 0,0 %s Z" style="%s"/>',
413 [DP2S(e.FC), DP2S(p1), DP2S(e.FR), DP2S(p2), StyleFill + StyleStroke]);
414 end;
415
416 procedure TSVGDrawer.Rectangle(AX1, AY1, AX2, AY2: Integer);
417 begin
418 WriteFmt(
419 RECT_FMT, [AX1, AY1, AX2 - AX1, AY2 - AY1, StyleFill + StyleStroke]);
420 end;
421
422 procedure TSVGDrawer.Rectangle(const ARect: TRect);
423 begin
424 with ARect do
425 Rectangle(Left, Top, Right, Bottom);
426 end;
427
428 procedure TSVGDrawer.ResetFont;
429 begin
430 FFontOrientation := 0;
431 end;
432
433 procedure TSVGDrawer.SetAntialiasingMode(AValue: TChartAntialiasingMode);
434 const
435 AM_TO_CSS: array [amOn .. amOff] of String =
436 ('geometricPrecision', 'crispEdges');
437 begin
438 if FAntialiasingMode = AValue then exit;
439 if FAntialiasingMode <> amDontCare then
440 WriteStr('</g>');
441 FAntialiasingMode := AValue;
442 if FAntialiasingMode <> amDontCare then
443 WriteFmt('<g style="shape-rendering: %s">',[AM_TO_CSS[FAntialiasingMode]]);
444 end;
445
446 procedure TSVGDrawer.SetBrush(ABrush: TFPCustomBrush);
447 begin
448 if ABrush is TBrush then
449 FBrushColor := FChartColorToFPColorFunc(ColorOrMono(TBrush(ABrush).Color))
450 else
451 FBrushColor := FPColorOrMono(ABrush.FPColor);
452 FBrushStyle := ABrush.Style;
453 end;
454
455 procedure TSVGDrawer.SetBrushColor(AColor: TChartColor);
456 begin
457 FBrushColor := FChartColorToFPColorFunc(ColorOrMono(AColor));
458 end;
459
460 procedure TSVGDrawer.SetBrushParams(
461 AStyle: TFPBrushStyle; AColor: TChartColor);
462 begin
463 FBrushColor := FChartColorToFPColorFunc(ColorOrMono(AColor));
464 FBrushStyle := AStyle;
465 end;
466
467 procedure TSVGDrawer.SetFont(AFont: TFPCustomFont);
468 var
469 style: TFreeTypeStyles;
470 fn: String;
471 begin
472 style := [];
473 if AFont.Bold then Include(style, ftsBold);
474 if AFont.Italic then Include(style, ftsItalic);
475
476 // create a new font if not yet loaded
477 if (FFont = nil) or (FFont.Family <> AFont.Name) or(FFont.Style <> style) then
478 begin
479 FreeAndNil(FFont);
480 if SameText(AFont.Name, 'default') then
481 fn := 'Arial' // FIXME: Find font in FontCollection!
482 else
483 fn := AFont.Name;
484 FFont := LoadFont(fn, style);
485 if FFont = nil then
486 raise Exception.CreateFmt('Font "%s" not found."', [AFont.Name]);
487 end;
488
489 // Set the requested font attributes
490 FFont.SizeInPoints := Math.IfThen(AFont.Size = 0, DEFAULT_FONT_SIZE, AFont.Size);
491 FFont.UnderlineDecoration := AFont.Underline;
492 FFont.StrikeoutDecoration := AFont.StrikeThrough;
493 FFont.Hinted := true;
494 FFont.Quality := grqHighQuality;
495
496 if FMonochromeColor <> clTAColor then
497 FFontColor := FChartColorToFPColorFunc(FMonochromeColor)
498 else
499 FFontColor := AFont.FPColor;
500 FFontOrientation := FGetFontOrientationFunc(AFont);
501 FFontHeight := round(FFont.TextHeight('Tg'));
502 end;
503
504 procedure TSVGDrawer.SetPen(APen: TFPCustomPen);
505 begin
506 if APen is TPen then
507 FPen.FPColor := FChartColorToFPColorFunc(ColorOrMono(TPen(APen).Color))
508 else
509 FPen.FPColor := FPColorOrMono(APen.FPColor);
510 FPen.Style := APen.Style;
511 FPen.Width := APen.Width;
512 end;
513
514 procedure TSVGDrawer.SetPenColor(AColor: TChartColor);
515 begin
516 FPen.FPColor := FChartColorToFPColorFunc(ColorOrMono(AColor));
517 end;
518
519 procedure TSVGDrawer.SetPenParams(AStyle: TFPPenStyle; AColor: TChartColor;
520 AWidth: Integer = 1);
521 begin
522 FPen.FPColor := FChartColorToFPColorFunc(ColorOrMono(AColor));
523 FPen.Style := AStyle;
524 FPen.Width := AWidth;
525 end;
526
527 procedure TSVGDrawer.SetPenWidth(AWidth: Integer);
528 begin
529 FPen.Width := AWidth;
530 end;
531
TSVGDrawer.SimpleTextExtentnull532 function TSVGDrawer.SimpleTextExtent(const AText: String): TPoint;
533 begin
534 Result.X := Round(FFont.TextWidth(AText));
535 Result.Y := FFontHeight;
536 end;
537
538 type
539 TFreeTypeFontOpener = class(TFreeTypeFont);
540
541 procedure TSVGDrawer.SimpleTextOut(AX, AY: Integer; const AText: String);
542 var
543 p: TPoint;
544 stext: String;
545 sstyle: String;
546 dy: Integer;
547 phi: Double;
548 begin
549 dy := round(TFreeTypeFontOpener(FFont).GetAscent);
550 phi := OrientToRad(FFontOrientation);
551 p := RotatePoint(Point(0, dy), -phi) + Point(AX, AY);
552 stext := Format('x="%d" y="%d"', [p.X, p.Y]);
553 if FFontOrientation <> 0 then
554 stext := stext + Format(' transform="rotate(%g,%d,%d)"',
555 [-FFontOrientation*0.1, p.X, p.Y], DefSeparatorSettings);
556
557 sstyle := Format('fill:%s; font-family:''%s''; font-size:%dpt;',
558 [ColorToHex(GetFontColor), GetFontName, round(FFont.SizeInPoints)]);
559 if (ftsBold in FFont.Style) then
560 sstyle := sstyle + ' font-weight:bold;';
561 if (ftsItalic in FFont.Style) then
562 sstyle := sstyle + ' font-style:oblique;';
563 if FFont.UnderlineDecoration and FFont.StrikeoutDecoration then
564 sstyle := sstyle + ' text-decoration:underline,line-through;'
565 else if FFont.UnderlineDecoration then
566 sstyle := sstyle + ' text-deocration:underline;'
567 else if FFont.StrikeoutDecoration then
568 sstyle := sstyle + ' text-decoration:line-through;';
569 if OpacityStr <> '' then
570 sstyle := sstyle + OpacityStr + ';';
571
572 WriteFmt('<text %s style="%s">%s</text>', [stext, sstyle, EscapeXML(AText)]);
573 end;
574
StyleFillnull575 function TSVGDrawer.StyleFill: String;
576
AddPatternnull577 function AddPattern(APattern: String): String;
578 var
579 i: Integer;
580 begin
581 i := FPatterns.IndexOf(APattern);
582 if i < 0 then
583 i := FPatterns.Add(APattern);
584 Result := Format('url(#bs%d)', [i]);
585 end;
586
587 const
588 PATTERNS: array [TFPBrushStyle] of String = (
589 '', '',
590 'M0,4 h8', // bsHorizontal
591 'M4,0 v8', // bsVertical
592 'M0,0 l8,8', // bsFDiagonal
593 'M0,8 l8,-8', // bsBDiagonal
594 'M0,4 h8 M4,0 v8', // bsCross
595 'M0,0 l8,8 M0,8 l8,-8', // bsDiagCross
596 '', '');
597 var
598 fill: String;
599 begin
600 case FBrushStyle of
601 bsClear: exit('fill: none;');
602 bsHorizontal..bsDiagCross:
603 fill := AddPattern(Format(
604 '<path d="%s" stroke="%s"/>',
605 [PATTERNS[FBrushStyle], ColorToHex(FBrushColor)]));
606 else
607 fill := ColorToHex(FBrushColor);
608 end;
609 Result :=
610 Format('fill:%s;', [fill]) + FormatIfNotEmpty('fill-opacity:%s;', OpacityStr);
611 end;
612
TSVGDrawer.StyleStrokenull613 function TSVGDrawer.StyleStroke: String;
614 const
615 PEN_DASHARRAY: array [TFPPenStyle] of String =
616 ('', '2,2', '1,1', '2,1,1,1', '2,1,1,1,1,1', '', '', '');
617 begin
618 if FPen.Style = psClear then
619 exit('stroke: none');
620 Result := 'stroke:' + ColorToHex(FPen.FPColor) + ';';
621 if FPen.Width <> 1 then
622 Result += 'stroke-width:' + IntToStr(FPen.Width) + ';';
623 Result +=
624 FormatIfNotEmpty('stroke-dasharray:%s;', PEN_DASHARRAY[FPen.Style]) +
625 FormatIfNotEmpty('stroke-opacity:%s;', OpacityStr);
626 end;
627
628 procedure TSVGDrawer.WriteFmt(const AFormat: String; AParams: array of const);
629 begin
630 WriteStr(Format(AFormat, AParams, DefSeparatorSettings));
631 end;
632
633 procedure TSVGDrawer.WriteStr(const AString: String);
634 var
635 le: String = LineEnding;
636 begin
637 FStream.WriteBuffer(AString[1], Length(AString));
638 FStream.WriteBuffer(le[1], Length(le));
639 end;
640
641
642 { TSVGChartHelper }
643
644 procedure TSVGChartHelper.SaveToSVGFile(const AFileName: String);
645 var
646 fs: TFileStream;
647 begin
648 fs := TFileStream.Create(AFileName, fmCreate);
649 try
650 Draw(TSVGDrawer.Create(fs, true), Rect(0, 0, Width, Height));
651 finally
652 fs.Free;
653 end;
654 end;
655
656
657 end.
658
659