source: trunk/Packages/bgrabitmap/bgrasvg.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 31.4 KB
Line 
1unit BGRASVG;
2
3{$mode objfpc}{$H+}
4
5interface
6
7uses
8 Classes, SysUtils, BGRABitmapTypes, laz2_DOM, BGRAUnits, BGRASVGShapes,
9 BGRACanvas2D, BGRASVGType, FPimage;
10
11type
12 TCSSUnit = BGRAUnits.TCSSUnit;
13
14const
15 cuCustom = BGRAUnits.cuCustom;
16 cuPixel = BGRAUnits.cuPixel;
17 cuCentimeter = BGRAUnits.cuCentimeter;
18 cuMillimeter = BGRAUnits.cuMillimeter;
19 cuInch = BGRAUnits.cuInch;
20 cuPica = BGRAUnits.cuPica;
21 cuPoint = BGRAUnits.cuPoint;
22 cuFontEmHeight = BGRAUnits.cuFontEmHeight;
23 cuFontXHeight = BGRAUnits.cuFontXHeight;
24 cuPercent = BGRAUnits.cuPercent;
25
26type
27 TSVGViewBox = record
28 min, size: TPointF;
29 end;
30 TSVGSize = record
31 width, height: TFloatWithCSSUnit;
32 end;
33
34 { TSVGUnits }
35
36 TSVGUnits = class(TCSSUnitConverter)
37 private
38 FOnRecompute: TSVGRecomputeEvent;
39 FViewOffset: TPointF;
40 function GetCustomDpi: TPointF;
41 procedure Recompute;
42 procedure SetOnRecompute(AValue: TSVGRecomputeEvent);
43 protected
44 FSvg: TDOMElement;
45 FViewBox: TSVGViewBox;
46 FOriginalViewSize, FProportionalViewSize: TSVGSize;
47
48 FDefaultUnitHeight, FDefaultUnitWidth: TFloatWithCSSUnit;
49 FDefaultDpi: PSingle;
50 FUseDefaultDPI: boolean;
51 FDpiScaleX,FDpiScaleY: single;
52 FContainerHeight: TFloatWithCSSUnit;
53 FContainerWidth: TFloatWithCSSUnit;
54 procedure SetContainerHeight(AValue: TFloatWithCSSUnit);
55 procedure SetContainerWidth(AValue: TFloatWithCSSUnit);
56 function GetDefaultUnitHeight: TFloatWithCSSUnit; override;
57 function GetDefaultUnitWidth: TFloatWithCSSUnit; override;
58 function GetDpiX: single; override;
59 function GetDpiY: single; override;
60 function GetCustomDpiX: single;
61 function GetCustomDpiY: single;
62 function GetCustomOrigin: TPointF;
63 procedure SetCustomOrigin(AValue: TPointF);
64 procedure SetViewBox(AValue: TSVGViewBox);
65 procedure SetCustomDpi(ADpi: TPointF);
66 function GetDpiScaleX: single; override;
67 function GetDpiScaleY: single; override;
68 function GetDPIScaled: boolean; override;
69 public
70 procedure SetDefaultDpiAndOrigin;
71 constructor Create(ASvg: TDOMElement; ADefaultDpi: PSingle);
72 function GetStretchRectF(AViewSize: TRectF; par: TSVGPreserveAspectRatio): TRectF;
73 property ViewBox: TSVGViewBox read FViewBox write SetViewBox;
74 property OriginalViewSize: TSVGSize read FOriginalViewSize;
75 property ProportionalViewSize: TSVGSize read FProportionalViewSize;
76 property ViewOffset: TPointF read FViewOffset;
77 property CustomOrigin: TPointF read GetCustomOrigin write SetCustomOrigin;
78 property CustomDpiX: single read GetCustomDpiX;
79 property CustomDpiY: single read GetCustomDpiY;
80 property CustomDpi: TPointF read GetCustomDpi write SetCustomDpi;
81 property ContainerWidth: TFloatWithCSSUnit read FContainerWidth write SetContainerWidth;
82 property ContainerHeight: TFloatWithCSSUnit read FContainerHeight write SetContainerHeight;
83 property OnRecompute: TSVGRecomputeEvent read FOnRecompute write SetOnRecompute;
84 end;
85
86 { TBGRASVG }
87
88 TBGRASVG = class
89 private
90 function GetAttribute(AName: string): string; overload;
91 function GetAttribute(AName: string; ADefault: string): string; overload;
92 function GetCustomDpi: TPointF;
93 function GetHeight: TFloatWithCSSUnit;
94 function GetHeightAsCm: single;
95 function GetHeightAsInch: single;
96 function GetPreserveAspectRatio: TSVGPreserveAspectRatio;
97 function GetUTF8String: utf8string;
98 function GetViewBox: TSVGViewBox; overload;
99 function GetViewBox(AUnit: TCSSUnit): TSVGViewBox; overload;
100 procedure GetViewBoxIndirect(AUnit: TCSSUnit; out AViewBox: TSVGViewBox);
101 function GetViewMin(AUnit: TCSSUnit): TPointF;
102 function GetViewSize(AUnit: TCSSUnit): TPointF;
103 function GetWidth: TFloatWithCSSUnit;
104 function GetWidthAsCm: single;
105 function GetWidthAsInch: single;
106 function GetZoomable: boolean;
107 procedure SetAttribute(AName: string; AValue: string);
108 procedure SetCustomDpi(AValue: TPointF);
109 procedure SetDefaultDpi(AValue: single);
110 procedure SetHeight(AValue: TFloatWithCSSUnit);
111 procedure SetHeightAsCm(AValue: single);
112 procedure SetHeightAsInch(AValue: single);
113 procedure SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio);
114 procedure SetUTF8String(AValue: utf8string);
115 procedure SetViewBox(AValue: TSVGViewBox);
116 procedure SetWidth(AValue: TFloatWithCSSUnit);
117 procedure SetWidthAsCm(AValue: single);
118 procedure SetWidthAsInch(AValue: single);
119 procedure SetZoomable(AValue: boolean);
120 protected
121 FXml: TXMLDocument;
122 FRoot: TDOMElement;
123 FUnits: TSVGUnits;
124 FDefaultDpi: single;
125 FContent: TSVGContent;
126 FDataLink: TSVGDataLink;
127 procedure Init(ACreateEmpty: boolean);
128 function GetViewBoxAlignment(AHorizAlign: TAlignment; AVertAlign: TTextLayout): TPointF;
129 procedure UnitsRecompute(Sender: TObject);
130 public
131 constructor Create; overload;
132 constructor Create(AWidth,AHeight: single; AUnit: TCSSUnit); overload;
133 constructor Create(AWidth,AHeight: single; AUnit: TCSSUnit; ACustomDPI: single); overload;
134 constructor Create(AFilenameUTF8: string); overload;
135 constructor Create(AStream: TStream); overload;
136 constructor CreateFromString(AUTF8String: string);
137 destructor Destroy; override;
138 procedure LoadFromFile(AFilenameUTF8: string);
139 procedure LoadFromStream(AStream: TStream);
140 procedure LoadFromResource(AFilename: string);
141 procedure SaveToFile(AFilenameUTF8: string);
142 procedure SaveToStream(AStream: TStream);
143 procedure Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; AVertAlign: TTextLayout; x,y: single; AUnit: TCSSUnit = cuPixel); overload;
144 procedure Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; AVertAlign: TTextLayout; x,y: single; destDpi: single); overload;
145 procedure Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; AVertAlign: TTextLayout; x,y: single; destDpi: TPointF); overload;
146 procedure Draw(ACanvas2d: TBGRACanvas2D; x,y: single; AUnit: TCSSUnit = cuPixel); overload;
147 procedure Draw(ACanvas2d: TBGRACanvas2D; x,y: single; destDpi: single); overload;
148 procedure Draw(ACanvas2d: TBGRACanvas2D; x,y: single; destDpi: TPointF); overload;
149 procedure StretchDraw(ACanvas2d: TBGRACanvas2D; x,y,w,h: single; useSvgAspectRatio: boolean = false); overload;
150 procedure StretchDraw(ACanvas2d: TBGRACanvas2D; r: TRectF; useSvgAspectRatio: boolean = false); overload;
151 procedure StretchDraw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment; AVertAlign: TTextLayout; x,y,w,h: single); overload;
152 function GetStretchRectF(AHorizAlign: TAlignment; AVertAlign: TTextLayout; x,y,w,h: single): TRectF;
153 property AsUTF8String: utf8string read GetUTF8String write SetUTF8String;
154 property Units: TSVGUnits read FUnits;
155 property Width: TFloatWithCSSUnit read GetWidth write SetWidth;
156 property Height: TFloatWithCSSUnit read GetHeight write SetHeight;
157 property WidthAsCm: single read GetWidthAsCm write SetWidthAsCm;
158 property HeightAsCm: single read GetHeightAsCm write SetHeightAsCm;
159 property WidthAsInch: single read GetWidthAsInch write SetWidthAsInch;
160 property HeightAsInch: single read GetHeightAsInch write SetHeightAsInch;
161 property Zoomable: boolean read GetZoomable write SetZoomable;
162 property ViewBox: TSVGViewBox read GetViewBox write SetViewBox;
163 property ViewBoxInUnit[AUnit: TCSSUnit]: TSVGViewBox read GetViewBox;
164 property ViewMinInUnit[AUnit: TCSSUnit]: TPointF read GetViewMin;
165 property ViewSizeInUnit[AUnit: TCSSUnit]: TPointF read GetViewSize;
166 property Attribute[AName: string]: string read GetAttribute write SetAttribute;
167 property AttributeDef[AName: string; ADefault: string]: string read GetAttribute;
168 property DefaultDpi: single read FDefaultDpi write SetDefaultDpi; //this is not saved in the SVG file
169 property CustomDpi: TPointF read GetCustomDpi write SetCustomDpi;
170 property Content: TSVGContent read FContent;
171 property DataLink: TSVGDataLink read FDataLink;//(for test or internal info)
172 property preserveAspectRatio: TSVGPreserveAspectRatio read GetPreserveAspectRatio write SetPreserveAspectRatio;
173 end;
174
175 { TFPReaderSVG }
176
177 TFPReaderSVG = class(TBGRAImageReader)
178 private
179 FRenderDpi: single;
180 FWidth,FHeight: integer;
181 FScale: single;
182 protected
183 function InternalCheck(Stream: TStream): boolean; override;
184 procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override;
185 public
186 constructor Create; override;
187 function GetQuickInfo(AStream: TStream): TQuickImageInfo; override;
188 function GetBitmapDraft(AStream: TStream; AMaxWidth, AMaxHeight: integer; out AOriginalWidth,AOriginalHeight: integer): TBGRACustomBitmap; override;
189 property RenderDpi: single read FRenderDpi write FRenderDpi;
190 property Width: integer read FWidth;
191 property Height: integer read FHeight;
192 property Scale: single read FScale write FScale;
193 end;
194
195procedure RegisterSvgFormat;
196
197implementation
198
199uses laz2_XMLRead, laz2_XMLWrite, BGRAUTF8, math;
200
201const SvgNamespace = 'http://www.w3.org/2000/svg';
202
203{ TFPReaderSVG }
204
205function TFPReaderSVG.InternalCheck(Stream: TStream): boolean;
206var
207 magic: array[1..6] of char;
208 prevPos: int64;
209 count: LongInt;
210begin
211 prevPos := Stream.Position;
212 count := Stream.Read({%H-}magic, sizeof(magic));
213 Stream.Position:= prevPos;
214 result:= (count = sizeof(magic)) and (magic = '<?xml ');
215end;
216
217procedure TFPReaderSVG.InternalRead(Stream: TStream; Img: TFPCustomImage);
218var
219 svg: TBGRASVG;
220 vmin,vsize: TPointF;
221 bgra: TBGRACustomBitmap;
222 c2d: TBGRACanvas2D;
223 y, x: Integer;
224 p: PBGRAPixel;
225begin
226 svg := TBGRASVG.Create(Stream);
227 bgra := nil;
228 try
229 svg.DefaultDpi:= RenderDpi;
230 if Img is TBGRACustomBitmap then
231 bgra := TBGRACustomBitmap(Img)
232 else
233 bgra := BGRABitmapFactory.Create;
234 vsize := svg.GetViewSize(cuPixel);
235 bgra.SetSize(ceil(vsize.x*scale),ceil(vsize.y*scale));
236 bgra.FillTransparent;
237 vmin := svg.GetViewMin(cuPixel);
238 c2d := TBGRACanvas2D.Create(bgra);
239 c2d.scale(Scale);
240 c2d.translate(-vmin.x,-vmin.y);
241 svg.Draw(c2d,0,0);
242 c2d.Free;
243 if bgra<>Img then
244 begin
245 Img.SetSize(bgra.Width,bgra.Height);
246 for y := 0 to bgra.Height-1 do
247 begin
248 p := bgra.ScanLine[y];
249 for x := 0 to bgra.Width-1 do
250 begin
251 Img.Colors[x,y] := BGRAToFPColor(p^);
252 inc(p);
253 end;
254 end;
255 end;
256 FWidth:= bgra.Width;
257 FHeight:= bgra.Height;
258 finally
259 if bgra<>Img then bgra.Free;
260 svg.Free;
261 end;
262end;
263
264constructor TFPReaderSVG.Create;
265begin
266 inherited Create;
267 FRenderDpi:= 96;
268 FScale := 1;
269end;
270
271function TFPReaderSVG.GetQuickInfo(AStream: TStream): TQuickImageInfo;
272var
273 svg: TBGRASVG;
274 vsize: TPointF;
275begin
276 svg := TBGRASVG.Create(AStream);
277 svg.DefaultDpi:= RenderDpi;
278 vsize := svg.GetViewSize(cuPixel);
279 svg.Free;
280 result.Width:= ceil(vsize.x);
281 result.Height:= ceil(vsize.y);
282 result.AlphaDepth:= 8;
283 result.ColorDepth:= 24;
284end;
285
286function TFPReaderSVG.GetBitmapDraft(AStream: TStream; AMaxWidth,
287 AMaxHeight: integer; out AOriginalWidth, AOriginalHeight: integer): TBGRACustomBitmap;
288var
289 svg: TBGRASVG;
290 vmin,vsize: TPointF;
291 c2d: TBGRACanvas2D;
292 ratio: Single;
293begin
294 svg := TBGRASVG.Create(AStream);
295 result := nil;
296 try
297 svg.DefaultDpi:= RenderDpi;
298 vsize := svg.GetViewSize(cuPixel);
299 AOriginalWidth:= ceil(vsize.x);
300 AOriginalHeight:= ceil(vsize.y);
301 if (vsize.x = 0) or (vsize.y = 0) then exit;
302 ratio := min(AMaxWidth/vsize.x, AMaxHeight/vsize.y);
303 result := BGRABitmapFactory.Create(ceil(vsize.x*ratio),ceil(vsize.y*ratio));
304 if ratio <> 0 then
305 begin
306 vmin := svg.GetViewMin(cuPixel);
307 c2d := TBGRACanvas2D.Create(result);
308 c2d.scale(ratio);
309 c2d.translate(-vmin.x,-vmin.y);
310 svg.Draw(c2d,0,0);
311 c2d.Free;
312 end;
313 finally
314 svg.Free;
315 end;
316end;
317
318var AlreadyRegistered: boolean;
319
320procedure RegisterSvgFormat;
321begin
322 if AlreadyRegistered then exit;
323 ImageHandlers.RegisterImageReader ('Scalable Vector Graphic', 'svg', TFPReaderSVG);
324 AlreadyRegistered:= True;
325end;
326
327function TSVGUnits.GetCustomDpiX: single;
328var pixSize: single;
329begin
330 with GetDefaultUnitWidth do
331 pixSize := Convert(value,CSSUnit,cuInch,FDefaultDpi^);
332 if pixSize = 0 then
333 result := 0
334 else
335 result := 1/pixSize;
336end;
337
338function TSVGUnits.GetCustomDpiY: single;
339var pixSize: single;
340begin
341 with GetDefaultUnitHeight do
342 pixSize := Convert(value,CSSUnit,cuInch,FDefaultDpi^);
343 if pixSize = 0 then
344 result := 0
345 else
346 result := 1/pixSize;
347end;
348
349function TSVGUnits.GetCustomOrigin: TPointF;
350begin
351 result := FViewBox.min;
352end;
353
354procedure TSVGUnits.SetCustomOrigin(AValue: TPointF);
355var newViewBox: TSVGViewBox;
356begin
357 newViewBox := ViewBox;
358 newViewBox.min := AValue;
359 ViewBox := newViewBox;
360end;
361
362function TSVGUnits.GetCustomDpi: TPointF;
363begin
364 result := PointF(CustomDpiX,CustomDpiY);
365end;
366
367procedure TSVGUnits.Recompute;
368var viewBoxStr: string;
369
370 function parseNextFloat: single;
371 var
372 idxSpace,{%H-}errPos: integer;
373 begin
374 idxSpace:= pos(' ',viewBoxStr);
375 if idxSpace <> 0 then
376 val(copy(viewBoxStr,1,idxSpace-1),result,errPos)
377 else
378 result := 0;
379 delete(viewBoxStr,1,idxSpace);
380 while (viewBoxStr <> '') and (viewBoxStr[1] = ' ') do delete(viewBoxStr,1,1);
381 end;
382
383begin
384 viewBoxStr := trim(FSvg.GetAttribute('viewBox'))+' ';
385 FViewBox.min.x := parseNextFloat;
386 FViewBox.min.y := parseNextFloat;
387 FViewBox.size.x := parseNextFloat;
388 FViewBox.size.y := parseNextFloat;
389
390 FOriginalViewSize.width := parseValue(FSvg.GetAttribute('width'), FloatWithCSSUnit(FViewBox.size.x, cuPixel));
391 if FOriginalViewSize.width.CSSUnit = cuCustom then FOriginalViewSize.width.CSSUnit := cuPixel;
392 if FOriginalViewSize.width.CSSUnit = cuPercent then
393 begin
394 FOriginalViewSize.width.value := FOriginalViewSize.width.value/100*FContainerWidth.value;
395 FOriginalViewSize.width.CSSUnit := FContainerWidth.CSSUnit;
396 end;
397 FOriginalViewSize.height := parseValue(FSvg.GetAttribute('height'), FloatWithCSSUnit(FViewBox.size.y, cuPixel));
398 if FOriginalViewSize.height.CSSUnit = cuCustom then FOriginalViewSize.height.CSSUnit := cuPixel;
399 if FOriginalViewSize.height.CSSUnit = cuPercent then
400 begin
401 FOriginalViewSize.height.value := FOriginalViewSize.height.value/100*FContainerHeight.value;
402 FOriginalViewSize.height.CSSUnit := FContainerHeight.CSSUnit;
403 end;
404 if FOriginalViewSize.height.CSSUnit <> FOriginalViewSize.width.CSSUnit then
405 FOriginalViewSize.height := ConvertHeight(FOriginalViewSize.height, FOriginalViewSize.width.CSSUnit);
406
407 FProportionalViewSize := FOriginalViewSize;
408 with GetStretchRectF(RectF(0,0,FOriginalViewSize.width.value,FOriginalViewSize.height.value), TSVGPreserveAspectRatio.DefaultValue) do
409 begin
410 FProportionalViewSize.width.value := Right-Left;
411 FProportionalViewSize.height.value := Bottom-Top;
412 end;
413
414 if (FViewBox.size.x <= 0) and (FViewBox.size.y <= 0) then
415 begin
416 FDefaultUnitWidth.value:= 1/FDefaultDpi^;
417 FDefaultUnitWidth.CSSUnit := cuInch;
418 FDefaultUnitHeight.value:= 1/FDefaultDpi^;
419 FDefaultUnitHeight.CSSUnit := cuInch;
420 FUseDefaultDPI := true;
421 FDpiScaleX := 1;
422 FDpiScaleY := 1;
423 FViewBox.min := PointF(0,0);
424 FViewBox.size.x := ConvertWidth(FProportionalViewSize.width,cuCustom).value;
425 FViewBox.size.y := ConvertHeight(FProportionalViewSize.height,cuCustom).value;
426 end else
427 begin
428 FDefaultUnitWidth.value := FProportionalViewSize.width.value/FViewBox.size.x;
429 FDefaultUnitWidth.CSSUnit := FProportionalViewSize.width.CSSUnit;
430 if FDefaultUnitWidth.CSSUnit = cuCustom then
431 begin
432 FDefaultUnitWidth.value /= FDefaultDpi^;
433 FDefaultUnitWidth.CSSUnit := cuInch;
434 end;
435 FDefaultUnitHeight.value := FProportionalViewSize.height.value/FViewBox.size.y;
436 FDefaultUnitHeight.CSSUnit := FProportionalViewSize.height.CSSUnit;
437 if FDefaultUnitHeight.CSSUnit = cuCustom then
438 begin
439 FDefaultUnitHeight.value /= FDefaultDpi^;
440 FDefaultUnitHeight.CSSUnit := cuInch;
441 end;
442 FUseDefaultDPI := false;
443 FDpiScaleX := CustomDpiX/DpiX;
444 FDpiScaleY := CustomDpiY/DpiY;
445 end;
446
447 if Assigned(FOnRecompute) then FOnRecompute(self);
448end;
449
450procedure TSVGUnits.SetOnRecompute(AValue: TSVGRecomputeEvent);
451begin
452 if FOnRecompute=AValue then Exit;
453 FOnRecompute:=AValue;
454end;
455
456procedure TSVGUnits.SetContainerHeight(AValue: TFloatWithCSSUnit);
457begin
458 if CompareMem(@FContainerHeight,@AValue,sizeof(TFloatWithCSSUnit)) then Exit;
459 FContainerHeight:=AValue;
460 Recompute;
461end;
462
463procedure TSVGUnits.SetContainerWidth(AValue: TFloatWithCSSUnit);
464begin
465 if CompareMem(@FContainerWidth,@AValue,sizeof(TFloatWithCSSUnit)) then Exit;
466 FContainerWidth:=AValue;
467 Recompute;
468end;
469
470procedure TSVGUnits.SetCustomDpi(ADpi: TPointF);
471var vb: TSVGViewBox;
472 vs: TSVGSize;
473begin
474 vb := ViewBox;
475 vs := FProportionalViewSize;
476 if (vs.width.value > 0) and (vs.height.value > 0) then
477 begin
478 vb.size.x := ConvertWidth(vs.width,cuInch).value*ADpi.X;
479 vb.size.y := ConvertHeight(vs.height,cuInch).value*ADpi.Y;
480 end
481 else
482 raise exception.Create('The size of the view port is not properly defined. Use Width and Height properties of TBGRASVG object.');
483 viewBox := vb;
484end;
485
486function TSVGUnits.GetDpiScaleX: single;
487begin
488 Result:=FDpiScaleX;
489end;
490
491function TSVGUnits.GetDpiScaleY: single;
492begin
493 Result:=FDpiScaleY;
494end;
495
496function TSVGUnits.GetDPIScaled: boolean;
497begin
498 Result:= not FUseDefaultDPI;
499end;
500
501procedure TSVGUnits.SetDefaultDpiAndOrigin;
502begin
503 FSvg.RemoveAttribute('viewBox');
504 Recompute;
505end;
506
507procedure TSVGUnits.SetViewBox(AValue: TSVGViewBox);
508begin
509 FSvg.SetAttribute('viewBox', formatValue(AValue.min.x)+' '+
510 formatValue(AValue.min.y)+' '+
511 formatValue(AValue.size.x)+' '+
512 formatValue(AValue.size.y));
513 Recompute;
514end;
515
516function TSVGUnits.GetDefaultUnitHeight: TFloatWithCSSUnit;
517begin
518 result := FDefaultUnitHeight;
519end;
520
521function TSVGUnits.GetDefaultUnitWidth: TFloatWithCSSUnit;
522begin
523 result := FDefaultUnitWidth;
524end;
525
526function TSVGUnits.GetDpiX: single;
527begin
528 result := FDefaultDpi^;
529end;
530
531function TSVGUnits.GetDpiY: single;
532begin
533 result := FDefaultDpi^;
534end;
535
536constructor TSVGUnits.Create(ASvg: TDOMElement; ADefaultDpi: PSingle);
537begin
538 FSvg := ASvg;
539 FDefaultDpi := ADefaultDpi;
540 FContainerWidth := FloatWithCSSUnit(640,cuPixel);
541 FContainerHeight := FloatWithCSSUnit(480,cuPixel);
542 Recompute;
543end;
544
545function TSVGUnits.GetStretchRectF(AViewSize: TRectF; par: TSVGPreserveAspectRatio): TRectF;
546var w0,h0,w,h: single;
547begin
548 result := AViewSize;
549 w0 := AViewSize.Right-AViewSize.Left;
550 h0 := AViewSize.Bottom-AViewSize.Top;
551 w := w0;
552 h := h0;
553
554 if par.Preserve and
555 (FViewBox.size.x > 0) and (FViewBox.size.y > 0) and
556 (w > 0) and (h > 0) then
557 begin
558 //viewBox wider than viewSize
559 if (FViewBox.size.x/FViewBox.size.y > w/h) xor par.Slice then
560 h := w * FViewBox.size.y / FViewBox.size.x
561 else
562 w := h * FViewBox.size.x / FViewBox.size.y;
563 case par.HorizAlign of
564 taCenter: result.Left += (w0-w)/2;
565 taRightJustify: result.Left += w0-w;
566 end;
567 case par.VertAlign of
568 tlCenter: result.Top += (h0-h)/2;
569 tlBottom: result.Top += h0-h;
570 end;
571 end;
572 result.Right := result.Left+w;
573 result.Bottom := result.Top+h;
574end;
575
576{ TBGRASVG }
577
578function TBGRASVG.GetAttribute(AName: string): string;
579begin
580 result := Trim(FRoot.GetAttribute(AName));
581end;
582
583function TBGRASVG.GetAttribute(AName: string; ADefault: string): string;
584begin
585 result := GetAttribute(AName);
586 if result = '' then result := ADefault;
587end;
588
589function TBGRASVG.GetCustomDpi: TPointF;
590begin
591 result := FUnits.CustomDpi;
592end;
593
594function TBGRASVG.GetHeight: TFloatWithCSSUnit;
595begin
596 result := TCSSUnitConverter.parseValue(Attribute['height'],FloatWithCSSUnit(FUnits.ViewBox.size.y,cuCustom));
597end;
598
599function TBGRASVG.GetHeightAsCm: single;
600begin
601 result := FUnits.ConvertHeight(Height,cuCentimeter).value;
602end;
603
604function TBGRASVG.GetHeightAsInch: single;
605begin
606 result := FUnits.ConvertHeight(Height,cuInch).value;
607end;
608
609function TBGRASVG.GetPreserveAspectRatio: TSVGPreserveAspectRatio;
610begin
611 result := TSVGPreserveAspectRatio.Parse(Attribute['preserveAspectRatio','xMidYMid']);
612end;
613
614function TBGRASVG.GetUTF8String: utf8string;
615var str: TMemoryStream;
616begin
617 str := TMemoryStream.Create;
618 SaveToStream(str);
619 setlength(result, str.Size);
620 str.Position := 0;
621 str.Read(result[1], length(result));
622 str.Free;
623end;
624
625function TBGRASVG.GetViewBox: TSVGViewBox;
626begin
627 result := FUnits.ViewBox;
628end;
629
630function TBGRASVG.GetViewBox(AUnit: TCSSUnit): TSVGViewBox;
631begin
632 GetViewBoxIndirect(AUnit,result);
633end;
634
635procedure TBGRASVG.GetViewBoxIndirect(AUnit: TCSSUnit; out AViewBox: TSVGViewBox);
636begin
637 with FUnits.ViewBox do
638 begin
639 AViewBox.min := FUnits.ConvertCoord(min,cuCustom,AUnit);
640 AViewBox.size := FUnits.ConvertCoord(size,cuCustom,AUnit);
641 end;
642end;
643
644function TBGRASVG.GetViewMin(AUnit: TCSSUnit): TPointF;
645var
646 vb: TSVGViewBox;
647begin
648 GetViewBoxIndirect(AUnit,vb);
649 result:= vb.min;
650end;
651
652function TBGRASVG.GetViewSize(AUnit: TCSSUnit): TPointF;
653var
654 vb: TSVGViewBox;
655begin
656 GetViewBoxIndirect(AUnit,vb);
657 result:= vb.size;
658end;
659
660function TBGRASVG.GetWidth: TFloatWithCSSUnit;
661begin
662 result := TCSSUnitConverter.parseValue(Attribute['width'],FloatWithCSSUnit(FUnits.ViewBox.size.x,cuCustom));
663end;
664
665function TBGRASVG.GetWidthAsCm: single;
666begin
667 result := FUnits.ConvertWidth(Width,cuCentimeter).value;
668end;
669
670function TBGRASVG.GetWidthAsInch: single;
671begin
672 result := FUnits.ConvertWidth(Width,cuInch).value;
673end;
674
675function TBGRASVG.GetZoomable: boolean;
676begin
677 result := AttributeDef['zoomAndPan','magnify']<>'disable';
678end;
679
680procedure TBGRASVG.SetAttribute(AName: string; AValue: string);
681begin
682 AName := trim(AName);
683 if compareText(AName,'viewBox')= 0 then AName := 'viewBox' else
684 if compareText(AName,'width')=0 then AName := 'width' else
685 if compareText(AName,'height')=0 then AName := 'height';
686 FRoot.SetAttribute(AName,AValue);
687 if (AName = 'viewBox') or (AName = 'width') or (AName = 'height') then
688 FUnits.Recompute;
689end;
690
691procedure TBGRASVG.SetCustomDpi(AValue: TPointF);
692begin
693 FUnits.CustomDpi := AValue;
694 if AValue.x <> AValue.y then
695 preserveAspectRatio := TSVGPreserveAspectRatio.Parse('none');
696end;
697
698procedure TBGRASVG.SetDefaultDpi(AValue: single);
699begin
700 if FDefaultDpi=AValue then Exit;
701 FDefaultDpi:=AValue;
702 Units.Recompute;
703end;
704
705procedure TBGRASVG.SetHeight(AValue: TFloatWithCSSUnit);
706begin
707 Attribute['height'] := TCSSUnitConverter.formatValue(AValue);
708end;
709
710procedure TBGRASVG.SetHeightAsCm(AValue: single);
711begin
712 Height := FloatWithCSSUnit(AValue,cuCentimeter);
713end;
714
715procedure TBGRASVG.SetHeightAsInch(AValue: single);
716begin
717 Height := FloatWithCSSUnit(AValue,cuInch);
718end;
719
720procedure TBGRASVG.SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio);
721begin
722 Attribute['preserveAspectRatio'] := AValue.ToString;
723 Units.Recompute;
724end;
725
726procedure TBGRASVG.SetUTF8String(AValue: utf8string);
727var str: TMemoryStream;
728begin
729 str:= TMemoryStream.Create;
730 str.Write(AValue[1],length(AValue));
731 str.Position:= 0;
732 LoadFromStream(str);
733 str.Free;
734end;
735
736{$PUSH}{$OPTIMIZATION OFF} //avoids Internal error 2012090607
737procedure TBGRASVG.SetViewBox(AValue: TSVGViewBox);
738begin
739 FUnits.ViewBox := AValue;
740end;
741{$POP}
742
743procedure TBGRASVG.SetWidth(AValue: TFloatWithCSSUnit);
744begin
745 Attribute['width'] := TCSSUnitConverter.formatValue(AValue);
746end;
747
748procedure TBGRASVG.SetWidthAsCm(AValue: single);
749begin
750 Width := FloatWithCSSUnit(AValue,cuCentimeter);
751end;
752
753procedure TBGRASVG.SetWidthAsInch(AValue: single);
754begin
755 Width := FloatWithCSSUnit(AValue,cuInch);
756end;
757
758procedure TBGRASVG.SetZoomable(AValue: boolean);
759begin
760 if AValue then
761 Attribute['zoomAndPan'] := 'magnify'
762 else
763 Attribute['zoomAndPan'] := 'disable';
764end;
765
766procedure TBGRASVG.Init(ACreateEmpty: boolean);
767begin
768 FDefaultDpi := 96; //web browser default
769 if ACreateEmpty then
770 begin
771 FXml := TXMLDocument.Create;
772 FRoot := FXml.CreateElement('svg');
773 FUnits := TSVGUnits.Create(FRoot,@FDefaultDpi);
774 FUnits.OnRecompute:= @UnitsRecompute;
775 FDataLink := TSVGDataLink.Create;
776 FContent := TSVGContent.Create(FXml,FRoot,FUnits,FDataLink,nil);
777 FXml.AppendChild(FRoot);
778 end;
779end;
780
781function TBGRASVG.GetViewBoxAlignment(AHorizAlign: TAlignment;
782 AVertAlign: TTextLayout): TPointF;
783var vb: TSVGViewBox;
784begin
785 GetViewBoxIndirect(cuPixel, vb);
786 with vb do
787 begin
788 case AHorizAlign of
789 taCenter: result.x := -(min.x+size.x*0.5);
790 taRightJustify: result.x := -(min.x+size.x);
791 else
792 {taLeftJustify:} result.x := -min.x;
793 end;
794 case AVertAlign of
795 tlCenter: result.y := -(min.y+size.y*0.5);
796 tlBottom: result.y := -(min.y+size.y);
797 else
798 {tlTop:} result.y := -min.y;
799 end;
800 end;
801end;
802
803procedure TBGRASVG.UnitsRecompute(Sender: TObject);
804begin
805 FContent.Recompute;
806end;
807
808constructor TBGRASVG.Create;
809begin
810 Init(True);
811end;
812
813constructor TBGRASVG.Create(AWidth, AHeight: single; AUnit: TCSSUnit);
814begin
815 Init(True);
816 Width := FloatWithCSSUnit(AWidth,AUnit);
817 Height := FloatWithCSSUnit(AHeight,AUnit);
818 if AUnit in[cuInch,cuPoint,cuPica] then
819 CustomDpi := PointF(288,288)
820 else if AUnit in[cuCentimeter,cuMillimeter] then
821 CustomDpi := PointF(254,254);
822end;
823
824constructor TBGRASVG.Create(AWidth,AHeight: single; AUnit: TCSSUnit; ACustomDPI: single);
825begin
826 Init(True);
827 Width := FloatWithCSSUnit(AWidth,AUnit);
828 Height := FloatWithCSSUnit(AHeight,AUnit);
829 CustomDpi := PointF(ACustomDPI,ACustomDPI);
830end;
831
832constructor TBGRASVG.Create(AFilenameUTF8: string);
833begin
834 Init(False);
835 LoadFromFile(AFilenameUTF8);
836end;
837
838constructor TBGRASVG.Create(AStream: TStream);
839begin
840 Init(False);
841 LoadFromStream(AStream);
842end;
843
844constructor TBGRASVG.CreateFromString(AUTF8String: string);
845begin
846 Init(False);
847 AsUTF8String:= AUTF8String;
848end;
849
850destructor TBGRASVG.Destroy;
851begin
852 FreeAndNil(FDataLink);
853 FreeAndNil(FContent);
854 FreeAndNil(FUnits);
855 FRoot:= nil;
856 FreeAndNil(FXml);
857 inherited Destroy;
858end;
859
860procedure TBGRASVG.LoadFromFile(AFilenameUTF8: string);
861var stream: TStream;
862begin
863 stream := TFileStreamUTF8.Create(AFilenameUTF8,fmOpenRead or fmShareDenyWrite);
864 try
865 LoadFromStream(stream);
866 finally
867 stream.Free;
868 end;
869end;
870
871procedure TBGRASVG.LoadFromStream(AStream: TStream);
872var xml: TXMLDocument;
873 root: TDOMNode;
874 byteOrderMark: packed array[1..3] of byte;
875 startPos: int64;
876begin
877 //skip utf8 byte order mark
878 startPos:= AStream.Position;
879 if AStream.Read({%H-}byteOrderMark,sizeof(byteOrderMark)) = 3 then
880 begin
881 if (byteOrderMark[1] = $ef) and (byteOrderMark[2] = $bb) and (byteOrderMark[3] = $bf) then
882 startPos += 3;
883 end;
884 AStream.Position:= startPos;
885 ReadXMLFile(xml,AStream);
886 root := xml.FirstChild;
887 while (root <> nil) and not (root is TDOMElement) do root := root.NextSibling;
888 if root = nil then
889 begin
890 xml.Free;
891 raise exception.Create('Root node not found');
892 end;
893 FreeAndNil(FDataLink);
894 FreeAndNil(FContent);
895 FreeAndNil(FUnits);
896 FreeAndNil(FXml);
897 FXml := xml;
898 FRoot := root as TDOMElement;
899 FUnits := TSVGUnits.Create(FRoot,@FDefaultDpi);
900 FUnits.OnRecompute:= @UnitsRecompute;
901 FDataLink := TSVGDataLink.Create;
902 FContent := TSVGContent.Create(FXml,FRoot,FUnits,FDataLink,nil);
903end;
904
905procedure TBGRASVG.LoadFromResource(AFilename: string);
906var
907 stream: TStream;
908begin
909 stream := BGRAResource.GetResourceStream(AFilename);
910 try
911 LoadFromStream(stream);
912 finally
913 stream.Free;
914 end;
915end;
916
917procedure TBGRASVG.SaveToFile(AFilenameUTF8: string);
918var stream: TFileStreamUTF8;
919begin
920 stream := TFileStreamUTF8.Create(AFilenameUTF8,fmCreate);
921 try
922 SaveToStream(stream);
923 finally
924 stream.free;
925 end;
926end;
927
928procedure TBGRASVG.SaveToStream(AStream: TStream);
929begin
930 if Attribute['xmlns'] = '' then Attribute['xmlns'] := SvgNamespace;
931 WriteXMLFile(FXml, AStream);
932end;
933
934procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment;
935 AVertAlign: TTextLayout; x, y: single; AUnit: TCSSUnit);
936var prevMatrix: TAffineMatrix;
937begin
938 prevMatrix := ACanvas2d.matrix;
939 ACanvas2d.translate(x,y);
940 with GetViewBoxAlignment(AHorizAlign,AVertAlign) do ACanvas2d.translate(x,y);
941 Draw(ACanvas2d, 0,0, AUnit);
942 ACanvas2d.matrix := prevMatrix;
943end;
944
945procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment;
946 AVertAlign: TTextLayout; x, y: single; destDpi: single);
947begin
948 Draw(ACanvas2d, AHorizAlign,AVertAlign, x,y, PointF(destDpi,destDpi));
949end;
950
951procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; AHorizAlign: TAlignment;
952 AVertAlign: TTextLayout; x, y: single; destDpi: TPointF);
953begin
954 ACanvas2d.save;
955 ACanvas2d.translate(x,y);
956 ACanvas2d.scale(destDpi.x/Units.DpiX,destDpi.y/Units.DpiY);
957 with GetViewBoxAlignment(AHorizAlign,AVertAlign) do ACanvas2d.translate(x,y);
958 Draw(ACanvas2d, 0,0, cuPixel);
959 ACanvas2d.restore;
960end;
961
962procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; x, y: single; AUnit: TCSSUnit);
963var prevLinearBlend: boolean;
964begin
965 prevLinearBlend:= ACanvas2d.linearBlend;
966 acanvas2d.linearBlend := true;
967 ACanvas2d.save;
968 ACanvas2d.translate(x,y);
969 ACanvas2d.strokeMatrix := ACanvas2d.matrix;
970 Content.Draw(ACanvas2d,AUnit);
971 ACanvas2d.restore;
972 ACanvas2d.linearBlend := prevLinearBlend;
973end;
974
975procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; x, y: single; destDpi: single);
976begin
977 Draw(ACanvas2d, x,y, PointF(destDpi,destDpi));
978end;
979
980procedure TBGRASVG.Draw(ACanvas2d: TBGRACanvas2D; x, y: single; destDpi: TPointF);
981begin
982 ACanvas2d.save;
983 ACanvas2d.translate(x,y);
984 ACanvas2d.scale(destDpi.x/Units.DpiX,destDpi.y/Units.DpiY);
985 Draw(ACanvas2d, 0,0, cuPixel);
986 ACanvas2d.restore;
987end;
988
989procedure TBGRASVG.StretchDraw(ACanvas2d: TBGRACanvas2D; x, y, w, h: single; useSvgAspectRatio: boolean);
990var vb: TSVGViewBox;
991begin
992 if useSvgAspectRatio then
993 begin
994 with preserveAspectRatio do
995 StretchDraw(ACanvas2d, HorizAlign, VertAlign, x,y,w,h);
996 exit;
997 end;
998 ACanvas2d.save;
999 ACanvas2d.translate(x,y);
1000 ACanvas2d.strokeResetTransform;
1001 GetViewBoxIndirect(cuPixel,vb);
1002 with vb do
1003 begin
1004 ACanvas2d.translate(-min.x,-min.y);
1005 if size.x <> 0 then
1006 ACanvas2d.scale(w/size.x,1);
1007 if size.y <> 0 then
1008 ACanvas2d.scale(1,h/size.y);
1009 end;
1010 Draw(ACanvas2d, 0,0);
1011 ACanvas2d.restore;
1012end;
1013
1014procedure TBGRASVG.StretchDraw(ACanvas2d: TBGRACanvas2D; r: TRectF; useSvgAspectRatio: boolean);
1015begin
1016 StretchDraw(ACanvas2d, r.Left,r.Top,r.Right-r.Left,r.Bottom-r.Top, useSvgAspectRatio);
1017end;
1018
1019procedure TBGRASVG.StretchDraw(ACanvas2d: TBGRACanvas2D;
1020 AHorizAlign: TAlignment; AVertAlign: TTextLayout; x, y, w, h: single);
1021var r: TRectF;
1022begin
1023 r := GetStretchRectF(AHorizAlign,AVertAlign, x, y, w, h);
1024 StretchDraw(ACanvas2d, r.Left,r.Top,r.Right-r.Left,r.Bottom-r.Top);
1025end;
1026
1027function TBGRASVG.GetStretchRectF(AHorizAlign: TAlignment;
1028 AVertAlign: TTextLayout; x, y, w, h: single): TRectF;
1029var ratio,stretchRatio,zoom: single;
1030 sx,sy,sw,sh: single;
1031 size: TSVGSize;
1032begin
1033 //determine global ratio according to viewSize
1034 size := Units.OriginalViewSize;
1035 size.width := Units.ConvertWidth(size.Width,cuPixel);
1036 size.height := Units.ConvertHeight(size.height,cuPixel);
1037 if (h = 0) or (w = 0) or (size.width.value = 0) or (size.height.value = 0) then
1038 begin
1039 result := RectF(x,y,w,h);
1040 exit;
1041 end;
1042 ratio := size.width.value/size.height.value;
1043 stretchRatio := w/h;
1044 if ratio > stretchRatio then
1045 zoom := w / size.width.value
1046 else
1047 zoom := h / size.height.value;
1048
1049 sx := x;
1050 sy := y;
1051 sw := size.width.value*zoom;
1052 sh := size.height.value*zoom;
1053
1054 case AHorizAlign of
1055 taCenter: sx += (w - sw)/2;
1056 taRightJustify: sx += w - sw;
1057 end;
1058 case AVertAlign of
1059 tlCenter: sy += (h - sh)/2;
1060 tlBottom: sy += h - sh;
1061 end;
1062
1063 result := Units.GetStretchRectF(RectF(sx,sy,sx+sw,sy+sh), preserveAspectRatio);
1064end;
1065
1066initialization
1067
1068 DefaultBGRAImageReader[ifSvg] := TFPReaderSVG;
1069
1070end.
1071
Note: See TracBrowser for help on using the repository browser.