Changeset 521 for GraphicTest/Packages/bgrabitmap/bgrasvg.pas
- Timestamp:
- Apr 17, 2019, 12:58:41 AM (5 years ago)
- Location:
- GraphicTest
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
GraphicTest
- Property svn:ignore
-
old new 8 8 GraphicTest.lps 9 9 GraphicTest.dbg 10 heaptrclog.trc
-
- Property svn:ignore
-
GraphicTest/Packages/bgrabitmap/bgrasvg.pas
r494 r521 7 7 uses 8 8 Classes, SysUtils, BGRABitmapTypes, laz2_DOM, BGRAUnits, BGRASVGShapes, 9 BGRACanvas2D; 9 BGRACanvas2D, BGRASVGType, FPimage; 10 11 type 12 TCSSUnit = BGRAUnits.TCSSUnit; 13 14 const 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; 10 25 11 26 type … … 21 36 TSVGUnits = class(TCSSUnitConverter) 22 37 private 38 FOnRecompute: TSVGRecomputeEvent; 39 FViewOffset: TPointF; 23 40 function GetCustomDpi: TPointF; 24 41 procedure Recompute; 42 procedure SetOnRecompute(AValue: TSVGRecomputeEvent); 25 43 protected 26 44 FSvg: TDOMElement; 27 45 FViewBox: TSVGViewBox; 28 FViewSize: TSVGSize; 46 FOriginalViewSize, FProportionalViewSize: TSVGSize; 47 29 48 FDefaultUnitHeight, FDefaultUnitWidth: TFloatWithCSSUnit; 30 49 FDefaultDpi: PSingle; 31 50 FUseDefaultDPI: boolean; 32 51 FDpiScaleX,FDpiScaleY: single; 52 FContainerHeight: TFloatWithCSSUnit; 53 FContainerWidth: TFloatWithCSSUnit; 54 procedure SetContainerHeight(AValue: TFloatWithCSSUnit); 55 procedure SetContainerWidth(AValue: TFloatWithCSSUnit); 33 56 function GetDefaultUnitHeight: TFloatWithCSSUnit; override; 34 57 function GetDefaultUnitWidth: TFloatWithCSSUnit; override; … … 47 70 procedure SetDefaultDpiAndOrigin; 48 71 constructor Create(ASvg: TDOMElement; ADefaultDpi: PSingle); 72 function GetStretchRectF(AViewSize: TRectF; par: TSVGPreserveAspectRatio): TRectF; 49 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; 50 77 property CustomOrigin: TPointF read GetCustomOrigin write SetCustomOrigin; 51 78 property CustomDpiX: single read GetCustomDpiX; 52 79 property CustomDpiY: single read GetCustomDpiY; 53 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; 54 84 end; 55 85 … … 58 88 TBGRASVG = class 59 89 private 60 function GetAttribute(AName: string): string; 90 function GetAttribute(AName: string): string; overload; 91 function GetAttribute(AName: string; ADefault: string): string; overload; 61 92 function GetCustomDpi: TPointF; 62 93 function GetHeight: TFloatWithCSSUnit; 63 94 function GetHeightAsCm: single; 64 95 function GetHeightAsInch: single; 65 function GetPreserveAspectRatio: string; 66 function GetViewBox: TSVGViewBox; 67 function GetViewBox(AUnit: TCSSUnit): TSVGViewBox; 96 function GetPreserveAspectRatio: TSVGPreserveAspectRatio; 97 function GetUTF8String: utf8string; 98 function GetViewBox: TSVGViewBox; overload; 99 function GetViewBox(AUnit: TCSSUnit): TSVGViewBox; overload; 68 100 procedure GetViewBoxIndirect(AUnit: TCSSUnit; out AViewBox: TSVGViewBox); 101 function GetViewMin(AUnit: TCSSUnit): TPointF; 102 function GetViewSize(AUnit: TCSSUnit): TPointF; 69 103 function GetWidth: TFloatWithCSSUnit; 70 104 function GetWidthAsCm: single; … … 77 111 procedure SetHeightAsCm(AValue: single); 78 112 procedure SetHeightAsInch(AValue: single); 79 procedure SetPreserveAspectRatio(AValue: string); 113 procedure SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio); 114 procedure SetUTF8String(AValue: utf8string); 80 115 procedure SetViewBox(AValue: TSVGViewBox); 81 116 procedure SetWidth(AValue: TFloatWithCSSUnit); … … 89 124 FDefaultDpi: single; 90 125 FContent: TSVGContent; 126 FDataLink: TSVGDataLink; 91 127 procedure Init(ACreateEmpty: boolean); 92 128 function GetViewBoxAlignment(AHorizAlign: TAlignment; AVertAlign: TTextLayout): TPointF; 129 procedure UnitsRecompute(Sender: TObject); 93 130 public 94 131 constructor Create; overload; … … 97 134 constructor Create(AFilenameUTF8: string); overload; 98 135 constructor Create(AStream: TStream); overload; 136 constructor CreateFromString(AUTF8String: string); 99 137 destructor Destroy; override; 100 138 procedure LoadFromFile(AFilenameUTF8: string); 101 139 procedure LoadFromStream(AStream: TStream); 140 procedure LoadFromResource(AFilename: string); 102 141 procedure SaveToFile(AFilenameUTF8: string); 103 142 procedure SaveToStream(AStream: TStream); … … 108 147 procedure Draw(ACanvas2d: TBGRACanvas2D; x,y: single; destDpi: single); overload; 109 148 procedure Draw(ACanvas2d: TBGRACanvas2D; x,y: single; destDpi: TPointF); overload; 110 procedure StretchDraw(ACanvas2d: TBGRACanvas2D; x,y,w,h: single); 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; 111 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; 112 154 property Units: TSVGUnits read FUnits; 113 155 property Width: TFloatWithCSSUnit read GetWidth write SetWidth; … … 120 162 property ViewBox: TSVGViewBox read GetViewBox write SetViewBox; 121 163 property ViewBoxInUnit[AUnit: TCSSUnit]: TSVGViewBox read GetViewBox; 164 property ViewMinInUnit[AUnit: TCSSUnit]: TPointF read GetViewMin; 165 property ViewSizeInUnit[AUnit: TCSSUnit]: TPointF read GetViewSize; 122 166 property Attribute[AName: string]: string read GetAttribute write SetAttribute; 167 property AttributeDef[AName: string; ADefault: string]: string read GetAttribute; 123 168 property DefaultDpi: single read FDefaultDpi write SetDefaultDpi; //this is not saved in the SVG file 124 169 property CustomDpi: TPointF read GetCustomDpi write SetCustomDpi; 125 170 property Content: TSVGContent read FContent; 126 property preserveAspectRatio: string read GetPreserveAspectRatio write SetPreserveAspectRatio; 127 end; 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 195 procedure RegisterSvgFormat; 128 196 129 197 implementation 130 198 131 uses laz2_XMLRead, laz2_XMLWrite, BGRAUTF8 ;199 uses laz2_XMLRead, laz2_XMLWrite, BGRAUTF8, math; 132 200 133 201 const SvgNamespace = 'http://www.w3.org/2000/svg'; 202 203 { TFPReaderSVG } 204 205 function TFPReaderSVG.InternalCheck(Stream: TStream): boolean; 206 var 207 magic: array[1..6] of char; 208 prevPos: int64; 209 count: LongInt; 210 begin 211 prevPos := Stream.Position; 212 count := Stream.Read({%H-}magic, sizeof(magic)); 213 Stream.Position:= prevPos; 214 result:= (count = sizeof(magic)) and (magic = '<?xml '); 215 end; 216 217 procedure TFPReaderSVG.InternalRead(Stream: TStream; Img: TFPCustomImage); 218 var 219 svg: TBGRASVG; 220 vmin,vsize: TPointF; 221 bgra: TBGRACustomBitmap; 222 c2d: TBGRACanvas2D; 223 y, x: Integer; 224 p: PBGRAPixel; 225 begin 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; 262 end; 263 264 constructor TFPReaderSVG.Create; 265 begin 266 inherited Create; 267 FRenderDpi:= 96; 268 FScale := 1; 269 end; 270 271 function TFPReaderSVG.GetQuickInfo(AStream: TStream): TQuickImageInfo; 272 var 273 svg: TBGRASVG; 274 vsize: TPointF; 275 begin 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; 284 end; 285 286 function TFPReaderSVG.GetBitmapDraft(AStream: TStream; AMaxWidth, 287 AMaxHeight: integer; out AOriginalWidth, AOriginalHeight: integer): TBGRACustomBitmap; 288 var 289 svg: TBGRASVG; 290 vmin,vsize: TPointF; 291 c2d: TBGRACanvas2D; 292 ratio: Single; 293 begin 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; 316 end; 317 318 var AlreadyRegistered: boolean; 319 320 procedure RegisterSvgFormat; 321 begin 322 if AlreadyRegistered then exit; 323 ImageHandlers.RegisterImageReader ('Scalable Vector Graphic', 'svg', TFPReaderSVG); 324 AlreadyRegistered:= True; 325 end; 134 326 135 327 function TSVGUnits.GetCustomDpiX: single; 136 328 var pixSize: single; 137 329 begin 138 pixSize := Convert(FDefaultUnitWidth.value,FDefaultUnitWidth.CSSUnit,cuInch,FDefaultDpi^); 330 with GetDefaultUnitWidth do 331 pixSize := Convert(value,CSSUnit,cuInch,FDefaultDpi^); 139 332 if pixSize = 0 then 140 333 result := 0 … … 146 339 var pixSize: single; 147 340 begin 148 pixSize := Convert(FDefaultUnitHeight.value,FDefaultUnitHeight.CSSUnit,cuInch,FDefaultDpi^); 341 with GetDefaultUnitHeight do 342 pixSize := Convert(value,CSSUnit,cuInch,FDefaultDpi^); 149 343 if pixSize = 0 then 150 344 result := 0 … … 194 388 FViewBox.size.y := parseNextFloat; 195 389 196 FViewSize.width := parseValue(FSvg.GetAttribute('width'), FloatWithCSSUnit(FViewBox.size.x, cuPixel)); 197 if FViewSize.width.CSSUnit = cuCustom then FViewSize.width.CSSUnit := cuPixel; 198 FViewSize.height := parseValue(FSvg.GetAttribute('height'), FloatWithCSSUnit(FViewBox.size.y, cuPixel)); 199 if FViewSize.height.CSSUnit = cuCustom then FViewSize.height.CSSUnit := cuPixel; 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; 200 413 201 414 if (FViewBox.size.x <= 0) and (FViewBox.size.y <= 0) then … … 209 422 FDpiScaleY := 1; 210 423 FViewBox.min := PointF(0,0); 211 FViewBox.size.x := ConvertWidth(F ViewSize.width,cuCustom).value;212 FViewBox.size.y := ConvertHeight(F ViewSize.height,cuCustom).value;424 FViewBox.size.x := ConvertWidth(FProportionalViewSize.width,cuCustom).value; 425 FViewBox.size.y := ConvertHeight(FProportionalViewSize.height,cuCustom).value; 213 426 end else 214 427 begin 215 FDefaultUnitWidth.value := F ViewSize.width.value/FViewBox.size.x;216 FDefaultUnitWidth.CSSUnit := F ViewSize.width.CSSUnit;428 FDefaultUnitWidth.value := FProportionalViewSize.width.value/FViewBox.size.x; 429 FDefaultUnitWidth.CSSUnit := FProportionalViewSize.width.CSSUnit; 217 430 if FDefaultUnitWidth.CSSUnit = cuCustom then 218 431 begin … … 220 433 FDefaultUnitWidth.CSSUnit := cuInch; 221 434 end; 222 FDefaultUnitHeight.value := F ViewSize.height.value/FViewBox.size.y;223 FDefaultUnitHeight.CSSUnit := F ViewSize.height.CSSUnit;435 FDefaultUnitHeight.value := FProportionalViewSize.height.value/FViewBox.size.y; 436 FDefaultUnitHeight.CSSUnit := FProportionalViewSize.height.CSSUnit; 224 437 if FDefaultUnitHeight.CSSUnit = cuCustom then 225 438 begin … … 231 444 FDpiScaleY := CustomDpiY/DpiY; 232 445 end; 446 447 if Assigned(FOnRecompute) then FOnRecompute(self); 448 end; 449 450 procedure TSVGUnits.SetOnRecompute(AValue: TSVGRecomputeEvent); 451 begin 452 if FOnRecompute=AValue then Exit; 453 FOnRecompute:=AValue; 454 end; 455 456 procedure TSVGUnits.SetContainerHeight(AValue: TFloatWithCSSUnit); 457 begin 458 if CompareMem(@FContainerHeight,@AValue,sizeof(TFloatWithCSSUnit)) then Exit; 459 FContainerHeight:=AValue; 460 Recompute; 461 end; 462 463 procedure TSVGUnits.SetContainerWidth(AValue: TFloatWithCSSUnit); 464 begin 465 if CompareMem(@FContainerWidth,@AValue,sizeof(TFloatWithCSSUnit)) then Exit; 466 FContainerWidth:=AValue; 467 Recompute; 233 468 end; 234 469 … … 238 473 begin 239 474 vb := ViewBox; 240 vs := F ViewSize;475 vs := FProportionalViewSize; 241 476 if (vs.width.value > 0) and (vs.height.value > 0) then 242 477 begin … … 303 538 FSvg := ASvg; 304 539 FDefaultDpi := ADefaultDpi; 540 FContainerWidth := FloatWithCSSUnit(640,cuPixel); 541 FContainerHeight := FloatWithCSSUnit(480,cuPixel); 305 542 Recompute; 306 543 end; 307 544 545 function TSVGUnits.GetStretchRectF(AViewSize: TRectF; par: TSVGPreserveAspectRatio): TRectF; 546 var w0,h0,w,h: single; 547 begin 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; 574 end; 575 308 576 { TBGRASVG } 309 577 310 578 function TBGRASVG.GetAttribute(AName: string): string; 311 579 begin 312 result := FRoot.GetAttribute(AName); 580 result := Trim(FRoot.GetAttribute(AName)); 581 end; 582 583 function TBGRASVG.GetAttribute(AName: string; ADefault: string): string; 584 begin 585 result := GetAttribute(AName); 586 if result = '' then result := ADefault; 313 587 end; 314 588 … … 320 594 function TBGRASVG.GetHeight: TFloatWithCSSUnit; 321 595 begin 322 result := TCSSUnitConverter.parseValue(Attribute['height'],FloatWithCSSUnit( 0,cuCustom));596 result := TCSSUnitConverter.parseValue(Attribute['height'],FloatWithCSSUnit(FUnits.ViewBox.size.y,cuCustom)); 323 597 end; 324 598 … … 333 607 end; 334 608 335 function TBGRASVG.GetPreserveAspectRatio: string; 336 begin 337 result := Attribute['preserveAspectRatio']; 609 function TBGRASVG.GetPreserveAspectRatio: TSVGPreserveAspectRatio; 610 begin 611 result := TSVGPreserveAspectRatio.Parse(Attribute['preserveAspectRatio','xMidYMid']); 612 end; 613 614 function TBGRASVG.GetUTF8String: utf8string; 615 var str: TMemoryStream; 616 begin 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; 338 623 end; 339 624 … … 357 642 end; 358 643 644 function TBGRASVG.GetViewMin(AUnit: TCSSUnit): TPointF; 645 var 646 vb: TSVGViewBox; 647 begin 648 GetViewBoxIndirect(AUnit,vb); 649 result:= vb.min; 650 end; 651 652 function TBGRASVG.GetViewSize(AUnit: TCSSUnit): TPointF; 653 var 654 vb: TSVGViewBox; 655 begin 656 GetViewBoxIndirect(AUnit,vb); 657 result:= vb.size; 658 end; 659 359 660 function TBGRASVG.GetWidth: TFloatWithCSSUnit; 360 661 begin 361 result := TCSSUnitConverter.parseValue(Attribute['width'],FloatWithCSSUnit( 0,cuCustom));662 result := TCSSUnitConverter.parseValue(Attribute['width'],FloatWithCSSUnit(FUnits.ViewBox.size.x,cuCustom)); 362 663 end; 363 664 … … 374 675 function TBGRASVG.GetZoomable: boolean; 375 676 begin 376 result := trim(Attribute['zoomAndPan'])<>'disable';677 result := AttributeDef['zoomAndPan','magnify']<>'disable'; 377 678 end; 378 679 … … 392 693 FUnits.CustomDpi := AValue; 393 694 if AValue.x <> AValue.y then 394 preserveAspectRatio := 'none';695 preserveAspectRatio := TSVGPreserveAspectRatio.Parse('none'); 395 696 end; 396 697 … … 417 718 end; 418 719 419 procedure TBGRASVG.SetPreserveAspectRatio(AValue: string); 420 begin 421 Attribute['preserveAspectRatio'] := AValue; 720 procedure TBGRASVG.SetPreserveAspectRatio(AValue: TSVGPreserveAspectRatio); 721 begin 722 Attribute['preserveAspectRatio'] := AValue.ToString; 723 Units.Recompute; 724 end; 725 726 procedure TBGRASVG.SetUTF8String(AValue: utf8string); 727 var str: TMemoryStream; 728 begin 729 str:= TMemoryStream.Create; 730 str.Write(AValue[1],length(AValue)); 731 str.Position:= 0; 732 LoadFromStream(str); 733 str.Free; 422 734 end; 423 735 … … 460 772 FRoot := FXml.CreateElement('svg'); 461 773 FUnits := TSVGUnits.Create(FRoot,@FDefaultDpi); 462 FContent := TSVGContent.Create(FXml,FRoot,FUnits); 774 FUnits.OnRecompute:= @UnitsRecompute; 775 FDataLink := TSVGDataLink.Create; 776 FContent := TSVGContent.Create(FXml,FRoot,FUnits,FDataLink,nil); 463 777 FXml.AppendChild(FRoot); 464 778 end; … … 487 801 end; 488 802 803 procedure TBGRASVG.UnitsRecompute(Sender: TObject); 804 begin 805 FContent.Recompute; 806 end; 807 489 808 constructor TBGRASVG.Create; 490 809 begin … … 523 842 end; 524 843 844 constructor TBGRASVG.CreateFromString(AUTF8String: string); 845 begin 846 Init(False); 847 AsUTF8String:= AUTF8String; 848 end; 849 525 850 destructor TBGRASVG.Destroy; 526 851 begin 852 FreeAndNil(FDataLink); 527 853 FreeAndNil(FContent); 528 854 FreeAndNil(FUnits); … … 565 891 raise exception.Create('Root node not found'); 566 892 end; 893 FreeAndNil(FDataLink); 567 894 FreeAndNil(FContent); 568 895 FreeAndNil(FUnits); … … 571 898 FRoot := root as TDOMElement; 572 899 FUnits := TSVGUnits.Create(FRoot,@FDefaultDpi); 573 FContent := TSVGContent.Create(FXml,FRoot,FUnits); 900 FUnits.OnRecompute:= @UnitsRecompute; 901 FDataLink := TSVGDataLink.Create; 902 FContent := TSVGContent.Create(FXml,FRoot,FUnits,FDataLink,nil); 903 end; 904 905 procedure TBGRASVG.LoadFromResource(AFilename: string); 906 var 907 stream: TStream; 908 begin 909 stream := BGRAResource.GetResourceStream(AFilename); 910 try 911 LoadFromStream(stream); 912 finally 913 stream.Free; 914 end; 574 915 end; 575 916 … … 614 955 ACanvas2d.translate(x,y); 615 956 ACanvas2d.scale(destDpi.x/Units.DpiX,destDpi.y/Units.DpiY); 616 ACanvas2d.strokeResetTransform;617 ACanvas2d.strokeScale(destDpi.x/Units.DpiX,destDpi.y/Units.DpiY);618 957 with GetViewBoxAlignment(AHorizAlign,AVertAlign) do ACanvas2d.translate(x,y); 619 958 Draw(ACanvas2d, 0,0, cuPixel); … … 628 967 ACanvas2d.save; 629 968 ACanvas2d.translate(x,y); 969 ACanvas2d.strokeMatrix := ACanvas2d.matrix; 630 970 Content.Draw(ACanvas2d,AUnit); 631 971 ACanvas2d.restore; … … 643 983 ACanvas2d.translate(x,y); 644 984 ACanvas2d.scale(destDpi.x/Units.DpiX,destDpi.y/Units.DpiY); 645 ACanvas2d.strokeResetTransform;646 ACanvas2d.strokeScale(destDpi.x/Units.DpiX,destDpi.y/Units.DpiY);647 985 Draw(ACanvas2d, 0,0, cuPixel); 648 986 ACanvas2d.restore; 649 987 end; 650 988 651 procedure TBGRASVG.StretchDraw(ACanvas2d: TBGRACanvas2D; x, y, w, h: single );989 procedure TBGRASVG.StretchDraw(ACanvas2d: TBGRACanvas2D; x, y, w, h: single; useSvgAspectRatio: boolean); 652 990 var vb: TSVGViewBox; 653 991 begin 992 if useSvgAspectRatio then 993 begin 994 with preserveAspectRatio do 995 StretchDraw(ACanvas2d, HorizAlign, VertAlign, x,y,w,h); 996 exit; 997 end; 654 998 ACanvas2d.save; 655 999 ACanvas2d.translate(x,y); … … 660 1004 ACanvas2d.translate(-min.x,-min.y); 661 1005 if size.x <> 0 then 662 begin663 1006 ACanvas2d.scale(w/size.x,1); 664 ACanvas2d.strokeScale(w/size.x,1);665 end;666 1007 if size.y <> 0 then 667 begin668 1008 ACanvas2d.scale(1,h/size.y); 669 ACanvas2d.strokeScale(1,h/size.y);670 end;671 1009 end; 672 1010 Draw(ACanvas2d, 0,0); … … 674 1012 end; 675 1013 1014 procedure TBGRASVG.StretchDraw(ACanvas2d: TBGRACanvas2D; r: TRectF; useSvgAspectRatio: boolean); 1015 begin 1016 StretchDraw(ACanvas2d, r.Left,r.Top,r.Right-r.Left,r.Bottom-r.Top, useSvgAspectRatio); 1017 end; 1018 676 1019 procedure TBGRASVG.StretchDraw(ACanvas2d: TBGRACanvas2D; 677 1020 AHorizAlign: TAlignment; AVertAlign: TTextLayout; x, y, w, h: single); 1021 var r: TRectF; 1022 begin 1023 r := GetStretchRectF(AHorizAlign,AVertAlign, x, y, w, h); 1024 StretchDraw(ACanvas2d, r.Left,r.Top,r.Right-r.Left,r.Bottom-r.Top); 1025 end; 1026 1027 function TBGRASVG.GetStretchRectF(AHorizAlign: TAlignment; 1028 AVertAlign: TTextLayout; x, y, w, h: single): TRectF; 678 1029 var ratio,stretchRatio,zoom: single; 679 vb: TSVGViewBox;680 1030 sx,sy,sw,sh: single; 681 begin 682 GetViewBoxIndirect(cuPixel,vb); 683 if (h = 0) or (w = 0) or (vb.size.x = 0) or (vb.size.y = 0) then exit; 684 ratio := vb.size.x/vb.size.y; 1031 size: TSVGSize; 1032 begin 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; 685 1043 stretchRatio := w/h; 686 1044 if ratio > stretchRatio then 687 zoom := w / vb.size.x1045 zoom := w / size.width.value 688 1046 else 689 zoom := h / vb.size.y;1047 zoom := h / size.height.value; 690 1048 691 1049 sx := x; 692 1050 sy := y; 693 sw := vb.size.x*zoom;694 sh := vb.size.y*zoom;1051 sw := size.width.value*zoom; 1052 sh := size.height.value*zoom; 695 1053 696 1054 case AHorizAlign of … … 702 1060 tlBottom: sy += h - sh; 703 1061 end; 704 StretchDraw(ACanvas2d, sx,sy,sw,sh); 705 end; 1062 1063 result := Units.GetStretchRectF(RectF(sx,sy,sx+sw,sy+sh), preserveAspectRatio); 1064 end; 1065 1066 initialization 1067 1068 DefaultBGRAImageReader[ifSvg] := TFPReaderSVG; 706 1069 707 1070 end.
Note:
See TracChangeset
for help on using the changeset viewer.