From 01eae0174e4e97db53a0dec9a6899fd8bef8e52d Mon Sep 17 00:00:00 2001 From: Carlo Barazzetta Date: Fri, 26 Apr 2024 18:05:23 +0200 Subject: [PATCH] version 4.1.3 (VCL+FMX) - Aligned To latest Image32 - Fixed compilation with MacOSX - Added support for Delphi 12.1 --- Demo/D12/SVGIconImageListDemo.dproj | 4 +- Demo/SVGExplorer/FExplorerSVG.dfm | 24 +- Demo/SVGExplorer/SVGExplorer.dpr | 2 +- Demo/SVGExplorer/SVGExplorer.dproj | 137 ++- Demo/SvgViewer/FrameViewer.dfm | 18 +- Demo/SvgViewer/SvgViewer.dpr | 1 + Demo/SvgViewer/SvgViewer.dproj | 137 ++- Demo/SvgViewer/SvgViewerUnit.dfm | 65 - Demo/SvgViewer/SvgViewerUnit.pas | 1 + Demo/svg_examples/chessboard.svg | 281 +++++ .../flat-color-icons/svg/Bind.svg | 7 + Image32/source/Clipper.Core.pas | 107 +- Image32/source/Clipper.Engine.pas | 208 ++-- Image32/source/Clipper.Minkowski.pas | 11 +- Image32/source/Clipper.Offset.pas | 451 ++++--- Image32/source/Clipper.RectClip.pas | 52 +- Image32/source/Clipper.inc | 18 +- Image32/source/Clipper.pas | 112 +- Image32/source/Img32.CQ.pas | 46 +- Image32/source/Img32.Clipper2.pas | 7 +- Image32/source/Img32.Draw.pas | 142 ++- Image32/source/Img32.Extra.pas | 42 +- Image32/source/Img32.Fmt.BMP.pas | 16 +- Image32/source/Img32.Fmt.SVG.pas | 116 +- Image32/source/Img32.Layers.pas | 134 +-- Image32/source/Img32.Panels.pas | 27 +- Image32/source/Img32.Resamplers.pas | 258 ++-- Image32/source/Img32.SVG.Core.pas | 105 +- Image32/source/Img32.SVG.HashConsts.inc | 2 + Image32/source/Img32.SVG.Path.pas | 42 +- Image32/source/Img32.SVG.PathDesign.pas | 5 +- Image32/source/Img32.SVG.Reader.pas | 690 ++++++----- Image32/source/Img32.Text.pas | 14 +- Image32/source/Img32.Transform.pas | 94 +- Image32/source/Img32.Vector.pas | 1051 ++++++++++------- Image32/source/Img32.inc | 11 +- Image32/source/Img32.pas | 33 +- Packages/D12/SVGIconImageList.dproj | 19 +- Packages/D12/SVGIconImageListFMX.dproj | 14 + Packages/D12/SVGImage32Package.dproj | 20 + Packages/D12/dclSVGIconImageList.dproj | 14 + Packages/D12/dclSVGIconImageListFMX.dproj | 12 + README.htm | 455 +++++++ README.md | 8 +- Source/FMX.SVGIconImageList.pas | 2 +- Source/Image32SVGFactory.pas | 2 +- Source/SVGIconImageListBase.pas | 2 +- 47 files changed, 3273 insertions(+), 1746 deletions(-) create mode 100644 Demo/svg_examples/chessboard.svg create mode 100644 Demo/svg_examples/flat-color-icons/svg/Bind.svg create mode 100644 README.htm diff --git a/Demo/D12/SVGIconImageListDemo.dproj b/Demo/D12/SVGIconImageListDemo.dproj index f418b06..e9ba53d 100644 --- a/Demo/D12/SVGIconImageListDemo.dproj +++ b/Demo/D12/SVGIconImageListDemo.dproj @@ -1,10 +1,10 @@ - + {DAE3A37C-D7A5-4230-A31E-7E95B5B41269} SVGIconImageListDemo.dpr Debug DCC32 - 20.0 + 20.1 VCL True Win32 diff --git a/Demo/SVGExplorer/FExplorerSVG.dfm b/Demo/SVGExplorer/FExplorerSVG.dfm index fda3596..c57a410 100644 --- a/Demo/SVGExplorer/FExplorerSVG.dfm +++ b/Demo/SVGExplorer/FExplorerSVG.dfm @@ -8,7 +8,7 @@ object fmExplorerSVG: TfmExplorerSVG Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 - Font.Name = 'Tahoma' + Font.Name = 'Segoe UI' Font.Style = [] ShowHint = True OnCreate = FormCreate @@ -41,7 +41,6 @@ object fmExplorerSVG: TfmExplorerSVG Height = 509 Align = alLeft TabOrder = 0 - ExplicitHeight = 508 object DirSelection: TDirectoryListBox Left = 1 Top = 41 @@ -50,7 +49,6 @@ object fmExplorerSVG: TfmExplorerSVG Align = alClient TabOrder = 0 OnChange = DirSelectionChange - ExplicitHeight = 387 end object DrivePanel: TPanel Left = 1 @@ -76,7 +74,6 @@ object fmExplorerSVG: TfmExplorerSVG Height = 19 Panels = <> SimplePanel = True - ExplicitTop = 488 end object TrackBarPanel: TPanel Left = 1 @@ -86,11 +83,10 @@ object fmExplorerSVG: TfmExplorerSVG Align = alBottom BevelOuter = bvNone TabOrder = 3 - ExplicitTop = 428 object Label1: TLabel Left = 8 Top = 5 - Width = 51 + Width = 52 Height = 13 Caption = 'Icons size:' end @@ -117,8 +113,6 @@ object fmExplorerSVG: TfmExplorerSVG Height = 509 Align = alClient TabOrder = 1 - ExplicitWidth = 581 - ExplicitHeight = 508 object ImageListLabel: TLabel Left = 1 Top = 42 @@ -154,7 +148,6 @@ object fmExplorerSVG: TfmExplorerSVG Height = 41 Align = alTop TabOrder = 0 - ExplicitWidth = 579 DesignSize = ( 583 41) @@ -167,7 +160,6 @@ object fmExplorerSVG: TfmExplorerSVG TabOrder = 0 TextHint = 'Insert filter with wildcards to search icons by name...' OnInvokeSearch = SearchBoxInvokeSearch - ExplicitWidth = 562 end end object ImageView: TListView @@ -184,8 +176,6 @@ object fmExplorerSVG: TfmExplorerSVG TabOrder = 1 OnKeyDown = ImageViewKeyDown OnSelectItem = ImageViewSelectItem - ExplicitWidth = 579 - ExplicitHeight = 327 end object StatusBar: TStatusBar Left = 1 @@ -194,8 +184,6 @@ object fmExplorerSVG: TfmExplorerSVG Height = 19 Panels = <> SimplePanel = True - ExplicitTop = 488 - ExplicitWidth = 579 end object paSVGText: TPanel Left = 1 @@ -205,8 +193,6 @@ object fmExplorerSVG: TfmExplorerSVG Hint = 'SVG Text content' Align = alBottom TabOrder = 3 - ExplicitTop = 388 - ExplicitWidth = 579 object SVGMemo: TMemo Left = 1 Top = 1 @@ -222,7 +208,6 @@ object fmExplorerSVG: TfmExplorerSVG ReadOnly = True ScrollBars = ssBoth TabOrder = 0 - ExplicitWidth = 577 end end end @@ -234,8 +219,6 @@ object fmExplorerSVG: TfmExplorerSVG Align = alRight TabOrder = 2 OnResize = paPreviewResize - ExplicitLeft = 774 - ExplicitHeight = 508 DesignSize = ( 136 509) @@ -263,7 +246,6 @@ object fmExplorerSVG: TfmExplorerSVG Action = DeleteAction Anchors = [akLeft, akRight, akBottom] TabOrder = 1 - ExplicitTop = 477 end object BtRename: TButton Left = 5 @@ -273,7 +255,6 @@ object fmExplorerSVG: TfmExplorerSVG Action = RenameAction Anchors = [akLeft, akRight, akBottom] TabOrder = 0 - ExplicitTop = 446 end object ShowTextCheckBox: TCheckBox Left = 6 @@ -286,7 +267,6 @@ object fmExplorerSVG: TfmExplorerSVG State = cbChecked TabOrder = 2 OnClick = ShowTextCheckBoxClick - ExplicitTop = 419 end object grpFactory: TRadioGroup Left = 1 diff --git a/Demo/SVGExplorer/SVGExplorer.dpr b/Demo/SVGExplorer/SVGExplorer.dpr index 6ec84d9..d5a4724 100644 --- a/Demo/SVGExplorer/SVGExplorer.dpr +++ b/Demo/SVGExplorer/SVGExplorer.dpr @@ -7,7 +7,7 @@ uses {$R *.res} begin - Application.Title := 'SVG Icons Explorer - Copyright (c) 2020-2022 Ethea S.r.l.'; + Application.Title := 'SVG Icons Explorer - Copyright (c) 2020-2024 Ethea S.r.l.'; Application.Initialize; Application.MainFormOnTaskbar := True; Application.CreateForm(TfmExplorerSVG, fmExplorerSVG); diff --git a/Demo/SVGExplorer/SVGExplorer.dproj b/Demo/SVGExplorer/SVGExplorer.dproj index 80c9283..bfa5bb4 100644 --- a/Demo/SVGExplorer/SVGExplorer.dproj +++ b/Demo/SVGExplorer/SVGExplorer.dproj @@ -1,7 +1,7 @@  {62B8E620-E233-45E4-9FDA-7A955E08C7EC} - 19.5 + 20.1 VCL SVGExplorer.dpr True @@ -9,6 +9,7 @@ Win64 3 Application + SVGExplorer true @@ -331,6 +332,16 @@ 1 + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + res\values @@ -351,6 +362,66 @@ 1 + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + res\values @@ -361,6 +432,16 @@ 1 + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + res\drawable @@ -531,6 +612,56 @@ 1 + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 1 + + 1 @@ -771,6 +902,9 @@ 1 + + 1 + @@ -1063,6 +1197,7 @@ + 12 diff --git a/Demo/SvgViewer/FrameViewer.dfm b/Demo/SvgViewer/FrameViewer.dfm index 7eebbd0..a3b4ff0 100644 --- a/Demo/SvgViewer/FrameViewer.dfm +++ b/Demo/SvgViewer/FrameViewer.dfm @@ -1,14 +1,14 @@ object FrameView: TFrameView Left = 0 Top = 0 - Width = 510 - Height = 432 + Width = 300 + Height = 300 TabOrder = 0 object ClientPanel: TPanel Left = 0 Top = 0 - Width = 510 - Height = 432 + Width = 300 + Height = 300 Align = alClient BevelOuter = bvNone BorderWidth = 1 @@ -18,21 +18,17 @@ object FrameView: TFrameView object SVGPaintBox: TPaintBox Left = 1 Top = 24 - Width = 508 - Height = 407 + Width = 298 + Height = 275 Align = alClient Color = clWhite ParentColor = False OnPaint = SVGPaintBoxPaint - ExplicitLeft = 145 - ExplicitTop = 129 - ExplicitWidth = 300 - ExplicitHeight = 300 end object TitlePanel: TPanel Left = 1 Top = 1 - Width = 508 + Width = 298 Height = 23 Align = alTop BevelOuter = bvNone diff --git a/Demo/SvgViewer/SvgViewer.dpr b/Demo/SvgViewer/SvgViewer.dpr index aad787c..add27bb 100644 --- a/Demo/SvgViewer/SvgViewer.dpr +++ b/Demo/SvgViewer/SvgViewer.dpr @@ -10,6 +10,7 @@ uses {$R *.res} begin + Application.Title := 'SVG Preview & Engine Comparison - Copyright (c) 2020-2024 Ethea S.r.l.'; Application.Initialize; Application.MainFormOnTaskbar := True; Application.CreateForm(TSVGViewerForm, SVGViewerForm); diff --git a/Demo/SvgViewer/SvgViewer.dproj b/Demo/SvgViewer/SvgViewer.dproj index 178d6ad..ad77f93 100644 --- a/Demo/SvgViewer/SvgViewer.dproj +++ b/Demo/SvgViewer/SvgViewer.dproj @@ -1,7 +1,7 @@  {AD7AD52D-F991-4DFE-95E0-FDDC2564C73C} - 19.5 + 20.1 VCL SvgViewer.dpr True @@ -9,6 +9,7 @@ Win32 1 Application + SvgViewer true @@ -333,6 +334,16 @@ 1 + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + res\values @@ -353,6 +364,66 @@ 1 + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + res\values @@ -363,6 +434,16 @@ 1 + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + res\drawable @@ -533,6 +614,56 @@ 1 + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 1 + + 1 @@ -773,6 +904,9 @@ 1 + + 1 + @@ -1066,6 +1200,7 @@ + True diff --git a/Demo/SvgViewer/SvgViewerUnit.dfm b/Demo/SvgViewer/SvgViewerUnit.dfm index c69908c..91837d8 100644 --- a/Demo/SvgViewer/SvgViewerUnit.dfm +++ b/Demo/SvgViewer/SvgViewerUnit.dfm @@ -21,7 +21,6 @@ object SVGViewerForm: TSVGViewerForm Height = 600 Align = alLeft TabOrder = 0 - ExplicitHeight = 599 object ListBox: TListBox Left = 1 Top = 42 @@ -31,7 +30,6 @@ object SVGViewerForm: TSVGViewerForm ItemHeight = 13 TabOrder = 0 OnClick = ListBoxClick - ExplicitHeight = 556 end object OpenPanel: TPanel Left = 1 @@ -69,8 +67,6 @@ object SVGViewerForm: TSVGViewerForm Align = alRight BevelOuter = bvNone TabOrder = 1 - ExplicitLeft = 496 - ExplicitHeight = 599 inline FrameViewSkia: TFrameView Left = 0 Top = 300 @@ -78,26 +74,6 @@ object SVGViewerForm: TSVGViewerForm Height = 300 Align = alClient TabOrder = 0 - ExplicitTop = 300 - ExplicitWidth = 300 - ExplicitHeight = 299 - inherited ClientPanel: TPanel - Width = 300 - Height = 300 - ExplicitWidth = 300 - ExplicitHeight = 299 - inherited SVGPaintBox: TPaintBox - Width = 298 - Height = 275 - ExplicitWidth = 296 - ExplicitHeight = 276 - end - inherited TitlePanel: TPanel - Width = 298 - Font.Height = -11 - ExplicitWidth = 298 - end - end end object ControlPanel: TPanel Left = 0 @@ -227,8 +203,6 @@ object SVGViewerForm: TSVGViewerForm Align = alClient BevelOuter = bvNone TabOrder = 2 - ExplicitWidth = 296 - ExplicitHeight = 599 inline FrameViewerD2D: TFrameView Left = 0 Top = 300 @@ -236,26 +210,6 @@ object SVGViewerForm: TSVGViewerForm Height = 300 Align = alClient TabOrder = 0 - ExplicitTop = 300 - ExplicitWidth = 296 - ExplicitHeight = 299 - inherited ClientPanel: TPanel - Width = 300 - Height = 300 - ExplicitWidth = 296 - ExplicitHeight = 299 - inherited SVGPaintBox: TPaintBox - Width = 298 - Height = 275 - ExplicitWidth = 296 - ExplicitHeight = 273 - end - inherited TitlePanel: TPanel - Width = 298 - Font.Height = -11 - ExplicitWidth = 294 - end - end end inline FrameViewImage32: TFrameView Left = 0 @@ -264,25 +218,6 @@ object SVGViewerForm: TSVGViewerForm Height = 300 Align = alTop TabOrder = 1 - ExplicitWidth = 296 - ExplicitHeight = 300 - inherited ClientPanel: TPanel - Width = 300 - Height = 300 - ExplicitWidth = 296 - ExplicitHeight = 300 - inherited SVGPaintBox: TPaintBox - Width = 298 - Height = 275 - ExplicitWidth = 296 - ExplicitHeight = 273 - end - inherited TitlePanel: TPanel - Width = 298 - Font.Height = -11 - ExplicitWidth = 294 - end - end end end object OpenDialog1: TOpenDialog diff --git a/Demo/SvgViewer/SvgViewerUnit.pas b/Demo/SvgViewer/SvgViewerUnit.pas index 0ea7ded..b0a952a 100644 --- a/Demo/SvgViewer/SvgViewerUnit.pas +++ b/Demo/SvgViewer/SvgViewerUnit.pas @@ -125,6 +125,7 @@ procedure TSVGViewerForm.FixedColorComboBoxChange(Sender: TObject); procedure TSVGViewerForm.FormCreate(Sender: TObject); begin + Caption := Application.Title; SourcePath := ExtractFilePath(Application.ExeName)+'..\svg_examples'; FrameViewerD2D.InitViewer('Native Direct2D', GetD2DSVGFactory); diff --git a/Demo/svg_examples/chessboard.svg b/Demo/svg_examples/chessboard.svg new file mode 100644 index 0000000..16b23c3 --- /dev/null +++ b/Demo/svg_examples/chessboard.svg @@ -0,0 +1,281 @@ + + + 
+			r n b q . k n r
+			p p p p . . p p
+			. . . . . . . .
+			. . b . p Q . .
+			. . . . P . . .
+			. . . . . . . .
+			P P P P . P P P
+			R N B . K . N R
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/Demo/svg_examples/flat-color-icons/svg/Bind.svg b/Demo/svg_examples/flat-color-icons/svg/Bind.svg new file mode 100644 index 0000000..3b86ede --- /dev/null +++ b/Demo/svg_examples/flat-color-icons/svg/Bind.svg @@ -0,0 +1,7 @@ + + + + + + + diff --git a/Image32/source/Clipper.Core.pas b/Image32/source/Clipper.Core.pas index 4e710bd..0a76571 100644 --- a/Image32/source/Clipper.Core.pas +++ b/Image32/source/Clipper.Core.pas @@ -2,9 +2,9 @@ (******************************************************************************* * Author : Angus Johnson * -* Date : 17 July 2023 * +* Date : 14 February 2024 * * Website : http://www.angusj.com * -* Copyright : Angus Johnson 2010-2023 * +* Copyright : Angus Johnson 2010-2024 * * Purpose : Core Clipper Library module * * Contains structures and functions used throughout the library * * License : http://www.boost.org/LICENSE_1_0.txt * @@ -64,6 +64,7 @@ TPointD = record function GetWidth: Int64; {$IFDEF INLINING} inline; {$ENDIF} function GetHeight: Int64; {$IFDEF INLINING} inline; {$ENDIF} function GetIsEmpty: Boolean; {$IFDEF INLINING} inline; {$ENDIF} + function GetIsValid: Boolean; {$IFDEF INLINING} inline; {$ENDIF} function GetMidPoint: TPoint64; {$IFDEF INLINING} inline; {$ENDIF} public Left : Int64; @@ -78,6 +79,7 @@ TPointD = record property Width: Int64 read GetWidth; property Height: Int64 read GetHeight; property IsEmpty: Boolean read GetIsEmpty; + property IsValid: Boolean read GetIsValid; property MidPoint: TPoint64 read GetMidPoint; end; @@ -86,6 +88,7 @@ TPointD = record function GetWidth: double; {$IFDEF INLINING} inline; {$ENDIF} function GetHeight: double; {$IFDEF INLINING} inline; {$ENDIF} function GetIsEmpty: Boolean; {$IFDEF INLINING} inline; {$ENDIF} + function GetIsValid: Boolean; {$IFDEF INLINING} inline; {$ENDIF} function GetMidPoint: TPointD; {$IFDEF INLINING} inline; {$ENDIF} public Left : double; @@ -99,6 +102,7 @@ TPointD = record property Width: double read GetWidth; property Height: double read GetHeight; property IsEmpty: Boolean read GetIsEmpty; + property IsValid: Boolean read GetIsValid; property MidPoint: TPointD read GetMidPoint; end; @@ -168,8 +172,8 @@ function DistanceSqr(const pt1, pt2: TPoint64): double; overload; {$IFDEF INLINING} inline; {$ENDIF} function DistanceSqr(const pt1, pt2: TPointD): double; overload; {$IFDEF INLINING} inline; {$ENDIF} -function DistanceFromLineSqrd(const pt, linePt1, linePt2: TPoint64): double; overload; -function DistanceFromLineSqrd(const pt, linePt1, linePt2: TPointD): double; overload; +function PerpendicDistFromLineSqrd(const pt, linePt1, linePt2: TPoint64): double; overload; +function PerpendicDistFromLineSqrd(const pt, linePt1, linePt2: TPointD): double; overload; function SegmentsIntersect(const s1a, s1b, s2a, s2b: TPoint64; inclusive: Boolean = false): boolean; {$IFDEF INLINING} inline; {$ENDIF} @@ -311,7 +315,7 @@ procedure AppendPaths(var paths: TPathsD; const extra: TPathsD); overload; function ArrayOfPathsToPaths(const ap: TArrayOfPaths): TPaths64; -function GetIntersectPoint(const ln1a, ln1b, ln2a, ln2b: TPoint64; +function GetSegmentIntersectPt(const ln1a, ln1b, ln2a, ln2b: TPoint64; out ip: TPoint64): Boolean; function PointInPolygon(const pt: TPoint64; const polygon: TPath64): TPointInPolygonResult; @@ -333,8 +337,14 @@ procedure QuickSort(SortList: TPointerList; procedure CheckPrecisionRange(var precision: integer); +function Iif(eval: Boolean; trueVal, falseVal: Boolean): Boolean; overload; +function Iif(eval: Boolean; trueVal, falseVal: integer): integer; overload; +function Iif(eval: Boolean; trueVal, falseVal: Int64): Int64; overload; +function Iif(eval: Boolean; trueVal, falseVal: double): double; overload; + const MaxInt64 = 9223372036854775807; + MinInt64 = -MaxInt64; MaxCoord = MaxInt64 div 4; MinCoord = - MaxCoord; invalid64 = MaxInt64; @@ -346,6 +356,11 @@ procedure CheckPrecisionRange(var precision: integer); InvalidPtD : TPointD = (X: invalidD; Y: invalidD); NullRectD : TRectD = (left: 0; top: 0; right: 0; Bottom: 0); + InvalidRect64 : TRect64 = + (left: invalid64; top: invalid64; right: invalid64; bottom: invalid64); + InvalidRectD : TRectD = + (left: invalidD; top: invalidD; right: invalidD; bottom: invalidD); + Tolerance : Double = 1.0E-12; //https://github.com/AngusJohnson/Clipper2/discussions/564 @@ -378,6 +393,12 @@ function TRect64.GetIsEmpty: Boolean; end; //------------------------------------------------------------------------------ +function TRect64.GetIsValid: Boolean; +begin + result := left <> invalid64; +end; +//------------------------------------------------------------------------------ + function TRect64.GetMidPoint: TPoint64; begin result := Point64((Left + Right) div 2, (Top + Bottom) div 2); @@ -450,6 +471,12 @@ function TRectD.GetIsEmpty: Boolean; end; //------------------------------------------------------------------------------ +function TRectD.GetIsValid: Boolean; +begin + result := left <> invalidD; +end; +//------------------------------------------------------------------------------ + function TRectD.GetMidPoint: TPointD; begin result := PointD((Left + Right) *0.5, (Top + Bottom) *0.5); @@ -633,6 +660,34 @@ procedure TListEx.Swap(idx1, idx2: integer); // Miscellaneous Functions ... //------------------------------------------------------------------------------ +function Iif(eval: Boolean; trueVal, falseVal: Boolean): Boolean; + {$IFDEF INLINING} inline; {$ENDIF} +begin + if eval then Result := trueVal else Result := falseVal; +end; +//------------------------------------------------------------------------------ + +function Iif(eval: Boolean; trueVal, falseVal: integer): integer; + {$IFDEF INLINING} inline; {$ENDIF} +begin + if eval then Result := trueVal else Result := falseVal; +end; +//------------------------------------------------------------------------------ + +function Iif(eval: Boolean; trueVal, falseVal: Int64): Int64; + {$IFDEF INLINING} inline; {$ENDIF} +begin + if eval then Result := trueVal else Result := falseVal; +end; +//------------------------------------------------------------------------------ + +function Iif(eval: Boolean; trueVal, falseVal: double): double; + {$IFDEF INLINING} inline; {$ENDIF} +begin + if eval then Result := trueVal else Result := falseVal; +end; +//------------------------------------------------------------------------------ + procedure CheckPrecisionRange(var precision: integer); begin if (precision < -MaxDecimalPrecision) or (precision > MaxDecimalPrecision) then @@ -1831,7 +1886,7 @@ function DistanceSqr(const pt1, pt2: TPointD): double; end; //------------------------------------------------------------------------------ -function DistanceFromLineSqrd(const pt, linePt1, linePt2: TPoint64): double; +function PerpendicDistFromLineSqrd(const pt, linePt1, linePt2: TPoint64): double; var a,b,c: double; begin @@ -1842,11 +1897,13 @@ function DistanceFromLineSqrd(const pt, linePt1, linePt2: TPoint64): double; b := (linePt2.X - linePt1.X); c := a * linePt1.X + b * linePt1.Y; c := a * pt.x + b * pt.y - c; - Result := (c * c) / (a * a + b * b); + if (a = 0) and (b = 0) then + Result := 0 else + Result := (c * c) / (a * a + b * b); end; //--------------------------------------------------------------------------- -function DistanceFromLineSqrd(const pt, linePt1, linePt2: TPointD): double; +function PerpendicDistFromLineSqrd(const pt, linePt1, linePt2: TPointD): double; var a,b,c: double; begin @@ -1854,7 +1911,9 @@ function DistanceFromLineSqrd(const pt, linePt1, linePt2: TPointD): double; b := (linePt2.X - linePt1.X); c := a * linePt1.X + b * linePt1.Y; c := a * pt.x + b * pt.y - c; - Result := (c * c) / (a * a + b * b); + if (a = 0) and (b = 0) then + Result := 0 else + Result := (c * c) / (a * a + b * b); end; //--------------------------------------------------------------------------- @@ -1934,7 +1993,7 @@ function __Trunc(val: double): Int64; {$IFDEF INLINE} inline; {$ENDIF} end; //------------------------------------------------------------------------------ -function GetIntersectPoint(const ln1a, ln1b, ln2a, ln2b: TPoint64; +function GetSegmentIntersectPt(const ln1a, ln1b, ln2a, ln2b: TPoint64; out ip: TPoint64): Boolean; var dx1,dy1, dx2,dy2, t, cp: double; @@ -2119,20 +2178,6 @@ function GetClosestPointOnSegment(const pt, seg1, seg2: TPoint64): TPoint64; end; //------------------------------------------------------------------------------ -function PerpendicDistFromLineSqrd(const pt, line1, line2: TPoint64): double; overload; -var - a,b,c,d: double; -begin - a := pt.X - line1.X; - b := pt.Y - line1.Y; - c := line2.X - line1.X; - d := line2.Y - line1.Y; - if (c = 0) and (d = 0) then - result := 0 else - result := Sqr(a * d - c * b) / (c * c + d * d); -end; -//------------------------------------------------------------------------------ - procedure RDP(const path: TPath64; startIdx, endIdx: integer; epsilonSqrd: double; var boolArray: TArrayOfBoolean); overload; var @@ -2162,20 +2207,6 @@ procedure RDP(const path: TPath64; startIdx, endIdx: integer; end; //------------------------------------------------------------------------------ -function PerpendicDistFromLineSqrd(const pt, line1, line2: TPointD): double; overload; -var - a,b,c,d: double; -begin - a := pt.X - line1.X; - b := pt.Y - line1.Y; - c := line2.X - line1.X; - d := line2.Y - line1.Y; - if (c = 0) and (d = 0) then - result := 0 else - result := Sqr(a * d - c * b) / (c * c + d * d); -end; -//------------------------------------------------------------------------------ - procedure RDP(const path: TPathD; startIdx, endIdx: integer; epsilonSqrd: double; var boolArray: TArrayOfBoolean); overload; var diff --git a/Image32/source/Clipper.Engine.pas b/Image32/source/Clipper.Engine.pas index e78e7f7..26ac220 100644 --- a/Image32/source/Clipper.Engine.pas +++ b/Image32/source/Clipper.Engine.pas @@ -2,9 +2,9 @@ (******************************************************************************* * Author : Angus Johnson * -* Date : 27 August 2023 * +* Date : 14 February 2024 * * Website : http://www.angusj.com * -* Copyright : Angus Johnson 2010-2023 * +* Copyright : Angus Johnson 2010-2024 * * Purpose : This is the main polygon clipping module * * License : http://www.boost.org/LICENSE_1_0.txt * *******************************************************************************) @@ -347,10 +347,9 @@ TPolyPathBase = class TPolyPath64 = class(TPolyPathBase) {$IFDEF STRICT}strict{$ENDIF} private FPath : TPath64; - function GetChild64(index: Integer): TPolyPath64; - protected - function AddChild(const path: TPath64): TPolyPathBase; override; + function GetChild64(index: Integer): TPolyPath64; public + function AddChild(const path: TPath64): TPolyPathBase; override; property Child[index: Integer]: TPolyPath64 read GetChild64; default; property Polygon: TPath64 read FPath; end; @@ -403,8 +402,9 @@ TPolyPathD = class(TPolyPathBase) function GetChildD(index: Integer): TPolyPathD; protected FScale : double; - function AddChild(const path: TPath64): TPolyPathBase; override; public + function AddChild(const path: TPath64): TPolyPathBase; overload; override; + function AddChild(const path: TPathD): TPolyPathBase; reintroduce; overload; property Polygon: TPathD read FPath; property Child[index: Integer]: TPolyPathD read GetChildD; default; end; @@ -862,6 +862,7 @@ function GetCleanPath(op: POutPt): TPath64; ((op2.pt.Y <> op2.next.pt.Y) or (op2.pt.Y <> prevOp.pt.Y))) then begin result[cnt] := op2.pt; + inc(cnt); prevOp := op2; end; op2 := op2.next; @@ -958,11 +959,16 @@ function Path1InsidePath2(const op1, op2: POutPt): Boolean; else if pipResult = pipInside then dec(outsideCnt); op := op.next; until (op = op1) or (Abs(outsideCnt) = 2); - // if path1's location is still equivocal then check its midpoint - path := GetCleanPath(op1); - mp := Clipper.Core.GetBounds(path).MidPoint; - path := GetCleanPath(op2); - Result := PointInPolygon(mp, path) <> pipOutside; + if (Abs(outsideCnt) < 2) then + begin + // if path1's location is still equivocal then check its midpoint + path := GetCleanPath(op1); + mp := Clipper.Core.GetBounds(path).MidPoint; + path := GetCleanPath(op2); + Result := PointInPolygon(mp, path) <> pipOutside; + end + else + Result := (outsideCnt < 0); end; //------------------------------------------------------------------------------ @@ -1119,7 +1125,7 @@ function BuildPath(op: POutPt; reverse, isOpen: Boolean; Exit; end; - if (cnt = 3) and IsVerySmallTriangle(op) then + if (cnt = 3) and not IsOpen and IsVerySmallTriangle(op) then begin Result := false; Exit; @@ -1715,23 +1721,18 @@ procedure TClipperBase.SetWindCountForClosedPathEdge(e: PActive); if (Abs(e2.windCnt) > 1) then begin // outside prev poly but still inside another. - if (e2.windDx * e.windDx < 0) then - // reversing direction so use the same WC - e.windCnt := e2.windCnt else - // otherwise keep 'reducing' the WC by 1 (ie towards 0) ... - e.windCnt := e2.windCnt + e.windDx; + e.windCnt := Iif(e2.windDx * e.windDx < 0, + e2.windCnt, // reversing direction so use the same WC + e2.windCnt + e.windDx); end // now outside all polys of same polytype so set own WC ... else e.windCnt := e.windDx; end else begin //'e' must be inside 'e2' - if (e2.windDx * e.windDx < 0) then - // reversing direction so use the same WC - e.windCnt := e2.windCnt - else - // otherwise keep 'increasing' the WC by 1 (ie away from 0) ... - e.windCnt := e2.windCnt + e.windDx; + e.windCnt := Iif(e2.windDx * e.windDx < 0, + e2.windCnt, // reversing direction so use the same WC + e2.windCnt + e.windDx); // else keep 'increasing' the WC end; e.windCnt2 := e2.windCnt2; e2 := e2.nextInAEL; @@ -1772,8 +1773,8 @@ procedure TClipperBase.SetWindCountForOpenPathEdge(e: PActive); else if not IsOpen(e2) then inc(cnt1); e2 := e2.nextInAEL; end; - if Odd(cnt1) then e.windCnt := 1 else e.windCnt := 0; - if Odd(cnt2) then e.windCnt2 := 1 else e.windCnt2 := 0; + e.windCnt := Iif(Odd(cnt1), 1, 0); + e.windCnt2 := Iif(Odd(cnt2), 1, 0); end else begin // if FClipType in [ctUnion, ctDifference] then e.WindCnt := e.WindDx; @@ -2149,7 +2150,7 @@ procedure TClipperBase.DoSplitOp(outrec: POutRec; splitOp: POutPt); prevOp := splitOp.prev; nextNextOp := splitOp.next.next; outrec.pts := prevOp; - GetIntersectPoint( + GetSegmentIntersectPt( prevOp.pt, splitOp.pt, splitOp.next.pt, nextNextOp.pt, ip); {$IFDEF USINGZ} if Assigned(fZCallback) then @@ -2336,22 +2337,10 @@ procedure TClipperBase.JoinOutrecPaths(e1, e2: PActive); begin e2.outrec.pts := e1.outrec.pts; e1.outrec.pts := nil; - end else - begin + end + else SetOwner(e2.outrec, e1.outrec); -// if FUsingPolytree then -// begin -// e := GetPrevHotEdge(e1); -// if not Assigned(e) then -// outRec.owner := nil else -// SetOwner(outRec, e.outrec); -// // nb: outRec.owner here is likely NOT the real -// // owner but this will be checked in DeepCheckOwner() -// end; - - end; - // and e1 and e2 are maxima and are about to be dropped from the Actives list. e1.outrec := nil; e2.outrec := nil; @@ -2380,14 +2369,16 @@ procedure TClipperBase.CheckJoinLeft(e: PActive; prev: PActive; begin prev := e.prevInAEL; - if IsOpen(e) or not IsHotEdge(e) or not Assigned(prev) or - IsOpen(prev) or not IsHotEdge(prev) then Exit; + if not Assigned(prev) or + not IsHotEdge(e) or not IsHotEdge(prev) or + IsHorizontal(e) or IsHorizontal(prev) or + IsOpen(e) or IsOpen(prev) then Exit; if ((pt.Y < e.top.Y +2) or (pt.Y < prev.top.Y +2)) and ((e.bot.Y > pt.Y) or (prev.bot.Y > pt.Y)) then Exit; // (#490) if checkCurrX then begin - if DistanceFromLineSqrd(pt, prev.bot, prev.top) > 0.25 then Exit + if PerpendicDistFromLineSqrd(pt, prev.bot, prev.top) > 0.25 then Exit end else if (e.currX <> prev.currX) then Exit; if (CrossProduct(e.top, pt, prev.top) <> 0) then Exit; @@ -2409,14 +2400,16 @@ procedure TClipperBase.CheckJoinRight(e: PActive; next: PActive; begin next := e.nextInAEL; - if IsOpen(e) or not IsHotEdge(e) or not Assigned(next) or - not IsHotEdge(next) or IsOpen(next) then Exit; + if not Assigned(next) or + not IsHotEdge(e) or not IsHotEdge(next) or + IsHorizontal(e) or IsHorizontal(next) or + IsOpen(e) or IsOpen(next) then Exit; if ((pt.Y < e.top.Y +2) or (pt.Y < next.top.Y +2)) and ((e.bot.Y > pt.Y) or (next.bot.Y > pt.Y)) then Exit; // (#490) if (checkCurrX) then begin - if DistanceFromLineSqrd(pt, next.bot, next.top) > 0.25 then Exit + if PerpendicDistFromLineSqrd(pt, next.bot, next.top) > 0.25 then Exit end else if (e.currX <> next.currX) then Exit; @@ -2486,6 +2479,31 @@ function TClipperBase.StartOpenPath(e: PActive; const pt: TPoint64): POutPt; end; //------------------------------------------------------------------------------ +procedure TrimHorz(horzEdge: PActive; preserveCollinear: Boolean); +var + pt: TPoint64; + wasTrimmed: Boolean; +begin + wasTrimmed := false; + pt := NextVertex(horzEdge).pt; + while (pt.Y = horzEdge.top.Y) do + begin + // always trim 180 deg. spikes (in closed paths) + // but otherwise break if preserveCollinear = true + if preserveCollinear and + ((pt.X < horzEdge.top.X) <> (horzEdge.bot.X < horzEdge.top.X)) then + break; + + horzEdge.vertTop := NextVertex(horzEdge); + horzEdge.top := pt; + wasTrimmed := true; + if IsMaxima(horzEdge) then Break; + pt := NextVertex(horzEdge).pt; + end; + if wasTrimmed then SetDx(horzEdge); // +/-infinity +end; +//------------------------------------------------------------------------------ + procedure TClipperBase.UpdateEdgeIntoAEL(var e: PActive); begin e.bot := e.top; @@ -2496,7 +2514,11 @@ procedure TClipperBase.UpdateEdgeIntoAEL(var e: PActive); if IsJoined(e) then UndoJoin(e, e.bot); - if IsHorizontal(e) then Exit; + if IsHorizontal(e) then + begin + if not IsOpen(e) then TrimHorz(e, PreserveCollinear); + Exit; + end; InsertScanLine(e.top.Y); CheckJoinLeft(e, e.bot); @@ -2610,12 +2632,10 @@ function TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64): POutPt; e2.windCnt := e1WindCnt; end else begin - if e1.windCnt + e2.windDx = 0 then - e1.windCnt := -e1.windCnt else - Inc(e1.windCnt, e2.windDx); - if e2.windCnt - e1.windDx = 0 then - e2.windCnt := -e2.windCnt else - Dec(e2.windCnt, e1.windDx); + e1.windCnt := Iif(e1.windCnt + e2.windDx = 0, + -e1.windCnt, e1.windCnt + e2.windDx); + e2.windCnt := Iif(e2.windCnt - e1.windDx = 0, + -e2.windCnt, e2.windCnt - e1.windDx); end; end else begin @@ -2882,14 +2902,14 @@ function HorzontalsOverlap(const horz1a, horz1b, horz2a, horz2b: TPoint64): bool begin if horz1a.X < horz1b.X then begin - if horz2a.X < horz2b.X then - Result := HorzOverlapWithLRSet(horz1a, horz1b, horz2a, horz2b) else - Result := HorzOverlapWithLRSet(horz1a, horz1b, horz2b, horz2a); + Result := Iif(horz2a.X < horz2b.X, + HorzOverlapWithLRSet(horz1a, horz1b, horz2a, horz2b), + HorzOverlapWithLRSet(horz1a, horz1b, horz2b, horz2a)); end else begin - if horz2a.X < horz2b.X then - Result := HorzOverlapWithLRSet(horz1b, horz1a, horz2a, horz2b) else - Result := HorzOverlapWithLRSet(horz1b, horz1a, horz2b, horz2a); + Result := Iif(horz2a.X < horz2b.X, + HorzOverlapWithLRSet(horz1b, horz1a, horz2a, horz2b), + HorzOverlapWithLRSet(horz1b, horz1a, horz2b, horz2a)); end; end; //------------------------------------------------------------------------------ @@ -3128,7 +3148,7 @@ procedure TClipperBase.AddNewIntersectNode(e1, e2: PActive; topY: Int64); absDx1, absDx2: double; node: PIntersectNode; begin - if not GetIntersectPoint(e1.bot, e1.top, e2.bot, e2.top, ip) then + if not GetSegmentIntersectPt(e1.bot, e1.top, e2.bot, e2.top, ip) then ip := Point64(e1.currX, topY); // Rounding errors can occasionally place the calculated intersection // point either below or above the scanbeam, so check and correct ... @@ -3148,12 +3168,8 @@ procedure TClipperBase.AddNewIntersectNode(e1, e2: PActive; topY: Int64); ip := GetClosestPointOnSegment(ip, e2.bot, e2.top) else begin - if (ip.Y < topY) then - ip.Y := topY else - ip.Y := fBotY; - if (absDx1 < absDx2) then - ip.X := TopX(e1, ip.Y) else - ip.X := TopX(e2, ip.Y); + ip.Y := Iif(ip.Y < topY, topY , fBotY); + ip.X := Iif(absDx1 < absDx2, TopX(e1, ip.Y), TopX(e2, ip.Y)); end; end; new(node); @@ -3339,41 +3355,6 @@ procedure TClipperBase.SwapPositionsInAEL(e1, e2: PActive); end; //------------------------------------------------------------------------------ -function HorzIsSpike(horzEdge: PActive): Boolean; -var - nextPt: TPoint64; -begin - nextPt := NextVertex(horzEdge).pt; - Result := (nextPt.Y = horzEdge.top.Y) and - (horzEdge.bot.X < horzEdge.top.X) <> (horzEdge.top.X < nextPt.X); -end; -//------------------------------------------------------------------------------ - -procedure TrimHorz(horzEdge: PActive; preserveCollinear: Boolean); -var - pt: TPoint64; - wasTrimmed: Boolean; -begin - wasTrimmed := false; - pt := NextVertex(horzEdge).pt; - while (pt.Y = horzEdge.top.Y) do - begin - // always trim 180 deg. spikes (in closed paths) - // but otherwise break if preserveCollinear = true - if preserveCollinear and - ((pt.X < horzEdge.top.X) <> (horzEdge.bot.X < horzEdge.top.X)) then - break; - - horzEdge.vertTop := NextVertex(horzEdge); - horzEdge.top := pt; - wasTrimmed := true; - if IsMaxima(horzEdge) then Break; - pt := NextVertex(horzEdge).pt; - end; - if wasTrimmed then SetDx(horzEdge); // +/-infinity -end; -//------------------------------------------------------------------------------ - function GetLastOp(hotEdge: PActive): POutPt; {$IFDEF INLINING} inline; {$ENDIF} var @@ -3450,10 +3431,6 @@ procedure TClipperBase.DoHorizontal(horzEdge: PActive); maxVertex := GetCurrYMaximaVertexOpen(horzEdge) else maxVertex := GetCurrYMaximaVertex(horzEdge); - if Assigned(maxVertex) and not horzIsOpen and - (maxVertex <> horzEdge.vertTop) then - TrimHorz(horzEdge, FPreserveCollinear); - isLeftToRight := ResetHorzDirection; // nb: TrimHorz above hence not using Bot.X here @@ -3533,12 +3510,14 @@ procedure TClipperBase.DoHorizontal(horzEdge: PActive); begin IntersectEdges(horzEdge, e, pt); SwapPositionsInAEL(horzEdge, e); + CheckJoinLeft(e, pt); horzEdge.currX := e.currX; e := horzEdge.nextInAEL; end else begin IntersectEdges(e, horzEdge, pt); SwapPositionsInAEL(e, horzEdge); + CheckJoinRight(e, pt); horzEdge.currX := e.currX; e := horzEdge.prevInAEL; end; @@ -3573,11 +3552,6 @@ procedure TClipperBase.DoHorizontal(horzEdge: PActive); if IsHotEdge(horzEdge) then AddOutPt(horzEdge, horzEdge.top); UpdateEdgeIntoAEL(horzEdge); - - if PreserveCollinear and - not horzIsOpen and HorzIsSpike(horzEdge) then - TrimHorz(horzEdge, true); - isLeftToRight := ResetHorzDirection; end; // end while horizontal @@ -4046,9 +4020,7 @@ function TPolyPathBase.GetLevel: Integer; function TPolyPathBase.GetIsHole: Boolean; begin - if not Assigned(Parent) then - Result := false else - Result := not Odd(GetLevel); + Result := Iif(Assigned(Parent), not Odd(GetLevel), false); end; //------------------------------------------------------------------------------ @@ -4256,6 +4228,16 @@ function TPolyPathD.AddChild(const path: TPath64): TPolyPathBase; end; //------------------------------------------------------------------------------ +function TPolyPathD.AddChild(const path: TPathD): TPolyPathBase; +begin + Result := TPolyPathD.Create; + Result.Parent := self; + TPolyPathD(Result).fScale := fScale; + TPolyPathD(Result).FPath := path; + ChildList.Add(Result); +end; +//------------------------------------------------------------------------------ + function TPolyPathD.GetChildD(index: Integer): TPolyPathD; begin Result := TPolyPathD(GetChild(index)); diff --git a/Image32/source/Clipper.Minkowski.pas b/Image32/source/Clipper.Minkowski.pas index 1d7a82b..bacb3ea 100644 --- a/Image32/source/Clipper.Minkowski.pas +++ b/Image32/source/Clipper.Minkowski.pas @@ -2,7 +2,7 @@ (******************************************************************************* * Author : Angus Johnson * -* Date : 15 October 2022 * +* Date : 21 December 2023 * * Copyright : Angus Johnson 2010-2022 * * Purpose : Minkowski Addition and Difference * * License : http://www.boost.org/LICENSE_1_0.txt * @@ -51,9 +51,7 @@ function Minkowski(const Base, Path: TPath64; tmp: TPaths64; quad: TPath64; begin - if IsClosed then - delta := 0 else - delta := 1; + delta := Iif(IsClosed, 0 , 1); baseLen := Length(Base); pathLen := Length(Path); setLength(tmp, pathLen); @@ -71,10 +69,7 @@ function Minkowski(const Base, Path: TPath64; SetLength(quad, 4); SetLength(Result, (pathLen - delta) * baseLen); - - if IsClosed then - g := pathLen - 1 else - g := 0; + g := Iif(IsClosed, pathLen - 1, 0); for i := delta to pathLen - 1 do begin diff --git a/Image32/source/Clipper.Offset.pas b/Image32/source/Clipper.Offset.pas index f3bf669..bf95bf8 100644 --- a/Image32/source/Clipper.Offset.pas +++ b/Image32/source/Clipper.Offset.pas @@ -2,9 +2,9 @@ (******************************************************************************* * Author : Angus Johnson * -* Date : 24 September 2023 * +* Date : 14 March 2024 * * Website : http://www.angusj.com * -* Copyright : Angus Johnson 2010-2023 * +* Copyright : Angus Johnson 2010-2024 * * Purpose : Path Offset (Inflate/Shrink) * * License : http://www.boost.org/LICENSE_1_0.txt * *******************************************************************************) @@ -32,13 +32,18 @@ interface TDeltaCallback64 = function (const path: TPath64; const path_norms: TPathD; currIdx, prevIdx: integer): double of object; + TDoubleArray = array of double; + BooleanArray = array of Boolean; TGroup = class - paths : TPaths64; - reversed : Boolean; - joinType : TJoinType; - endType : TEndType; - constructor Create(jt: TJoinType; et: TEndType); + paths : TPaths64; + joinType : TJoinType; + endType : TEndType; + reversed : Boolean; + lowestPathIdx : integer; + areasList : TDoubleArray; + isHoleList : BooleanArray; + constructor Create(const pathsIn: TPaths64; jt: TJoinType; et: TEndType); end; TClipperOffset = class @@ -58,9 +63,10 @@ TClipperOffset = class fGroupList : TListEx; fInPath : TPath64; fOutPath : TPath64; - fOutPaths : TPaths64; fOutPathLen : Integer; fSolution : TPaths64; + fSolutionLen : Integer; + fSolutionTree : TPolyTree64; fPreserveCollinear : Boolean; fReverseSolution : Boolean; fDeltaCallback64 : TDeltaCallback64; @@ -80,9 +86,13 @@ TClipperOffset = class procedure BuildNormals; procedure DoGroupOffset(group: TGroup); - procedure OffsetPolygon; + procedure OffsetPolygon(isShrinking: Boolean; area_: double); procedure OffsetOpenJoined; procedure OffsetOpenPath; + function CalcSolutionCapacity: integer; + procedure UpdateSolution; {$IFDEF INLINING} inline; {$ENDIF} + + function CheckReverseOrientation: Boolean; procedure ExecuteInternal(delta: Double); public constructor Create(miterLimit: double = 2.0; @@ -119,6 +129,10 @@ implementation uses Math; +resourcestring + rsClipper_CoordRangeError = + 'Offsetting will exceed the valid coordinate range'; + const TwoPi : Double = 2 * PI; InvTwoPi : Double = 1/(2 * PI); @@ -186,21 +200,21 @@ function GetUnitNormal(const pt1, pt2: TPoint64): TPointD; function GetLowestPolygonIdx(const paths: TPaths64): integer; var i,j: integer; - lp: TPoint64; - p: TPath64; + botPt: TPoint64; begin Result := -1; - lp := Point64(0, -MaxInt64); - for i := 0 to High(paths) do - begin - p := paths[i]; - for j := 0 to High(p) do - begin - if (p[j].Y < lp.Y) or - ((p[j].Y = lp.Y) and (p[j].X >= lp.X)) then Continue; - Result := i; - lp := p[j]; - end; + botPt := Point64(MaxInt64, MinInt64); + for i := 0 to High(paths) do + begin + for j := 0 to High(paths[i]) do + with paths[i][j] do + begin + if (Y < botPt.Y) or + ((Y = botPt.Y) and (X >= botPt.X)) then Continue; + result := i; + botPt.X := X; + botPt.Y := Y; + end; end; end; //------------------------------------------------------------------------------ @@ -215,10 +229,48 @@ function UnsafeGet(List: TList; Index: Integer): Pointer; // TGroup methods //------------------------------------------------------------------------------ -constructor TGroup.Create(jt: TJoinType; et: TEndType); +constructor TGroup.Create(const pathsIn: TPaths64; jt: TJoinType; et: TEndType); +var + i, len: integer; + a: double; + isJoined: boolean; + pb: PBoolean; begin Self.joinType := jt; Self.endType := et; + + isJoined := et in [etPolygon, etJoined]; + len := Length(pathsIn); + SetLength(paths, len); + for i := 0 to len -1 do + paths[i] := StripDuplicates(pathsIn[i], isJoined); + + reversed := false; + SetLength(isHoleList, len); + SetLength(areasList, len); + if (et = etPolygon) then + begin + pb := @isHoleList[0]; + for i := 0 to len -1 do + begin + a := Area(paths[i]); + pb^ := a < 0; + inc(pb); + end; + + // the lowermost path must be an outer path, so if its orientation is + // negative, then flag that the whole group is 'reversed' (so negate + // delta etc.) as this is much more efficient than reversing every path. + lowestPathIdx := GetLowestPolygonIdx(pathsIn); + reversed := (lowestPathIdx >= 0) and isHoleList[lowestPathIdx]; + if not reversed then Exit; + pb := @isHoleList[0]; + for i := 0 to len -1 do + begin + pb^ := not pb^; inc(pb); + end; + end else + lowestPathIdx := -1; end; //------------------------------------------------------------------------------ @@ -253,6 +305,7 @@ procedure TClipperOffset.Clear; TGroup(fGroupList[i]).Free; fGroupList.Clear; fSolution := nil; + fSolutionLen := 0; end; //------------------------------------------------------------------------------ @@ -274,8 +327,7 @@ procedure TClipperOffset.AddPaths(const paths: TPaths64; group: TGroup; begin if Length(paths) = 0 then Exit; - group := TGroup.Create(joinType, endType); - AppendPaths(group.paths, paths); + group := TGroup.Create(paths, joinType, endType); fGroupList.Add(group); end; //------------------------------------------------------------------------------ @@ -302,45 +354,38 @@ function GetPerpendicD(const pt: TPoint64; const norm: TPointD; delta: double): procedure TClipperOffset.DoGroupOffset(group: TGroup); var - i,j, len, lowestIdx, steps: Integer; - r, stepsPer360, arcTol, area: Double; + i,j, len, steps: Integer; + r, stepsPer360, arcTol: Double; absDelta: double; + isShrinking: Boolean; rec: TRect64; - isJoined: Boolean; + pt0: TPoint64; begin + if group.endType = etPolygon then begin - // the lowermost polygon must be an outer polygon. So we can use that as the - // designated orientation for outer polygons (needed for tidy-up clipping) - lowestIdx := GetLowestPolygonIdx(group.paths); - if lowestIdx < 0 then Exit; - // nb: don't use the default orientation here ... - area := Clipper.Core.Area(group.paths[lowestIdx]); - //if area = 0 then Exit; // this is probably unhelpful (#430) - group.reversed := (area < 0); - if group.reversed then fGroupDelta := -fDelta - else fGroupDelta := fDelta; - end else - begin - group.reversed := false; - fGroupDelta := Abs(fDelta) * 0.5; - end; + if (group.lowestPathIdx < 0) then fDelta := Abs(fDelta); + fGroupDelta := Iif(group.reversed, -fDelta, fDelta); + end + else + fGroupDelta := Abs(fDelta); + + absDelta := Abs(fGroupDelta); + fJoinType := group.joinType; fEndType := group.endType; - // calculate a sensible number of steps (for 360 deg for the given offset - if (not Assigned(fDeltaCallback64) and - (group.joinType = jtRound) or (group.endType = etRound)) then + if (group.joinType = jtRound) or (group.endType = etRound) then begin - absDelta := Abs(fGroupDelta); - // arcTol - when fArcTolerance is undefined (0), the amount of - // curve imprecision that's allowed is based on the size of the - // offset (delta). Obviously very large offsets will almost always - // require much less precision. See also offset_triginometry2.svg - if fArcTolerance > 0.01 then - arcTol := Min(absDelta, fArcTolerance) else - arcTol := Log10(2 + absDelta) * 0.25; // empirically derived - //http://www.angusj.com/clipper2/Docs/Trigonometry.htm + // calculate the number of steps required to approximate a circle + // (see http://www.angusj.com/clipper2/Docs/Trigonometry.htm) + // arcTol - when arc_tolerance_ is undefined (0) then curve imprecision + // will be relative to the size of the offset (delta). Obviously very + //large offsets will almost always require much less precision. + arcTol := Iif(fArcTolerance > 0.01, + Min(absDelta, fArcTolerance), + Log10(2 + absDelta) * 0.25); // empirically derived + stepsPer360 := Pi / ArcCos(1 - arcTol / absDelta); if (stepsPer360 > absDelta * Pi) then stepsPer360 := absDelta * Pi; // avoid excessive precision @@ -350,72 +395,67 @@ procedure TClipperOffset.DoGroupOffset(group: TGroup); fStepsPerRad := stepsPer360 / TwoPi; end; - fOutPaths := nil; - isJoined := fEndType in [etPolygon, etJoined]; for i := 0 to High(group.paths) do begin - fInPath := StripDuplicates(group.paths[i], IsJoined); - len := Length(fInPath); - if (len = 0) or ((len < 3) and (fEndType = etPolygon)) then - Continue; + isShrinking := (group.endType = etPolygon) and + (group.reversed = ((fGroupDelta < 0) = group.isHoleList[i])); + fInPath := group.paths[i]; fNorms := nil; - fOutPath := nil; - fOutPathLen := 0; + len := Length(fInPath); //if a single vertex then build a circle or a square ... if len = 1 then begin if fGroupDelta < 1 then Continue; - absDelta := Abs(fGroupDelta); + pt0 := fInPath[0]; + + if Assigned(fDeltaCallback64) then + begin + fGroupDelta := fDeltaCallback64(fInPath, fNorms, 0, 0); + if TGroup(fGroupList[0]).reversed then fGroupDelta := -fGroupDelta; + absDelta := Abs(fGroupDelta); + end; + if (group.endType = etRound) then begin r := absDelta; - with fInPath[0] do - begin - steps := Ceil(fStepsPerRad * TwoPi); //#617 - fOutPath := Path64(Ellipse(RectD(X-r, Y-r, X+r, Y+r), steps)); + steps := Ceil(fStepsPerRad * TwoPi); //#617 + fOutPath := Path64(Ellipse( + RectD(pt0.X-r, pt0.Y-r, pt0.X+r, pt0.Y+r), steps)); {$IFDEF USINGZ} - for j := 0 to high(fOutPath) do - fOutPath[j].Z := Z; + for j := 0 to high(fOutPath) do + fOutPath[j].Z := pt0.Z; {$ENDIF} - end; end else begin j := Round(absDelta); - with fInPath[0] do - begin - rec := Rect64(X -j, Y -j, X+j, Y+j); - fOutPath := rec.AsPath; + rec := Rect64(pt0.X -j, pt0.Y -j, pt0.X+j, pt0.Y+j); + fOutPath := rec.AsPath; {$IFDEF USINGZ} - for j := 0 to high(fOutPath) do - fOutPath[j].Z := Z; + for j := 0 to high(fOutPath) do + fOutPath[j].Z := pt0.Z; {$ENDIF} - end end; - AppendPath(fOutPaths, fOutPath); + UpdateSolution; Continue; - end else - begin - if (len = 2) and (group.endType = etJoined) then - begin - if fJoinType = jtRound then - fEndType := etRound else - fEndType := etSquare; - end; - BuildNormals; + end; // end of offsetting a single point - if fEndType = etPolygon then OffsetPolygon - else if fEndType = etJoined then OffsetOpenJoined - else OffsetOpenPath; + if (len = 2) and (group.endType = etJoined) then + begin + if fJoinType = jtRound then + fEndType := etRound else + fEndType := etSquare; end; - if fOutPathLen = 0 then Continue; - SetLength(fOutPath, fOutPathLen); - AppendPath(fOutPaths, fOutPath); + BuildNormals; + if fEndType = etPolygon then + OffsetPolygon(isShrinking, group.areasList[i]) + else if fEndType = etJoined then + OffsetOpenJoined + else + OffsetOpenPath; end; - // finally copy the working 'outPaths' to the solution - AppendPaths(fSolution, fOutPaths); end; //------------------------------------------------------------------------------ @@ -431,44 +471,57 @@ procedure TClipperOffset.BuildNormals; end; //------------------------------------------------------------------------------ -procedure TClipperOffset.OffsetPolygon; +procedure TClipperOffset.UpdateSolution; +begin + if fOutPathLen = 0 then Exit; + SetLength(fOutPath, fOutPathLen); + fSolution[fSolutionLen] := fOutPath; + inc(fSolutionLen); + fOutPath := nil; + fOutPathLen := 0; +end; +//------------------------------------------------------------------------------ + +function TClipperOffset.CalcSolutionCapacity: integer; var - i,j: integer; - a, offsetMinDim: double; - rec: TRect64; + i: integer; begin - //when the path is contracting, make sure - //there is sufficient space to do so. //#593 - //nb: this will have a small impact on performance - a := Area(fInPath); - if (a < 0) <> (fGroupDelta < 0) then - begin - rec := GetBounds(fInPath); - offsetMinDim := Abs(fGroupDelta) * 2; - if (offsetMinDim >= rec.Width) or (offsetMinDim >= rec.Height) then Exit; - end; + Result := 0; + for i := 0 to fGroupList.Count -1 do + with TGroup(fGroupList[i]) do + if endType = etJoined then + inc(Result, Length(paths) *2) else + inc(Result, Length(paths)); +end; +//------------------------------------------------------------------------------ +procedure TClipperOffset.OffsetPolygon(isShrinking: Boolean; area_: double); +var + i,j: integer; +begin j := high(fInPath); for i := 0 to high(fInPath) do OffsetPoint(i, j); + + // make sure that polygon areas aren't reversing which would indicate + // that the polygon has shrunk too far and that it should be discarded. + // See also - #593 & #715 + if isShrinking and (area_ <> 0) and // area = 0.0 when JoinType.Joined + ((area_ < 0) <> (Area(fOutPath) < 0)) then Exit; + + UpdateSolution; end; //------------------------------------------------------------------------------ procedure TClipperOffset.OffsetOpenJoined; begin - OffsetPolygon; - SetLength(fOutPath, fOutPathLen); - AppendPath(fOutPaths, fOutPath); - fOutPath := nil; - fOutPathLen := 0; + OffsetPolygon(false, 0); fInPath := ReversePath(fInPath); - // Rebuild normals // BuildNormals; fNorms := ReversePath(fNorms); fNorms := ShiftPath(fNorms, 1); fNorms := NegatePath(fNorms); - - OffsetPolygon; + OffsetPolygon(true, 0); end; //------------------------------------------------------------------------------ @@ -481,17 +534,29 @@ procedure TClipperOffset.OffsetOpenPath; if Assigned(fDeltaCallback64) then fGroupDelta := fDeltaCallback64(fInPath, fNorms, 0, 0); - // do the line start cap - if Abs(fGroupDelta) < Tolerance then + if (Abs(fGroupDelta) < Tolerance) and + not Assigned(fDeltaCallback64) then begin - AddPoint(fInPath[0]); - end else - case fEndType of - etButt: DoBevel(0, 0); - etRound: DoRound(0,0, PI); - else DoSquare(0, 0); + inc(highI); + SetLength(fOutPath, highI); + Move(fInPath[0], fOutPath, highI + SizeOf(TPointD)); + fOutPathLen := highI; + Exit; end; + // do the line start cap + if Assigned(fDeltaCallback64) then + fGroupDelta := fDeltaCallback64(fInPath, fNorms, 0, 0); + + if (Abs(fGroupDelta) < Tolerance) then + AddPoint(fInPath[0]) + else + case fEndType of + etButt: DoBevel(0, 0); + etRound: DoRound(0,0, PI); + else DoSquare(0, 0); + end; + // offset the left side going forward k := 0; for i := 1 to highI -1 do //nb: -1 is important @@ -520,19 +585,26 @@ procedure TClipperOffset.OffsetOpenPath; end; // offset the left side going back - k := 0; - for i := highI downto 1 do //and stop at 1! + k := highI; + for i := highI -1 downto 1 do //and stop at 1! OffsetPoint(i, k); + + UpdateSolution; end; //------------------------------------------------------------------------------ procedure TClipperOffset.ExecuteInternal(delta: Double); var - i: integer; + i,j: integer; group: TGroup; + pathsReversed: Boolean; + fillRule: TFillRule; + dummy: TPaths64; begin fSolution := nil; + fSolutionLen := 0; if fGroupList.Count = 0 then Exit; + SetLength(fSolution, CalcSolutionCapacity); fMinLenSqrd := 1; if abs(delta) < Tolerance then @@ -541,7 +613,11 @@ procedure TClipperOffset.ExecuteInternal(delta: Double); for i := 0 to fGroupList.Count -1 do begin group := TGroup(fGroupList[i]); - AppendPaths(fSolution, group.paths); + for j := 0 to High(group.paths) do + begin + fSolution[fSolutionLen] := group.paths[i]; + inc(fSolutionLen); + end; end; Exit; end; @@ -558,45 +634,52 @@ procedure TClipperOffset.ExecuteInternal(delta: Double); group := TGroup(fGroupList[i]); DoGroupOffset(group); end; + SetLength(fSolution, fSolutionLen); + + pathsReversed := CheckReverseOrientation(); + if pathsReversed then + fillRule := frNegative else + fillRule := frPositive; // clean up self-intersections ... with TClipper64.Create do try PreserveCollinear := fPreserveCollinear; // the solution should retain the orientation of the input - ReverseSolution := - fReverseSolution <> TGroup(fGroupList[0]).reversed; + ReverseSolution := fReverseSolution <> pathsReversed; AddSubject(fSolution); - if TGroup(fGroupList[0]).reversed then - Execute(ctUnion, frNegative, fSolution) else - Execute(ctUnion, frPositive, fSolution); + if assigned(fSolutionTree) then + Execute(ctUnion, fillRule, fSolutionTree, dummy); + Execute(ctUnion, fillRule, fSolution); finally free; end; end; //------------------------------------------------------------------------------ +function TClipperOffset.CheckReverseOrientation: Boolean; +var + i: integer; +begin + Result := false; + // find the orientation of the first closed path + for i := 0 to fGroupList.Count -1 do + with TGroup(fGroupList[i]) do + if endType = etPolygon then + begin + Result := reversed; + break; + end; +end; +//------------------------------------------------------------------------------ + procedure TClipperOffset.Execute(delta: Double; out solution: TPaths64); begin - fSolution := nil; solution := nil; - ExecuteInternal(delta); + fSolutionTree := nil; if fGroupList.Count = 0 then Exit; - - // clean up self-intersections ... - with TClipper64.Create do - try - PreserveCollinear := fPreserveCollinear; - // the solution should retain the orientation of the input - ReverseSolution := - fReverseSolution <> TGroup(fGroupList[0]).reversed; - AddSubject(fSolution); - if TGroup(fGroupList[0]).reversed then - Execute(ctUnion, frNegative, solution) else - Execute(ctUnion, frPositive, solution); - finally - free; - end; + ExecuteInternal(delta); + solution := fSolution; end; //------------------------------------------------------------------------------ @@ -608,29 +691,12 @@ procedure TClipperOffset.Execute(DeltaCallback: TDeltaCallback64; out solution: //------------------------------------------------------------------------------ procedure TClipperOffset.Execute(delta: Double; polytree: TPolyTree64); -var - dummy: TPaths64; begin - fSolution := nil; if not Assigned(polytree) then Raise EClipper2LibException(rsClipper_PolyTreeErr); - + fSolutionTree := polytree; + fSolutionTree.Clear; ExecuteInternal(delta); - - // clean up self-intersections ... - with TClipper64.Create do - try - PreserveCollinear := fPreserveCollinear; - // the solution should retain the orientation of the input - ReverseSolution := - fReverseSolution <> TGroup(fGroupList[0]).reversed; - AddSubject(fSolution); - if TGroup(fGroupList[0]).reversed then - Execute(ctUnion, frNegative, polytree, dummy) else - Execute(ctUnion, frPositive, polytree, dummy); - finally - free; - end; end; //------------------------------------------------------------------------------ @@ -718,20 +784,38 @@ procedure TClipperOffset.DoBevel(j, k: Integer); if k = j then begin absDelta := abs(fGroupDelta); +{$IFDEF USINGZ} + AddPoint( + fInPath[j].x - absDelta * fNorms[j].x, + fInPath[j].y - absDelta * fNorms[j].y, fInPath[j].z); + AddPoint( + fInPath[j].x + absDelta * fNorms[j].x, + fInPath[j].y + absDelta * fNorms[j].y, fInPath[j].z); +{$ELSE} AddPoint( fInPath[j].x - absDelta * fNorms[j].x, fInPath[j].y - absDelta * fNorms[j].y); AddPoint( fInPath[j].x + absDelta * fNorms[j].x, fInPath[j].y + absDelta * fNorms[j].y); +{$ENDIF} end else begin +{$IFDEF USINGZ} + AddPoint( + fInPath[j].x + fGroupDelta * fNorms[k].x, + fInPath[j].y + fGroupDelta * fNorms[k].y, fInPath[j].z); + AddPoint( + fInPath[j].x + fGroupDelta * fNorms[j].x, + fInPath[j].y + fGroupDelta * fNorms[j].y, fInPath[j].z); +{$ELSE} AddPoint( fInPath[j].x + fGroupDelta * fNorms[k].x, fInPath[j].y + fGroupDelta * fNorms[k].y); AddPoint( fInPath[j].x + fGroupDelta * fNorms[j].x, fInPath[j].y + fGroupDelta * fNorms[j].y); +{$ENDIF} end; end; //------------------------------------------------------------------------------ @@ -827,9 +911,9 @@ procedure TClipperOffset.DoRound(j, k: Integer; angle: double); // when fDeltaCallback64 is assigned, fGroupDelta won't be constant, // so we'll need to do the following calculations for *every* vertex. absDelta := Abs(fGroupDelta); - if fArcTolerance > 0.01 then - arcTol := Min(absDelta, fArcTolerance) else - arcTol := Log10(2 + absDelta) * 0.25; // empirically derived + arcTol := Iif(fArcTolerance > 0.01, + Min(absDelta, fArcTolerance), + Log10(2 + absDelta) * 0.25); // empirically derived //http://www.angusj.com/clipper2/Docs/Trigonometry.htm stepsPer360 := Pi / ArcCos(1 - arcTol / absDelta); if (stepsPer360 > absDelta * Pi) then @@ -864,7 +948,7 @@ procedure TClipperOffset.DoRound(j, k: Integer; angle: double); end; //------------------------------------------------------------------------------ -procedure TClipperOffset.OffsetPoint(j: Integer; var k: integer); + procedure TClipperOffset.OffsetPoint(j: Integer; var k: integer); var sinA, cosA: Double; begin @@ -897,7 +981,7 @@ procedure TClipperOffset.OffsetPoint(j: Integer; var k: integer); end; //test for concavity first (#593) - if (cosA > -0.99) and (sinA * fGroupDelta < 0) then + if (cosA > -0.999) and (sinA * fGroupDelta < 0) then begin // is concave AddPoint(GetPerpendic(fInPath[j], fNorms[k], fGroupDelta)); @@ -906,20 +990,21 @@ procedure TClipperOffset.OffsetPoint(j: Integer; var k: integer); AddPoint(fInPath[j]); // (#405) AddPoint(GetPerpendic(fInPath[j], fNorms[j], fGroupDelta)); end - else if (cosA > 0.999) then - // almost straight - less than 2.5 degree (#424, #526) - DoMiter(j, k, cosA) + else if (cosA > 0.999) and (fJoinType <> jtRound) then + begin + // almost straight - less than 2.5 degree (#424, #482, #526 & #724) + DoMiter(j, k, cosA); + end else if (fJoinType = jtMiter) then begin - // miter unless the angle is so acute the miter would exceeds ML + // miter unless the angle is sufficiently acute to exceed ML if (cosA > fTmpLimit -1) then DoMiter(j, k, cosA) else DoSquare(j, k); end - else if (cosA > 0.99) or (fJoinType = jtBevel) then - // ie > 2.5 deg (see above) but less than ~8 deg ( acos(0.99) ) - DoBevel(j, k) else if (fJoinType = jtRound) then DoRound(j, k, ArcTan2(sinA, cosA)) + else if (fJoinType = jtBevel) then + DoBevel(j, k) else DoSquare(j, k); diff --git a/Image32/source/Clipper.RectClip.pas b/Image32/source/Clipper.RectClip.pas index c687a1f..4e2da7d 100644 --- a/Image32/source/Clipper.RectClip.pas +++ b/Image32/source/Clipper.RectClip.pas @@ -2,9 +2,9 @@ (******************************************************************************* * Author : Angus Johnson * -* Date : 9 September 2023 * +* Date : 14 February 2024 * * Website : http://www.angusj.com * -* Copyright : Angus Johnson 2010-2023 * +* Copyright : Angus Johnson 2010-2024 * * Purpose : FAST rectangular clipping * * License : http://www.boost.org/LICENSE_1_0.txt * *******************************************************************************) @@ -121,7 +121,7 @@ function IsHorizontal(pt1: TPoint64; pt2: TPoint64): Boolean; end; //------------------------------------------------------------------------------ -function GetSegmentIntersection(p1: TPoint64; +function GetSegmentIntersectPt2(p1: TPoint64; p2: TPoint64; p3: TPoint64; p4: TPoint64; out ip: TPoint64): Boolean; var res1, res2, res3, res4: double; @@ -189,7 +189,7 @@ function GetSegmentIntersection(p1: TPoint64; end else // segments must intersect to get here - Result := GetIntersectPoint(p1, p2, p3, p4, ip); + Result := GetSegmentIntersectPt(p1, p2, p3, p4, ip); end; //------------------------------------------------------------------------------ @@ -201,60 +201,60 @@ function GetIntersection(const rectPath: TPath64; Result := True; case loc of locLeft: - if GetSegmentIntersection(p, p2, rectPath[0], rectPath[3], ip) then + if GetSegmentIntersectPt2(p, p2, rectPath[0], rectPath[3], ip) then //Result := True else if (p.Y < rectPath[0].Y) and - GetSegmentIntersection(p, p2, rectPath[0], rectPath[1], ip) then + GetSegmentIntersectPt2(p, p2, rectPath[0], rectPath[1], ip) then loc := locTop - else if GetSegmentIntersection(p, p2, rectPath[2], rectPath[3], ip) then + else if GetSegmentIntersectPt2(p, p2, rectPath[2], rectPath[3], ip) then loc := locBottom else Result := False; locRight: - if GetSegmentIntersection(p, p2, rectPath[1], rectPath[2], ip) then + if GetSegmentIntersectPt2(p, p2, rectPath[1], rectPath[2], ip) then //Result := True else if (p.Y < rectPath[0].Y) and - GetSegmentIntersection(p, p2, rectPath[0], rectPath[1], ip) then + GetSegmentIntersectPt2(p, p2, rectPath[0], rectPath[1], ip) then loc := locTop - else if GetSegmentIntersection(p, p2, rectPath[2], rectPath[3], ip) then + else if GetSegmentIntersectPt2(p, p2, rectPath[2], rectPath[3], ip) then loc := locBottom else Result := False; locTop: - if GetSegmentIntersection(p, p2, rectPath[0], rectPath[1], ip) then + if GetSegmentIntersectPt2(p, p2, rectPath[0], rectPath[1], ip) then //Result := True else if (p.X < rectPath[0].X) and - GetSegmentIntersection(p, p2, rectPath[0], rectPath[3], ip) then + GetSegmentIntersectPt2(p, p2, rectPath[0], rectPath[3], ip) then loc := locLeft else if (p.X > rectPath[1].X) and - GetSegmentIntersection(p, p2, rectPath[1], rectPath[2], ip) then + GetSegmentIntersectPt2(p, p2, rectPath[1], rectPath[2], ip) then loc := locRight else Result := False; locBottom: - if GetSegmentIntersection(p, p2, rectPath[2], rectPath[3], ip) then + if GetSegmentIntersectPt2(p, p2, rectPath[2], rectPath[3], ip) then //Result := True else if (p.X < rectPath[3].X) and - GetSegmentIntersection(p, p2, rectPath[0], rectPath[3], ip) then + GetSegmentIntersectPt2(p, p2, rectPath[0], rectPath[3], ip) then loc := locLeft else if (p.X > rectPath[2].X) and - GetSegmentIntersection(p, p2, rectPath[1], rectPath[2], ip) then + GetSegmentIntersectPt2(p, p2, rectPath[1], rectPath[2], ip) then loc := locRight else Result := False; else // loc = rInside begin - if GetSegmentIntersection(p, p2, rectPath[0], rectPath[3], ip) then + if GetSegmentIntersectPt2(p, p2, rectPath[0], rectPath[3], ip) then loc := locLeft - else if GetSegmentIntersection(p, p2, rectPath[0], rectPath[1], ip) then + else if GetSegmentIntersectPt2(p, p2, rectPath[0], rectPath[1], ip) then loc := locTop - else if GetSegmentIntersection(p, p2, rectPath[1], rectPath[2], ip) then + else if GetSegmentIntersectPt2(p, p2, rectPath[1], rectPath[2], ip) then loc := locRight - else if GetSegmentIntersection(p, p2, rectPath[2], rectPath[3], ip) then + else if GetSegmentIntersectPt2(p, p2, rectPath[2], rectPath[3], ip) then loc := locBottom else Result := False; @@ -282,7 +282,7 @@ function GetAdjacentLocation(loc: TLocation; isClockwise: Boolean): TLocation; var delta: integer; begin - if isClockwise then delta := 1 else delta := 3; + delta := Iif(isClockwise, 1 , 3); Result := TLocation((Ord(loc) + delta) mod 4); end; //------------------------------------------------------------------------------ @@ -291,9 +291,9 @@ function IsClockwise(prev, curr: TLocation; const prevPt, currPt, rectMidPt: TPoint64): Boolean; {$IFDEF INLINING} inline; {$ENDIF} begin - if AreOpposites(prev, curr) then - Result := CrossProduct(prevPt, rectMidPt, currPt) < 0 else - Result := HeadingClockwise(prev, curr); + Result := Iif(AreOpposites(prev, curr), + CrossProduct(prevPt, rectMidPt, currPt) < 0, + HeadingClockwise(prev, curr)); end; //------------------------------------------------------------------------------ @@ -517,9 +517,7 @@ procedure TRectClip64.AddCorner(prev, curr: TLocation); cnrIdx: integer; begin if prev = curr then Exit; - if (HeadingClockwise(prev, curr)) then - cnrIdx := Ord(prev) else - cnrIdx := Ord(curr); + cnrIdx := Iif(HeadingClockwise(prev, curr), Ord(prev), Ord(curr)); Add(fRectPath[cnrIdx]); end; //------------------------------------------------------------------------------ diff --git a/Image32/source/Clipper.inc b/Image32/source/Clipper.inc index 066d5dc..5b15f92 100644 --- a/Image32/source/Clipper.inc +++ b/Image32/source/Clipper.inc @@ -14,21 +14,21 @@ {$DEFINE INLINING} {$MODE DELPHI} {$ELSE} - {$IF CompilerVersion < 14} + {$IF COMPILERVERSION < 14} Requires Delphi version 6 or above. {$IFEND} - {$IF CompilerVersion >= 18} //Delphi 2007 + {$IF COMPILERVERSION >= 18} //Delphi 2007 {$DEFINE RECORD_METHODS} {$DEFINE STRICT} - {$IF CompilerVersion >= 19} //Delphi 2009 + {$IF COMPILERVERSION >= 19} //Delphi 2009 //While "inlining" is supported from D2005, it's buggy (see QC41166) until D2009 {$DEFINE INLINING} - {$IFEND} - {$IF COMPILERVERSION >= 23} //Delphi XE2+ - {$DEFINE XPLAT_GENERICS} - {$DEFINE ROUNDINGMODE} - {$IF COMPILERVERSION >= 24} //Delphi XE3+ - {$LEGACYIFEND ON} + {$IF COMPILERVERSION >= 23} //Delphi XE2+ + {$DEFINE XPLAT_GENERICS} + {$DEFINE ROUNDINGMODE} + {$IF COMPILERVERSION >= 24} //Delphi XE3+ + {$LEGACYIFEND ON} + {$IFEND} {$IFEND} {$IFEND} {$IFEND} diff --git a/Image32/source/Clipper.pas b/Image32/source/Clipper.pas index 73fb326..1c36223 100644 --- a/Image32/source/Clipper.pas +++ b/Image32/source/Clipper.pas @@ -2,7 +2,7 @@ (******************************************************************************* * Author : Angus Johnson * -* Date : 17 July 2023 * +* Date : 21 December 2023 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2010-2023 * * Purpose : This module provides a simple interface to the Clipper Library * @@ -17,9 +17,8 @@ interface Math, SysUtils, Classes, Clipper.Core, Clipper.Engine, Clipper.Offset, Clipper.RectClip; -// Redeclare here a number of structures defined in -// other units so those units won't need to be declared -// just to use the following functions. +// A number of structures defined in other units are redeclared here +// so those units won't also need to be declared in your own units clauses. type TClipper = Clipper.Engine.TClipper64; TClipper64 = Clipper.Engine.TClipper64; @@ -148,9 +147,13 @@ function PointInPolygon(const pt: TPoint64; const polygon: TPath64): TPointInPolygonResult; function SimplifyPath(const path: TPath64; - shapeTolerance: double; isOpenPath: Boolean): TPath64; + shapeTolerance: double; isClosedPath: Boolean = true): TPath64; overload; function SimplifyPaths(const paths: TPaths64; - shapeTolerance: double; isOpenPaths: Boolean): TPaths64; + shapeTolerance: double; isClosedPath: Boolean = true): TPaths64; overload; +function SimplifyPath(const path: TPathD; shapeTolerance: double; + isClosedPath: Boolean = true; decimalPrecision: integer = 2): TPathD; overload; +function SimplifyPaths(const paths: TPathsD; shapeTolerance: double; + isClosedPath: Boolean = true; decimalPrecision: integer = 2): TPathsD; overload; implementation @@ -833,9 +836,8 @@ function PerpendicDistSqrd(const pt, line1, line2: TPoint64): double; b := pt.Y - line1.Y; c := line2.X - line1.X; d := line2.Y - line1.Y; - if (c = 0) and (d = 0) then - result := 0 else - result := Sqr(a * d - c * b) / (c * c + d * d); + result := Iif((c = 0) and (d = 0), + 0, Sqr(a * d - c * b) / (c * c + d * d)); end; //------------------------------------------------------------------------------ @@ -848,22 +850,22 @@ TSimplifyRec = record pdSqrd : double; prev : PSimplifyRec; next : PSimplifyRec; - isEnd : Boolean; + //isEnd : Boolean; end; function SimplifyPath(const path: TPath64; - shapeTolerance: double; isOpenPath: Boolean): TPath64; + shapeTolerance: double; isClosedPath: Boolean): TPath64; var - i, highI, minLen: integer; + i, highI, minHigh: integer; tolSqrd: double; srArray: array of TSimplifyRec; first, last: PSimplifyRec; begin Result := nil; highI := High(path); - if isOpenPath then minLen := 2 else minLen := 3; - if highI +1 < minLen then Exit; + minHigh := Iif(isClosedPath, 2, 1); + if highI < minHigh then Exit; SetLength(srArray, highI +1); with srArray[0] do @@ -871,15 +873,8 @@ function SimplifyPath(const path: TPath64; pt := path[0]; prev := @srArray[highI]; next := @srArray[1]; - if isOpenPath then - begin - pdSqrd := MaxDouble; - isEnd := true; - end else - begin - pdSqrd := PerpendicDistSqrd(path[0], path[highI], path[1]); - isEnd := false; - end; + pdSqrd := Iif(isClosedPath, + PerpendicDistSqrd(path[0], path[highI], path[1]), invalidD); end; with srArray[highI] do @@ -887,15 +882,8 @@ function SimplifyPath(const path: TPath64; pt := path[highI]; prev := @srArray[highI-1]; next := @srArray[0]; - if isOpenPath then - begin - pdSqrd := MaxDouble; - isEnd := true; - end else - begin - pdSqrd := PerpendicDistSqrd(path[highI], path[highI-1], path[0]); - isEnd := false; - end; + pdSqrd := Iif(isClosedPath, + PerpendicDistSqrd(path[highI], path[highI-1], path[0]), invalidD); end; for i := 1 to highI -1 do @@ -905,7 +893,6 @@ function SimplifyPath(const path: TPath64; prev := @srArray[i-1]; next := @srArray[i+1]; pdSqrd := PerpendicDistSqrd(path[i], path[i-1], path[i+1]); - isEnd := false; end; first := @srArray[0]; @@ -914,26 +901,23 @@ function SimplifyPath(const path: TPath64; tolSqrd := Sqr(shapeTolerance); while first <> last do begin - if first.isEnd or (first.pdSqrd > tolSqrd) or + if (first.pdSqrd > tolSqrd) or (first.next.pdSqrd < first.pdSqrd) then begin first := first.next; - end else - begin - first.prev.next := first.next; - first.next.prev := first.prev; - last := first.prev; - dec(highI); - if last.next = last.prev then break; - last.pdSqrd := - PerpendicDistSqrd(last.pt, last.prev.pt, last.next.pt); - first := last.next; - first.pdSqrd := - PerpendicDistSqrd(first.pt, first.prev.pt, first.next.pt); + Continue; end; + dec(highI); + first.prev.next := first.next; + first.next.prev := first.prev; + last := first.prev; + first := last.next; + if first.next = first.prev then break; + last.pdSqrd := PerpendicDistSqrd(last.pt, last.prev.pt, first.pt); + first.pdSqrd := PerpendicDistSqrd(first.pt, last.pt, first.next.pt); end; - if highI +1 < minLen then Exit; - if isOpenPath then first := @srArray[0]; + if highI < minHigh then Exit; + if not isClosedPath then first := @srArray[0]; SetLength(Result, highI +1); for i := 0 to HighI do begin @@ -944,15 +928,43 @@ function SimplifyPath(const path: TPath64; //------------------------------------------------------------------------------ function SimplifyPaths(const paths: TPaths64; - shapeTolerance: double; isOpenPaths: Boolean): TPaths64; + shapeTolerance: double; isClosedPath: Boolean): TPaths64; var i, len: integer; begin len := Length(paths); SetLength(Result, len); for i := 0 to len -1 do - result[i] := SimplifyPath(paths[i], shapeTolerance, isOpenPaths); + result[i] := SimplifyPath(paths[i], shapeTolerance, isClosedPath); end; +//------------------------------------------------------------------------------ + +function SimplifyPath(const path: TPathD; shapeTolerance: double; + isClosedPath: Boolean; decimalPrecision: integer): TPathD; +var + p: TPath64; + scale: double; +begin + scale := power(10, decimalPrecision); + p := ScalePath(path, scale); + p := SimplifyPath(p, shapeTolerance, isClosedPath); + Result := ScalePathD(p, 1/scale); +end; +//------------------------------------------------------------------------------ + +function SimplifyPaths(const paths: TPathsD; shapeTolerance: double; + isClosedPath: Boolean; decimalPrecision: integer): TPathsD; +var + pp: TPaths64; + scale: double; +begin + scale := power(10, decimalPrecision); + pp := ScalePaths(paths, scale); + pp := SimplifyPaths(pp, shapeTolerance, isClosedPath); + Result := ScalePathsD(pp, 1/scale); +end; +//------------------------------------------------------------------------------ + end. diff --git a/Image32/source/Img32.CQ.pas b/Image32/source/Img32.CQ.pas index cd8d5f6..8acea08 100644 --- a/Image32/source/Img32.CQ.pas +++ b/Image32/source/Img32.CQ.pas @@ -3,9 +3,9 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.4 * -* Date : 4 July 2023 * +* Date : 10 April 2024 * * Website : http://www.angusj.com * -* Copyright : Angus Johnson 2019-2021 * +* Copyright : Angus Johnson 2019-2024 * * Purpose : Color reduction for TImage32 * * : Uses Octree Color Quantization & Floyd / Steinberg Dithering * * License : http://www.boost.org/LICENSE_1_0.txt * @@ -90,6 +90,7 @@ TOctree = class destructor Destroy; override; procedure Reset; procedure BuildTree(image: TImage32); + procedure ApplyPalette(image: TImage32); function GetColorFreqArray: TArrayOfColFreq; property ColorCount: cardinal read fLeaves; // PixelCount: = Sum( leaves[ 0 .. n-1 ].Count ) @@ -343,12 +344,16 @@ procedure PaletteSort(var ptrArray: TArrayOfColFreq; function RoundDownNearestPower2(val: Cardinal): Cardinal; begin - Result := val or val shr 1; - Result := Result or Result shr 2; - Result := Result or Result shr 3; - Result := Result or Result shr 4; - Result := Result or Result shr 16; - Result := Result - Result shr 1; + if (val and (val - 1)) > 0 then + begin + Result := val or val shr 1; + Result := Result or (Result shr 2); + Result := Result or (Result shr 3); + Result := Result or (Result shr 4); + Result := Result or (Result shr 16); + Result := Result - (Result shr 1); + end else + Result := val; end; //------------------------------------------------------------------------------ @@ -630,6 +635,25 @@ procedure TOctree.BuildTree(image: TImage32); end; //------------------------------------------------------------------------------ +type TImg32 = class(TImage32); + +procedure TOctree.ApplyPalette(image: TImage32); +var + i: integer; + pc: PARGB; +begin + pc := PARGB(image.PixelBase); + for i := 0 to image.Width * image.Height -1 do + begin + if pc.A < OpacityThreshold then + pc.Color := clNone32 else + fTop.GetNodeColor(pc.Color); + inc(pc); + end; + TImg32(image).ResetColorCount; +end; +//------------------------------------------------------------------------------ + function TOctree.ReduceOne: Boolean; var lvl, i, childCnt: integer; @@ -985,6 +1009,7 @@ function ReduceImage(image: TImage32; maxColors: Cardinal; if octree.fReduceType = rtSimple then begin Result := octree.BasicReduce(maxColors); + octree.ApplyPalette(image); Exit; end; @@ -1043,6 +1068,7 @@ function ReduceImage(image: TImage32; maxColors: Cardinal; finally octree.Free; end; + TImg32(image).ResetColorCount; end; //------------------------------------------------------------------------------ @@ -1078,8 +1104,8 @@ procedure DrawPalette(image: TImage32; const palette: TArrayOfColor32); begin image.FillRect(rec, palette[i] or $FF000000); if (i + 1) mod w = 0 then - Types.OffsetRect(rec, -15 * w, 16) else - Types.OffsetRect(rec, 16, 0); + TranslateRect(rec, -15 * w, 16) else + TranslateRect(rec, 16, 0); end; end; diff --git a/Image32/source/Img32.Clipper2.pas b/Image32/source/Img32.Clipper2.pas index feb61d9..4fa6708 100644 --- a/Image32/source/Img32.Clipper2.pas +++ b/Image32/source/Img32.Clipper2.pas @@ -94,9 +94,10 @@ function InflatePaths(const paths: Img32.TPathsD; jt: Clipper.Offset.TJoinType; begin case joinStyle of - jsSquare: jt := jtSquare; - jsMiter: jt := jtMiter; - jsRound: jt := jtRound; + jsSquare : jt := jtSquare; + jsButt : jt := jtBevel; + jsMiter : jt := jtMiter; + jsRound : jt := jtRound; else if endType = etRound then jt := jtRound else jt := jtSquare; end; diff --git a/Image32/source/Img32.Draw.pas b/Image32/source/Img32.Draw.pas index 5c98383..e7b89c4 100644 --- a/Image32/source/Img32.Draw.pas +++ b/Image32/source/Img32.Draw.pas @@ -3,9 +3,9 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.4 * -* Date : 15 December 2023 * +* Date : 23 March 2024 * * Website : http://www.angusj.com * -* Copyright : Angus Johnson 2019-2023 * +* Copyright : Angus Johnson 2019-2024 * * * * Purpose : Polygon renderer for TImage32 * * * @@ -18,7 +18,13 @@ interface {$I Img32.inc} -{.$DEFINE MemCheck} //for debugging only (adds a minimal cost to performance) +// MemCheck may be useful for debugging (adds a minimal cost to performance) +{.$DEFINE MemCheck} + +// UseTrunc makes rendering thread safe, +// so it's generally preferred over Round and SetRoundMode(). +// See https://github.com/AngusJohnson/Image32/issues/45 +{$DEFINE UseTrunc} uses SysUtils, Classes, Types, Math, Img32, Img32.Vector; @@ -424,27 +430,6 @@ procedure ApplyClearType(img: TImage32; textColor: TColor32 = clBlack32; // Other miscellaneous functions // ------------------------------------------------------------------------------ -// //__Trunc: An efficient Trunc() algorithm (ie rounds toward zero) -// function __Trunc(val: double): integer; {$IFDEF INLINE} inline; {$ENDIF} -// var -// exp: integer; -// i64: UInt64 absolute val; -// begin -// //https://en.wikipedia.org/wiki/Double-precision_floating-point_format -// Result := 0; -// if i64 = 0 then Exit; -// exp := Integer(Cardinal(i64 shr 52) and $7FF) - 1023; -// //nb: when exp == 1024 then val == INF or NAN. -// if exp < 0 then -// Exit -// else if exp > 52 then -// Result := ((i64 and $1FFFFFFFFFFFFF) shl (exp - 52)) or (UInt64(1) shl exp) -// else -// Result := ((i64 and $1FFFFFFFFFFFFF) shr (52 - exp)) or (UInt64(1) shl exp); -// if val < 0 then Result := -Result; -// end; -// ------------------------------------------------------------------------------ - function ClampByte(val: double): byte; {$IFDEF INLINE} inline; {$ENDIF} begin if val < 0 then result := 0 @@ -534,9 +519,15 @@ function MirrorQ(q, endQ: integer): integer; function MirrorD(d: double; colorCnt: integer): integer; begin dec(colorCnt); +{$IFDEF UseTrunc} // used in TSvgRadialGradientRenderer.RenderProc + if Odd(Trunc(d)) then + result := Trunc((1 - frac(d)) * colorCnt) else + result := Trunc(frac(d) * colorCnt); +{$ELSE} if Odd(Round(d)) then result := Round((1 - frac(d)) * colorCnt) else result := Round(frac(d) * colorCnt); +{$ENDIF} end; // ------------------------------------------------------------------------------ @@ -564,9 +555,15 @@ function SoftRptQ(q, endQ: integer): integer; function RepeatD(d: double; colorCnt: integer): integer; begin dec(colorCnt); +{$IFDEF UseTrunc} // used in TSvgRadialGradientRenderer.RenderProc + if (d < 0) then + result := Trunc((1 + frac(d)) * colorCnt) else + result := Trunc(frac(d) * colorCnt); +{$ELSE} if (d < 0) then result := Round((1 + frac(d)) * colorCnt) else result := Round(frac(d) * colorCnt); +{$ENDIF} end; // ------------------------------------------------------------------------------ @@ -659,10 +656,18 @@ procedure AllocateScanlines(const polygons: TPathsD; begin highJ := high(polygons[i]); if highJ < 2 then continue; +{$IFDEF UseTrunc} + y1 := Trunc(polygons[i][highJ].Y); +{$ELSE} y1 := Round(polygons[i][highJ].Y); +{$ENDIF} for j := 0 to highJ do begin +{$IFDEF UseTrunc} + y2 := Trunc(polygons[i][j].Y); +{$ELSE} y2 := Round(polygons[i][j].Y); +{$ENDIF} if y1 < y2 then begin // descending (but ignore edges outside the clipping range) @@ -758,8 +763,13 @@ procedure SplitEdgeIntoFragments(const pt1, pt2: TPointD; // but still update maxX for each scanline the edge passes if bot.X > maxX then begin +{$IFDEF UseTrunc} + for i := Min(maxY, Trunc(bot.Y)) downto Max(0, Trunc(top.Y)) do + scanlines[i].maxX := maxX; +{$ELSE} for i := Min(maxY, Round(bot.Y)) downto Max(0, Round(top.Y)) do scanlines[i].maxX := maxX; +{$ENDIF} Exit; end; @@ -776,14 +786,24 @@ procedure SplitEdgeIntoFragments(const pt1, pt2: TPointD; begin if top.X >= maxX then begin +{$IFDEF UseTrunc} + for i := Min(maxY, Trunc(bot.Y)) downto Max(0, Trunc(top.Y)) do + scanlines[i].maxX := maxX; +{$ELSE} for i := Min(maxY, Round(bot.Y)) downto Max(0, Round(top.Y)) do scanlines[i].maxX := maxX; +{$ENDIF} Exit; end; // here the edge must be oriented bottom-right to top-left y := bot.Y - (bot.X - maxX) * Abs(dydx); +{$IFDEF UseTrunc} + for i := Min(maxY, Trunc(bot.Y)) downto Max(0, Trunc(y)) do + scanlines[i].maxX := maxX; +{$ELSE} for i := Min(maxY, Round(bot.Y)) downto Max(0, Round(y)) do scanlines[i].maxX := maxX; +{$ENDIF} bot.Y := y; if bot.Y <= 0 then Exit; bot.X := maxX; @@ -792,8 +812,13 @@ procedure SplitEdgeIntoFragments(const pt1, pt2: TPointD; begin // here the edge must be oriented bottom-left to top-right y := top.Y + (top.X - maxX) * Abs(dydx); +{$IFDEF UseTrunc} + for i := Min(maxY, Trunc(y)) downto Max(0, Trunc(top.Y)) do + scanlines[i].maxX := maxX; +{$ELSE} for i := Min(maxY, Round(y)) downto Max(0, Round(top.Y)) do scanlines[i].maxX := maxX; +{$ENDIF} top.Y := y; if top.Y >= maxY then Exit; top.X := maxX; @@ -812,7 +837,11 @@ procedure SplitEdgeIntoFragments(const pt1, pt2: TPointD; end; // SPLIT THE EDGE INTO MULTIPLE SCANLINE FRAGMENTS +{$IFDEF UseTrunc} + scanlineY := Trunc(bot.Y); +{$ELSE} scanlineY := Round(bot.Y); +{$ENDIF} if bot.Y = scanlineY then dec(scanlineY); // at the lower-most extent of the edge 'split' the first fragment @@ -920,8 +949,13 @@ procedure ProcessScanlineFragments(var scanline: TScanLine; right := q; end; +{$IFDEF UseTrunc} + leftXi := Max(0, Trunc(left)); + rightXi := Max(0, Trunc(right)); +{$ELSE} leftXi := Max(0, Round(left)); rightXi := Max(0, Round(right)); +{$ENDIF} if (leftXi = rightXi) then begin @@ -992,20 +1026,24 @@ procedure Rasterize(const paths: TPathsD; const clipRec: TRect; scanlines: TArrayOfScanline; fragments: PDouble; scanline: PScanline; +{$IFnDEF UseTrunc} savedRoundMode: TRoundingMode; +{$ENDIF} begin // See also https://nothings.org/gamedev/rasterize/ if not assigned(renderer) then Exit; Types.IntersectRect(clipRec2, clipRec, GetBounds(paths)); if IsEmptyRect(clipRec2) then Exit; - paths2 := OffsetPath(paths, -clipRec2.Left, -clipRec2.Top); + paths2 := TranslatePath(paths, -clipRec2.Left, -clipRec2.Top); // Delphi's Round() function is *much* faster than Trunc(), - // and even a little faster than __Trunc() above (except + // and even a little faster than Trunc() above (except // when the FastMM4 memory manager is enabled.) fragments := nil; +{$IFnDEF UseTrunc} savedRoundMode := SetRoundMode(rmDown); +{$ENDIF} try RectWidthHeight(clipRec2, maxW, maxH); SetLength(scanlines, maxH +1); @@ -1041,14 +1079,22 @@ procedure Rasterize(const paths: TPathsD; const clipRec: TRect; case fillRule of frEvenOdd: begin +{$IFDEF UseTrunc} + aa := Trunc(Abs(accum) * 1275) mod 2550; // *5 +{$ELSE} aa := Round(Abs(accum) * 1275) mod 2550; // *5 +{$ENDIF} if aa > 1275 then byteBuffer[j] := Min(255, (2550 - aa) shr 2) else // /4 byteBuffer[j] := Min(255, aa shr 2); // /4 end; frNonZero: begin +{$IFDEF UseTrunc} + byteBuffer[j] := Min(255, Trunc(Abs(accum) * 318)); +{$ELSE} byteBuffer[j] := Min(255, Round(Abs(accum) * 318)); +{$ENDIF} end; {$IFDEF REVERSE_ORIENTATION} frPositive: @@ -1056,8 +1102,13 @@ procedure Rasterize(const paths: TPathsD; const clipRec: TRect; frNegative: {$ENDIF} begin +{$IFDEF UseTrunc} + if accum > 0.002 then + byteBuffer[j] := Min(255, Trunc(accum * 318)); +{$ELSE} if accum > 0.002 then byteBuffer[j] := Min(255, Round(accum * 318)); +{$ENDIF} end; {$IFDEF REVERSE_ORIENTATION} frNegative: @@ -1065,8 +1116,13 @@ procedure Rasterize(const paths: TPathsD; const clipRec: TRect; frPositive: {$ENDIF} begin +{$IFDEF UseTrunc} + if accum < -0.002 then + byteBuffer[j] := Min(255, Trunc(-accum * 318)); +{$ELSE} if accum < -0.002 then byteBuffer[j] := Min(255, Round(-accum * 318)); +{$ENDIF} end; end; end; @@ -1079,7 +1135,9 @@ procedure Rasterize(const paths: TPathsD; const clipRec: TRect; end; finally FreeMem(fragments); +{$IFnDEF UseTrunc} SetRoundMode(savedRoundMode); +{$ENDIF} end; end; @@ -1500,7 +1558,11 @@ procedure TRadialGradientRenderer.RenderProc(x1, x2, y: integer; alpha: PByte); for i := x1 to x2 do begin dist := Hypot((y - fCenterPt.Y) *fScaleY, (i - fCenterPt.X) *fScaleX); +{$IFDEF UseTrunc} + color.Color := fColors[fBoundsProc(Trunc(dist), fColorsCnt)]; +{$ELSE} color.Color := fColors[fBoundsProc(Round(dist), fColorsCnt)]; +{$ENDIF} pDst^ := BlendToAlpha(pDst^, MulBytes(color.A, Ord(alpha^)) shl 24 or (color.Color and $FFFFFF)); inc(pDst); inc(alpha); @@ -1551,7 +1613,7 @@ procedure TSvgRadialGradientRenderer.SetParameters(const ellipseRect: TRect; procedure TSvgRadialGradientRenderer.RenderProc(x1, x2, y: integer; alpha: PByte); var i: integer; - q,m,c, qa,qb,qc,qs: double; + q,qq, m,c, qa,qb,qc,qs: double; dist, dist2: double; color: TARGB; pDst: PColor32; @@ -1567,7 +1629,10 @@ procedure TSvgRadialGradientRenderer.RenderProc(x1, x2, y: integer; alpha: PByte if (pt.X = fFocusPt.X) then //vertical line begin // let x = pt.X, then y*y = b*b(1 - Sqr(pt.X)/aa) - q := Sqrt(fBB*(1 - Sqr(pt.X)/fAA)); + qq := (1 - Sqr(pt.X)/fAA); + if (qq > 1) then qq := 1 + else if (qq < 0) then qq := 0; + q := Sqrt(fBB*qq); ellipsePt.X := pt.X; if pt.Y >= fFocusPt.Y then ellipsePt.Y := q else @@ -1834,7 +1899,7 @@ procedure DrawLine(img: TImage32; const lines: TPathsD; begin if not assigned(lines) then exit; if (lineWidth < MinStrokeWidth) then lineWidth := MinStrokeWidth; - lines2 := Outline(lines, lineWidth, joinStyle, endStyle, miterLimit); + lines2 := RoughOutline(lines, lineWidth, joinStyle, endStyle, miterLimit); if img.AntiAliased then cr := TColorRenderer.Create(color) else @@ -1860,7 +1925,7 @@ procedure DrawLine(img: TImage32; const lines: TPathsD; begin if (not assigned(lines)) or (not assigned(renderer)) then exit; if (lineWidth < MinStrokeWidth) then lineWidth := MinStrokeWidth; - lines2 := Outline(lines, lineWidth, joinStyle, endStyle, miterLimit); + lines2 := RoughOutline(lines, lineWidth, joinStyle, endStyle, miterLimit); if renderer.Initialize(img) then begin Rasterize(lines2, img.bounds, frNonZero, renderer); @@ -1878,7 +1943,7 @@ procedure DrawInvertedLine(img: TImage32; begin if not assigned(lines) then exit; if (lineWidth < MinStrokeWidth) then lineWidth := MinStrokeWidth; - lines2 := Outline(lines, lineWidth, joinStyle, endStyle, 2); + lines2 := RoughOutline(lines, lineWidth, joinStyle, endStyle, 2); ir := TInverseRenderer.Create; try if ir.Initialize(img) then @@ -1908,15 +1973,20 @@ procedure DrawDashedLine(img: TImage32; const line: TPathD; lines := GetDashedPath(line, endStyle = esPolygon, dashPattern, patternOffset); if Length(lines) = 0 then Exit; + case joinStyle of + jsAuto: + if endStyle = esRound then + joinStyle := jsRound else + joinStyle := jsSquare; jsSquare, jsMiter: endStyle := esSquare; jsRound: endStyle := esRound; - else + jsButt: endStyle := esButt; end; - lines := Outline(lines, lineWidth, joinStyle, endStyle); + lines := RoughOutline(lines, lineWidth, joinStyle, endStyle); cr := TColorRenderer.Create(color); try if cr.Initialize(img) then @@ -1958,7 +2028,7 @@ procedure DrawDashedLine(img: TImage32; const line: TPathD; lines := GetDashedPath(line, endStyle = esPolygon, dashPattern, patternOffset); if Length(lines) = 0 then Exit; - lines := Outline(lines, lineWidth, joinStyle, endStyle); + lines := RoughOutline(lines, lineWidth, joinStyle, endStyle); if renderer.Initialize(img) then begin Rasterize(lines, img.bounds, frNonZero, renderer); @@ -1997,7 +2067,7 @@ procedure DrawInvertedDashedLine(img: TImage32; lines := GetDashedPath(line, endStyle = esPolygon, dashPattern, patternOffset); if Length(lines) = 0 then Exit; - lines := Outline(lines, lineWidth, joinStyle, endStyle); + lines := RoughOutline(lines, lineWidth, joinStyle, endStyle); renderer := TInverseRenderer.Create; try if renderer.Initialize(img) then @@ -2132,7 +2202,7 @@ procedure DrawPolygon_ClearType(img: TImage32; const polygons: TPathsD; RectWidthHeight(rec, w, h); tmpImg := TImage32.Create(w *3, h); try - tmpPolygons := OffsetPath(polygons, -rec.Left, -rec.Top); + tmpPolygons := TranslatePath(polygons, -rec.Left, -rec.Top); tmpPolygons := ScalePath(tmpPolygons, 3, 1); cr := TColorRenderer.Create(clBlack32); try diff --git a/Image32/source/Img32.Extra.pas b/Image32/source/Img32.Extra.pas index 7436f6c..11115c6 100644 --- a/Image32/source/Img32.Extra.pas +++ b/Image32/source/Img32.Extra.pas @@ -3,9 +3,9 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.4 * -* Date : 17 December 2023 * +* Date : 15 March 2024 * * Website : http://www.angusj.com * -* Copyright : Angus Johnson 2019-2023 * +* Copyright : Angus Johnson 2019-2024 * * Purpose : Miscellaneous routines that don't belong in other modules. * * License : http://www.boost.org/LICENSE_1_0.txt * *******************************************************************************) @@ -233,11 +233,9 @@ function CurveFit(const paths: TPathsD; closed: Boolean; implementation uses - {$IFNDEF MSWINDOWS} - {$IFNDEF FPC} + {$IFDEF USING_FMX} Img32.FMX, {$ENDIF} - {$ENDIF} Img32.Transform; const @@ -395,7 +393,7 @@ procedure DrawEdge(img: TImage32; const path: TPathD; p := path; if closePath and not PointsNearEqual(p[0], p[highI], 0.01) then begin - AppendPath(p, p[0]); + AppendToPath(p, p[0]); inc(highI); end; for i := 1 to highI do @@ -596,8 +594,8 @@ procedure DrawShadow(img: TImage32; const polygons: TPathsD; y := depth * y; blurSize := Max(1,Round(depth / 2)); Img32.Vector.InflateRect(rec, Ceil(depth*2), Ceil(depth*2)); - polys := OffsetPath(polygons, -rec.Left, -rec.Top); - shadowPolys := OffsetPath(polys, x, y); + polys := TranslatePath(polygons, -rec.Left, -rec.Top); + shadowPolys := TranslatePath(polys, x, y); RectWidthHeight(rec, w, h); shadowImg := TImage32.Create(w, h); try @@ -631,7 +629,7 @@ procedure DrawGlow(img: TImage32; const polygons: TPathsD; glowImg: TImage32; begin rec := GetBounds(polygons); - glowPolys := OffsetPath(polygons, + glowPolys := TranslatePath(polygons, blurRadius -rec.Left +1, blurRadius -rec.Top +1); Img32.Vector.InflateRect(rec, blurRadius +1, blurRadius +1); RectWidthHeight(rec, w, h); @@ -668,7 +666,7 @@ procedure TileImage(img: TImage32; for i := 1 to cnt do begin img.Copy(tile, tileRec, dstRec); - Types.OffsetRect(dstRec, srcW, 0); + TranslateRect(dstRec, srcW, 0); end; cnt := Ceil(dstH / srcH) -1; srcRec := Img32.Vector.Rect(rec.Left, rec.Top, @@ -676,7 +674,7 @@ procedure TileImage(img: TImage32; dstRec := srcRec; for i := 1 to cnt do begin - Types.OffsetRect(dstRec, 0, srcH); + TranslateRect(dstRec, 0, srcH); img.Copy(img, srcRec, dstRec); end; end; @@ -1019,7 +1017,7 @@ procedure EraseOutsidePath(img: TImage32; const path: TPathD; RectWidthHeight(outsideBounds, w,h); mask := TImage32.Create(w, h); try - p := OffsetPath(path, -outsideBounds.Left, -outsideBounds.top); + p := TranslatePath(path, -outsideBounds.Left, -outsideBounds.top); DrawPolygon(mask, p, fillRule, clBlack32); img.CopyBlend(mask, mask.Bounds, outsideBounds, BlendMask); finally @@ -1039,7 +1037,7 @@ procedure EraseOutsidePaths(img: TImage32; const paths: TPathsD; RectWidthHeight(outsideBounds, w,h); mask := TImage32.Create(w, h); try - pp := OffsetPath(paths, -outsideBounds.Left, -outsideBounds.top); + pp := TranslatePath(paths, -outsideBounds.Left, -outsideBounds.top); DrawPolygon(mask, pp, fillRule, clBlack32); img.CopyBlend(mask, mask.Bounds, outsideBounds, BlendMask); finally @@ -1074,14 +1072,14 @@ procedure Draw3D(img: TImage32; const polygons: TPathsD; if IsEmptyRect(rec) then Exit; if not ClockwiseRotationIsAnglePositive then angleRads := -angleRads; GetSinCos(angleRads, y, x); - paths := OffsetPath(polygons, -rec.Left, -rec.Top); + paths := TranslatePath(polygons, -rec.Left, -rec.Top); RectWidthHeight(rec, w, h); tmp := TImage32.Create(w, h); try if GetAlpha(colorLt) > 0 then begin tmp.Clear(colorLt); - paths2 := OffsetPath(paths, -height*x, -height*y); + paths2 := TranslatePath(paths, -height*x, -height*y); EraseInsidePaths(tmp, paths2, fillRule); FastGaussianBlur(tmp, tmp.Bounds, Round(blurRadius), 0); EraseOutsidePaths(tmp, paths, fillRule, tmp.Bounds); @@ -1090,7 +1088,7 @@ procedure Draw3D(img: TImage32; const polygons: TPathsD; if GetAlpha(colorDk) > 0 then begin tmp.Clear(colorDk); - paths2 := OffsetPath(paths, height*x, height*y); + paths2 := TranslatePath(paths, height*x, height*y); EraseInsidePaths(tmp, paths2, fillRule); FastGaussianBlur(tmp, tmp.Bounds, Round(blurRadius), 0); EraseOutsidePaths(tmp, paths, fillRule, tmp.Bounds); @@ -2034,11 +2032,11 @@ function SmoothToCubicBezier(const path: TPathD; end; if i = 0 then - Result[len*3-1] := OffsetPoint(path[0], -vec.X * d1, -vec.Y * d1) + Result[len*3-1] := TranslatePoint(path[0], -vec.X * d1, -vec.Y * d1) else - Result[i*3-1] := OffsetPoint(path[i], -vec.X * d1, -vec.Y * d1); + Result[i*3-1] := TranslatePoint(path[i], -vec.X * d1, -vec.Y * d1); Result[i*3] := path[i]; - Result[i*3+1] := OffsetPoint(path[i], vec.X * d2, vec.Y * d2); + Result[i*3+1] := TranslatePoint(path[i], vec.X * d2, vec.Y * d2); end; Result[len*3] := path[0]; @@ -2105,11 +2103,11 @@ function SmoothToCubicBezier2(const path: TPathD; end; if i = 0 then - Result[len*3-1] := OffsetPoint(path[0], -vec.X * d1, -vec.Y * d1) + Result[len*3-1] := TranslatePoint(path[0], -vec.X * d1, -vec.Y * d1) else - Result[i*3-1] := OffsetPoint(path[i], -vec.X * d1, -vec.Y * d1); + Result[i*3-1] := TranslatePoint(path[i], -vec.X * d1, -vec.Y * d1); Result[i*3] := path[i]; - Result[i*3+1] := OffsetPoint(path[i], vec.X * d2, vec.Y * d2); + Result[i*3+1] := TranslatePoint(path[i], vec.X * d2, vec.Y * d2); end; Result[len*3] := path[0]; diff --git a/Image32/source/Img32.Fmt.BMP.pas b/Image32/source/Img32.Fmt.BMP.pas index 6612c58..c1c0837 100644 --- a/Image32/source/Img32.Fmt.BMP.pas +++ b/Image32/source/Img32.Fmt.BMP.pas @@ -3,9 +3,9 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.4 * -* Date : 12 October 2023 * +* Date : 28 March 2024 * * Website : http://www.angusj.com * -* Copyright : Angus Johnson 2019-2023 * +* Copyright : Angus Johnson 2010-2024 * * Purpose : BMP file format extension for TImage32 * * License : http://www.boost.org/LICENSE_1_0.txt * *******************************************************************************) @@ -487,7 +487,7 @@ function TImageFormat_BMP.LoadFromStream(stream: TStream; isTopDown := bih.biHeight < 0; bih.biHeight := abs(bih.biHeight); - if (bih.biBitCount < 32) and + if //(bih.biBitCount < 32) and ((bih.biCompression and BI_BITFIELDS) = BI_BITFIELDS) then begin stream.Position := bihStart + 40; @@ -536,16 +536,14 @@ function TImageFormat_BMP.LoadFromStream(stream: TStream; //read pixels .... if stream.Position < bfh.bfOffBits then stream.Position := bfh.bfOffBits; - if (bih.biBitCount = 32) then + if hasValidBitFields then + tmp := StreamReadImageWithBitfields( + stream, img32.Width, img32.Height, bih.biBitCount, bitfields) + else if (bih.biBitCount = 32) then begin Read(img32.Pixels[0], bih.biWidth * bih.biHeight * sizeof(TColor32)); if AlphaChannelAllZero(img32) then ResetAlphaChannel(img32); end - - else if hasValidBitFields then - tmp := StreamReadImageWithBitfields( - stream, img32.Width, img32.Height, bih.biBitCount, bitfields) - else if (bih.biCompression = BI_RLE8) or (bih.biCompression = BI_RLE4) then tmp := ReadRLE4orRLE8Compression( stream, img32.Width, img32.Height, bih.biBitCount, pal) diff --git a/Image32/source/Img32.Fmt.SVG.pas b/Image32/source/Img32.Fmt.SVG.pas index 0c6666c..2166d71 100644 --- a/Image32/source/Img32.Fmt.SVG.pas +++ b/Image32/source/Img32.Fmt.SVG.pas @@ -3,9 +3,9 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.4 * -* Date : 22 October 2023 * +* Date : 11 March 2024 * * Website : http://www.angusj.com * -* Copyright : Angus Johnson 2019-2023 * +* Copyright : Angus Johnson 2019-2024 * * Purpose : SVG file format extension for TImage32 * * License : http://www.boost.org/LICENSE_1_0.txt * *******************************************************************************) @@ -91,101 +91,8 @@ TSvgImageList32 = class(TInterfacedObj, INotifySender) {$ENDIF} end; -function GetImageSize(const filename: string): TSize; - -var - defaultSvgWidth: integer = 800; - defaultSvgHeight: integer = 600; - implementation -function GetImageSize(const filename: string): TSize; -var - i,j, l,t,r,b: integer; - s: AnsiString; - ms: TMemoryStream; - - function GetValAndIgnoreFracs(var i: integer): integer; - begin - Result := 0; - while (s[i] >= '0') and (s[i] <= '9') do - begin - Result := Result * 10 + Ord(s[i]) - Ord('0'); - inc(i); - end; - - // ignore fractions - if s[i] <> '.' then Exit; - inc(i); - while (s[i] >= '0') and (s[i] <= '9') do inc(i); - end; - -begin - // this is quick and dirty code that - // needs to be made much more reliable - FillChar(Result.cx, SizeOf(TSize), 0); - if not FileExists(filename) then Exit; - ms := TMemoryStream.Create; - try - ms.LoadFromFile(filename); - ConvertUnicodeToUtf8(ms); - {$IFDEF UNICODE} - s := AnsiStrings.StrPas(ms.Memory); - {$ELSE} - s := StrPas(ms.Memory); - {$ENDIF} - finally - ms.Free; - end; - {$IFDEF UNICODE} - i := AnsiStrings.PosEx('', s, i); //watch out for inside '>' - {$ELSE} - j := PosEx('>', s, i); - {$ENDIF} - - if j < i then Exit; - s := Lowercase(Copy(s, i + 5, j - i -5)); - {$IFDEF UNICODE} - i := AnsiStrings.PosEx('width="', s); //watch out for space before = - j := AnsiStrings.PosEx('height="', s); - {$ELSE} - i := PosEx('width="', s); //watch out for space before = - j := PosEx('height="', s); - {$ENDIF} - if (i > 0) and (j > 0) then - begin - inc(i,7); - Result.cx := GetValAndIgnoreFracs(i); - inc(j,8); - Result.cy := GetValAndIgnoreFracs(j); - end else - begin - {$IFDEF UNICODE} - i := AnsiStrings.PosEx('viewbox="', s); - {$ELSE} - i := PosEx('viewbox="', s); - {$ENDIF} - if i < 1 then Exit; - inc(i, 9); - l := GetValAndIgnoreFracs(i); - while (s[i] <= #32) do inc(i); - t := GetValAndIgnoreFracs(i); - while (s[i] <= #32) do inc(i); - r := GetValAndIgnoreFracs(i); - while (s[i] <= #32) do inc(i); - b := GetValAndIgnoreFracs(i); - Result.cx := r - l; - Result.cy := b - t; - end; -end; - //------------------------------------------------------------------------------ // Three routines used to enumerate a resource type //------------------------------------------------------------------------------ @@ -463,32 +370,23 @@ function TImageFormat_SVG.LoadFromStream(stream: TStream; img32: TImage32; imgIndex: integer = 0): Boolean; var r: TRectWH; - w,h, sx,sy: double; + sx: double; begin with TSvgReader.Create do try Result := LoadFromStream(stream); if not Result then Exit; - r := GetViewbox(img32.Width, img32.Height); + r := RootElement.GetViewbox; img32.BeginUpdate; try if img32.IsEmpty and not r.IsEmpty then img32.SetSize(Round(r.Width), Round(r.Height)) else if not r.IsEmpty then begin - //then scale the SVG to fit image - w := r.Width; - h := r.Height; - sx := img32.Width / w; - sy := img32.Height / h; - if sy < sx then sx := sy; - if not(SameValue(sx, 1, 0.00001)) then - begin - w := w * sx; - h := h * sx; - end; - img32.SetSize(Round(w), Round(h)); + // scale the SVG to best fit the image dimensions + sx := GetScaleForBestFit(r.Width, r.Height, img32.Width, img32.Height); + img32.SetSize(Round(r.Width * sx), Round(r.Height * sx)); end else img32.SetSize(defaultSvgWidth, defaultSvgHeight); diff --git a/Image32/source/Img32.Layers.pas b/Image32/source/Img32.Layers.pas index 7a846ee..352effb 100644 --- a/Image32/source/Img32.Layers.pas +++ b/Image32/source/Img32.Layers.pas @@ -2,16 +2,12 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : 4.3 * -* Date : 3 September 2023 * +* Version : 4.4 * +* Date : 16 April 2024 * * Website : http://www.angusj.com * -* Copyright : Angus Johnson 2019-2023 * -* * +* Copyright : Angus Johnson 2019-2024 * * Purpose : Layered images support * -* * -* License : Use, modification & distribution is subject to * -* Boost Software License Ver 1 * -* http://www.boost.org/LICENSE_1_0.txt * +* License : http://www.boost.org/LICENSE_1_0.txt * *******************************************************************************) interface @@ -254,26 +250,23 @@ TVectorLayer32 = class(TRotLayer32) property OnDraw: TNotifyEvent read fOnDraw write fOnDraw; end; - TRasterLayer32 = class(TRotLayer32) //display laer for raster images + TRasterLayer32 = class(TRotLayer32) //display layer for raster images private fMasterImg : TImage32; //fMatrix: allows combining any number of scaling & rotating ops. fMatrix : TMatrixD; fRotating : Boolean; - fSavedMidPt : TPointD; + //fSavedMidPt : TPointD; fPreScaleSize : TSize; fAutoHitTest : Boolean; procedure DoAutoHitTest; - function GetMatrix: TMatrixD; protected procedure ImageChanged(Sender: TImage32); override; - procedure SetPivotPt(const pivot: TPointD); override; procedure UpdateHitTestMaskTranspar(compareFunc: TCompareFunction; referenceColor: TColor32; tolerance: integer); public constructor Create(parent: TLayer32 = nil; const name: string = ''); override; destructor Destroy; override; - procedure Offset(dx,dy: double); override; procedure UpdateHitTestMaskOpaque; virtual; procedure UpdateHitTestMaskTransparent(alphaValue: Byte = 127); overload; virtual; procedure SetInnerBounds(const newBounds: TRectD); override; @@ -281,7 +274,7 @@ TRasterLayer32 = class(TRotLayer32) //display laer for raster images property AutoSetHitTestMask: Boolean read fAutoHitTest write fAutoHitTest; property MasterImage: TImage32 read fMasterImg; - property Matrix: TMatrixD read GetMatrix; + //property Matrix: TMatrixD read fMatrix; end; TButtonDesignerLayer32 = class; @@ -466,11 +459,9 @@ function UpdateRotatingButtonGroup(rotateButton: TLayer32): double; implementation - {$IFNDEF MSWINDOWS} - {$IFNDEF FPC} + {$IFDEF USING_FMX} uses Img32.FMX; {$ENDIF} - {$ENDIF} resourcestring rsRoot = 'root'; @@ -726,17 +717,10 @@ function TLayer32.GetPrevLayerInGroup: TLayer32; //------------------------------------------------------------------------------ procedure TLayer32.ImageChanged(Sender: TImage32); -var - w,h: integer; begin if (StorageState = ssLoading) then Exit; - w := Ceil(fLeft + fWidth + fOuterMargin *2); - h := Ceil(fTop + fHeight + fOuterMargin *2); - if (Image.Width <> w) or (Image.Height <> h) then - begin - fWidth := Image.Width -fOuterMargin *2; - fHeight := Image.Height -fOuterMargin *2; - end; + fWidth := Image.Width -fOuterMargin *2; + fHeight := Image.Height -fOuterMargin *2; Invalidate; end; //------------------------------------------------------------------------------ @@ -747,8 +731,8 @@ procedure TLayer32.SetSize(width, height: double); begin if StorageState = ssDestroying then Exit; fWidth := width; fHeight := height; - w := Ceil(fLeft + fWidth + fOuterMargin *2); - h := Ceil(fTop + fHeight + fOuterMargin *2); + w := Ceil(fWidth + fOuterMargin *2); + h := Ceil(fHeight + fOuterMargin *2); Image.SetSize(w, h); end; //------------------------------------------------------------------------------ @@ -821,8 +805,7 @@ procedure TLayer32.PositionCenteredAt(const pt: TPointD); procedure TLayer32.Offset(dx, dy: double); begin - if (dx <> 0) or (dy <> 0) then - PositionAt(fLeft + dx, fTop + dy); + PositionAt(fLeft + dx, fTop + dy); end; //------------------------------------------------------------------------------ @@ -976,7 +959,7 @@ function TLayer32.MakeAbsolute(const pt: TPointD): TPointD; while assigned(layer) do begin if not (layer is TGroupLayer32) then - Result := OffsetPoint(Result, layer.Left, layer.Top); + Result := TranslatePoint(Result, layer.Left, layer.Top); layer := layer.Parent; end; end; @@ -1128,7 +1111,7 @@ procedure TLayer32.SetClipPath(const path: TPathsD); if Assigned(fClipImage) then fClipImage.SetSize(Image.Width, Image.Height) else fClipImage := TImage32.Create(Image.Width, Image.Height); - pp := OffsetPath(path, fOuterMargin, fOuterMargin); + pp := TranslatePath(path, fOuterMargin, fOuterMargin); DrawPolygon(fClipImage, pp, frEvenOdd, clWhite32); end else FreeAndNil(fClipImage); @@ -1194,7 +1177,7 @@ procedure TLayer32.Merge(hideDesigners: Boolean; updateRect: TRect); //that fMergeImage will then merge with its parent fMergeImage until root. if not (self is TGroupLayer32) then - Types.OffsetRect(updateRect, -Floor(fLeft), -Floor(fTop)); + TranslateRect(updateRect, -Floor(fLeft), -Floor(fTop)); if (self is TGroupLayer32) or (ChildCount = 0) then begin @@ -1209,6 +1192,7 @@ procedure TLayer32.Merge(hideDesigners: Boolean; updateRect: TRect); end; //merge redraw all children + childImg := nil; for i := 0 to ChildCount -1 do begin childLayer := Child[i]; @@ -1236,7 +1220,7 @@ procedure TLayer32.Merge(hideDesigners: Boolean; updateRect: TRect); //childs of group layers are positioned //independently of the group layer's positioning if (self is TGroupLayer32) then - Types.OffsetRect(dstRect, Floor(-self.Left), Floor(-self.Top)); + TranslateRect(dstRect, Floor(-self.Left), Floor(-self.Top)); Types.IntersectRect(dstRect, dstRect, self.Image.Bounds); end; @@ -1251,9 +1235,9 @@ procedure TLayer32.Merge(hideDesigners: Boolean; updateRect: TRect); end; if (self is TGroupLayer32) then - Types.OffsetRect(srcRect, Floor(fLeft), Floor(fTop)) + TranslateRect(srcRect, Floor(fLeft), Floor(fTop)) else //nb: offsetting **dstRect** below - Types.OffsetRect(dstRect, + TranslateRect(dstRect, Round(fOuterMargin), Round(fOuterMargin)); //DRAW THE CHILD ONTO THE PARENT'S IMAGE @@ -1270,7 +1254,7 @@ procedure TLayer32.Merge(hideDesigners: Boolean; updateRect: TRect); //use the clipping mask to 'trim' childLayer's image rec := fClipImage.Bounds; rec2 := rec; - Types.OffsetRect(rec2, + TranslateRect(rec2, Floor(childLayer.fOuterMargin -childLayer.Left -fOuterMargin), Floor(childLayer.fOuterMargin -childLayer.Top -fOuterMargin)); childImg2.CopyBlend(fClipImage, rec, rec2, BlendMask); @@ -1307,7 +1291,7 @@ function TLayer32.GetLayerAt(const pt: TPointD; ignoreDesigners: Boolean): TLaye if (self is TGroupLayer32) then pt2 := pt else - pt2 := OffsetPoint(pt, -Left, -Top); + pt2 := TranslatePoint(pt, -Left, -Top); //if 'pt2' is outside the clip mask then don't continue if Assigned(fClipImage) then @@ -1660,9 +1644,9 @@ procedure TVectorLayer32.SetInnerBounds(const newBounds: TRectD); procedure TVectorLayer32.Offset(dx,dy: double); begin inherited; - fPaths := OffsetPath(fPaths, dx,dy); + fPaths := TranslatePath(fPaths, dx,dy); if fAutoPivot and not PointsEqual(fPivotPt, InvalidPointD) then - fPivotPt := OffsetPoint(fPivotPt, dx,dy); + fPivotPt := TranslatePoint(fPivotPt, dx,dy); end; //------------------------------------------------------------------------------ @@ -1804,20 +1788,6 @@ procedure TRasterLayer32.ImageChanged(Sender: TImage32); end; //------------------------------------------------------------------------------ -procedure TRasterLayer32.Offset(dx,dy: double); -begin - inherited; - fSavedMidPt := OffsetPoint(fSavedMidPt, dx,dy); -end; -//------------------------------------------------------------------------------ - -procedure TRasterLayer32.SetPivotPt(const pivot: TPointD); -begin - inherited; - fSavedMidPt := MidPoint; -end; -//------------------------------------------------------------------------------ - procedure TRasterLayer32.SetInnerBounds(const newBounds: TRectD); var newWidth, newHeight: double; @@ -1826,22 +1796,23 @@ procedure TRasterLayer32.SetInnerBounds(const newBounds: TRectD); if fRotating and Assigned(Image) then begin + //rotation has just ended fRotating := false; - //rotation has just ended so add the rotation angle to fMatrix + //update fMatrix with the new rotation angle if (fAngle <> 0) then MatrixRotate(fMatrix, Image.MidPoint, fAngle); - fAngle := 0; + //and since we're about to start scaling, we need //to store the starting size, and reset the angle fPreScaleSize := Size(Image.Width, Image.Height); + fAngle := 0; end; newWidth := newBounds.Width; newHeight := newBounds.Height; //make sure the image is large enough to scale safely - if (MasterImage.Width > 1) and (MasterImage.Height > 1) and - (newWidth > 1) and (newHeight > 1) then + if not MasterImage.IsEmpty and (newWidth > 1) and (newHeight > 1) then begin Image.BeginUpdate; try @@ -1863,31 +1834,20 @@ procedure TRasterLayer32.SetInnerBounds(const newBounds: TRectD); end; //------------------------------------------------------------------------------ -function TRasterLayer32.GetMatrix: TMatrixD; -begin - Result := fMatrix; - //update for transformations not yet unapplied to fMatrix - if fRotating then - begin - if fAngle <> 0 then - MatrixRotate(Result, MidPoint, fAngle); - end else - begin - MatrixScale(Result, Image.Width/fPreScaleSize.cx, - Image.Height/fPreScaleSize.cy); - end; -end; -//------------------------------------------------------------------------------ - function TRasterLayer32.Rotate(angleDelta: double): Boolean; var mat: TMatrixD; + pt, mp: TPointD; begin - Result := not MasterImage.IsEmpty and + Result := (angleDelta <> 0) and + not MasterImage.IsEmpty and inherited Rotate(angleDelta); + if not Result then Exit; - //if not already rotating, then update scaling in fMatrix + mp := MidPoint; + + //if not already rotating, then update fMatrix with prior scaling if not fRotating then begin Assert((fPreScaleSize.cx > 0) and (fPreScaleSize.cy > 0), 'oops!'); @@ -1896,25 +1856,25 @@ function TRasterLayer32.Rotate(angleDelta: double): Boolean; Image.Height/fPreScaleSize.cy); fRotating := true; - fSavedMidPt := MidPoint; - if fAutoPivot then fPivotPt := fSavedMidPt; + if fAutoPivot then fPivotPt := mp; end; - if not fAutoPivot then - RotatePoint(fSavedMidPt, PivotPt, angleDelta); + RotatePoint(mp, PivotPt, angleDelta); - Image.BeginUpdate; + Image.BlockNotify; try Image.Assign(MasterImage); mat := fMatrix; - MatrixRotate(mat, NullPointD, Angle); + pt := PointD(PivotPt.X - fLeft, PivotPt.Y - fTop); + MatrixRotate(mat, pt, Angle); AffineTransformImage(Image, mat); - SymmetricCropTransparent(Image); finally - Image.EndUpdate; + Image.UnblockNotify; end; - PositionCenteredAt(fSavedMidPt); + fWidth := Image.Width; + fHeight := Image.Height; + PositionCenteredAt(mp); DoAutoHitTest; end; @@ -1958,7 +1918,7 @@ procedure TRotatingGroupLayer32.Init(const rec: TRect; begin SetInnerBounds(rec2); q := DPIAware(2); - pt := OffsetPoint(pivot, -Left, -Top); + pt := TranslatePoint(pivot, -Left, -Top); DrawDashedLine(Image, Circle(pt, dist - q), dashes, nil, q, clRed32, esPolygon); end; @@ -2663,7 +2623,7 @@ function UpdateRotatingButtonGroup(rotateButton: TLayer32): double; rec := RectD(mp.X -radius, mp.Y -radius, mp.X +radius,mp.Y +radius); designer := DesignLayer; designer.SetInnerBounds(rec); - pt2 := OffsetPoint(mp, -rec.Left, -rec.Top); + pt2 := TranslatePoint(mp, -rec.Left, -rec.Top); DrawDashedLine(designer.Image, Circle(pt2, radius -dpiAwareOne), dashes, nil, DPIAware(2), clRed32, esPolygon); diff --git a/Image32/source/Img32.Panels.pas b/Image32/source/Img32.Panels.pas index 74fbe09..88ccb70 100644 --- a/Image32/source/Img32.Panels.pas +++ b/Image32/source/Img32.Panels.pas @@ -207,7 +207,7 @@ procedure Register; implementation uses - Img32.Extra; + Img32.Extra, Img32.Vector; procedure Register; begin @@ -325,13 +325,6 @@ function GetThemeColor(const className: widestring; end; //------------------------------------------------------------------------------ -function OffsetPoint(const pt: TPoint; dx, dy: integer): TPoint; -begin - Result.X := pt.X + dx; - Result.Y := pt.Y + dy; -end; -//------------------------------------------------------------------------------ - function LeftMouseBtnDown: Boolean; begin Result := (GetKeyState(VK_LBUTTON) shr 8 > 0); @@ -422,7 +415,7 @@ procedure TBaseImgPanel.WMSize(var Message: TWMSize); function TBaseImgPanel.GetDstOffset: TPoint; begin if not fAutoCenter then - Result := Point(0,0) + Result := Types.Point(0,0) else with GetInnerClientRect do begin @@ -521,7 +514,7 @@ procedure TBaseImgPanel.ScaleAtPoint(scaleDelta: double; const pt: TPoint); q := 1 - 1/scaleDelta; marg := GetInnerMargin; pt1 := ClientToImage(pt); - pt2 := ClientToImage(Point(marg, marg)); + pt2 := ClientToImage(Types.Point(marg, marg)); SetScale(fScale * scaleDelta); with fScrollbarHorz do inc(srcOffset, Round((pt1.X - pt2.X) * q)); @@ -726,7 +719,7 @@ function TBaseImgPanel.RecenterImageAt(const imagePt: TPoint): Boolean; innerW := ClientWidth - marg*2; innerH := ClientHeight - marg*2; pt1 := imagePt; - pt2 := ClientToImage(Point(marg + innerW div 2, marg + innerH div 2)); + pt2 := ClientToImage(Types.Point(marg + innerW div 2, marg + innerH div 2)); with fScrollbarHorz do begin q := (pt1.X - pt2.X); @@ -781,7 +774,7 @@ procedure TBaseImgPanel.MouseMove(Shift: TShiftState; X, Y: Integer); inDrawRegion: Boolean; begin rec := GetInnerClientRect; - inDrawRegion := PtInRect(rec, Point(X,Y)); + inDrawRegion := PtInRect(rec, Types.Point(X,Y)); if inDrawRegion and not (fScrollbarHorz.MouseDown or fScrollbarVert.MouseDown) then begin @@ -934,8 +927,8 @@ procedure TBaseImgPanel.Paint; Canvas.Pen.Width := 1; while width > 0 do begin - tr := Point(rec.Right, rec.Top); - bl := Point(rec.Left, rec.Bottom); + tr := Types.Point(rec.Right, rec.Top); + bl := Types.Point(rec.Left, rec.Bottom); Canvas.Pen.Color := tlColor; Canvas.PolyLine([bl, rec.TopLeft, tr]); Canvas.Pen.Color := brColor; @@ -969,7 +962,7 @@ procedure TBaseImgPanel.Paint; dpiAwareBW := DpiAware(BorderWidth); dstRec := innerRec; srcRec := dstRec; - OffsetRect(srcRec, -marg, -marg); + TranslateRect(srcRec, -marg, -marg); ScaleRect(srcRec, 1/fScale); //if the scaled drawing is smaller than InnerClientRect then center it pt := GetDstOffset; @@ -996,7 +989,7 @@ procedure TBaseImgPanel.Paint; fScrollbarVert.srcOffset := Round(fScrollbarVert.maxSrcOffset); if fScrollbarHorz.srcOffset > fScrollbarHorz.maxSrcOffset then fScrollbarHorz.srcOffset := Round(fScrollbarHorz.maxSrcOffset); - OffsetRect(srcRec, fScrollbarHorz.srcOffset, fScrollbarVert.srcOffset); + TranslateRect(srcRec, fScrollbarHorz.srcOffset, fScrollbarVert.srcOffset); //paint innerRec background backgroundPainted := ParentBackground and {$IFDEF STYLESERVICES} @@ -1202,7 +1195,7 @@ procedure TBaseImgPanel.WMKeyDown(var Message: TWMKey); begin if not fAllowZoom then Exit; //zoom in and out with CTRL+UP and CTRL+DOWN respectively - midPoint := Point(ClientWidth div 2, ClientHeight div 2); + midPoint := Types.Point(ClientWidth div 2, ClientHeight div 2); case Message.CharCode of VK_UP: ScaleAtPoint(1.1, midPoint); VK_DOWN: ScaleAtPoint(0.9, midPoint); diff --git a/Image32/source/Img32.Resamplers.pas b/Image32/source/Img32.Resamplers.pas index 7024ed2..e5c71d6 100644 --- a/Image32/source/Img32.Resamplers.pas +++ b/Image32/source/Img32.Resamplers.pas @@ -3,9 +3,9 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.3 * -* Date : 17 December 2023 * +* Date : 17 April 2024 * * Website : http://www.angusj.com * -* Copyright : Angus Johnson 2019-2021 * +* Copyright : Angus Johnson 2019-2024 * * Purpose : For image transformations (scaling, rotating etc.) * * License : http://www.boost.org/LICENSE_1_0.txt * *******************************************************************************) @@ -15,7 +15,7 @@ interface {$I Img32.inc} uses - SysUtils, Classes, Img32; + SysUtils, Classes, Math, Img32; //BoxDownSampling: As the name implies, this routine is only intended for //image down-sampling (ie when shrinking images) where it generally performs @@ -26,9 +26,9 @@ interface procedure BoxDownSampling(Image: TImage32; newWidth, newHeight: Integer); (* The following functions are registered in the initialization section below -function NearestResampler(img: TImage32; x256, y256: Integer): TColor32; -function BilinearResample(img: TImage32; x256, y256: Integer): TColor32; -function BicubicResample(img: TImage32; x256, y256: Integer): TColor32; +function NearestResampler(img: TImage32; x, y: double): TColor32; +function BilinearResample(img: TImage32; x, y: double): TColor32; +function BicubicResample (img: TImage32; x, y: double): TColor32; *) implementation @@ -40,94 +40,115 @@ implementation // NearestNeighbor resampler //------------------------------------------------------------------------------ -function NearestResampler(img: TImage32; x256, y256: Integer): TColor32; +function NearestResampler(img: TImage32; x, y: double): TColor32; +var + iw, ih, xx, yy: integer; begin - if (x256 < -$7f) then - begin - Result := clNone32; - Exit; - end; - - if (y256 < -$7f) then + iw := img.Width; + ih := img.Height; + if (x < -0.5) or (x -0.5 >= iw) or + (y < -0.5) or (y -0.5 >= ih) then begin Result := clNone32; Exit; end; - if (x256 and $FF > $7F) then inc(x256, $100); - x256 := x256 shr 8; - if y256 and $FF > $7F then inc(y256, $100); - y256 := y256 shr 8; + // scale the image fractionally so as to avoid the pixels along the + // right and bottom edges effectively duplicating their adjacent pixels + if (x > 0) and (x < iw) then x := x - x/(iw+0.25); + if (y > 0) and (y < ih) then y := y - y/(ih+0.25); - if (x256 < 0) or (x256 >= img.Width) or - (y256 < 0) or (y256 >= img.Height) then - Result := clNone32 else - Result := img.Pixels[y256 * img.Width + x256]; + xx := Min(Max(0, Round(x)), iw -1); + yy := Min(Max(0, Round(y)), ih -1); + Result := img.Pixels[xx + yy * img.Width]; end; //------------------------------------------------------------------------------ // BiLinear resampler //------------------------------------------------------------------------------ -function BilinearResample(img: TImage32; x256, y256: Integer): TColor32; +function BilinearResample(img: TImage32; x, y: double): TColor32; var - xi,yi, weight: Integer; iw, ih: integer; + xx, yy, xR, yB: integer; + weight: Cardinal; pixels: TArrayOfColor32; - color: TWeightedColor; - xf, yf: cardinal; + weightedColor: TWeightedColor; + xf, yf: double; begin iw := img.Width; ih := img.Height; pixels := img.Pixels; - if (x256 <= -$100) or (x256 >= iw *$100) or - (y256 <= -$100) or (y256 >= ih *$100) then + if (x < -1) or (x >= iw + 1) or + (y < -1) or (y >= ih + 1) then begin result := clNone32; Exit; end; - if x256 < 0 then xi := -1 - else xi := x256 shr 8; + // scale the image fractionally so as to avoid the pixels along the + // right and bottom edges effectively duplicating their adjacent pixels + if (x > 0) and (x < iw) then x := x - x/(iw+0.25); + if (y > 0) and (y < ih) then y := y - y/(ih+0.25); - if y256 < 0 then yi := -1 - else yi := y256 shr 8; + if x < 0 then + xf := frac(1+x) else + xf := frac(x); + if y < 0 then + yf := frac(1+y) else + yf := frac(y); - xf := x256 and $FF; - yf := y256 and $FF; + xx := Floor(x); + yy := Floor(y); + xR := xx +1; + yB := yy +1; - color.Reset; + if xx >= iw -1 then + begin + xx := iw -1; + xR := xx; + end; + if yy >= ih -1 then + begin + yy := ih -1; + yB := yy; + end; + + weightedColor.Reset; - weight := (($100 - xf) * ($100 - yf)) shr 8; //top-left + weight := Round((1-xf) * (1-yf) * 256); //top-left if weight > 0 then begin - if (xi < 0) or (yi < 0) then color.AddWeight(weight) - else color.Add(pixels[xi + yi * iw], weight); + if (x < 0) or (y < 0) then + weightedColor.AddWeight(weight) else + weightedColor.Add(pixels[xx + yy * iw], weight); end; - weight := (xf * ($100 - yf)) shr 8; //top-right + weight := Round(xf * (1-yf) * 256); //top-right if weight > 0 then begin - if ((xi+1) >= iw) or (yi < 0) then color.AddWeight(weight) - else color.Add(pixels[(xi+1) + yi * iw], weight); + if (x > iw) or (y < 0) then + weightedColor.AddWeight(weight) else + weightedColor.Add(pixels[xR + yy * iw], weight); end; - weight := (($100 - xf) * yf) shr 8; //bottom-left + weight := Round((1-xf) * yf * 256); //bottom-left if weight > 0 then begin - if (xi < 0) or ((yi+1) >= ih) then color.AddWeight(weight) - else color.Add(pixels[(xi) + (yi+1) * iw], weight); + if (x < 0) or (y > ih) then + weightedColor.AddWeight(weight) else + weightedColor.Add(pixels[xx + yB * iw], weight); end; - weight := (xf * yf) shr 8; //bottom-right + weight := Round(xf * yf * 256); //bottom-right if weight > 0 then begin - if (xi + 1 >= iw) or (yi + 1 >= ih) then color.AddWeight(weight) - else color.Add(pixels[(xi+1) + (yi+1) * iw], weight); + if (x > iw) or (y > ih) then + weightedColor.AddWeight(weight) else + weightedColor.Add(pixels[xR + yB * iw], weight); end; - - Result := color.Color; + Result := weightedColor.Color; end; //------------------------------------------------------------------------------ @@ -135,7 +156,8 @@ function BilinearResample(img: TImage32; x256, y256: Integer): TColor32; //------------------------------------------------------------------------------ type - TBiCubicEdgeAdjust = (eaNone, eaOne, eaTwo, eaThree, eaFour); + TBiCubicEdgeAdjust = (eaNormal, eaOnePixel, + eaPreStart, eaStart, eaEnd, eaPostEnd); var byteFrac: array [0..255] of double; @@ -153,39 +175,37 @@ function CubicHermite(aclr: PColor32; t: Byte; bce: TBiCubicEdgeAdjust): TColor3 res: TARGB absolute Result; const clTrans: TColor32 = clNone32; + clDebug: TColor32 = clBlack32; begin case bce of - eaOne: + eaPreStart: begin + Inc(aclr); a := @clTrans; b := @clTrans; c := PARGB(aclr); - Inc(aclr); - d := PARGB(aclr); + d := c; end; - eaTwo: + eaStart: begin a := PARGB(aclr); b := a; Inc(aclr); c := PARGB(aclr); - Inc(aclr); - d := PARGB(aclr); + d := c; end; - eaThree: + eaEnd: begin a := PARGB(aclr); Inc(aclr); b := PARGB(aclr); - Inc(aclr); - c := PARGB(aclr); - d := c; + c := b; + d := b; end; - eaFour: + eaPostEnd: begin a := PARGB(aclr); - Inc(aclr); - b := PARGB(aclr); + b := a; c := @clTrans; d := @clTrans; end; @@ -206,6 +226,11 @@ function CubicHermite(aclr: PColor32; t: Byte; bce: TBiCubicEdgeAdjust): TColor3 result := clNone32; Exit; end + else if (b.Color = c.Color) then + begin + result := b.Color; + Exit; + end else if b.A = 0 then begin q := c^; @@ -245,54 +270,83 @@ function CubicHermite(aclr: PColor32; t: Byte; bce: TBiCubicEdgeAdjust): TColor3 end; //------------------------------------------------------------------------------ -function BicubicResample(img: TImage32; x256, y256: Integer): TColor32; +function BicubicResample(img: TImage32; x, y: double): TColor32; var - i, dx,dy, pi, iw, w,h: Integer; + i, pxIdx, iw, ih, dy, last: integer; + xFrac,yFrac: Byte; c: array[0..3] of TColor32; - x, y: Integer; bceX, bceY: TBiCubicEdgeAdjust; begin - Result := clNone32; iw := img.Width; - w := iw -1; - h := img.Height -1; - - x := Abs(x256) shr 8; - y := Abs(y256) shr 8; - - if (x256 < -$FF) or (x > w) or (y256 < -$FF) or (y > h) then Exit; - - if (x256 < 0) then bceX := eaOne - else if (x = 0) then bceX := eaTwo - else if (x256 > w shl 8) then bceX := eaFour - else if (x256 > (w -1) shl 8) then bceX := eaThree - else bceX := eaNone; - - if (bceX = eaOne) or (bceX = eaTwo) then dx := 1 - else dx := 0; - - if (y256 < 0) then bceY := eaOne - else if y = 0 then bceY := eaTwo - else if y = h -1 then bceY := eaThree - else if y = h then bceY := eaFour - else bceY := eaNone; - - if (bceY = eaOne) or (bceY = eaTwo) then dy := 1 - else dy := 0; - - pi := (y -1 +dy) * iw + (x -1 + dx); - - if bceY = eaFour then dx := 2 - else if bceY = eaThree then dx := 1 - else dx := 0; + ih := img.Height; + last := iw * ih -1; - for i := dy to 3 -dx do + Result := clNone32; + if (x <= -1) or (x >= iw +1) or + (y <= -1) or (y >= ih +1) then Exit; + + // scale the image fractionally so as to avoid the pixels along the + // right and bottom edges effectively duplicating their adjacent pixels + if (x > 0) and (x <= iw) then x := x - x/(iw+0.25); + if (y > 0) and (y <= ih) then y := y - y/(ih+0.25); + + if x < 0 then bceX := eaPreStart + else if x > iw then bceX := eaPostEnd + else if iw = 1 then bceX := eaOnePixel + else if x < 1 then bceX := eaStart + else if x >= iw -1 then bceX := eaEnd + else bceX := eaNormal; + + if y < 0 then bceY := eaPreStart + else if y > ih then bceY := eaPostEnd + else if ih = 1 then bceY := eaOnePixel + else if y < 1 then bceY := eaStart + else if y >= ih -1 then bceY := eaEnd + else bceY := eaNormal; + + if x < 0 then + xFrac := Round(frac(1+x) *255) else + xFrac := Round(frac(x) *255); + if y < 0 then + yFrac := Round(frac(1+y) *255) else + yFrac := Round(frac(y) *255); + + if (x < 0) then x := 0 + else if (x >= 1) then x := x - 1; + if (y < 0) then y := 0 + else if (y >= 1) then y := y - 1; + + if bceY = eaPostEnd then dy := 1 + else if bceY = eaNormal then dy := 4 + else dy := 2; + + pxIdx := Floor(y) * iw + Floor(x); + + if bceY = eaOnePixel then + begin + if bceX = eaOnePixel then + Result := img.Pixels[0] else + Result := CubicHermite(@img.Pixels[pxIdx], xFrac, bceX); + end + else if bceX = eaOnePixel then + begin + for i := 0 to dy-1 do + begin + c[i] := img.Pixels[pxIdx]; + inc(pxIdx, iw); + end; + Result := CubicHermite(@c[0], yFrac, bceY); + end else begin - c[i] := CubicHermite(@img.Pixels[pi], x256 and $FF, bceX); - inc(pi, iw); + for i := 0 to dy-1 do + begin + c[i] := CubicHermite(@img.Pixels[pxIdx], xFrac, bceX); + inc(pxIdx, iw); + if pxIdx >= last then break; + end; + Result := CubicHermite(@c[0], yFrac, bceY); end; - Result := CubicHermite(@c[dy], y256 and $FF, bceY); end; //------------------------------------------------------------------------------ diff --git a/Image32/source/Img32.SVG.Core.pas b/Image32/source/Img32.SVG.Core.pas index dd64e9f..afe6b31 100644 --- a/Image32/source/Img32.SVG.Core.pas +++ b/Image32/source/Img32.SVG.Core.pas @@ -3,9 +3,9 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.4 * -* Date : 22 October 2023 * +* Date : 13 March 2024 * * Website : http://www.angusj.com * -* Copyright : Angus Johnson 2019-2022 * +* Copyright : Angus Johnson 2019-2024 * * * * Purpose : Essential structures and functions to read SVG files * * * @@ -245,6 +245,11 @@ TSvgParser = class procedure ConvertUnicodeToUtf8(memStream: TMemoryStream); + function GetScale(src, dst: double): double; + function GetScaleForBestFit(srcW, srcH, dstW, dstH: double): double; + + function Base64Decode(const str: PAnsiChar; len: integer; memStream: TMemoryStream): Boolean; + type TSetOfUTF8Char = set of UTF8Char; UTF8Strings = array of UTF8String; @@ -285,10 +290,106 @@ TColorObj = class //include hashed html entity constants {$I Img32.SVG.HtmlHashConsts.inc} +//------------------------------------------------------------------------------ +// Base64 (MIME) Encode & Decode and other encoding functions ... +//------------------------------------------------------------------------------ + +type + PFourChars = ^TFourChars; + TFourChars = record + c1: ansichar; + c2: ansichar; + c3: ansichar; + c4: ansichar; + end; + +function Chr64ToVal(c: ansiChar): integer; {$IFDEF INLINE} inline; {$ENDIF} +begin + case c of + '+': result := 62; + '/': result := 63; + '0'..'9': result := ord(c) + 4; + 'A'..'Z': result := ord(c) -65; + 'a'..'z': result := ord(c) -71; + else Raise Exception.Create('Corrupted MIME encoded text'); + end; +end; +//------------------------------------------------------------------------------ + +function FrstChr(c: PFourChars): ansichar; {$IFDEF INLINE} inline; {$ENDIF} +begin + result := ansichar(Chr64ToVal(c.c1) shl 2 or Chr64ToVal(c.c2) shr 4); +end; +//------------------------------------------------------------------------------ + +function ScndChr(c: PFourChars): ansichar; {$IFDEF INLINE} inline; {$ENDIF} +begin + result := ansichar(Chr64ToVal(c.c2) shl 4 or Chr64ToVal(c.c3) shr 2); +end; +//------------------------------------------------------------------------------ + +function ThrdChr(c: PFourChars): ansichar; {$IFDEF INLINE} inline; {$ENDIF} +begin + result := ansichar( Chr64ToVal(c.c3) shl 6 or Chr64ToVal(c.c4) ); +end; +//------------------------------------------------------------------------------ + +function Base64Decode(const str: PAnsiChar; len: integer; memStream: TMemoryStream): Boolean; +var + i, j, extra: integer; + Chars4: PFourChars; + dst: PAnsiChar; +begin + result := false; + if (len = 0) or (len mod 4 > 0) or not Assigned(memStream) then exit; + if str[len-2] = '=' then extra := 2 + else if str[len-1] = '=' then extra := 1 + else extra := 0; + memStream.SetSize(LongInt((len div 4 * 3) - extra)); + dst := memStream.Memory; + Chars4 := @str[0]; + i := 0; + try + for j := 1 to (len div 4) -1 do + begin + dst[i] := FrstChr(Chars4); + dst[i+1] := ScndChr(Chars4); + dst[i+2] := ThrdChr(Chars4); + inc(pbyte(Chars4),4); + inc(i,3); + end; + dst[i] := FrstChr(Chars4); + if extra < 2 then dst[i+1] := ScndChr(Chars4); + if extra < 1 then dst[i+2] := ThrdChr(Chars4); + except + Exit; + end; + Result := true; +end; + //------------------------------------------------------------------------------ // Miscellaneous functions ... //------------------------------------------------------------------------------ +function GetScale(src, dst: double): double; +begin + Result := dst / src; + if (SameValue(Result, 1, 0.00001)) then Result := 1; +end; +//------------------------------------------------------------------------------ + +function GetScaleForBestFit(srcW, srcH, dstW, dstH: double): double; +var + sx,sy: double; +begin + sx := dstW / srcW; + sy := dstH / srcH; + if sy < sx then sx := sy; + if (SameValue(sx, 1, 0.00001)) then + Result := 1 else + Result := sx; +end; + function ClampRange(val, min, max: double): double; {$IFDEF INLINE} inline; {$ENDIF} begin diff --git a/Image32/source/Img32.SVG.HashConsts.inc b/Image32/source/Img32.SVG.HashConsts.inc index 25904f2..08db2ca 100644 --- a/Image32/source/Img32.SVG.HashConsts.inc +++ b/Image32/source/Img32.SVG.HashConsts.inc @@ -46,6 +46,7 @@ const hfeFuncG = $E45FE81A; // feFuncG hfeFuncR = $F8BB10C8; // feFuncR hfeGaussianBlur = $B2225552; // feGaussianBlur + hfeImage = $905096A0; // feImage hfeMerge = $A2C358C0; // feMerge hfeMergeNode = $F5F1E90F; // feMergeNode hfeOffset = $04493A72; // feOffset @@ -74,6 +75,7 @@ const hhidden = $4C4D777D; // hidden hHref = $8E926F4B; // Href hId = $1B60404D; // Id + hImage = $D58C8637; // Image hIn = $4D5FA44B; // In hIn2 = $FBFE02B1; // In2 hIntercept = $7CBB607F; // Intercept diff --git a/Image32/source/Img32.SVG.Path.pas b/Image32/source/Img32.SVG.Path.pas index 944dab6..7941f87 100644 --- a/Image32/source/Img32.SVG.Path.pas +++ b/Image32/source/Img32.SVG.Path.pas @@ -3,9 +3,9 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.4 * -* Date : 14 October 2023 * +* Date : 16 March 2024 * * Website : http://www.angusj.com * -* Copyright : Angus Johnson 2019-2021 * +* Copyright : Angus Johnson 2019-2024 * * * * Purpose : Essential structures and functions to read SVG Path elements * * * @@ -276,7 +276,6 @@ implementation resourcestring rsSvgPathRangeError = 'TSvgPath.GetPath range error'; rsSvgSubPathRangeError = 'TSvgSubPath.GetSeg range error'; - //rsSvgSegmentRangeError = 'TSvgSegment.GetVal range error'; //------------------------------------------------------------------------------ // Miscellaneous functions ... @@ -418,22 +417,22 @@ procedure TSvgPathSeg.Scale(value: double); function TSvgPathSeg.DescaleAndOffset(const pt: TPointD): TPointD; begin Result := pt; - OffsetPoint(Result, -parent.PathOffset.X, -parent.PathOffset.Y); + TranslatePoint(Result, -parent.PathOffset.X, -parent.PathOffset.Y); Result := ScalePoint(Result, 1/Owner.Scale); end; //------------------------------------------------------------------------------ function TSvgPathSeg.DescaleAndOffset(const p: TPathD): TPathD; begin - Result := OffsetPath(p, -parent.PathOffset.X, -parent.PathOffset.Y); + Result := TranslatePath(p, -parent.PathOffset.X, -parent.PathOffset.Y); Result := ScalePath(Result, 1/Owner.Scale); end; //------------------------------------------------------------------------------ procedure TSvgPathSeg.Offset(dx, dy: double); begin - fFirstPt := OffsetPoint(fFirstPt, dx, dy); - fCtrlPts := OffsetPath(fCtrlPts, dx, dy); + fFirstPt := TranslatePoint(fFirstPt, dx, dy); + fCtrlPts := TranslatePath(fCtrlPts, dx, dy); end; //------------------------------------------------------------------------------ @@ -562,9 +561,9 @@ procedure TSvgASegment.SetArcInfo(ai: TArcInfo); begin dx := ai.startPos.X - startPos.X; dy := ai.startPos.Y - startPos.Y; - OffsetRect(rec, dx, dy); + TranslateRect(rec, dx, dy); startPos := ai.startPos; - endPos := OffsetPoint(endPos, dx, dy); + endPos := TranslatePoint(endPos, dx, dy); end; end; SetCtrlPtsFromArcInfo; @@ -669,9 +668,9 @@ procedure TSvgASegment.Offset(dx, dy: double); inherited; with fArcInfo do begin - OffsetRect(rec, dx, dy); - startPos := OffsetPoint(startPos, dx, dy); - endPos := OffsetPoint(endPos, dx, dy); + TranslateRect(rec, dx, dy); + startPos := TranslatePoint(startPos, dx, dy); + endPos := TranslatePoint(endPos, dx, dy); end; end; //------------------------------------------------------------------------------ @@ -1287,7 +1286,6 @@ procedure TSvgSubPath.Offset(dx, dy: double); var i: integer; begin - //fPathOffset := OffsetPoint(pathOffset, dx,dy); //DON'T DO THIS! for i := 0 to High(fSegs) do fSegs[i].Offset(dx, dy); end; //------------------------------------------------------------------------------ @@ -1592,16 +1590,26 @@ function TSvgPath.GetControlBounds: TRectD; for i := 0 to Count -1 do with fSubPaths[i] do begin - AppendPath(p, GetFirstPt); + AppendToPath(p, GetFirstPt); for j := 0 to High(fSegs) do AppendPath(p, fSegs[j].fCtrlPts); end; Result := GetBoundsD(p); //watch out for straight horizontal or vertical lines - if not IsEmptyRect(Result) then Exit; - p := Grow(p, nil, 1, jsSquare, 0); - Result := GetBoundsD(p); + if IsEmptyRect(Result) then + begin + if Result.Width = 0 then + begin + Result.Left := Result.Left - 0.5; + Result.Right := Result.Left + 1.0; + end + else if Result.Height = 0 then + begin + Result.Top := Result.Top - 0.5; + Result.Bottom := Result.Top + 1.0; + end; + end; end; //------------------------------------------------------------------------------ diff --git a/Image32/source/Img32.SVG.PathDesign.pas b/Image32/source/Img32.SVG.PathDesign.pas index 2adfe95..d1b33a1 100644 --- a/Image32/source/Img32.SVG.PathDesign.pas +++ b/Image32/source/Img32.SVG.PathDesign.pas @@ -2,8 +2,8 @@ (******************************************************************************* * Author : Angus Johnson * -* Version : 4.2 * -* Date : 30 May 2022 * +* Version : 4.0 * +* Date : 10 January 2022 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2022 * * * @@ -1111,7 +1111,6 @@ procedure TSubPathLayer.Init(subPath: TSvgSubPath); begin fOwner := Parent as TSvgPathLayer; fSubPath := subPath; - seg := nil; for i := 0 to subPath.Count -1 do begin case subPath[i].segType of diff --git a/Image32/source/Img32.SVG.Reader.pas b/Image32/source/Img32.SVG.Reader.pas index 977bd0c..6508841 100644 --- a/Image32/source/Img32.SVG.Reader.pas +++ b/Image32/source/Img32.SVG.Reader.pas @@ -3,9 +3,9 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.4 * -* Date : 22 October 2023 * +* Date : 23 March 2024 * * Website : http://www.angusj.com * -* Copyright : Angus Johnson 2019-2022 * +* Copyright : Angus Johnson 2019-2024 * * * * Purpose : Read SVG 2.0 files * * * @@ -29,7 +29,9 @@ interface {$ENDIF} type - TSvgElement = class; + + TBaseElement = class; + TElementClass = class of TBaseElement; TDrawData = record currentColor : TColor32; @@ -56,29 +58,28 @@ TDrawData = record opacity : integer; matrix : TMatrixD; visible : Boolean; - useEl : TSvgElement; //to check for and prevent recursion + useEl : TBaseElement; //to check for and prevent recursion bounds : TRectD; end; TSvgReader = class; - TElementClass = class of TSvgElement; - TSvgElement = class + TBaseElement = class private - fParent : TSvgElement; + fParent : TBaseElement; fParserEl : TSvgTreeEl; fReader : TSvgReader; {$IFDEF XPLAT_GENERICS} - fChilds : TList; + fChilds : TList; {$ELSE} fChilds : TList; {$ENDIF} fId : UTF8String; fDrawData : TDrawData; //currently both static and dynamic vars - function FindRefElement(refname: UTF8String): TSvgElement; + function FindRefElement(refname: UTF8String): TBaseElement; function GetChildCount: integer; - function GetChild(index: integer): TSvgElement; - function FindChild(const idName: UTF8String): TSvgElement; + function GetChild(index: integer): TBaseElement; + function FindChild(const idName: UTF8String): TBaseElement; protected elRectWH : TValueRecWH; //multifunction variable function IsFirstChild: Boolean; @@ -90,19 +91,20 @@ TSvgElement = class procedure Draw(image: TImage32; drawDat: TDrawData); virtual; procedure DrawChildren(image: TImage32; drawDat: TDrawData); virtual; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); virtual; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); virtual; destructor Destroy; override; - property Child[index: integer]: TSvgElement read GetChild; default; + property Child[index: integer]: TBaseElement read GetChild; default; property ChildCount: integer read GetChildCount; property DrawData: TDrawData read fDrawData write fDrawData; property Id: UTF8String read fId; end; - TSvgRootElement = class(TSvgElement) + TSvgElement = class(TBaseElement) protected viewboxWH : TRectWH; + procedure Draw(image: TImage32; drawDat: TDrawData); override; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + function GetViewbox: TRectWH; end; TSvgReader = class @@ -116,8 +118,7 @@ TSvgReader = class fClassStyles : TClassStylesList; fLinGradRenderer : TLinearGradientRenderer; fRadGradRenderer : TSvgRadialGradientRenderer; - fImgRenderer : TImageRenderer; - fRootElement : TSvgRootElement; + fRootElement : TSvgElement; fFontCache : TFontCache; fUsePropScale : Boolean; fSimpleDraw : Boolean; @@ -131,14 +132,12 @@ TSvgReader = class procedure GetBestFontForFontCache(const svgFontInfo: TSVGFontInfo); property RadGradRenderer: TSvgRadialGradientRenderer read fRadGradRenderer; property LinGradRenderer: TLinearGradientRenderer read fLinGradRenderer; - property ImageRenderer : TImageRenderer read fImgRenderer; property BackgndImage : TImage32 read fBackgndImage; property TempImage : TImage32 read fTempImage; public constructor Create; destructor Destroy; override; procedure Clear; - function GetViewbox(containerWidth, containerHeight: integer): TRectWH; procedure DrawImage(img: TImage32; scaleToImage: Boolean); function LoadFromStream(stream: TStream): Boolean; function LoadFromFile(const filename: string): Boolean; @@ -149,7 +148,7 @@ TSvgReader = class procedure SetOverrideFillColor(color: TColor32); //deprecated; procedure SetOverrideStrokeColor(color: TColor32); //deprecated; - function FindElement(const idName: UTF8String): TSvgElement; + function FindElement(const idName: UTF8String): TBaseElement; property BackgroundColor : TColor32 read fBkgndColor write fBkgndColor; property BlurQuality : integer read fBlurQuality write SetBlurQuality; property IsEmpty : Boolean read GetIsEmpty; @@ -157,7 +156,7 @@ TSvgReader = class //the third-party SVGIconImageList. (IMHO it should always = true) property KeepAspectRatio: Boolean read fUsePropScale write fUsePropScale; - property RootElement : TSvgRootElement read fRootElement; + property RootElement : TSvgElement read fRootElement; //RecordSimpleDraw: record simple drawing instructions property RecordSimpleDraw: Boolean read fSimpleDraw write fSimpleDraw; //SimpleDrawList: list of PSimpleDrawData records; @@ -172,6 +171,12 @@ TSimpleDrawData = record tag : integer; end; +var + // https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/width + defaultSvgWidth: integer = 300; + // https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/height + defaultSvgHeight: integer = 150; + implementation uses @@ -180,14 +185,29 @@ implementation type TFourDoubles = array [0..3] of double; - TDefsElement = class(TSvgElement) + TDefsElement = class(TBaseElement) public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; + end; + + //------------------------------------- + + // TImageElement only supports *embedded* jpg & png images. + // And it requires Img32.Fmt.JPG & Img32.Fmt.PNG to be included + // in the USES clause of at least one of the application's units. + // (nb: If using the FMX framework, then add Img32.FMX instead of + // Img32.Fmt.JPG & Img32.Fmt.PNG to the USES clause.) + + TImageElement = class(TBaseElement) + private + refEl: UTF8String; + protected + procedure Draw(image: TImage32; drawDat: TDrawData); override; end; //------------------------------------- - TShapeElement = class(TSvgElement) + TShapeElement = class(TBaseElement) private procedure SimpleDrawFill(const paths: TPathsD; fillRule: TFillRule; color: TColor32); @@ -208,7 +228,7 @@ TShapeElement = class(TSvgElement) procedure DrawMarkers(img: TImage32; drawDat: TDrawData); procedure Draw(image: TImage32; drawDat: TDrawData); override; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; end; TGroupElement = class(TShapeElement) @@ -223,8 +243,8 @@ TSwitchElement = class(TShapeElement) TUseElement = class(TShapeElement) private - callerUse: TSvgElement; - function ValidateNonRecursion(el: TSvgElement): Boolean; + callerUse: TBaseElement; + function ValidateNonRecursion(el: TBaseElement): Boolean; protected refEl: UTF8String; procedure GetPaths(const drawDat: TDrawData); override; @@ -242,7 +262,7 @@ TSymbolElement = class(TShapeElement) protected viewboxWH: TRectWH; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; end; //------------------------------------- @@ -258,7 +278,7 @@ TPathElement = class(TShapeElement) procedure GetPaths(const drawDat: TDrawData); override; function GetSimplePath(const drawDat: TDrawData): TPathsD; override; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; destructor Destroy; override; end; @@ -278,7 +298,7 @@ TLineElement = class(TShapeElement) procedure GetPaths(const drawDat: TDrawData); override; function GetSimplePath(const drawDat: TDrawData): TPathsD; override; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; end; TCircleElement = class(TShapeElement) @@ -288,7 +308,7 @@ TCircleElement = class(TShapeElement) function GetBounds: TRectD; override; procedure GetPaths(const drawDat: TDrawData); override; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; end; TEllipseElement = class(TShapeElement) @@ -298,7 +318,7 @@ TEllipseElement = class(TShapeElement) function GetBounds: TRectD; override; procedure GetPaths(const drawDat: TDrawData); override; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; end; TRectElement = class(TShapeElement) @@ -308,7 +328,7 @@ TRectElement = class(TShapeElement) procedure GetPaths(const drawDat: TDrawData); override; function GetSimplePath(const drawDat: TDrawData): TPathsD; override; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; end; //TTextElement: although this is a TShapeElement descendant, it's really @@ -325,12 +345,12 @@ TTextElement = class(TShapeElement) function LoadContent: Boolean; override; procedure Draw(img: TImage32; drawDat: TDrawData); override; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; end; TTSpanElement = class(TTextElement) public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; end; TSubtextElement = class(TShapeElement) @@ -339,7 +359,7 @@ TSubtextElement = class(TShapeElement) procedure GetPaths(const drawDat: TDrawData); override; function GetBounds: TRectD; override; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; end; //------------------------------------- @@ -363,7 +383,7 @@ TMarkerElement = class(TShapeElement) function SetMiddlePoints(const points: TPathD): Boolean; procedure Draw(img: TImage32; drawDat: TDrawData); override; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; end; TSvgColorStop = record @@ -372,7 +392,7 @@ TSvgColorStop = record end; TSvgColorStops = array of TSvgColorStop; - TFillElement = class(TSvgElement) + TFillElement = class(TBaseElement) protected refEl : UTF8String; units : Cardinal; @@ -381,11 +401,13 @@ TFillElement = class(TSvgElement) TPatternElement = class(TFillElement) protected - pattBoxWH : TRectWH; + ImgRenderer : TImageRenderer; + pattBoxWH : TRectWH; function PrepareRenderer(renderer: TImageRenderer; drawDat: TDrawData): Boolean; virtual; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; + destructor Destroy; override; end; //nb: gradients with objectBoundingBox should not be applied to @@ -396,7 +418,7 @@ TGradientElement = class(TFillElement) spreadMethod : TGradientFillStyle; function LoadContent: Boolean; override; procedure AddStop(color: TColor32; offset: double); - procedure AssignTo(other: TSvgElement); virtual; + procedure AssignTo(other: TBaseElement); virtual; function PrepareRenderer(renderer: TCustomGradientRenderer; drawDat: TDrawData): Boolean; virtual; end; @@ -405,32 +427,32 @@ TRadGradElement = class(TGradientElement) protected radius: TValuePt; F, C: TValuePt; - procedure AssignTo(other: TSvgElement); override; + procedure AssignTo(other: TBaseElement); override; function PrepareRenderer(renderer: TCustomGradientRenderer; drawDat: TDrawData): Boolean; override; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; end; TLinGradElement = class(TGradientElement) protected startPt, endPt: TValuePt; - procedure AssignTo(other: TSvgElement); override; + procedure AssignTo(other: TBaseElement); override; function PrepareRenderer(renderer: TCustomGradientRenderer; drawDat: TDrawData): Boolean; override; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; end; - TGradStopElement = class(TSvgElement) + TGradStopElement = class(TBaseElement) protected offset: double; color: TColor32; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; end; - TFilterElement = class(TSvgElement) + TFilterElement = class(TBaseElement) private fSrcImg : TImage32; fLastImg : TImage32; @@ -449,11 +471,11 @@ TFilterElement = class(TSvgElement) procedure Apply(img: TImage32; const filterBounds: TRect; const matrix: TMatrixD); public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; destructor Destroy; override; end; - TFeBaseElement = class(TSvgElement) + TFeBaseElement = class(TBaseElement) private function GetParentAsFilterEl: TFilterElement; protected @@ -473,6 +495,13 @@ TFeBlendElement = class(TFeBaseElement) procedure Apply; override; end; + TFeImageElement = class(TFeBaseElement) + private + refEl: UTF8String; + protected + procedure Apply; override; + end; + TCompositeOp = (coOver, coIn, coOut, coAtop, coXOR, coArithmetic); TFeCompositeElement = class(TFeBaseElement) @@ -481,7 +510,7 @@ TFeCompositeElement = class(TFeBaseElement) compositeOp: TCompositeOp; procedure Apply; override; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; end; TFeColorMatrixElement = class(TFeBaseElement) @@ -506,7 +535,7 @@ TFeDropShadowElement = class(TFeBaseElement) floodColor : TColor32; procedure Apply; override; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; end; TFeFloodElement = class(TFeBaseElement) @@ -514,7 +543,7 @@ TFeFloodElement = class(TFeBaseElement) floodColor : TColor32; procedure Apply; override; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; end; TFeGaussElement = class(TFeBaseElement) @@ -522,7 +551,7 @@ TFeGaussElement = class(TFeBaseElement) stdDev: double; procedure Apply; override; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; end; TFeMergeElement = class(TFeBaseElement) @@ -558,7 +587,7 @@ TClipPathElement = class(TShapeElement) units: Cardinal; procedure GetPaths(const drawDat: TDrawData); override; public - constructor Create(parent: TSvgElement; svgEl: TSvgTreeEl); override; + constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); override; end; //------------------------------------- @@ -612,12 +641,14 @@ function HashToElementClass(hash: Cardinal): TElementClass; hfeDropShadow : Result := TFeDropShadowElement; hfeFlood : Result := TFeFloodElement; hFeGaussianBlur : Result := TFeGaussElement; + hFeImage : Result := TFeImageElement; hfeMerge : Result := TFeMergeElement; hfeMergeNode : Result := TFeMergeNodeElement; hfeOffset : Result := TFeOffsetElement; hfePointLight : Result := TFePointLightElement; hfeSpecularLighting : Result := TFeSpecLightElement; hG : Result := TGroupElement; + hImage : Result := TImageElement; hLine : Result := TLineElement; hLineargradient : Result := TLinGradElement; hMarker : Result := TMarkerElement; @@ -629,19 +660,19 @@ function HashToElementClass(hash: Cardinal): TElementClass; hRadialgradient : Result := TRadGradElement; hRect : Result := TRectElement; hStop : Result := TGradStopElement; - hSvg : Result := TSvgRootElement; + hSvg : Result := TSvgElement; hSwitch : Result := TSwitchElement; hSymbol : Result := TSymbolElement; hText : Result := TTextElement; hTextPath : Result := TTextPathElement; hTSpan : Result := TTSpanElement; hUse : Result := TUseElement; - else Result := TSvgElement; //use generic class + else Result := TBaseElement; //use generic class end; end; //------------------------------------------------------------------------------ -procedure UpdateDrawInfo(var drawDat: TDrawData; thisElement: TSvgElement); +procedure UpdateDrawInfo(var drawDat: TDrawData; thisElement: TBaseElement); begin with thisElement.fDrawData do begin @@ -824,20 +855,89 @@ function MatrixApply(const paths: TPathsD; const matrix: TMatrixD): TPathsD; ove // TDefsElement //------------------------------------------------------------------------------ -constructor TDefsElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TDefsElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; fDrawData.visible := false; end; +//------------------------------------------------------------------------------ +// TImageElement +//------------------------------------------------------------------------------ + +function TrimSpaces(const s: UTF8String): UTF8String; +var + i, j, len: integer; +begin + len := Length(s); + SetLength(Result, len); + j := 0; + for i := 1 to len do + if s[i] > #32 then + begin + inc(j); + Result[j] := s[i]; + end; + SetLength(Result, j); +end; +//------------------------------------------------------------------------------ + +function DrawRefElImage(const refEl: UTF8String; + image: TImage32; dstRec: TRect): Boolean; +var + len, offset: integer; + s: UTF8String; + ms: TMemoryStream; + img: TImage32; +begin + Result := false; + // unfortunately white spaces are sometimes found inside encoded base64 + s := TrimSpaces(refEl); + + len := Length(s); + // currently only accepts **embedded** images + if (len = 0) then Exit; + if Match(@s[1], 'data:image/jpg;base64,') then offset := 22 + else if Match(@s[1], 'data:image/jpeg;base64,') then offset := 23 + else if Match(@s[1], 'data:image/png;base64,') then offset := 22 + else if Match(@s[1], 'data:img/jpg;base64,') then offset := 20 + else if Match(@s[1], 'data:img/jpeg;base64,') then offset := 21 + else if Match(@s[1], 'data:img/png;base64,') then offset := 20 + else Exit; + + ms := TMemoryStream.Create; + img := TImage32.Create; + try + if not Base64Decode(@s[offset +1], len -offset, ms) or + not img.LoadFromStream(ms) then Exit; + image.Copy(img, img.Bounds, dstRec); + finally + ms.Free; + img.Free; + end; + Result := true; +end; +//------------------------------------------------------------------------------ + +procedure TImageElement.Draw(image: TImage32; drawDat: TDrawData); +var + dstRecD: TRectD; +begin + dstRecD := Self.elRectWH.GetRectD(0,0); + drawDat.matrix := MatrixMultiply(drawDat.matrix, fDrawData.matrix); + + MatrixApply(drawDat.matrix, dstRecD); + DrawRefElImage(refEl, image, Rect(dstRecD)); +end; + //------------------------------------------------------------------------------ // TGroupElement //------------------------------------------------------------------------------ procedure TGroupElement.Draw(image: TImage32; drawDat: TDrawData); var - clipEl : TSvgElement; - maskEl : TSvgElement; + clipEl : TBaseElement; + maskEl : TBaseElement; tmpImg : TImage32; clipPaths : TPathsD; clipRec : TRect; @@ -908,7 +1008,7 @@ procedure TSwitchElement.Draw(image: TImage32; drawDat: TDrawData); i: integer; begin for i := 0 to fChilds.Count -1 do - if TSvgElement(fChilds[i]) is TShapeElement then + if TBaseElement(fChilds[i]) is TShapeElement then with TShapeElement(fChilds[i]) do if fDrawData.visible then begin @@ -923,7 +1023,7 @@ procedure TSwitchElement.Draw(image: TImage32; drawDat: TDrawData); procedure TUseElement.GetPaths(const drawDat: TDrawData); var - el: TSvgElement; + el: TBaseElement; dx, dy: double; begin if Assigned(drawPathsF) or (refEl = '') then Exit; @@ -946,8 +1046,8 @@ procedure TUseElement.GetPaths(const drawDat: TDrawData); if (dx <> 0) or (dy <> 0) then begin - drawPathsC := OffsetPath(drawPathsC, dx, dy); - drawPathsO := OffsetPath(drawPathsO, dx, dy); + drawPathsC := TranslatePath(drawPathsC, dx, dy); + drawPathsO := TranslatePath(drawPathsO, dx, dy); end; drawPathsF := CopyPaths(drawPathsC); @@ -955,7 +1055,7 @@ procedure TUseElement.GetPaths(const drawDat: TDrawData); end; //------------------------------------------------------------------------------ -function TUseElement.ValidateNonRecursion(el: TSvgElement): Boolean; +function TUseElement.ValidateNonRecursion(el: TBaseElement): Boolean; begin Result := false; while assigned(el) do @@ -970,7 +1070,7 @@ function TUseElement.ValidateNonRecursion(el: TSvgElement): Boolean; procedure TUseElement.Draw(img: TImage32; drawDat: TDrawData); var - el: TSvgElement; + el: TBaseElement; s, dx, dy: double; scale, scale2: TSizeD; mat: TMatrixD; @@ -1055,6 +1155,8 @@ procedure TUseElement.Draw(img: TImage32; drawDat: TDrawData); DrawChildren(img, drawDat); end; end + else if el is TImageElement then + el.Draw(img, drawDat) else if el is TShapeElement then el.Draw(img, drawDat); end; @@ -1070,7 +1172,7 @@ procedure TMaskElement.GetPaths(const drawDat: TDrawData); begin maskRec := NullRect; for i := 0 to fChilds.Count -1 do - if TSvgElement(fChilds[i]) is TShapeElement then + if TBaseElement(fChilds[i]) is TShapeElement then begin el := TShapeElement(fChilds[i]); el.GetPaths(drawDat); @@ -1098,7 +1200,7 @@ procedure TMaskElement.ApplyMask(img: TImage32; const drawDat: TDrawData); // TSymbolElement //------------------------------------------------------------------------------ -constructor TSymbolElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TSymbolElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; fDrawData.visible := false; @@ -1114,7 +1216,7 @@ function TGradientElement.LoadContent: Boolean; begin Result := inherited LoadContent; for i := 0 to fChilds.Count -1 do - if TSvgElement(fChilds[i]) is TGradStopElement then + if TBaseElement(fChilds[i]) is TGradStopElement then with TGradStopElement(fChilds[i]) do AddStop(color, offset); end; @@ -1135,7 +1237,7 @@ procedure TGradientElement.AddStop(color: TColor32; offset: double); end; //------------------------------------------------------------------------------ -procedure TGradientElement.AssignTo(other: TSvgElement); +procedure TGradientElement.AssignTo(other: TBaseElement); var i, len: integer; begin @@ -1164,7 +1266,7 @@ procedure TGradientElement.AssignTo(other: TSvgElement); function TGradientElement.PrepareRenderer( renderer: TCustomGradientRenderer; drawDat: TDrawData): Boolean; var - el: TSvgElement; + el: TBaseElement; begin if (refEl <> '') then begin @@ -1179,7 +1281,7 @@ function TGradientElement.PrepareRenderer( // TRadGradElement //------------------------------------------------------------------------------ -constructor TRadGradElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TRadGradElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; radius.Init; @@ -1188,7 +1290,7 @@ constructor TRadGradElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); end; //------------------------------------------------------------------------------ -procedure TRadGradElement.AssignTo(other: TSvgElement); +procedure TRadGradElement.AssignTo(other: TBaseElement); begin if not Assigned(other) or not (other is TGradientElement) then Exit; inherited; @@ -1238,7 +1340,7 @@ function TRadGradElement.PrepareRenderer(renderer: TCustomGradientRenderer; if C.X.HasFontUnits then cp := C.GetPoint(drawDat.fontInfo.size, GetRelFracLimit) else cp := C.GetPoint(rec2, GetRelFracLimit); - cp := OffsetPoint(cp, rec2.Left, rec2.Top); + cp := TranslatePoint(cp, rec2.Left, rec2.Top); end else cp := rec2.MidPoint; MatrixApply(fDrawData.matrix, cp); @@ -1251,7 +1353,7 @@ function TRadGradElement.PrepareRenderer(renderer: TCustomGradientRenderer; if F.X.HasFontUnits then fp := F.GetPoint(drawDat.fontInfo.size, GetRelFracLimit) else fp := F.GetPoint(rec2, GetRelFracLimit); - fp := OffsetPoint(fp, rec2.Left, rec2.Top); + fp := TranslatePoint(fp, rec2.Left, rec2.Top); MatrixApply(fDrawData.matrix, fp); MatrixApply(drawDat.matrix, fp); end else @@ -1271,7 +1373,7 @@ function TRadGradElement.PrepareRenderer(renderer: TCustomGradientRenderer; // TLinGradElement //------------------------------------------------------------------------------ -constructor TLinGradElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TLinGradElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; startPt.Init; @@ -1279,7 +1381,7 @@ constructor TLinGradElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); end; //------------------------------------------------------------------------------ -procedure TLinGradElement.AssignTo(other: TSvgElement); +procedure TLinGradElement.AssignTo(other: TBaseElement); begin if not Assigned(other) or not (other is TGradientElement) then Exit; inherited; @@ -1338,7 +1440,7 @@ function TLinGradElement.PrepareRenderer( pt2.X := rec2.Width else pt2.X := endPt.X.GetValue(rec2.Width, GetRelFracLimit); pt2.Y := endPt.Y.GetValue(rec2.Height, GetRelFracLimit); - pt2 := OffsetPoint(pt2, rec2.Left, rec2.Top); + pt2 := TranslatePoint(pt2, rec2.Left, rec2.Top); MatrixApply(fDrawData.matrix, pt2); MatrixApply(drawDat.matrix, pt2); @@ -1361,7 +1463,7 @@ function TLinGradElement.PrepareRenderer( // TGradStopElement //------------------------------------------------------------------------------ -constructor TGradStopElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TGradStopElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; color := clBlack32; @@ -1371,7 +1473,7 @@ constructor TGradStopElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); // TFilterElement //------------------------------------------------------------------------------ -constructor TFilterElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TFilterElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; fDrawData.visible := false; @@ -1571,13 +1673,14 @@ procedure TFilterElement.Apply(img: TImage32; try for i := 0 to fChilds.Count -1 do begin - case TSvgElement(fChilds[i]).fParserEl.hash of + case TBaseElement(fChilds[i]).fParserEl.hash of hfeBlend : TFeBlendElement(fChilds[i]).Apply; hfeColorMatrix : TFeColorMatrixElement(fChilds[i]).Apply; hfeComposite : TFeCompositeElement(fChilds[i]).Apply; hfeDefuseLighting : TFeDefuseLightElement(fChilds[i]).Apply; hfeDropShadow : TFeDropShadowElement(fChilds[i]).Apply; hfeFlood : TFeFloodElement(fChilds[i]).Apply; + hfeImage : TFeImageElement(fChilds[i]).Apply; hFeGaussianBlur : TFeGaussElement(fChilds[i]).Apply; hfeMerge : TFeMergeElement(fChilds[i]).Apply; hfeOffset : TFeOffsetElement(fChilds[i]).Apply; @@ -1597,7 +1700,7 @@ procedure TFilterElement.Apply(img: TImage32; function TFeBaseElement.GetParentAsFilterEl: TFilterElement; var - el: TSvgElement; + el: TBaseElement; begin el := fParent; while Assigned(el) and not (el is TFilterElement) do @@ -1668,11 +1771,21 @@ procedure TFeBlendElement.Apply; dstImg.Copy(dstImg2, dstRec2, dstRec); end; +//------------------------------------------------------------------------------ +// TFeImageElement +//------------------------------------------------------------------------------ + +procedure TFeImageElement.Apply; +begin + if GetSrcAndDst then + DrawRefElImage(refEl, dstImg, dstRec); +end; + //------------------------------------------------------------------------------ // TFeCompositeElement //------------------------------------------------------------------------------ -constructor TFeCompositeElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TFeCompositeElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; fourKs[0] := InvalidD; fourKs[1] := InvalidD; @@ -1847,7 +1960,7 @@ procedure TFeDefuseLightElement.Apply; // TFeDropShadowElement //------------------------------------------------------------------------------ -constructor TFeDropShadowElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TFeDropShadowElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; stdDev := InvalidD; @@ -1873,7 +1986,7 @@ procedure TFeDropShadowElement.Apply; off := offset.GetPoint(RectD(pfe.fObjectBounds), GetRelFracLimit); off := ScalePoint(off, pfe.fScale); dstOffRec := dstRec; - with Point(off) do Types.OffsetRect(dstOffRec, X, Y); + with Point(off) do TranslateRect(dstOffRec, X, Y); dstImg.Copy(srcImg, srcRec, dstOffRec); dstImg.SetRGB(floodColor); alpha := GetAlpha(floodColor); @@ -1889,7 +2002,7 @@ procedure TFeDropShadowElement.Apply; // TFeFloodElement //------------------------------------------------------------------------------ -constructor TFeFloodElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TFeFloodElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; floodColor := clInvalid; @@ -1911,7 +2024,7 @@ procedure TFeFloodElement.Apply; // TFeGaussElement //------------------------------------------------------------------------------ -constructor TFeGaussElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TFeGaussElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; stdDev := InvalidD; @@ -1921,15 +2034,11 @@ constructor TFeGaussElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); procedure TFeGaussElement.Apply; begin if not GetSrcAndDst or (stdDev = InvalidD) then Exit; - if srcImg <> dstImg then dstImg.Copy(srcImg, srcRec, dstRec); - ////True GaussianBlur is visually optimal, but it's also *extremely* slow. - //GaussianBlur(dstImg, dstRec, Ceil(stdDev *PI * ParentFilterEl.fScale)); - - //FastGaussianBlur is a very good approximation and also very much faster. - //Empirically stdDev * PI/4 more closely emulates other renderers. + // FastGaussianBlur is a very good approximation and also very much faster. + // Empirically stdDev * PI/4 more closely emulates other renderers. FastGaussianBlur(dstImg, dstRec, Ceil(stdDev * PI/4 * ParentFilterEl.fScale)); end; @@ -1948,7 +2057,7 @@ procedure TFeMergeElement.Apply; pfe := ParentFilterEl; for i := 0 to fChilds.Count -1 do - if TSvgElement(fChilds[i]) is TFeMergeNodeElement then + if TBaseElement(fChilds[i]) is TFeMergeNodeElement then with TFeMergeNodeElement(fChilds[i]) do begin if not GetSrcAndDst then Continue; @@ -1989,7 +2098,7 @@ procedure TFeOffsetElement.Apply; off := offset.GetPoint(RectD(pfe.fObjectBounds), GetRelFracLimit); off := ScalePoint(off, pfe.fScale); dstOffRec := dstRec; - with Point(off) do Types.OffsetRect(dstOffRec, X, Y); + with Point(off) do TranslateRect(dstOffRec, X, Y); if srcImg = dstImg then begin @@ -2020,7 +2129,7 @@ procedure TFeSpecLightElement.Apply; // TClipPathElement //------------------------------------------------------------------------------ -constructor TClipPathElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TClipPathElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; fDrawData.visible := false; @@ -2033,7 +2142,7 @@ procedure TClipPathElement.GetPaths(const drawDat: TDrawData); begin if Assigned(drawPathsC) or Assigned(drawPathsO) then Exit; for i := 0 to fChilds.Count -1 do - if TSvgElement(fChilds[i]) is TShapeElement then + if TBaseElement(fChilds[i]) is TShapeElement then with TShapeElement(fChilds[i]) do begin GetPaths(drawDat); @@ -2048,7 +2157,7 @@ procedure TClipPathElement.GetPaths(const drawDat: TDrawData); // TShapeElement //------------------------------------------------------------------------------ -constructor TShapeElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TShapeElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; elRectWH.Init; @@ -2064,7 +2173,7 @@ function TShapeElement.GetBounds: TRectD; begin Result := NullRectD; for i := 0 to fChilds.Count -1 do - if TSvgElement(fChilds[i]) is TShapeElement then + if TBaseElement(fChilds[i]) is TShapeElement then Result := UnionRect(Result, TShapeElement(fChilds[i]).GetBounds); end; //------------------------------------------------------------------------------ @@ -2084,9 +2193,9 @@ procedure TShapeElement.Draw(image: TImage32; drawDat: TDrawData); filled : Boolean; clipRec : TRectD; clipRec2 : TRect; - clipPathEl : TSvgElement; - filterEl : TSvgElement; - maskEl : TSvgElement; + clipPathEl : TBaseElement; + filterEl : TBaseElement; + maskEl : TBaseElement; clipPaths : TPathsD; di : TDrawData; usingTempImage: Boolean; @@ -2218,7 +2327,7 @@ procedure TShapeElement.DrawMarkers(img: TImage32; drawDat: TDrawData); var i,j: integer; sw: double; - markerEl: TSvgElement; + markerEl: TBaseElement; markerPaths: TPathsD; pt1, pt2: TPointD; di: TDrawData; @@ -2303,8 +2412,9 @@ function TShapeElement.GetSimplePath(const drawDat: TDrawData): TPathsD; procedure TShapeElement.DrawFilled(img: TImage32; drawDat: TDrawData); var - refEl: TSvgElement; + refEl: TBaseElement; fillPaths: TPathsD; + rec: TRect; begin if not assigned(drawPathsF) then Exit; if drawDat.fillColor = clCurrent then @@ -2332,9 +2442,13 @@ procedure TShapeElement.DrawFilled(img: TImage32; drawDat: TDrawData); end else if refEl is TPatternElement then begin - with TPatternElement(refEl), fReader do - if PrepareRenderer(ImageRenderer, drawDat) then - DrawPolygon(img, fillPaths, drawDat.fillRule, ImageRenderer); + with TPatternElement(refEl) do + if PrepareRenderer(ImgRenderer, drawDat) then + begin + rec := img32.Vector.GetBounds(fillPaths); + ImgRenderer.Offset := rec.TopLeft; + DrawPolygon(img, fillPaths, drawDat.fillRule, ImgRenderer); + end; end; end; end @@ -2364,7 +2478,7 @@ procedure TShapeElement.DrawStroke(img: TImage32; scale: Double; strokeClr: TColor32; strokePaths: TPathsD; - refEl: TSvgElement; + refEl: TBaseElement; endStyle: TEndStyle; joinStyle: TJoinStyle; bounds: TRectD; @@ -2432,12 +2546,12 @@ procedure TShapeElement.DrawStroke(img: TImage32; fReader.LinGradRenderer, endStyle, joinStyle, roundingScale); end else if refEl is TPatternElement then - begin with TPatternElement(refEl) do - PrepareRenderer(fReader.ImageRenderer, drawDat); - DrawLine(img, strokePaths, scaledStrokeWidth, - fReader.ImageRenderer, endStyle, joinStyle, roundingScale); - end; + begin + PrepareRenderer(imgRenderer, drawDat); + DrawLine(img, strokePaths, scaledStrokeWidth, + imgRenderer, endStyle, joinStyle, roundingScale); + end; end else if (joinStyle = jsMiter) then begin @@ -2488,7 +2602,7 @@ procedure TShapeElement.SimpleDrawStroke(const paths: TPathsD; // TPathElement //------------------------------------------------------------------------------ -constructor TPathElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TPathElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; fSvgPaths := TSvgPath.Create; @@ -2627,7 +2741,7 @@ procedure TPolyElement.ParsePoints(const value: UTF8String); // TLineElement //------------------------------------------------------------------------------ -constructor TLineElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TLineElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; SetLength(path, 2); @@ -2659,7 +2773,7 @@ function TLineElement.GetSimplePath(const drawDat: TDrawData): TPathsD; // TCircleElement //------------------------------------------------------------------------------ -constructor TCircleElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TCircleElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; centerPt.Init; @@ -2703,7 +2817,7 @@ procedure TCircleElement.GetPaths(const drawDat: TDrawData); // TEllipseElement //------------------------------------------------------------------------------ -constructor TEllipseElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TEllipseElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; centerPt.Init; @@ -2747,7 +2861,7 @@ procedure TEllipseElement.GetPaths(const drawDat: TDrawData); // TRectElement //------------------------------------------------------------------------------ -constructor TRectElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TRectElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; radius.Init; @@ -2801,7 +2915,7 @@ function TRectElement.GetSimplePath(const drawDat: TDrawData): TPathsD; // TTextElement //------------------------------------------------------------------------------ -constructor TTextElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TTextElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; offset.Init; @@ -2814,7 +2928,7 @@ function TTextElement.LoadContent: Boolean; i : integer; svgEl : TSvgTreeEl; elClass : TElementClass; - el : TSvgElement; + el : TBaseElement; begin Result := false; for i := 0 to fParserEl.childs.Count -1 do @@ -2829,7 +2943,7 @@ function TTextElement.LoadContent: Boolean; end else begin elClass := HashToElementClass(svgEl.hash); - if elClass = TSvgElement then Continue; + if elClass = TBaseElement then Continue; el := elClass.Create(self, svgEl); Self.fChilds.Add(el); el.LoadAttributes; @@ -2842,7 +2956,7 @@ function TTextElement.LoadContent: Boolean; function TTextElement.GetTopTextElement: TTextElement; var - el: TSvgElement; + el: TBaseElement; begin el := self; while Assigned(el.fParent) and (el.fParent is TTextElement) do @@ -2856,14 +2970,14 @@ procedure TTextElement.DoOffsetX(dx: double); i: integer; begin for i := 0 to fChilds.Count -1 do - if TSvgElement(fChilds[i]) is TTextElement then + if TBaseElement(fChilds[i]) is TTextElement then TTextElement(fChilds[i]).DoOffsetX(dx) - else if TSvgElement(fChilds[i]) is TSubTextElement then + else if TBaseElement(fChilds[i]) is TSubTextElement then with TSubTextElement(fChilds[i]) do begin - drawPathsC := OffsetPath(drawPathsC, dx, 0); - drawPathsO := OffsetPath(drawPathsO, dx, 0); - drawPathsF := OffsetPath(drawPathsF, dx, 0); + drawPathsC := TranslatePath(drawPathsC, dx, 0); + drawPathsO := TranslatePath(drawPathsO, dx, 0); + drawPathsF := TranslatePath(drawPathsF, dx, 0); end; end; //------------------------------------------------------------------------------ @@ -2872,7 +2986,7 @@ procedure TTextElement.GetPaths(const drawDat: TDrawData); var i : integer; dy : double; - el : TSvgElement; + el : TBaseElement; di : TDrawData; topTextEl : TTextElement; begin @@ -2931,7 +3045,7 @@ procedure TTextElement.GetPaths(const drawDat: TDrawData); end; for i := 0 to fChilds.Count -1 do - if TSvgElement(fChilds[i]) is TShapeElement then + if TBaseElement(fChilds[i]) is TShapeElement then TShapeElement(fChilds[i]).GetPaths(di); end; //------------------------------------------------------------------------------ @@ -2980,7 +3094,7 @@ procedure TTextElement.Draw(img: TImage32; drawDat: TDrawData); // TSubtextElement //------------------------------------------------------------------------------ -constructor TSubtextElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TSubtextElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; hasPaths := true; @@ -3033,7 +3147,7 @@ function IsBlankText(const text: UnicodeString): Boolean; procedure TSubtextElement.GetPaths(const drawDat: TDrawData); var - el : TSvgElement; + el : TBaseElement; topTextEl : TTextElement; s: UnicodeString; tmpX, offsetX, scale, fontSize, bs: double; @@ -3115,7 +3229,7 @@ function TSubtextElement.GetBounds: TRectD; // TTSpanElement //------------------------------------------------------------------------------ -constructor TTSpanElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TTSpanElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; fDrawData.FontInfo.decoration := fdUndefined; @@ -3142,7 +3256,7 @@ function GetPathDistance(const path: TPathD): double; procedure TTextPathElement.GetPaths(const drawDat: TDrawData); var parentTextEl, topTextEl: TTextElement; - el: TSvgElement; + el: TBaseElement; isFirst: Boolean; s: UnicodeString; i, dy, len, charsThatFit: integer; @@ -3178,11 +3292,11 @@ procedure TTextPathElement.GetPaths(const drawDat: TDrawData); if (fParserEl.text = '') then begin if (fChilds.Count = 0) or - not (TSvgElement(fChilds[0]) is TTSpanElement) then + not (TBaseElement(fChilds[0]) is TTSpanElement) then Exit; - el := TSvgElement(fChilds[0]); + el := TBaseElement(fChilds[0]); if (el.fChilds.Count = 0) or - not (TSvgElement(el.fChilds[0]) is TSubtextElement) then + not (TBaseElement(el.fChilds[0]) is TSubtextElement) then Exit; with TSubtextElement(el.fChilds[0]) do begin @@ -3266,7 +3380,7 @@ procedure TTextPathElement.GetPaths(const drawDat: TDrawData); // TMarkerElement //------------------------------------------------------------------------------ -constructor TMarkerElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TMarkerElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; fDrawData.visible := false; @@ -3362,9 +3476,10 @@ function TFillElement.GetRelFracLimit: double; // TPatternElement //------------------------------------------------------------------------------ -constructor TPatternElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TPatternElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; + imgRenderer := TImageRenderer.Create; elRectWH.Init; pattBoxWH.Width := InvalidD; pattBoxWH.Height := InvalidD; @@ -3372,12 +3487,19 @@ constructor TPatternElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); end; //------------------------------------------------------------------------------ +destructor TPatternElement.Destroy; +begin + imgRenderer.Free; + inherited; +end; +//------------------------------------------------------------------------------ + function TPatternElement.PrepareRenderer(renderer: TImageRenderer; drawDat: TDrawData): Boolean; var i : integer; recWH : TRectWH; - el : TSvgElement; + el : TBaseElement; rec : TRectD; mat : TMatrixD; sx,sy : double; @@ -3386,6 +3508,7 @@ function TPatternElement.PrepareRenderer(renderer: TImageRenderer; Result := false; scale := ExtractScaleFromMatrix(drawDat.matrix); + if units = hUserSpaceOnUse then rec := fReader.userSpaceBounds else rec := drawDat.bounds; @@ -3421,7 +3544,6 @@ function TPatternElement.PrepareRenderer(renderer: TImageRenderer; mat := IdentityMatrix; MatrixScale(mat, scale.cx * sx, scale.cy * sy); - //recWH.Left := 0; recWH.Top := 0; if (refEl <> '') then begin el := FindRefElement(refEl); @@ -3436,8 +3558,16 @@ function TPatternElement.PrepareRenderer(renderer: TImageRenderer; end; for i := 0 to fChilds.Count -1 do - if TSvgElement(fChilds[i]) is TShapeElement then + if TBaseElement(fChilds[i]) is TShapeElement then with TShapeElement(fChilds[i]) do + begin + drawDat := fDrawData; + drawDat.matrix := mat; + drawDat.bounds := rec; + Draw(renderer.Image, drawDat); + end + else if TBaseElement(fChilds[i]) is TImageElement then + with TImageElement(fChilds[i]) do begin drawDat := fDrawData; drawDat.matrix := mat; @@ -3447,22 +3577,41 @@ function TPatternElement.PrepareRenderer(renderer: TImageRenderer; end; //------------------------------------------------------------------------------ -// TSvgRootElement +// TSvgElement //------------------------------------------------------------------------------ -constructor TSvgRootElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +procedure TSvgElement.Draw(image: TImage32; drawDat: TDrawData); +var + sx, sy: double; begin - inherited Create(parent, svgEl); + if (fReader.RootElement <> self) and not viewboxWH.IsEmpty then + begin + sx := image.Width / viewboxWH.Width; + sy := image.Height / viewboxWH.Height; + MatrixScale(drawDat.matrix, sx, sy); + end; + inherited; +end; +//------------------------------------------------------------------------------ + +function TSvgElement.GetViewbox: TRectWH; +begin + if viewboxWH.IsEmpty then + begin + viewboxWH.Width := elRectWH.width.GetValue(defaultSvgWidth, 0); + viewboxWH.height := elRectWH.height.GetValue(defaultSvgHeight, 0); + end; + Result := viewboxWH; end; //------------------------------------------------------------------------------ -// TElement +// TBaseElement //------------------------------------------------------------------------------ -constructor TSvgElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); +constructor TBaseElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin {$IFDEF XPLAT_GENERICS} - fChilds := TList.create; + fChilds := TList.create; {$ELSE} fChilds := TList.Create; {$ENDIF} @@ -3475,51 +3624,50 @@ constructor TSvgElement.Create(parent: TSvgElement; svgEl: TSvgTreeEl); fDrawData.strokeCap := parent.fDrawData.strokeCap; fDrawData.strokeJoin := parent.fDrawData.strokeJoin; fReader := parent.fReader; - end - else + end; end; //------------------------------------------------------------------------------ -destructor TSvgElement.Destroy; +destructor TBaseElement.Destroy; var i: integer; begin for i := 0 to fChilds.Count -1 do - TSvgElement(fChilds[i]).Free; + TBaseElement(fChilds[i]).Free; fChilds.Free; inherited; end; //------------------------------------------------------------------------------ -function TSvgElement.IsFirstChild: Boolean; +function TBaseElement.IsFirstChild: Boolean; begin Result := not Assigned(fParent) or (self = fParent.fChilds[0]); end; //------------------------------------------------------------------------------ -procedure TSvgElement.Draw(image: TImage32; drawDat: TDrawData); +procedure TBaseElement.Draw(image: TImage32; drawDat: TDrawData); begin DrawChildren(image, drawDat); end; //------------------------------------------------------------------------------ -procedure TSvgElement.DrawChildren(image: TImage32; drawDat: TDrawData); +procedure TBaseElement.DrawChildren(image: TImage32; drawDat: TDrawData); var i: integer; begin for i := 0 to fChilds.Count -1 do - with TSvgElement(fChilds[i]) do + with TBaseElement(fChilds[i]) do if fDrawData.visible then Draw(image, drawDat); end; //------------------------------------------------------------------------------ -function TSvgElement.GetChildCount: integer; +function TBaseElement.GetChildCount: integer; begin Result := fChilds.Count; end; //------------------------------------------------------------------------------ -function TSvgElement.FindChild(const idName: UTF8String): TSvgElement; +function TBaseElement.FindChild(const idName: UTF8String): TBaseElement; var i: integer; begin @@ -3538,15 +3686,15 @@ function TSvgElement.FindChild(const idName: UTF8String): TSvgElement; end; //------------------------------------------------------------------------------ -function TSvgElement.GetChild(index: integer): TSvgElement; +function TBaseElement.GetChild(index: integer): TBaseElement; begin if (index < 0) or (index >= fChilds.count) then Result := nil else - Result := TSvgElement(fChilds[index]); + Result := TBaseElement(fChilds[index]); end; //------------------------------------------------------------------------------ -function TSvgElement.FindRefElement(refname: UTF8String): TSvgElement; +function TBaseElement.FindRefElement(refname: UTF8String): TBaseElement; var i, len: integer; c, endC: PUTF8Char; @@ -3566,7 +3714,7 @@ function TSvgElement.FindRefElement(refname: UTF8String): TSvgElement; ref := ToUTF8String(c, endC); i := fReader.fIdList.IndexOf(string(ref)); if i >= 0 then - Result := TSvgElement(fReader.fIdList.Objects[i]) else + Result := TBaseElement(fReader.fIdList.Objects[i]) else Result := nil; end; @@ -3574,40 +3722,44 @@ function TSvgElement.FindRefElement(refname: UTF8String): TSvgElement; // dozens of function to process various element attributes //------------------------------------------------------------------------------ -procedure Id_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Id_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin aOwnerEl.fId := value; aOwnerEl.fReader.fIdList.AddObject(string(value), aOwnerEl); end; //------------------------------------------------------------------------------ -procedure In_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure In_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin if aOwnerEl is TFeBaseElement then TFeBaseElement(aOwnerEl).in1 := value; end; //------------------------------------------------------------------------------ -procedure In2_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure In2_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin if aOwnerEl is TFeBaseElement then TFeBaseElement(aOwnerEl).in2 := value; end; //------------------------------------------------------------------------------ -procedure LetterSpacing_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure LetterSpacing_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin with TTextElement(aOwnerEl) do UTF8StringToFloat(value, fDrawData.FontInfo.spacing); end; //------------------------------------------------------------------------------ -procedure Href_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Href_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var - el: TSvgElement; + el: TBaseElement; begin el := aOwnerEl; case el.fParserEl.Hash of + hFeImage: + TFeImageElement(el).refEl := ExtractRef(value); + hImage: + TImageElement(el).refEl := ExtractRef(value); hUse: TUseElement(el).refEl := ExtractRef(value); hTextPath: @@ -3618,7 +3770,7 @@ procedure Href_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure BaselineShift_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure BaselineShift_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var mu: TUnitType; val: double; @@ -3642,7 +3794,7 @@ procedure BaselineShift_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Color_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Color_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var color: TColor32; begin @@ -3655,7 +3807,7 @@ procedure Color_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure LightingColor_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure LightingColor_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var color: TColor32; begin @@ -3668,20 +3820,20 @@ procedure LightingColor_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure ClipPath_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure ClipPath_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin aOwnerEl.fDrawData.clipElRef := ExtractRef(value); end; //------------------------------------------------------------------------------ -procedure D_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure D_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin if aOwnerEl is TPathElement then TPathElement(aOwnerEl).ParseDAttrib(value); end; //------------------------------------------------------------------------------ -procedure Fill_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Fill_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin case aOwnerEl.fParserEl.Hash of hfeDropShadow: @@ -3699,7 +3851,7 @@ procedure Fill_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure FillOpacity_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure FillOpacity_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var val: double; begin @@ -3717,7 +3869,7 @@ procedure FillOpacity_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure DashArray_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure DashArray_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var c, endC: PUTF8Char; val: double; @@ -3738,7 +3890,7 @@ procedure DashArray_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure DashOffset_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure DashOffset_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var c, endC: PUTF8Char; begin @@ -3749,20 +3901,20 @@ procedure DashOffset_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Display_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Display_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin if GetHash(value) = hNone then aOwnerEl.fDrawData.visible := false; end; //------------------------------------------------------------------------------ -procedure Font_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Font_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin GetSvgFontInfo(value, aOwnerEl.fDrawData.FontInfo); end; //------------------------------------------------------------------------------ -procedure FontFamily_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure FontFamily_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var word: UTF8String; c, endC: PUTF8Char; @@ -3786,7 +3938,7 @@ procedure FontFamily_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure FontSize_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure FontSize_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var num: double; c, endC: PUTF8Char; @@ -3797,7 +3949,7 @@ procedure FontSize_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure FontStyle_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure FontStyle_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin with aOwnerEl.fDrawData.FontInfo do if GetHash(value) = hItalic then @@ -3806,7 +3958,7 @@ procedure FontStyle_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure FontWeight_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure FontWeight_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var num: double; @@ -3834,7 +3986,7 @@ procedure FontWeight_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Fx_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Fx_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin if (aOwnerEl is TRadGradElement) then with TRadGradElement(aOwnerEl) do @@ -3844,7 +3996,7 @@ procedure Fx_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Fy_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Fy_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin if (aOwnerEl is TRadGradElement) then with TRadGradElement(aOwnerEl) do @@ -3854,7 +4006,7 @@ procedure Fy_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure TextAlign_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure TextAlign_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin with aOwnerEl.fDrawData.FontInfo do case GetHash(value) of @@ -3866,7 +4018,7 @@ procedure TextAlign_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure TextDecoration_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure TextDecoration_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin with aOwnerEl.fDrawData.FontInfo do case GetHash(value) of @@ -3877,49 +4029,49 @@ procedure TextDecoration_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure TextLength_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure TextLength_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin UTF8StringToFloat(value, aOwnerEl.fDrawData.FontInfo.textLength); end; //------------------------------------------------------------------------------ -procedure MarkerStart_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure MarkerStart_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin if not (aOwnerEl is TShapeElement) then Exit; aOwnerEl.fDrawData.markerStart := ExtractRef(value); end; //------------------------------------------------------------------------------ -procedure MarkerMiddle_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure MarkerMiddle_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin if not (aOwnerEl is TShapeElement) then Exit; aOwnerEl.fDrawData.markerMiddle := ExtractRef(value); end; //------------------------------------------------------------------------------ -procedure MarkerEnd_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure MarkerEnd_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin if not (aOwnerEl is TShapeElement) then Exit; aOwnerEl.fDrawData.markerEnd := ExtractRef(value); end; //------------------------------------------------------------------------------ -procedure Filter_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Filter_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin if (aOwnerEl is TShapeElement) then aOwnerEl.fDrawData.filterElRef := ExtractRef(value); end; //------------------------------------------------------------------------------ -procedure Mask_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Mask_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin if (aOwnerEl is TShapeElement) then aOwnerEl.fDrawData.maskElRef := ExtractRef(value); end; //------------------------------------------------------------------------------ -procedure Offset_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Offset_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var val: TValue; begin @@ -3933,7 +4085,7 @@ procedure Offset_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Opacity_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Opacity_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var opacity: double; begin @@ -3944,7 +4096,7 @@ procedure Opacity_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Operator_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Operator_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin if (aOwnerEl is TFeCompositeElement) then with TFeCompositeElement(aOwnerEl) do @@ -3959,7 +4111,7 @@ procedure Operator_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Orient_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Orient_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin if (aOwnerEl is TMarkerElement) and (GetHash(value) = hauto_045_start_045_reverse) then @@ -3967,7 +4119,7 @@ procedure Orient_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure StopColor_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure StopColor_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var acolor: TColor32; begin @@ -3983,30 +4135,32 @@ procedure StopColor_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure StopOpacity_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure StopOpacity_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin if aOwnerEl is TGradStopElement then UTF8StringToOpacity(value, TGradStopElement(aOwnerEl).color); end; //------------------------------------------------------------------------------ -procedure Points_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Points_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin if aOwnerEl is TPolyElement then TPolyElement(aOwnerEl).ParsePoints(value); end; //------------------------------------------------------------------------------ -procedure Stroke_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Stroke_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin if Match(PUTF8Char(value), 'url(') then aOwnerEl.fDrawData.strokeEl := ExtractRef(value) + else if Match(PUTF8Char(value), 'currentcolor') then + // do nothing else UTF8StringToColor32(value, aOwnerEl.fDrawData.strokeColor); end; //------------------------------------------------------------------------------ -procedure StrokeLineCap_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure StrokeLineCap_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var word: UTF8String; c, endC: PUTF8Char; @@ -4023,7 +4177,7 @@ procedure StrokeLineCap_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure StrokeLineJoin_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure StrokeLineJoin_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var word: UTF8String; c, endC: PUTF8Char; @@ -4040,13 +4194,13 @@ procedure StrokeLineJoin_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure StrokeMiterLimit_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure StrokeMiterLimit_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin UTF8StringToFloat(value, aOwnerEl.fDrawData.strokeMitLim); end; //------------------------------------------------------------------------------ -procedure StrokeOpacity_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure StrokeOpacity_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var val: double; begin @@ -4055,7 +4209,7 @@ procedure StrokeOpacity_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure StrokeWidth_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure StrokeWidth_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin with aOwnerEl do begin @@ -4065,7 +4219,7 @@ procedure StrokeWidth_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure FillRule_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure FillRule_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin if LowerCaseTable[value[1]] = 'e' then aOwnerEl.fDrawData.fillRule := frEvenOdd else @@ -4073,14 +4227,14 @@ procedure FillRule_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Transform_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Transform_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin with aOwnerEl.fDrawData do matrix := MatrixMultiply(matrix, ParseTransform(value)); end; //------------------------------------------------------------------------------ -procedure Values_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Values_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var cnt: integer; c, endC: PUTF8Char; @@ -4099,7 +4253,7 @@ procedure Values_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure GradientTransform_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure GradientTransform_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var mat: TMatrixD; begin @@ -4110,7 +4264,7 @@ procedure GradientTransform_Attrib(aOwnerEl: TSvgElement; const value: UTF8Strin end; //------------------------------------------------------------------------------ -procedure GradientUnits_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure GradientUnits_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin if aOwnerEl is TFillElement then with TFillElement(aOwnerEl) do @@ -4118,7 +4272,7 @@ procedure GradientUnits_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Viewbox_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Viewbox_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); function LoadViewbox: TRectWH; var @@ -4136,7 +4290,7 @@ procedure Viewbox_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); begin case aOwnerEl.fParserEl.Hash of - hSvg : TSvgRootElement(aOwnerEl).viewboxWH := LoadViewbox; + hSvg : TSvgElement(aOwnerEl).viewboxWH := LoadViewbox; hMarker : TMarkerElement(aOwnerEl).markerBoxWH := LoadViewbox; hSymbol : TSymbolElement(aOwnerEl).viewboxWH := LoadViewbox; else if aOwnerEl is TPatternElement then @@ -4145,7 +4299,7 @@ procedure Viewbox_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Visibility_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Visibility_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin case GetHash(value) of hCollapse: aOwnerEl.fDrawData.visible := false; @@ -4156,7 +4310,7 @@ procedure Visibility_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); //------------------------------------------------------------------------------ -procedure Height_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Height_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var mu: TUnitType; val: double; @@ -4169,7 +4323,7 @@ procedure Height_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Width_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Width_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var mu: TUnitType; val: double; @@ -4182,7 +4336,7 @@ procedure Width_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Cx_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Cx_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var mu: TUnitType; val: double; @@ -4202,7 +4356,7 @@ procedure Cx_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Cy_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Cy_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var mu: TUnitType; val: double; @@ -4222,7 +4376,7 @@ procedure Cy_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Dx_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Dx_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var mu: TUnitType; val: double; @@ -4239,7 +4393,7 @@ procedure Dx_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Dy_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Dy_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var mu: TUnitType; val: double; @@ -4256,14 +4410,14 @@ procedure Dy_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Result_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Result_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); begin if (aOwnerEl is TFeBaseElement) then TFeBaseElement(aOwnerEl).res := ExtractRef(value); end; //------------------------------------------------------------------------------ -procedure Rx_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Rx_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var mu: TUnitType; val: double; @@ -4298,7 +4452,7 @@ procedure Rx_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Ry_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Ry_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var mu: TUnitType; val: double; @@ -4321,7 +4475,7 @@ procedure Ry_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure SpreadMethod_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure SpreadMethod_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var word: UTF8String; c, endC: PUTF8Char; @@ -4339,7 +4493,7 @@ procedure SpreadMethod_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure SpectacularExponent(aOwnerEl: TSvgElement; const value: UTF8String); +procedure SpectacularExponent(aOwnerEl: TBaseElement; const value: UTF8String); var se: double; begin @@ -4350,7 +4504,7 @@ procedure SpectacularExponent(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure StdDev_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure StdDev_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var sd: double; begin @@ -4365,7 +4519,7 @@ procedure StdDev_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure K1_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure K1_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var val: double; begin @@ -4375,7 +4529,7 @@ procedure K1_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure K2_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure K2_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var val: double; begin @@ -4385,7 +4539,7 @@ procedure K2_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure K3_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure K3_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var val: double; begin @@ -4395,7 +4549,7 @@ procedure K3_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure K4_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure K4_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var val: double; begin @@ -4405,7 +4559,7 @@ procedure K4_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure X1_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure X1_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var mu: TUnitType; val: double; @@ -4430,7 +4584,7 @@ procedure X1_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure X2_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure X2_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var mu: TUnitType; val: double; @@ -4448,7 +4602,7 @@ procedure X2_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Y1_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Y1_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var mu: TUnitType; val: double; @@ -4473,7 +4627,7 @@ procedure Y1_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Y2_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Y2_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var mu: TUnitType; val: double; @@ -4491,7 +4645,7 @@ procedure Y2_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); end; //------------------------------------------------------------------------------ -procedure Z_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); +procedure Z_Attrib(aOwnerEl: TBaseElement; const value: UTF8String); var val: double; begin @@ -4503,7 +4657,7 @@ procedure Z_Attrib(aOwnerEl: TSvgElement; const value: UTF8String); //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ -procedure TSvgElement.LoadAttribute(attrib: PSvgAttrib); +procedure TBaseElement.LoadAttribute(attrib: PSvgAttrib); begin with attrib^ do case hash of @@ -4594,7 +4748,7 @@ procedure TSvgElement.LoadAttribute(attrib: PSvgAttrib); end; //------------------------------------------------------------------------------ -procedure TSvgElement.LoadAttributes; +procedure TBaseElement.LoadAttributes; var i: integer; begin @@ -4615,7 +4769,7 @@ function PreferRelativeFraction(val: TValue): TTriState; end; //------------------------------------------------------------------------------ -function TSvgElement.GetRelFracLimit: double; +function TBaseElement.GetRelFracLimit: double; begin //the default behaviour here is to assume untyped fractional values //below 1.0 are values relative (to the bounding size) BUT ONLY WHEN @@ -4635,12 +4789,12 @@ function TSvgElement.GetRelFracLimit: double; end; //------------------------------------------------------------------------------ -function TSvgElement.LoadContent: Boolean; +function TBaseElement.LoadContent: Boolean; var i : integer; svgEl : TSvgTreeEl; elClass : TElementClass; - el : TSvgElement; + el : TBaseElement; begin Result := false; for i := 0 to fParserEl.childs.Count -1 do @@ -4668,7 +4822,6 @@ constructor TSvgReader.Create; fClassStyles := TClassStylesList.Create; fLinGradRenderer := TLinearGradientRenderer.Create; fRadGradRenderer := TSvgRadialGradientRenderer.Create; - fImgRenderer := TImageRenderer.Create; fIdList := TStringList.Create; fIdList.Duplicates := dupIgnore; fIdList.CaseSensitive := false; @@ -4691,7 +4844,6 @@ destructor TSvgReader.Destroy; fLinGradRenderer.Free; fRadGradRenderer.Free; - fImgRenderer.Free; FreeAndNil(fFontCache); fSimpleDrawList.Free; @@ -4709,7 +4861,6 @@ procedure TSvgReader.Clear; fClassStyles.Clear; fLinGradRenderer.Clear; fRadGradRenderer.Clear; - fImgRenderer.Image.Clear; currentColor := clBlack32; userSpaceBounds := NullRectD; for i := 0 to fSimpleDrawList.Count -1 do @@ -4718,32 +4869,6 @@ procedure TSvgReader.Clear; end; //------------------------------------------------------------------------------ -function TSvgReader.GetViewbox(containerWidth, containerHeight: integer): TRectWH; -begin - if not Assigned(RootElement) then - begin - Result := RectWH(0,0,0,0); - Exit; - end; - - with RootElement do - begin - Result.Left := 0; - Result.Top := 0; - Result.Width := elRectWH.width.GetValue(containerWidth, 0); - Result.Height := elRectWH.height.GetValue(containerHeight, 0); - - if viewboxWH.IsEmpty then - begin - if Result.IsEmpty then - Result := RectWH(0, 0,containerWidth, containerHeight); - viewboxWH := Result; - end else if Result.IsEmpty then - Result := viewboxWH; - end; -end; -//------------------------------------------------------------------------------ - procedure TSvgReader.DrawImage(img: TImage32; scaleToImage: Boolean); var scale, scale2: double; @@ -4751,12 +4876,13 @@ procedure TSvgReader.DrawImage(img: TImage32; scaleToImage: Boolean); di: TDrawData; begin if not Assigned(fRootElement) or not assigned(img) then Exit; - vbox := GetViewbox(img.Width, img.Height); - if vbox.IsEmpty then Exit; - fBackgndImage := img; with fRootElement do begin + vbox := GetViewbox; + if vbox.IsEmpty then Exit; // this should never happen + fBackgndImage := img; + di := fDrawData; if di.currentColor = clInvalid then di.currentColor := currentColor; @@ -4767,9 +4893,7 @@ procedure TSvgReader.DrawImage(img: TImage32; scaleToImage: Boolean); //rendered image unless they are percentage values. Nevertheless, these //values can be still overridden by the scaleToImage parameter above - if vbox.IsEmpty then - di.bounds := RectD(img.Bounds) else - di.bounds := viewboxWH.RectD; + di.bounds := viewboxWH.RectD; userSpaceBounds := fDrawData.bounds; if scaleToImage and not img.IsEmpty then @@ -4777,13 +4901,15 @@ procedure TSvgReader.DrawImage(img: TImage32; scaleToImage: Boolean); //nb: the calculated vbox.width and vbox.height are ignored here since //we're scaling the SVG image to the display image. However we still //need to call GetViewbox (above) to make sure that viewboxWH is filled. - - scale := img.width / viewboxWH.Width; - scale2 := img.height / viewboxWH.Height; if fUsePropScale then begin - if scale2 < scale then scale := scale2 - else scale2 := scale; + scale := GetScaleForBestFit( + viewboxWH.Width, viewboxWH.Height, img.Width, img.Height); + scale2 := scale; + end else + begin + scale := GetScale(viewboxWH.Width, img.Width); + scale2 := GetScale(viewboxWH.Height, img.Height); end; MatrixScale(di.matrix, scale, scale2); img.SetSize( @@ -4818,7 +4944,7 @@ function TSvgReader.LoadInternal: Boolean; Result := false; if not Assigned(fSvgParser.svgTree) or (fSvgParser.svgTree.hash <> hSvg) then Exit; - fRootElement := TSvgRootElement.Create(nil, fSvgParser.svgTree); + fRootElement := TSvgElement.Create(nil, fSvgParser.svgTree); fRootElement.fReader := self; fRootElement.LoadAttributes; Result := fRootElement.LoadContent; @@ -4869,7 +4995,7 @@ procedure TSvgReader.SetOverrideStrokeColor(color: TColor32); end; //------------------------------------------------------------------------------ -function TSvgReader.FindElement(const idName: UTF8String): TSvgElement; +function TSvgReader.FindElement(const idName: UTF8String): TBaseElement; begin if Assigned(RootElement) then Result := RootElement.FindChild(idName) else diff --git a/Image32/source/Img32.Text.pas b/Image32/source/Img32.Text.pas index 620d2eb..bf4821c 100644 --- a/Image32/source/Img32.Text.pas +++ b/Image32/source/Img32.Text.pas @@ -2036,7 +2036,7 @@ function TFontReader.GetWeight: integer; end; GetGlyphInfo(Ord('G'),glyph, dummy, gm); rec := GetBoundsD(glyph); - glyph := Img32.Vector.OffsetPath(glyph, -rec.Left, -rec.Top); + glyph := Img32.Vector.TranslatePath(glyph, -rec.Left, -rec.Top); glyph := Img32.Vector.ScalePath(glyph, imgSize/rec.Width, imgSize/rec.Height); img := TImage32.Create(imgSize,imgSize); @@ -2441,7 +2441,7 @@ function TFontCache.GetTextOutline(const rec: TRect; with wordList.GetWord(j) do if aWord > #32 then begin - app := OffsetPath(paths, x, y + Ascent); + app := TranslatePath(paths, x, y + Ascent); pp := MergePathsArray(app); AppendPath(Result, pp); x := x + width; @@ -2483,7 +2483,7 @@ function TFontCache.GetTextOutline(const rec: TRect; else Exit; end; - Result := OffsetPath(Result, 0, dy); + Result := TranslatePath(Result, 0, dy); finally wl.Free; end; @@ -2552,7 +2552,7 @@ function TFontCache.GetVerticalTextOutline(x, y: double; y := y + yMax * scale; //yMax = char ascent dy := - yMin * scale; //yMin = char descent end; - AppendPath(Result, Img32.Vector.OffsetPath( glyphInfo.contours, x + dx, y)); + AppendPath(Result, TranslatePath( glyphInfo.contours, x + dx, y)); if text[i] = #32 then y := y + dy - interCharSpace else y := y + dy + interCharSpace; @@ -2593,7 +2593,7 @@ function TFontCache.GetTextOutlineInternal(x, y: double; nextX := nextX + prevGlyphKernList[j].kernValue * fScale; end; - currGlyph := OffsetPath(glyphInfo.contours, nextX, y); + currGlyph := TranslatePath(glyphInfo.contours, nextX, y); dx := glyphInfo.metrics.hmtx.advanceWidth * fScale; if i = underlineIdx then @@ -2895,7 +2895,7 @@ function DrawVerticalText(image: TImage32; x, y, interCharSpace: double; y := y + yMax * scale; //yMax = char ascent dy := - yMin * scale; //yMin = char descent end; - glyphs := Img32.Vector.OffsetPath( glyphInfo.contours, x + dx, y); + glyphs := TranslatePath( glyphInfo.contours, x + dx, y); DrawPolygon(image, glyphs, frNonZero, textColor); if text[i] = #32 then y := y + dy - interCharSpace else @@ -3012,7 +3012,7 @@ function GetTextOutlineOnPath(const text: UnicodeString; pt.X := pathInfo.pt.X + pathInfo.vector.X * dx - rotatePt.X; pt.Y := pathInfo.pt.Y + pathInfo.vector.Y * dx - rotatePt.Y; - tmpPaths := OffsetPath(tmpPaths, pt.X, pt.Y); + tmpPaths := TranslatePath(tmpPaths, pt.X, pt.Y); AppendPath(Result, tmpPaths); end; end; diff --git a/Image32/source/Img32.Transform.pas b/Image32/source/Img32.Transform.pas index 6bd833c..5303736 100644 --- a/Image32/source/Img32.Transform.pas +++ b/Image32/source/Img32.Transform.pas @@ -3,15 +3,11 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.4 * -* Date : 17 December 2023 * +* Date : 16 April 2024 * * Website : http://www.angusj.com * -* Copyright : Angus Johnson 2019-2021 * -* * +* Copyright : Angus Johnson 2019-2024 * * Purpose : Affine and projective transformation routines for TImage32 * -* * -* License : Use, modification & distribution is subject to * -* Boost Software License Ver 1 * -* http://www.boost.org/LICENSE_1_0.txt * +* License : http://www.boost.org/LICENSE_1_0.txt * *******************************************************************************) interface @@ -19,8 +15,7 @@ interface {$I Img32.inc} uses - SysUtils, Classes, Math, Types, - Img32, Img32.Vector; + SysUtils, Classes, Math, Types, Img32, Img32.Vector; type TMatrixD = array [0..2, 0..2] of double; @@ -204,15 +199,11 @@ procedure MatrixApply(const matrix: TMatrixD; var pt: TPointD); procedure MatrixApply(const matrix: TMatrixD; var rec: TRect); var - l,t,b,r,tmpX: double; + path: TPathD; begin - tmpX := rec.Left; - l := tmpX * matrix[0, 0] + rec.Top * matrix[1, 0] + matrix[2, 0]; - t := tmpX * matrix[0, 1] + rec.Top * matrix[1, 1] + matrix[2, 1]; - tmpX := rec.Right; - r := tmpX * matrix[0, 0] + rec.Bottom * matrix[1, 0] + matrix[2, 0]; - b := tmpX * matrix[0, 1] + rec.Bottom * matrix[1, 1] + matrix[2, 1]; - rec := Rect(RectD(l,t,r,b)); + path := Rectangle(rec); + MatrixApply(matrix, path); + rec := GetBounds(path); end; //------------------------------------------------------------------------------ @@ -402,18 +393,19 @@ function AffineTransformImage(img: TImage32; matrix: TMatrixD): TPoint; resampler: TResamplerFunction; begin Result := NullPoint; + if IsIdentityMatrix(matrix) or + img.IsEmpty or (img.Resampler = 0) then Exit; - if img.Resampler = 0 then - resampler := nil else - resampler := GetResampler(img.Resampler); - - if not Assigned(resampler) or img.IsEmpty or - IsIdentityMatrix(matrix) then - Exit; + resampler := GetResampler(img.Resampler); + if not Assigned(resampler) then Exit; //auto-resize the image so it'll fit transformed image - dstRec := GetTransformBounds(img, matrix); + + dstRec := img.Bounds; + MatrixApply(matrix, dstRec); + RectWidthHeight(dstRec, newWidth, newHeight); + //auto-translate the image too Result := dstRec.TopLeft; @@ -425,15 +417,16 @@ function AffineTransformImage(img: TImage32; matrix: TMatrixD): TPoint; pc := @tmp[0]; for i := dstRec.Top to + dstRec.Bottom -1 do + begin for j := dstRec.Left to dstRec.Right -1 do begin - //convert dest X,Y to src X,Y ... x := j; y := i; MatrixApply(matrix, x, y); - //get weighted pixel (slow) - pc^ := resampler(img, Round(x * 256), Round(y * 256)); + pc^ := resampler(img, x, y); inc(pc); end; + end; + img.BeginUpdate; try img.SetSize(newWidth, newHeight); @@ -505,6 +498,36 @@ procedure GetSrcCoords256(const matrix: TMatrixD; var x, y: integer); end; //------------------------------------------------------------------------------ +procedure GetSrcCoords(const matrix: TMatrixD; var x, y: double); +{$IFDEF INLINE} inline; {$ENDIF} +var + zz: double; +const + Q: integer = MaxInt div 256; +begin + //returns coords multiplied by 256 in anticipation of the following + //GetWeightedPixel function call which in turn expects the lower 8bits + //of the integer coord value to represent a fraction. + zz := 1; + MatrixMulCoord(matrix, x, y, zz); + + if zz = 0 then + begin + if x >= 0 then x := Q else x := -MaxDouble; + if y >= 0 then y := Q else y := -MaxDouble; + end else + begin + x := x/zz; + if x > Q then x := MaxDouble + else if x < -Q then x := -MaxDouble; + + y := y/zz; + if y > Q then y := MaxDouble + else if y < -Q then y := -MaxDouble + end; +end; +//------------------------------------------------------------------------------ + function GetProjectionMatrix(const srcPts, dstPts: TPathD): TMatrixD; var srcMat, dstMat: TMatrixD; @@ -526,7 +549,7 @@ function ProjectiveTransform(img: TImage32; const srcPts, dstPts: TPathD; const margins: TRect): Boolean; var w,h,i,j: integer; - x,y: integer; + x,y: double; rec: TRect; dstPts2: TPathD; mat: TMatrixD; @@ -549,7 +572,7 @@ function ProjectiveTransform(img: TImage32; dec(rec.Top, margins.Top); inc(rec.Right, margins.Right); inc(rec.Bottom, margins.Bottom); - dstPts2 := OffsetPath(dstPts, -rec.Left, -rec.Top); + dstPts2 := TranslatePath(dstPts, -rec.Left, -rec.Top); mat := GetProjectionMatrix(srcPts, dstPts2); RectWidthHeight(rec, w, h); @@ -559,7 +582,7 @@ function ProjectiveTransform(img: TImage32; for j := 0 to w -1 do begin x := j; y := i; - GetSrcCoords256(mat, x, y); + GetSrcCoords(mat, x, y); pc^ := resampler(img, x, y); inc(pc); end; @@ -735,10 +758,10 @@ function SplineVertTransform(img: TImage32; const topSpline: TPathD; if (j > y-1.0) and (j < y + img.Height) then if backColoring then pc^ := BlendToAlpha(pc^, - ReColor(resampler(img, Round(Distances[i]*q) ,Round((j - y)*256)), backColor)) + ReColor(resampler(img, Distances[i]*q, j - y), backColor)) else pc^ := BlendToAlpha(pc^, - resampler(img, Round(Distances[i]*q) ,Round((j - y)*256))); + resampler(img, Round(Distances[i]*q), j - y)); inc(pc, w); end; end; @@ -803,10 +826,9 @@ function SplineHorzTransform(img: TImage32; const leftSpline: TPathD; if (j > x-1.0) and (j < x + img.Width) then if backColoring then pc^ := BlendToAlpha(pc^, - ReColor(resampler(img, Round((j - x) *256), Round(Distances[i]*q)), backColor)) + ReColor(resampler(img, (j - x), Distances[i]*q), backColor)) else - pc^ := BlendToAlpha(pc^, - resampler(img, Round((j - x) *256), Round(Distances[i]*q))); + pc^ := BlendToAlpha(pc^, resampler(img, (j - x), Distances[i]*q)); inc(pc); end; end; diff --git a/Image32/source/Img32.Vector.pas b/Image32/source/Img32.Vector.pas index 72b2554..f2e5237 100644 --- a/Image32/source/Img32.Vector.pas +++ b/Image32/source/Img32.Vector.pas @@ -3,9 +3,9 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.4 * -* Date : 14 October 2023 * +* Date : 16 March 2024 * * Website : http://www.angusj.com * -* Copyright : Angus Johnson 2019-2023 * +* Copyright : Angus Johnson 2019-2024 * * * * Purpose : Vector drawing for TImage32 * * * @@ -23,7 +23,16 @@ interface type TArrowStyle = (asNone, asSimple, asFancy, asDiamond, asCircle, asTail); - TJoinStyle = (jsAuto, jsSquare, jsMiter, jsRound); + // TJoinStyle: + // jsSquare - Convex joins will be truncated using a 'squaring' edge. + // The mid-points of these squaring edges will also be exactly the offset + // (ie delta) distance away from their origins (ie the starting vertices). + // jsButt - joins are similar to 'squared' joins except that squaring + // won't occur at a fixed distance. While bevelled joins may not be as + // pretty as squared joins, bevelling will be much faster than squaring. + // And perhaps this is why bevelling (rather than squaring) is preferred + // in numerous graphics display formats (including SVG & PDF documents). + TJoinStyle = (jsAuto, jsSquare, jsButt, jsMiter, jsRound); TEndStyle = (esPolygon = 0, esClosed = 0, esButt, esSquare, esRound); TPathEnd = (peStart, peEnd, peBothEnds); TSplineType = (stQuadratic, stCubic); @@ -158,14 +167,14 @@ interface patternOffset: PDouble; lineWidth: double; joinStyle: TJoinStyle; endStyle: TEndStyle): TPathsD; - function OffsetPoint(const pt: TPoint; dx, dy: integer): TPoint; overload; - function OffsetPoint(const pt: TPointD; dx, dy: double): TPointD; overload; + function TranslatePoint(const pt: TPoint; dx, dy: integer): TPoint; overload; + function TranslatePoint(const pt: TPointD; dx, dy: double): TPointD; overload; - function OffsetPath(const path: TPathD; + function TranslatePath(const path: TPathD; dx, dy: double): TPathD; overload; - function OffsetPath(const paths: TPathsD; + function TranslatePath(const paths: TPathsD; dx, dy: double): TPathsD; overload; - function OffsetPath(const ppp: TArrayOfPathsD; + function TranslatePath(const ppp: TArrayOfPathsD; dx, dy: double): TArrayOfPathsD; overload; function Paths(const path: TPathD): TPathsD; @@ -202,7 +211,7 @@ interface procedure AppendPoint(var path: TPathD; const extra: TPointD); - procedure AppendPath(var path: TPathD; const pt: TPointD); overload; + procedure AppendToPath(var path: TPathD; const pt: TPointD); overload; procedure AppendPath(var path1: TPathD; const path2: TPathD); overload; procedure AppendPath(var paths: TPathsD; const extra: TPathD); overload; procedure AppendPath(var paths: TPathsD; const extra: TPathsD); overload; @@ -261,7 +270,8 @@ interface function RectsEqual(const rec1, rec2: TRect): Boolean; - procedure OffsetRect(var rec: TRectD; dx, dy: double); overload; + procedure TranslateRect(var rec: TRect; dx, dy: integer); overload; + procedure TranslateRect(var rec: TRectD; dx, dy: double); overload; function MakeSquare(rec: TRect): TRect; @@ -389,8 +399,8 @@ interface function IsPointInEllipse(const ellipseRec: TRect; const pt: TPoint): Boolean; - //GetIntersectsEllipseAndLine: Gets the intersection of an ellipse and - //a line. The function result = true when the line either touches + //GetLineEllipseIntersects: Gets the intersection of a line and + //an ellipse. The function succeeds when the line either touches //tangentially or passes through the ellipse. If the line touches //tangentially, the coordintates returned in pt1 and pt2 will match. function GetLineEllipseIntersects(const ellipseRec: TRect; @@ -410,18 +420,20 @@ interface function GetClosestPtOnRotatedEllipse(const ellipseRect: TRectD; ellipseRotation: double; const pt: TPointD): TPointD; - function Outline(const line: TPathD; lineWidth: double; + // RoughOutline: these are **rough** because outlines are untidy with + // numerous self-intersections and negative area regions. Nevertheless + // these functions are **much** faster that Img32.Clipper.InflatePaths. + // (These two functions are really only intended for internal use.) + function RoughOutline(const line: TPathD; lineWidth: double; joinStyle: TJoinStyle; endStyle: TEndStyle; miterLimOrRndScale: double = 0): TPathsD; overload; - function Outline(const lines: TPathsD; lineWidth: double; + function RoughOutline(const lines: TPathsD; lineWidth: double; joinStyle: TJoinStyle; endStyle: TEndStyle; miterLimOrRndScale: double = 0): TPathsD; overload; - //Grow: Offsets path by 'delta' (positive is away from the left of the path). - //With a positive delta, clockwise paths will expand and counter-clockwise - //ones will contract. The reverse happens with negative deltas. - function Grow(const path, normals: TPathD; delta: double; joinStyle: TJoinStyle; - miterLim: double; isOpen: Boolean = false): TPathD; + // Grow: only intended for internal use + function Grow(const path, normals: TPathD; delta: double; + joinStyle: TJoinStyle; miterLim: double; isOpen: Boolean = false): TPathD; function ValueAlmostZero(val: double; epsilon: double = 0.001): Boolean; function ValueAlmostOne(val: double; epsilon: double = 0.001): Boolean; @@ -801,7 +813,16 @@ function Area(const path: TPathD): Double; end; //------------------------------------------------------------------------------ -procedure OffsetRect(var rec: TRectD; dx, dy: double); +procedure TranslateRect(var rec: TRect; dx, dy: integer); +begin + rec.Left := rec.Left + dx; + rec.Top := rec.Top + dy; + rec.Right := rec.Right + dx; + rec.Bottom := rec.Bottom + dy; +end; +//------------------------------------------------------------------------------ + +procedure TranslateRect(var rec: TRectD; dx, dy: double); begin rec.Left := rec.Left + dx; rec.Top := rec.Top + dy; @@ -1117,21 +1138,21 @@ function CopyPaths(const paths: TPathsD): TPathsD; end; //------------------------------------------------------------------------------ -function OffsetPoint(const pt: TPoint; dx, dy: integer): TPoint; +function TranslatePoint(const pt: TPoint; dx, dy: integer): TPoint; begin result.x := pt.x + dx; result.y := pt.y + dy; end; //------------------------------------------------------------------------------ -function OffsetPoint(const pt: TPointD; dx, dy: double): TPointD; +function TranslatePoint(const pt: TPointD; dx, dy: double): TPointD; begin result.x := pt.x + dx; result.y := pt.y + dy; end; //------------------------------------------------------------------------------ -function OffsetPath(const path: TPathD; dx, dy: double): TPathD; +function TranslatePath(const path: TPathD; dx, dy: double): TPathD; var i, len: integer; begin @@ -1145,7 +1166,7 @@ function OffsetPath(const path: TPathD; dx, dy: double): TPathD; end; //------------------------------------------------------------------------------ -function OffsetPath(const paths: TPathsD; +function TranslatePath(const paths: TPathsD; dx, dy: double): TPathsD; var i,len: integer; @@ -1153,18 +1174,18 @@ function OffsetPath(const paths: TPathsD; len := length(paths); setLength(result, len); for i := 0 to len -1 do - result[i] := OffsetPath(paths[i], dx, dy); + result[i] := TranslatePath(paths[i], dx, dy); end; //------------------------------------------------------------------------------ -function OffsetPath(const ppp: TArrayOfPathsD; dx, dy: double): TArrayOfPathsD; +function TranslatePath(const ppp: TArrayOfPathsD; dx, dy: double): TArrayOfPathsD; var i,len: integer; begin len := length(ppp); setLength(result, len); for i := 0 to len -1 do - result[i] := OffsetPath(ppp[i], dx, dy); + result[i] := TranslatePath(ppp[i], dx, dy); end; //------------------------------------------------------------------------------ @@ -1701,7 +1722,7 @@ function IsPointInEllipse(const ellipseRec: TRect; const pt: TPoint): Boolean; dx := ellipseRec.Left + a; dy := ellipseRec.Top + b; rec := RectD(ellipseRec); - OffsetRect(rec, -dx, -dy); + TranslateRect(rec, -dx, -dy); x := pt.X -dx; y := pt.Y -dy; //first make sure pt is inside rect Result := (abs(x) <= a) and (abs(y) <= b); @@ -1728,9 +1749,9 @@ function GetLineEllipseIntersects(const ellipseRec: TRect; b := rec.Height *0.5; //offset ellipseRect so it's centered over the coordinate origin dx := ellipseRec.Left + a; dy := ellipseRec.Top + b; - offsetRect(rec, -dx, -dy); - pt1 := OffsetPoint(linePt1, -dx, -dy); - pt2 := OffsetPoint(linePt2, -dx, -dy); + TranslateRect(rec, -dx, -dy); + pt1 := TranslatePoint(linePt1, -dx, -dy); + pt2 := TranslatePoint(linePt2, -dx, -dy); //equation of ellipse = (x*x)/(a*a) + (y*y)/(b*b) = 1 //equation of line = y = mx + c; if (pt1.X = pt2.X) then //vertical line (ie infinite slope) @@ -1767,8 +1788,8 @@ function GetLineEllipseIntersects(const ellipseRec: TRect; pt2.Y := m * pt2.X + c; end; //finally reverse initial offset - linePt1 := OffsetPoint(pt1, dx, dy); - linePt2 := OffsetPoint(pt2, dx, dy); + linePt1 := TranslatePoint(pt1, dx, dy); + linePt2 := TranslatePoint(pt2, dx, dy); end; //------------------------------------------------------------------------------ @@ -1787,267 +1808,7 @@ function ApplyNormal(const pt, norm: TPointD; delta: double): TPointD; end; //------------------------------------------------------------------------------ -function GetParallelOffests(const path, norms: TPathD; - delta: double): TPathD; -var - i, highI, len: integer; -begin - len := Length(path); - highI := len -1; - SetLength(Result, len *2); - Result[0] := ApplyNormal(path[0], norms[0], delta); - for i := 1 to highI do - begin - Result[i*2-1] := ApplyNormal(path[i], norms[i-1], delta); - Result[i*2] := ApplyNormal(path[i], norms[i], delta); - end; - Result[highI*2+1] := ApplyNormal(path[0], norms[highI], delta); -end; -//------------------------------------------------------------------------------ - -type - TGrowRec = record - StepsPerRad : double; - StepSin : double; - StepCos : double; - Radius : double; - aSin : double; - aCos : double; - pt : TPointD; - norm1 : TPointD; - norm2 : TPointD; - end; - -function DoRound(const growRec: TGrowRec): TPathD; -var - i, steps: Integer; - a: Double; - pt2: TPointD; -begin - with growRec do - begin - a := ArcTan2(aSin, aCos); - steps := Round(StepsPerRad * Abs(a)); - SetLength(Result, steps + 2); - pt2 := PointD(norm1.x * Radius, norm1.y * Radius); - Result[0] := PointD(pt.x + pt2.x, pt.y + pt2.y); - for i := 1 to steps do - begin - pt2 := PointD(pt2.X * StepCos - StepSin * pt2.Y, - pt2.X * StepSin + pt2.Y * StepCos); - Result[i] := PointD(pt.X + pt2.X, pt.Y + pt2.Y); - end; - pt2 := PointD(norm2.x * Radius, norm2.y * Radius); - Result[steps+1] := PointD(pt.x + pt2.x, pt.y + pt2.y); - end; -end; -//------------------------------------------------------------------------------ - -function CalcRoundingSteps(radius: double): double; -begin - //the results of this function have been derived empirically - //and may need further adjustment - if radius < 0.55 then result := 4 - else result := Pi * Sqrt(radius); -end; -//------------------------------------------------------------------------------ - -function Grow(const path, normals: TPathD; delta: double; - joinStyle: TJoinStyle; miterLim: double; isOpen: Boolean): TPathD; -var - resCnt, resCap: integer; - norms : TPathD; - parallelOffsets : TPathD; - - procedure AddPoint(const pt: TPointD); - begin - if resCnt >= resCap then - begin - inc(resCap, 64); - setLength(result, resCap); - end; - result[resCnt] := pt; - inc(resCnt); - end; - - procedure DoMiter(const growRec: TGrowRec); - var - a: double; - begin - with growRec do - begin - a := delta / (1 + aCos); //see offset_triginometry4.svg - AddPoint(PointD(pt.X + (norm2.X + norm1.X) * a, - pt.Y + (norm2.Y + norm1.Y) * a)); - end; - end; - - procedure DoSquare(const growRec: TGrowRec; const po1, po2: TPointD); - var - pt1, pt2: TPointD; - ip, ptQ : TPointD; - vec : TPointD; - begin - with growRec do - begin - // using the reciprocal of unit normals (as unit vectors) - // get the average unit vector ... - //vec := GetAvgUnitVector(PointD(-norm1.Y, norm1.X),PointD(norm2.Y,-norm2.X)); - vec := NormalizeVector(PointD(norm2.Y - norm1.Y, norm1.X - norm2.X)); - // now offset the original vertex delta units along unit vector - ptQ := OffsetPoint(pt, delta * vec.X, delta * vec.Y); - - // get perpendicular vertices - pt1 := OffsetPoint(ptQ, delta * vec.Y, delta * -vec.X); - pt2 := OffsetPoint(ptQ, delta * -vec.Y, delta * vec.X); - // using 2 vertices along one edge offset (po1 & po2) - IntersectPoint(pt1,pt2,po1,po2, ip); - AddPoint(ip); - //get the second intersect point through reflecion - ip := ReflectPoint(ip, ptQ); - AddPoint(ip); - end; - end; - - procedure AppendPath(const path: TPathD); - var - len: integer; - begin - len := Length(path); - if resCnt + len > resCap then - begin - inc(resCap, len); - setLength(result, resCap); - end; - Move(path[0], result[resCnt], len * SizeOf(TPointD)); - inc(resCnt, len); - end; - -var - i : cardinal; - prevI : cardinal; - len : cardinal; - highI : cardinal; - iLo,iHi : cardinal; - growRec : TGrowRec; - absDelta : double; -begin - Result := nil; - if not Assigned(path) then exit; - len := Length(path); - if not isOpen then - while (len > 2) and - PointsNearEqual(path[len -1], path[0], 0.001) do - dec(len); - if len < 2 then Exit; - - absDelta := Abs(delta); - if absDelta < MinStrokeWidth/2 then - begin - if delta < 0 then - delta := -MinStrokeWidth/2 else - delta := MinStrokeWidth/2; - end; - if absDelta < 1 then - joinStyle := jsSquare - else if joinStyle = jsAuto then - begin - if delta < AutoWidthThreshold / 2 then - joinStyle := jsSquare else - joinStyle := jsRound; - end; - - if assigned(normals) then - norms := normals else - norms := GetNormals(path); - - highI := len -1; - parallelOffsets := GetParallelOffests(path, norms, delta); - - if joinStyle = jsRound then - begin - growRec.Radius := delta; - growRec.StepsPerRad := CalcRoundingSteps(growRec.Radius)/(Pi *2); - if delta < 0 then - GetSinCos(-1/growRec.StepsPerRad, growRec.StepSin, growRec.StepCos) else - GetSinCos(1/growRec.StepsPerRad, growRec.StepSin, growRec.StepCos); - end else - begin - if miterLim <= 0 then miterLim := DefaultMiterLimit - else if miterLim < 2 then miterLim := 2; - miterLim := 2 /(sqr(miterLim)); - growRec.StepsPerRad := 0; //stop compiler warning. - end; - - resCnt := 0; resCap := 0; - - if isOpen then - begin - iLo := 1; iHi := highI -1; - prevI := 0; - AddPoint(parallelOffsets[0]); - end else - begin - iLo := 0; iHi := highI; - prevI := highI; - end; - - for i := iLo to iHi do - begin - - if PointsNearEqual(path[i], path[prevI], 0.01) then - begin - prevI := i; - Continue; - end; - - growRec.aSin := CrossProduct(norms[prevI], norms[i]); - growRec.aCos := DotProduct(norms[prevI], norms[i]); - if (growRec.aSin > 1.0) then growRec.aSin := 1.0 - else if (growRec.aSin < -1.0) then growRec.aSin := -1.0; - - growRec.pt := path[i]; - growRec.norm1 := norms[prevI]; - growRec.norm2 := norms[i]; - - if (growRec.aCos > 0.99) then // almost straight - less than 8 degrees - begin - AddPoint(parallelOffsets[prevI*2+1]); - if (growRec.aCos < 0.9998) then // greater than 1 degree - AddPoint(parallelOffsets[i*2]); - end - else if (growRec.aCos > -0.99) and (growRec.aSin * delta < 0) then - begin //ie is concave - AddPoint(parallelOffsets[prevI*2+1]); - AddPoint(path[i]); - AddPoint(parallelOffsets[i*2]); - end - else if (joinStyle = jsRound) then - begin - AppendPath(DoRound(growRec)); - end - else if (joinStyle = jsMiter) then // nb: miterLim <= 2 - begin - if (1 + growRec.aCos > miterLim) then //within miter range - DoMiter(growRec) else - DoSquare(growRec, - parallelOffsets[prevI*2], parallelOffsets[prevI*2 +1]); - end - // don't bother squaring angles that deviate < ~20 deg. because squaring - // will be indistinguishable from mitering and just be a lot slower - else if (growRec.aCos > 0.9) then - DoMiter(growRec) - else - DoSquare(growRec, parallelOffsets[prevI*2], parallelOffsets[prevI*2 +1]); - - prevI := i; - end; - if isOpen then AddPoint(parallelOffsets[highI*2-1]); - SetLength(Result, resCnt); -end; -//------------------------------------------------------------------------------ - -procedure AppendPath(var path: TPathD; const pt: TPointD); +procedure AppendToPath(var path: TPathD; const pt: TPointD); var len: integer; begin @@ -2353,190 +2114,582 @@ function SegmentsIntersect(const ln1a, ln1b, ln2a, ln2b: TPointD; end; //------------------------------------------------------------------------------ -function ReverseNormals(const norms: TPathD): TPathD; +function CalcRoundingSteps(radius: double): double; +begin + //the results of this function have been derived empirically + //and may need further adjustment + if radius < 0.55 then result := 4 + else result := Pi * Sqrt(radius *2); +end; +//------------------------------------------------------------------------------ + +function Grow(const path, normals: TPathD; delta: double; + joinStyle: TJoinStyle; miterLim: double; isOpen: Boolean): TPathD; var - i, highI: integer; + resCnt, resCap : integer; + norms : TPathD; + stepsPerRadian : double; + stepSin, stepCos : double; + asin, acos : double; + + procedure AddPoint(const pt: TPointD); + begin + if resCnt >= resCap then + begin + inc(resCap, 64); + setLength(result, resCap); + end; + result[resCnt] := pt; + inc(resCnt); + end; + + procedure DoMiter(j, k: Integer; cosA: Double); + var + q: Double; + begin + q := delta / (cosA +1); + AddPoint(PointD( + path[j].X + (norms[k].X + norms[j].X) *q, + path[j].Y + (norms[k].Y + norms[j].Y) *q)); + end; + + procedure DoBevel(j, k: Integer); + var + absDelta: double; + begin + if k = j then + begin + absDelta := Abs(delta); + AddPoint(PointD( + path[j].x - absDelta * norms[j].x, + path[j].y - absDelta * norms[j].y)); + AddPoint(PointD( + path[j].x + absDelta * norms[j].x, + path[j].y + absDelta * norms[j].y)); + end else + begin + AddPoint(PointD( + path[j].x + delta * norms[k].x, + path[j].y + delta * norms[k].y)); + AddPoint(PointD( + path[j].x + delta * norms[j].x, + path[j].y + delta * norms[j].y)); + end; + end; + + procedure DoSquare(j, k: Integer); + var + vec, ptQ, ptR, ptS, ptT, ptU, ip: TPointD; + absDelta: double; + begin + if k = j then + begin + vec.X := norms[j].Y; //squaring a line end + vec.Y := -norms[j].X; + end else + begin + // using the reciprocal of unit normals (as unit vectors) + // get the average unit vector ... + vec := GetAvgUnitVector( + PointD(-norms[k].Y, norms[k].X), + PointD(norms[j].Y, -norms[j].X)); + end; + + absDelta := Abs(delta); + ptQ := PointD(path[j].X + absDelta * vec.X, path[j].Y + absDelta * vec.Y); + + ptR := PointD(ptQ.X + delta * vec.Y, ptQ.Y + delta * -vec.X); + ptS := ReflectPoint(ptR, ptQ); + + // get 2 vertices along one edge offset + ptT := PointD( + path[k].X + norms[k].X * delta, + path[k].Y + norms[k].Y * delta); + + if (j = k) then + begin + ptU.X := ptT.X + vec.X * delta; + ptU.Y := ptT.Y + vec.Y * delta; + ip := IntersectPoint(ptR, ptS, ptT, ptU); + AddPoint(ReflectPoint(ip, ptQ)); + AddPoint(ip); + end else + begin + ptU := PointD( + path[j].X + norms[k].X * delta, + path[j].Y + norms[k].Y * delta); + ip := IntersectPoint(ptR, ptS, ptT, ptU); + AddPoint(ip); + AddPoint(ReflectPoint(ip, ptQ)); + end; + end; + + procedure DoRound(j, k: Integer); + var + i, steps: Integer; + pt: TPointD; + dx, dy, oldDx: double; + angle: double; + begin + // nb: angles may be negative but this will always be a convex join + pt := path[j]; + if j = k then + begin + dx := -norms[k].X * delta; + dy := -norms[k].Y * delta; + end else + begin + dx := norms[k].X * delta; + dy := norms[k].Y * delta; + end; + AddPoint(PointD(pt.X + dx, pt.Y + dy)); + + angle := ArcTan2(asin, acos); + steps := Ceil(stepsPerRadian * abs(angle)); + + for i := 2 to steps do + begin + oldDx := dx; + dx := oldDx * stepCos - stepSin * dy; + dy := oldDx * stepSin + stepCos * dy; + AddPoint(PointD(pt.X + dx, pt.Y + dy)); + end; + AddPoint(PointD( + pt.X + norms[j].X * delta, + pt.Y + norms[j].Y * delta)); + end; + +var + j, k : cardinal; + len : cardinal; + steps : double; + highI : cardinal; + iLo,iHi : cardinal; + absDelta : double; begin - highI := high(norms); - setLength(result, highI +1); - for i := 1 to highI do + Result := nil; + if not Assigned(path) then exit; + len := Length(path); + if not isOpen then + while (len > 2) and + PointsNearEqual(path[len -1], path[0], 0.001) do + dec(len); + if len < 2 then Exit; + + absDelta := Abs(delta); + if absDelta < MinStrokeWidth/2 then + begin + if delta < 0 then + delta := -MinStrokeWidth/2 else + delta := MinStrokeWidth/2; + end; + if absDelta < 1 then + joinStyle := jsButt + else if joinStyle = jsAuto then + begin + if delta < AutoWidthThreshold / 2 then + joinStyle := jsSquare else + joinStyle := jsRound; + end; + + if assigned(normals) then + norms := normals else + norms := GetNormals(path); + + highI := len -1; + + stepsPerRadian := 0; + if joinStyle = jsRound then + begin + steps := CalcRoundingSteps(delta); +// // avoid excessive precision // todo - recheck if needed +// if (steps > absDelta * Pi) then +// steps := absDelta * Pi; + stepSin := sin(TwoPi/steps); + stepCos := cos(TwoPi/steps); + if (delta < 0) then stepSin := -stepSin; + stepsPerRadian := steps / TwoPi; + end; + + if miterLim <= 0 then miterLim := DefaultMiterLimit + else if miterLim < 2 then miterLim := 2; + miterLim := 2 /(sqr(miterLim)); + + resCnt := 0; + resCap := 0; + + if isOpen then + begin + iLo := 1; iHi := highI -1; + k := 0; + AddPoint(PointD( + path[0].X + norms[0].X * delta, + path[0].Y + norms[0].Y * delta)); + end else + begin + iLo := 0; iHi := highI; + k := highI; + end; + + for j := iLo to iHi do begin - result[i -1].X := -norms[highI -i].X; - result[i -1].Y := -norms[highI -i].Y; + + if PointsNearEqual(path[j], path[k], 0.01) then + begin + k := j; // todo - check if needed + Continue; + end; + + asin := CrossProduct(norms[k], norms[j]); + if (asin > 1.0) then asin := 1.0 + else if (asin < -1.0) then asin := -1.0; + acos := DotProduct(norms[k], norms[j]); + + if (acos > -0.999) and (asin * delta < 0) then + begin + // is concave + AddPoint(PointD( + path[j].X + norms[k].X * delta, path[j].Y + norms[k].Y * delta)); + AddPoint(path[j]); + AddPoint(PointD( + path[j].X + norms[j].X * delta, path[j].Y + norms[j].Y * delta)); + end + else if (acos > 0.999) and (joinStyle <> jsRound) then + begin + // almost straight - less than 2.5 degree, so miter + DoMiter(j, k, acos); + end + else if (joinStyle = jsMiter) then + begin + if (1 + acos > miterLim) then + DoMiter(j, k, acos) else + DoSquare(j, k); + end + else if (joinStyle = jsRound) then + DoRound(j, k) + else if (joinStyle = jsSquare) then + DoSquare(j, k) + else + DoBevel(j, k); + k := j; end; - result[highI].X := -norms[highI].X; - result[highI].Y := -norms[highI].Y; + + if isOpen then + AddPoint(PointD( + path[highI].X + norms[highI].X * delta, //todo - check this !!! + path[highI].Y + norms[highI].Y * delta)); + + SetLength(Result, resCnt); end; //------------------------------------------------------------------------------ -function GrowOpenLine(const line: TPathD; width: double; +function GrowOpenLine(const line: TPathD; delta: double; joinStyle: TJoinStyle; endStyle: TEndStyle; - miterLimOrRndScale: double): TPathD; + miterLim: double): TPathD; var - len, x,y: integer; - segLen, halfWidth: double; - normals, line2, lineL, lineR, arc: TPathD; - invNorm: TPointD; - growRec: TGrowRec; + len : integer; + resCnt, resCap : integer; + asin, acos : double; + stepSin, stepCos : double; + stepsPerRadian : double; + path, norms : TPathD; + + procedure AddPoint(const pt: TPointD); + begin + if resCnt >= resCap then + begin + inc(resCap, 64); + setLength(result, resCap); + end; + result[resCnt] := pt; + inc(resCnt); + end; + + procedure DoMiter(j, k: Integer; cosA: Double); + var + q: Double; + begin + q := delta / (cosA +1); + AddPoint(PointD( + path[j].X + (norms[k].X + norms[j].X) *q, + path[j].Y + (norms[k].Y + norms[j].Y) *q)); + end; + + procedure DoBevel(j, k: Integer); + var + absDelta: double; + begin + if k = j then + begin + absDelta := Abs(delta); + AddPoint(PointD( + path[j].x - absDelta * norms[j].x, + path[j].y - absDelta * norms[j].y)); + AddPoint(PointD( + path[j].x + absDelta * norms[j].x, + path[j].y + absDelta * norms[j].y)); + end else + begin + AddPoint(PointD( + path[j].x + delta * norms[k].x, + path[j].y + delta * norms[k].y)); + AddPoint(PointD( + path[j].x + delta * norms[j].x, + path[j].y + delta * norms[j].y)); + end; + end; + + procedure DoSquare(j, k: Integer); + var + vec, ptQ, ptR, ptS, ptT, ptU, ip: TPointD; + absDelta: double; + begin + if k = j then + begin + vec.X := norms[j].Y; //squaring a line end + vec.Y := -norms[j].X; + end else + begin + // using the reciprocal of unit normals (as unit vectors) + // get the average unit vector ... + vec := GetAvgUnitVector( + PointD(-norms[k].Y, norms[k].X), + PointD(norms[j].Y, -norms[j].X)); + end; + + absDelta := Abs(delta); + ptQ := PointD(path[j].X + absDelta * vec.X, path[j].Y + absDelta * vec.Y); + + ptR := PointD(ptQ.X + delta * vec.Y, ptQ.Y + delta * -vec.X); + ptS := ReflectPoint(ptR, ptQ); + + // get 2 vertices along one edge offset + ptT := PointD( + path[k].X + norms[k].X * delta, + path[k].Y + norms[k].Y * delta); + + if (j = k) then + begin + ptU.X := ptT.X + vec.X * delta; + ptU.Y := ptT.Y + vec.Y * delta; + ip := IntersectPoint(ptR, ptS, ptT, ptU); + AddPoint(ReflectPoint(ip, ptQ)); + AddPoint(ip); + end else + begin + ptU := PointD( + path[j].X + norms[k].X * delta, + path[j].Y + norms[k].Y * delta); + ip := IntersectPoint(ptR, ptS, ptT, ptU); + AddPoint(ip); + AddPoint(ReflectPoint(ip, ptQ)); + end; + end; + + procedure DoRound(j, k: Integer); + var + i, steps: Integer; + pt: TPointD; + dx, dy, oldDx: double; + angle: double; + begin + // nb: angles may be negative but this will always be a convex join + pt := path[j]; + if j = k then + begin + dx := -norms[k].X * delta; + dy := -norms[k].Y * delta; + angle := PI; + end else + begin + dx := norms[k].X * delta; + dy := norms[k].Y * delta; + angle := ArcTan2(asin, acos); + end; + AddPoint(PointD(pt.X + dx, pt.Y + dy)); + + steps := Ceil(stepsPerRadian * abs(angle)); + for i := 2 to steps do + begin + oldDx := dx; + dx := oldDx * stepCos - stepSin * dy; + dy := oldDx * stepSin + stepCos * dy; + AddPoint(PointD(pt.X + dx, pt.Y + dy)); + end; + AddPoint(PointD( + pt.X + norms[j].X * delta, + pt.Y + norms[j].Y * delta)); + end; + + procedure DoPoint(j: Cardinal; var k: Cardinal); + begin + asin := CrossProduct(norms[k], norms[j]); + if (asin > 1.0) then asin := 1.0 + else if (asin < -1.0) then asin := -1.0; + acos := DotProduct(norms[k], norms[j]); + + if (acos > -0.999) and (asin * delta < 0) then + begin + // is concave + AddPoint(PointD( + path[j].X + norms[k].X * delta, path[j].Y + norms[k].Y * delta)); + AddPoint(path[j]); + AddPoint(PointD( + path[j].X + norms[j].X * delta, path[j].Y + norms[j].Y * delta)); + end + else if (acos > 0.999) and (joinStyle <> jsRound) then + // almost straight - less than 2.5 degree, so miter + DoMiter(j, k, acos) + else if (joinStyle = jsMiter) then + begin + if (1 + acos > miterLim) then + DoMiter(j, k, acos) else + DoSquare(j, k); + end + else if (joinStyle = jsRound) then + DoRound(j, k) + else if (joinStyle = jsSquare) then + DoSquare(j, k) + else + DoBevel(j, k); + k := j; + end; + +var + highJ : cardinal; + j, k : cardinal; + steps : double; begin Result := nil; - line2 := StripNearDuplicates(line, 0.5, false); - len := length(line2); + path := StripNearDuplicates(line, 0.5, false); + len := length(path); if len = 0 then Exit; - if width < MinStrokeWidth then - width := MinStrokeWidth; - halfWidth := width * 0.5; + if delta < MinStrokeWidth then + delta := MinStrokeWidth; + delta := delta * 0.5; + if len = 1 then begin - x := Round(line2[0].X); - y := Round(line2[0].Y); - SetLength(result, 1); - result := Ellipse(RectD(x -halfWidth, y -halfWidth, - x +halfWidth, y +halfWidth)); + with path[0] do + result := Ellipse(RectD(x-delta, y-delta, x+delta, y+delta)); Exit; end; - if endStyle = esPolygon then - begin - case joinStyle of - jsSquare, jsMiter : endStyle := esSquare; - else endStyle := esRound; - end; - end; + //Assert(endStyle <> esClosed); //with very narrow lines, don't get fancy with joins and line ends - if (width <= 2) then + if (delta <= 1) then begin - joinStyle := jsSquare; + joinStyle := jsButt; if endStyle = esRound then endStyle := esSquare; end else if joinStyle = jsAuto then begin if (endStyle = esRound) and - (width >= AutoWidthThreshold) then + (delta >= AutoWidthThreshold) then joinStyle := jsRound else joinStyle := jsSquare; end; - normals := GetNormals(line2); - if endStyle = esRound then - begin - //grow the line's left side of the line => line1 - lineL := Grow(line2, normals, - halfWidth, joinStyle, miterLimOrRndScale, true); - //build the rounding at the start => result - invNorm.X := -normals[0].X; - invNorm.Y := -normals[0].Y; - //get the rounding parameters - growRec.StepsPerRad := - CalcRoundingSteps(halfWidth * miterLimOrRndScale)/(Pi*2); - GetSinCos(1/growRec.StepsPerRad, growRec.StepSin, growRec.StepCos); - growRec.aSin := invNorm.X * normals[0].Y - invNorm.Y * normals[0].X; - growRec.aCos := invNorm.X * normals[0].X + invNorm.Y * normals[0].Y; - growRec.Radius := halfWidth; - growRec.pt := line2[0]; - growRec.norm1 := invNorm; - growRec.norm2 := normals[0]; - Result := DoRound(growRec); - //join line1 into result - AppendPath(Result, lineL); - //reverse the normals and build the end arc => arc - normals := ReverseNormals(normals); - invNorm.X := -normals[0].X; invNorm.Y := -normals[0].Y; - growRec.aSin := invNorm.X * normals[0].Y - invNorm.Y * normals[0].X; - growRec.aCos := invNorm.X * normals[0].X + invNorm.Y * normals[0].Y; - growRec.pt := line2[High(line2)]; - growRec.norm1 := invNorm; - growRec.norm2 := normals[0]; - arc := DoRound(growRec); - //grow the line's right side of the line - lineR := Grow(ReversePath(line2), normals, - halfWidth, joinStyle, miterLimOrRndScale, true); - //join arc and line2 into result - AppendPath(Result, arc); - AppendPath(Result, lineR); - end else + stepsPerRadian := 0; + if (joinStyle = jsRound) or (endStyle = esRound) then begin - lineL := Copy(line2, 0, len); - if endStyle = esSquare then - begin - // esSquare => extends both line ends by 1/2 lineWidth - AdjustPoint(lineL[0], lineL[1], width * 0.5); - AdjustPoint(lineL[len-1], lineL[len-2], width * 0.5); - end else - begin - //esButt -> extend only very short end segments - segLen := Distance(lineL[0], lineL[1]); - if segLen < width * 0.5 then - AdjustPoint(lineL[0], lineL[1], width * 0.5 - segLen); - segLen := Distance(lineL[len-1], lineL[len-2]); - if segLen < width * 0.5 then - AdjustPoint(lineL[len-1], lineL[len-2], width * 0.5 - segLen); - end; - //first grow the left side of the line => Result - Result := Grow(lineL, normals, - halfWidth, joinStyle, miterLimOrRndScale, true); - //reverse normals and path and grow the right side => lineR - normals := ReverseNormals(normals); - lineR := Grow(ReversePath(lineL), normals, - halfWidth, joinStyle, miterLimOrRndScale, true); - //join both sides - AppendPath(Result, lineR); + steps := CalcRoundingSteps(delta); +// if (steps > absDelta * Pi) then // todo - recheck if needed +// steps := absDelta * Pi; + stepSin := sin(TwoPi/steps); + stepCos := cos(TwoPi/steps); + if (delta < 0) then stepSin := -stepSin; + stepsPerRadian := steps / TwoPi; end; + + if miterLim <= 0 then miterLim := DefaultMiterLimit + else if miterLim < 2 then miterLim := 2; + miterLim := 2 /(sqr(miterLim)); + + norms := GetNormals(path); + resCnt := 0; resCap := 0; + + case endStyle of + esButt: DoBevel(0,0); + esRound: DoRound(0,0); + else DoSquare(0, 0); + end; + + // offset the left side going **forward** + k := 0; + highJ := len -1; + for j := 1 to highJ -1 do DoPoint(j,k); + + // reverse the normals ... + for j := highJ downto 1 do + begin + norms[j].X := -norms[j-1].X; + norms[j].Y := -norms[j-1].Y; + end; + norms[0] := norms[len -1]; + + case endStyle of + esButt: DoBevel(highJ,highJ); + esRound: DoRound(highJ,highJ); + else DoSquare(highJ,highJ); + end; + + // offset the left side going **backward** + k := highJ; + for j := highJ -1 downto 1 do + DoPoint(j, k); + + SetLength(Result, resCnt); end; //------------------------------------------------------------------------------ function GrowClosedLine(const line: TPathD; width: double; joinStyle: TJoinStyle; miterLimOrRndScale: double): TPathsD; var - line2, norms: TPathD; + norms: TPathD; rec: TRectD; skipHole: Boolean; begin - line2 := StripNearDuplicates(line, 0.5, true); - rec := GetBoundsD(line2); + rec := GetBoundsD(line); skipHole := (rec.Width <= width) or (rec.Height <= width); if skipHole then begin SetLength(Result, 1); - norms := GetNormals(line2); - Result[0] := Grow(line2, norms, width/2, joinStyle, miterLimOrRndScale); + norms := GetNormals(line); + Result[0] := Grow(line, norms, width/2, joinStyle, miterLimOrRndScale, false); end else begin SetLength(Result, 2); - norms := GetNormals(line2); - Result[0] := Grow(line2, norms, width/2, joinStyle, miterLimOrRndScale); - line2 := ReversePath(line2); - norms := ReverseNormals(norms); - Result[1] := Grow(line2, norms, width/2, joinStyle, miterLimOrRndScale); + norms := GetNormals(line); + Result[0] := Grow(line, norms, width/2, joinStyle, miterLimOrRndScale, false); + Result[1] := ReversePath( + Grow(line, norms, -width/2, joinStyle, miterLimOrRndScale, false)); end; end; //------------------------------------------------------------------------------ -function Outline(const line: TPathD; lineWidth: double; +function RoughOutline(const line: TPathD; lineWidth: double; joinStyle: TJoinStyle; endStyle: TEndStyle; miterLimOrRndScale: double): TPathsD; +var + lines: TPathsD; begin - if not assigned(line) then - Result := nil - else if endStyle = esClosed then - result := GrowClosedLine(line, - lineWidth, joinStyle, miterLimOrRndScale) - else - begin - SetLength(Result,1); - result[0] := GrowOpenLine(line, lineWidth, - joinStyle, endStyle, miterLimOrRndScale); - end; + SetLength(lines,1); + lines[0] := line; + Result := RoughOutline(lines, lineWidth, + joinStyle, endStyle, miterLimOrRndScale); end; //------------------------------------------------------------------------------ -function Outline(const lines: TPathsD; lineWidth: double; +function RoughOutline(const lines: TPathsD; lineWidth: double; joinStyle: TJoinStyle; endStyle: TEndStyle; miterLimOrRndScale: double): TPathsD; var i: integer; + lwDiv2: double; + p: TPathD; begin result := nil; if not assigned(lines) then exit; @@ -2549,12 +2702,21 @@ function Outline(const lines: TPathsD; lineWidth: double; if endStyle = esPolygon then begin for i := 0 to high(lines) do - if Length(lines[i]) > 2 then - AppendPath(Result, GrowClosedLine(lines[i], - lineWidth, joinStyle, miterLimOrRndScale)) - else - AppendPath(Result, GrowOpenLine(lines[i], lineWidth, - joinStyle, endStyle, miterLimOrRndScale)); + begin + if Length(lines[i]) = 1 then + begin + lwDiv2 := lineWidth/2; + with lines[i][0] do + AppendPath(Result, + Ellipse(RectD(x-lwDiv2, y-lwDiv2, x+lwDiv2, y+lwDiv2))); + end else + begin + p := StripNearDuplicates(lines[i], 0.25, true); + if Length(p) = 2 then AppendToPath(p, p[0]); + AppendPath(Result, + GrowClosedLine(p, lineWidth, joinStyle, miterLimOrRndScale)); + end; + end; end else for i := 0 to high(lines) do @@ -2955,7 +3117,7 @@ function Arc(const rec: TRectD; angle := endAngle - startAngle + angle360 else angle := endAngle - startAngle; //steps = (No. steps for a whole ellipse) * angle/(2*Pi) - steps := Round(CalcRoundingSteps((rec.width + rec.height) * scale)); + steps := Round(CalcRoundingSteps((rec.width + rec.height)/2 * scale)); steps := steps div 2; ///////////////////////////////// if steps < 2 then steps := 2; SetLength(Result, Steps +1); @@ -3006,46 +3168,46 @@ function ArrowHead(const arrowTip, ctrlPt: TPointD; size: double; asSimple: begin setLength(result, 3); - basePt := OffsetPoint(arrowTip, -unitVec.X * size, -unitVec.Y * size); + basePt := TranslatePoint(arrowTip, -unitVec.X * size, -unitVec.Y * size); result[0] := arrowTip; - result[1] := OffsetPoint(basePt, -unitVec.Y * sDiv50, unitVec.X * sDiv50); - result[2] := OffsetPoint(basePt, unitVec.Y * sDiv50, -unitVec.X * sDiv50); + result[1] := TranslatePoint(basePt, -unitVec.Y * sDiv50, unitVec.X * sDiv50); + result[2] := TranslatePoint(basePt, unitVec.Y * sDiv50, -unitVec.X * sDiv50); end; asFancy: begin setLength(result, 4); - basePt := OffsetPoint(arrowTip, + basePt := TranslatePoint(arrowTip, -unitVec.X * sDiv120, -unitVec.Y * sDiv120); - result[0] := OffsetPoint(basePt, -unitVec.Y *sDiv50, unitVec.X *sDiv50); - result[1] := OffsetPoint(arrowTip, -unitVec.X *size, -unitVec.Y *size); - result[2] := OffsetPoint(basePt, unitVec.Y *sDiv50, -unitVec.X *sDiv50); + result[0] := TranslatePoint(basePt, -unitVec.Y *sDiv50, unitVec.X *sDiv50); + result[1] := TranslatePoint(arrowTip, -unitVec.X *size, -unitVec.Y *size); + result[2] := TranslatePoint(basePt, unitVec.Y *sDiv50, -unitVec.X *sDiv50); result[3] := arrowTip; end; asDiamond: begin setLength(result, 4); - basePt := OffsetPoint(arrowTip, -unitVec.X * sDiv60, -unitVec.Y * sDiv60); + basePt := TranslatePoint(arrowTip, -unitVec.X * sDiv60, -unitVec.Y * sDiv60); result[0] := arrowTip; - result[1] := OffsetPoint(basePt, -unitVec.Y * sDiv50, unitVec.X * sDiv50); - result[2] := OffsetPoint(arrowTip, -unitVec.X * sDiv120, -unitVec.Y * sDiv120); - result[3] := OffsetPoint(basePt, unitVec.Y * sDiv50, -unitVec.X * sDiv50); + result[1] := TranslatePoint(basePt, -unitVec.Y * sDiv50, unitVec.X * sDiv50); + result[2] := TranslatePoint(arrowTip, -unitVec.X * sDiv120, -unitVec.Y * sDiv120); + result[3] := TranslatePoint(basePt, unitVec.Y * sDiv50, -unitVec.X * sDiv50); end; asCircle: begin - basePt := OffsetPoint(arrowTip, -unitVec.X * sDiv50, -unitVec.Y * sDiv50); + basePt := TranslatePoint(arrowTip, -unitVec.X * sDiv50, -unitVec.Y * sDiv50); with Point(basePt) do result := Ellipse(RectD(x - sDiv50, y - sDiv50, x + sDiv50, y + sDiv50)); end; asTail: begin setLength(result, 6); - basePt := OffsetPoint(arrowTip, -unitVec.X * sDiv60, -unitVec.Y * sDiv60); - result[0] := OffsetPoint(arrowTip, -unitVec.X * sDiv50, -unitVec.Y * sDiv50); - result[1] := OffsetPoint(arrowTip, -unitVec.Y * sDiv40, unitVec.X * sDiv40); - result[2] := OffsetPoint(basePt, -unitVec.Y * sDiv40, unitVec.X * sDiv40); - result[3] := OffsetPoint(arrowTip, -unitVec.X * sDiv120, -unitVec.Y * sDiv120); - result[4] := OffsetPoint(basePt, unitVec.Y * sDiv40, -unitVec.X * sDiv40); - result[5] := OffsetPoint(arrowTip, unitVec.Y * sDiv40, -unitVec.X * sDiv40); + basePt := TranslatePoint(arrowTip, -unitVec.X * sDiv60, -unitVec.Y * sDiv60); + result[0] := TranslatePoint(arrowTip, -unitVec.X * sDiv50, -unitVec.Y * sDiv50); + result[1] := TranslatePoint(arrowTip, -unitVec.Y * sDiv40, unitVec.X * sDiv40); + result[2] := TranslatePoint(basePt, -unitVec.Y * sDiv40, unitVec.X * sDiv40); + result[3] := TranslatePoint(arrowTip, -unitVec.X * sDiv120, -unitVec.Y * sDiv120); + result[4] := TranslatePoint(basePt, unitVec.Y * sDiv40, -unitVec.X * sDiv40); + result[5] := TranslatePoint(arrowTip, unitVec.Y * sDiv40, -unitVec.X * sDiv40); end; end; end; @@ -3255,8 +3417,9 @@ function GetDashedOutLine(const path: TPathD; if pattern[i] <= 0 then pattern[i] := 1; tmp := GetDashedPath(path, closed, pattern, patternOffset); for i := 0 to high(tmp) do - AppendPath(Result, GrowOpenLine(tmp[i], - lineWidth, joinStyle, endStyle, 2)); +// AppendPath(Result, GrowOpenLine(tmp[i], +// lineWidth, joinStyle, endStyle, 2)); + AppendPath(Result, GrowClosedLine(tmp[i], lineWidth, joinStyle, 2)); end; //------------------------------------------------------------------------------ diff --git a/Image32/source/Img32.inc b/Image32/source/Img32.inc index 8690d94..026dded 100644 --- a/Image32/source/Img32.inc +++ b/Image32/source/Img32.inc @@ -8,13 +8,11 @@ //and adds a few extra library features (eg copying to and from TBitmap objects) {$IF DEFINED(FPC)} {$DEFINE USING_LCL} -{$ELSEIF declared(FireMonkeyVersion)} + {$DEFINE USING_VCL_LCL} +{$ELSEIF declared(FireMonkeyVersion) OR DEFINED(FRAMEWORK_FMX)} {$DEFINE USING_FMX} {$ELSE} {$DEFINE USING_VCL} -{$IFEND} - -{$IF DEFINED(USING_VCL) or DEFINED(USING_LCL)} {$DEFINE USING_VCL_LCL} {$IFEND} @@ -63,14 +61,11 @@ {$IF COMPILERVERSION >= 21} //Delphi 2010 {$DEFINE GESTURES} //added screen gesture support {$IF COMPILERVERSION >= 23} //DelphiXE2 - {$IF declared(FireMonkeyVersion)} //defined in FMX.Types - {$DEFINE FMX} - {$IFEND} {$DEFINE USES_NAMESPACES} {$DEFINE FORMATSETTINGS} {$DEFINE TROUNDINGMODE} {$DEFINE UITYPES} //added UITypes unit - {$DEFINE XPLAT_GENERICS} //reasonable cross-platform & generics support + {$DEFINE XPLAT_GENERICS} //cross-platform generics support {$DEFINE STYLESERVICES} //added StyleServices unit {$IF COMPILERVERSION >= 24} //DelphiXE3 {$LEGACYIFEND ON} diff --git a/Image32/source/Img32.pas b/Image32/source/Img32.pas index d431269..f39ecff 100644 --- a/Image32/source/Img32.pas +++ b/Image32/source/Img32.pas @@ -3,9 +3,9 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.4 * -* Date : 17 December 2023 * +* Date : 16 April 2024 * * Website : http://www.angusj.com * -* Copyright : Angus Johnson 2019-2023 * +* Copyright : Angus Johnson 2019-2024 * * Purpose : The core module of the Image32 library * * License : http://www.boost.org/LICENSE_1_0.txt * *******************************************************************************) @@ -164,7 +164,7 @@ TImageFormat = class TTileFillStyle = (tfsRepeat, tfsMirrorHorz, tfsMirrorVert, tfsRotate180); - TResamplerFunction = function(img: TImage32; x256, y256: integer): TColor32; + TResamplerFunction = function(img: TImage32; x, y: double): TColor32; TImage32 = class(TObject) private @@ -195,6 +195,7 @@ TImage32 = class(TObject) function GetBounds: TRect; function GetMidPoint: TPointD; protected + procedure ResetColorCount; function RectHasTransparency(rec: TRect): Boolean; function CopyPixels(rec: TRect): TArrayOfColor32; //CopyInternal: Internal routine (has no scaling or bounds checking) @@ -1667,7 +1668,7 @@ procedure TImage32.AssignTo(dst: TImage32); dst.fResampler := fResampler; dst.fIsPremultiplied := fIsPremultiplied; dst.fAntiAliased := fAntiAliased; - dst.fColorCount := 0; + dst.ResetColorCount; try dst.SetSize(Width, Height); if (Width > 0) and (Height > 0) then @@ -1684,7 +1685,7 @@ procedure TImage32.AssignTo(dst: TImage32); procedure TImage32.Changed; begin if fUpdateCnt <> 0 then Exit; - fColorCount := 0; + ResetColorCount; if Assigned(fOnChange) then fOnChange(Self); end; //------------------------------------------------------------------------------ @@ -1801,6 +1802,12 @@ procedure TImage32.FillRect(rec: TRect; color: TColor32); end; //------------------------------------------------------------------------------ +procedure TImage32.ResetColorCount; +begin + fColorCount := 0; +end; +//------------------------------------------------------------------------------ + function TImage32.RectHasTransparency(rec: TRect): Boolean; var i,j, rw: Integer; @@ -2083,7 +2090,7 @@ procedure TImage32.ScaleToFitCentered(width, height: integer); Scale(sx); if height = self.Height then Exit; rec2 := Bounds; - Types.OffsetRect(rec2, 0, (height - self.Height) div 2); + TranslateRect(rec2, 0, (height - self.Height) div 2); tmp := TImage32.Create(self); try SetSize(width, height); @@ -2096,7 +2103,7 @@ procedure TImage32.ScaleToFitCentered(width, height: integer); Scale(sy); if width = self.Width then Exit; rec2 := Bounds; - Types.OffsetRect(rec2, (width - self.Width) div 2, 0); + TranslateRect(rec2, (width - self.Width) div 2, 0); tmp := TImage32.Create(self); try SetSize(width, height); @@ -2450,7 +2457,7 @@ function TImage32.CopyBlend(src: TImage32; srcRec, dstRec: TRect; RectWidthHeight(srcRecClipped, w, h); RectWidthHeight(srcRec, srcW, srcH); ScaleRect(dstRec, w / srcW, h / srcH); - Types.OffsetRect(dstRec, + TranslateRect(dstRec, srcRecClipped.Left - srcRec.Left, srcRecClipped.Top - srcRec.Top); end; @@ -2480,7 +2487,7 @@ function TImage32.CopyBlend(src: TImage32; srcRec, dstRec: TRect; RectWidthHeight(dstRecClipped, w, h); RectWidthHeight(dstRec, dstW, dstH); ScaleRect(srcRecClipped, w / dstW, h / dstH); - Types.OffsetRect(srcRecClipped, + TranslateRect(srcRecClipped, dstRecClipped.Left - dstRec.Left, dstRecClipped.Top - dstRec.Top); end; @@ -3156,7 +3163,6 @@ function TImage32.CropTransparentPixels: TRect; procedure TImage32.Rotate(angleRads: double); var - rec: TRectD; mat: TMatrixD; begin if not ClockwiseRotationIsAnglePositive then @@ -3182,11 +3188,10 @@ procedure TImage32.Rotate(angleRads: double); end else begin mat := IdentityMatrix; - MatrixTranslate(mat, Width/2, Height/2); - rec := RectD(Bounds); - rec := GetRotatedRectBounds(rec, angleRads); + // the rotation point isn't important + // because AffineTransformImage() will + // will resize and recenter the image MatrixRotate(mat, NullPointD, angleRads); - MatrixTranslate(mat, rec.Width/2, rec.Height/2); AffineTransformImage(self, mat); end; end; diff --git a/Packages/D12/SVGIconImageList.dproj b/Packages/D12/SVGIconImageList.dproj index 4470375..142fa69 100644 --- a/Packages/D12/SVGIconImageList.dproj +++ b/Packages/D12/SVGIconImageList.dproj @@ -9,6 +9,7 @@ Win32 3 Package + SVGIconImageList true @@ -23,6 +24,11 @@ Base true + + true + Base + true + true Base @@ -49,7 +55,7 @@ false true true - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;System;Xml;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Shell;$(DCC_Namespace) All SVGIconImageList Ethea SVGIconImageList VCL components @@ -59,13 +65,17 @@ true - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) Debug - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) Debug + + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + DEBUG;$(DCC_Define) true @@ -126,10 +136,13 @@ SVGIconImageList.dpk + + True True + False 12 diff --git a/Packages/D12/SVGIconImageListFMX.dproj b/Packages/D12/SVGIconImageListFMX.dproj index 6d2b92e..5b14ac0 100644 --- a/Packages/D12/SVGIconImageListFMX.dproj +++ b/Packages/D12/SVGIconImageListFMX.dproj @@ -9,6 +9,7 @@ Win32 3 Package + SVGIconImageListFMX true @@ -53,6 +54,11 @@ Base true + + true + Base + true + true Base @@ -127,6 +133,11 @@ Debug true + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + DEBUG;$(DCC_Define) true @@ -176,6 +187,8 @@ SVGIconImageListFMX.dpk + + False @@ -187,6 +200,7 @@ False True True + False 12 diff --git a/Packages/D12/SVGImage32Package.dproj b/Packages/D12/SVGImage32Package.dproj index f195fd5..6369412 100644 --- a/Packages/D12/SVGImage32Package.dproj +++ b/Packages/D12/SVGImage32Package.dproj @@ -9,6 +9,7 @@ Win32 3 Package + SVGImage32Package true @@ -18,6 +19,16 @@ Base true + + true + Base + true + + + true + Base + true + true Base @@ -56,6 +67,12 @@ Debug + + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + DEBUG;$(DCC_Define) true @@ -125,10 +142,13 @@ SVGImage32Package.dpk + + True True + False 12 diff --git a/Packages/D12/dclSVGIconImageList.dproj b/Packages/D12/dclSVGIconImageList.dproj index 60cc3ae..e5947ce 100644 --- a/Packages/D12/dclSVGIconImageList.dproj +++ b/Packages/D12/dclSVGIconImageList.dproj @@ -9,6 +9,7 @@ Win32 1 Package + dclSVGIconImageList true @@ -18,6 +19,11 @@ Base true + + true + Base + true + true Base @@ -58,6 +64,13 @@ Debug SVGIconImageList;$(DCC_UsePackage) + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + DEBUG;$(DCC_Define) true @@ -116,6 +129,7 @@ True False + False 12 diff --git a/Packages/D12/dclSVGIconImageListFMX.dproj b/Packages/D12/dclSVGIconImageListFMX.dproj index 6d77731..c203151 100644 --- a/Packages/D12/dclSVGIconImageListFMX.dproj +++ b/Packages/D12/dclSVGIconImageListFMX.dproj @@ -9,6 +9,7 @@ Win32 1 Package + dclSVGIconImageListFMX true @@ -53,6 +54,11 @@ Base true + + true + Base + true + true Base @@ -125,6 +131,11 @@ rtl;$(DCC_UsePackage) + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + DEBUG;$(DCC_Define) true @@ -189,6 +200,7 @@ False True False + False 12 diff --git a/README.htm b/README.htm new file mode 100644 index 0000000..273e9da --- /dev/null +++ b/README.htm @@ -0,0 +1,455 @@ + +

SVGIconImageList License

+

Three engines to render SVG (Delphi Image32, Skia4Delphi, Direct2D wrapper) and four components to simplify use of SVG images (resize, fixedcolor, grayscale…)

+

Actual official version 4.1.3 (VCL+FMX)

+ + + + + + + + + + + + + + + + + + + + + +
ComponentDescription
SVGIconImageCollectionComponentIcon.pngTSVGIconImageCollection is collection of SVG Images for Delphi to provide a centralized list of images for SVGIconVirtualImageLists (only for VCL)
SVGIconVirtualImageListComponentIcon.pngTSVGIconVirtualImageList is a special “virtual” ImageList for Delphi linked to an SVGIconImageCollection (only for VCL) to simplify use of SVG Icons (resize, opacity, grayscale and more…)
SVGIconImageComponentIcon.pngTSVGIconImage is an extended Image component for Delphi (VCL+FMX) to show any SVG image directly or included into a an SVGIconImageList with all functionality (stretch, opacity, grayscale and more…)
SVGIconImageListComponentIcon.pngTSVGIconImageList is an extended ImageList for Delphi (VCL+FMX) with an embedded SVG image collection: the VCL component is deprecated, we recommend to use SVGIconImageCollection + SVGIconVirtualImageList also for older Delphi versions!
+

Very important notice

+

WARNING: From version 4.0, TSVGIconVirtualImageList inherits from TVirtualImageList (using Delphi 10.3 to latest). For previous Delphi versions TSVGIconVirtualImageList inherits from TSVGIconImageListBase.

+

An important difference is that a TVirtualImageList may use and create only a subset of the images in the collection.

+

Although, the standard TVirtualImageList does not have the FixedColor, GrayScale, ApplyToRootOnly and Opacity properties, these properties exist at the TSVGIconImageCollection and they would be reflected on the linked TVirtualImageList, but if you change those properties at collection level, all the VirtualImageList linked changes!

+

For this reasons, now TSVGIconVirtualImageList have also FixedColor, GrayScale, ApplyToRootOnly and Opacity properties, so you can setup those properties only at VirtualImageList level, and you can share the same TSVGIconImageCollection from many VirtualImageList with different poperties, as you can see in the new SVGIconVirtualImageListDemo.

+

So, if you are using those components from Delphi 10.3, the recommended combination should be TSVGIconImageCollection + TSVGIconVirtualImageList.

+

Don't forget also the importance of PreserveItems when you have a large ImageCollection with many linked Actions. Without setting this property to “True”, everytime you add or remove an icon in the collection, you have to check and change the ImageIndex of all the Actions.

+

Another feature available from Delphi 10.4 version, is that TSVGIconImageCollection inherits from TCustomImageCollection, so you can also use it with the TVirtualImage component and place SVG icons into the TControlList component, as explained here…

+

Choose your preferred SVG engine!

+

There are three implementation:

+
    +

  • Native Delphi Image32 (default), uses Image32 library by Angus Johnson

    +
    • +

  • Using Skia4Delphi library, a cross-platform 2D graphics API based on Google's Skia Graphics Library

    +
    • +

  • A wrapper to the native Windows Direct2D implementation

    +
    • +
+

You can read more details here.

+

Performance comparison

+

This table shows the performance of the three rendering engines tested with SVGExplorer, using a significant amount of icons from different sets, rendered at 128x128 pixels.

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
CountIcon setImage32D2DSkia4Delphi
997Font-Awesome1265ms1453ms1172ms
654Papirus2750ms(1)937ms1266ms(1)
5366Material-Design11015ms12001ms10688ms
+

As you can see, the three engines perform differently depending on the icons and their complexity.

+

(1)Notice that Image32 and Skia4Delphi are the only engines capable of rendering blur effect (that is always slow to calculate): this is the reason of “slow” performance to render Papirus icons that contains blur effect.

+

Available from Delphi XE3 to Delphi 12 (VCL and FMX Platforms)

+

Delphi 12 Support

+

Related links: embarcadero.com - learndelphi.org

+

Sample image of VCL version

+

Sample.jpg

+

Sample image of FMX (Windows) version

+

SampleFMX.jpg

+

Sample images of the VCL SVGText-property editor (VCL and FMX)

+

SVGTextPropertyEditor.jpg

+

SVGTextPropertyEditorFMX.jpg

+

UTILITIES

+

The SVG Viewer Demo is useful to check the rendering quality of the engines available.

+

The SVG Icon Explorer utility is useful to explore and preview your svg image collections.

+

You can use SVG Shell Extensions if you want to see your icons directly into Windows Explorer or you want to edit them using a powerful SVG Text Editor.

+

DOCUMENTATION

+

Follow the guide in Wiki section to known how to use those components to modernize your Delphi VCL or FMX Windows applications scalable, colored and beautiful with few lines of code.

+

RELEASE NOTES

+

19 Apr 2024: version 4.1.3 (VCL+FMX)

+
    +
  • Aligned To latest Image32
    • +
  • Fixed compilation with MacOSX
    • +
  • Added support for Delphi 12.1
    • +
+

08 Jan 2024: version 4.1.2 (VCL+FMX)

+
    +
  • Aligned To latest Image32
    • +
  • Added copy SVG to Clipboard into “Export to png” dialog
    • +
  • Updated Copyrights
    • +
+

09 Nov 2023: version 4.1.1 (VCL+FMX)

+
    +
  • Aligned To Skia4Delphi 6.0.0
    • +
  • Added FMX Components to all platform
    • +
  • Fixed Demos for Delphi 12
    • +
  • Added SvgDisableEngineHint option
    • +
+

03 Sep 2023: version 4.1.0 (VCL+FMX)

+
    +
  • Aligned Image32 Library released on 03/09/2023
    • +
  • Fixed demo (removed “obsolete” SVGColor uses)
    • +
+

24 Aug 2023: version 4.0.0 (VCL+FMX)

+
    +
  • Removed old “native” engine TSVG
    • +
  • Updated to Skia4Delphi ver. 6.0.0
    • +
  • TSVGIconVirtualImageList inherits from TVirtualImageList (from D10.3 to actual version).
    • +
  • Added SVGIconVirtualImageListDemo to test multiple TSVGIconVirtualImageList in same form
    • +
  • Added support for Delphi 12
    • +
+

28 Feb 2023: version 3.9.6 (VCL+FMX)

+
    +
  • Updated to Image32 ver. 4.4 (30 Jan 2023)
    • +
  • Updated to Skia4Delphi ver. 4.1.1 (26 Feb 2023)
    • +
+

13 Jan 2023: version 3.9.5 (VCL+FMX)

+
    +
  • Updated Copyright 2023
    • +
  • Updated to Image32 ver. 4.3 (27 Sep 2022)
    • +
  • Updated to Skia4Delphi ver. 4.0.2
    • +
+

23 Oct 2022: version 3.9.4 (VCL+FMX)

+
    +
  • FMX Component editor: changed selection for fixed color
    • +
  • Updated to Image32 ver. 4.3 (27 Sep 2022)
    • +
+

15 Sep 2022: version 3.9.3 (VCL+FMX)

+
    +
  • Removed W11 Styles from Demo (available in Delphi only by Get-it)
    • +
  • Updated D11 packages to Delphi 11.2
    • +
+

28 Aug 2022: version 3.9.2 (VCL+FMX)

+
    +
  • Fixed #240 TSVGGraphic.Assign
    • +
  • Updated to Image32 ver. 4.2 (28 July 2022)
    • +
  • Updated to Skia4Delphi 3.4.1 library
    • +
  • Fixed #241 Alignment from Source and Destination Items (FMX)
    • +
+

21 Jun 2022: version 3.9.1 (VCL+FMX)

+
    +
  • Added support for other Delphi versions (VCL): D10 Seattle
    • +
+

08 May 2022: version 3.8.3 (VCL+FMX)

+
    +
  • Updated to Skia4Delphi 3.4.0 library
    • +
  • SVGExplorer example moved under “Demo” folder
    • +
+

10 Apr 2022: version 3.8.2 (VCL+FMX)

+
    +
  • Updated to Skia4Delphi 3.3.1 llibrary
    • +
  • Updated to Image32 4.11 library
    • +
+

29 Mar 2022: version 3.8.1 (VCL+FMX)

+
    +
  • Fixed Aspect-Ratio for Skia engine
    • +
  • Updated SVGViewer
    • +
  • Updated Demos
    • +
  • Alignment to latest Skia4Delphi version
    • +
+

17 Mar 2022: version 3.8.0 (VCL+FMX)

+
    +
  • Support for Delphi 11.1
    • +
  • Updated Library suffix for Delphi 10.4 and 11 to (auto)
    • +
+

09 Mar 2022: version 3.7.0 (VCL+FMX)

+
    +
  • Support for Skia4Delphi 3.2.0 completed
    • +
  • Removed support for Cairo Engine
    • +
  • Fixed rendering with Image32
    • +
+

28 Feb 2022: version 3.6.0 (VCL + FMX)

+
    +
  • Support for Skia4Delphi also in FMX platforms
    • +
+

26 Feb 2022: version 3.5.2 (VCL+FMX)

+
    +
  • Fixed rendering with FMX-Image32
    • +
+

23 Feb 2022: version 3.5.1 (VCL+FMX)

+
    +
  • Updated Image32 Library to 4.1.0 version
    • +
  • Updated support to Skia4Delphi 3.1.0
    • +
+

19 Feb 2022: version 3.5.0 (VCL+FMX)

+
    +
  • Updated Image32 Library to 4.0.2 version
    • +
  • Updated support to Skia4Delphi 3.0.3
    • +
  • Fixed SVGText Editor
    • +
  • Fixed some Skia4Delphi SVG rendering
    • +
+

14 Feb 2022: version 3.4.0 (VCL+FMX)

+
    +
  • Updated Image32 Library to 4.0.1 version
    • +
  • Added support to Skia4Delphi 3.0
    • +
  • Fixed some Image32 drawing problem
    • +
+

13 Jan 2022: version 3.3.0 (VCL+FMX)

+
    +
  • Updated Image32 library to 4.0.0 version
    • +
  • Added a set of playing cards svg examples
    • +
  • Fixed Image32 drawing problem with “playing cards”
    • +
+

24 Nov 2021: version 3.2.0 (VCL+FMX)

+
    +
  • Component Editors uses IDE themes (light, dark…) and style
    • +
  • Fixed available components into palette when working with mobile platforms
    • +
+

05 Nov 2021: version 3.1.1 (VCL+FMX)

+
    +
  • Fixed Image32 drawing problem in FMX
    • +
  • Added Export to multiple png files to Component Editor
    • +
+

31 Oct 2021: version 3.1.0 (VCL+FMX)

+
    +
  • Updated Image32 library to 3.4.1 version
    • +
  • Added Skia4Delphi engine (not complete)
    • +
+

28 Aug 2021: version 3.0.0 (VCL+FMX)

+
    +
  • Updated Packages for Delphi 11
    • +
  • Updated some documentation (Images and Wiki)
    • +
+

24 Aug 2021: version 2.5.0 (VCL+FMX)

+
    +
  • Aligned to Image32 library ver.3.1
    • +
+

22 Jul 2021: version 2.4.0 (VCL+FMX)

+
    +
  • Updated and aligned to Image32 ver.3 library
    • +
  • Added packages for Delphi 11 Alexandria
    • +
+

18 Jul 2021: version 2.3.1 (VCL+FMX)

+
    +
  • Fixed rendering files with color defined by 8 digits
    • +
+

17 Jul 2021: version 2.3.0 (VCL+FMX)

+
    +
  • Added new engine: Image32 library by Angus Johnson (VCL+FMX)
    • +
  • Image32 is now the default native Delphi engine
    • +
  • Added support for Android and iOS platforms (by Image32 engine)
    • +
  • Added support for backward Delphi versions (from XE3)
    • +
  • Added demo to compare the four engines (SVGViewer)
    • +
  • Fixed rendering “centered” in SVGIconImage for Cairo engine.
    • +
  • Warning: changed TSVGIconImage component ancestor from TCustomControl to TGraphicControl
    • +
+

18 Apr 2021: version 2.2.6 (VCL+FMX)

+
    +
  • Added new ApplyFixedColorToRootOnly property
    • +
  • Added demo for new TControlList component (only for D10.4.2)
    • +
+

22 Feb 2021: version 2.2.5 (VCL+FMX)

+
    +
  • Added export to PNG option into Component editor
    • +
+

23 Jan 2021: version 2.2.4 (VCL+FMX)

+
    +
  • Fixed #156 Stretch for SVGIconImage
    • +
  • Fixed #157 SVGIconImage gets correct image from VirtualImageList
    • +
+

17 Jan 2021: version 2.2.3 (VCL+FMX)

+
    +
  • Fixed #151 Antialiasing problems
    • +
  • Fixed settings of different Width and Height into editor
    • +
  • Fixed preview of icon with different Height and Width into editor
    • +
+

24 Dec 2020: version 2.2.2 (VCL+FMX)

+
    +
  • Added Width, Height and Zoom property for FMX components
    • +
  • Redesigned FMX component editor
    • +
  • Fixed VCL component editor
    • +
+

08 Dec 2020: version 2.2.1 (VCL+FMX)

+
    +
  • Added 64bit platforms for packages
    • +
  • Minor fixes (empty except blocks)
    • +
  • Fixed TSVGIconImage inherited color
    • +
  • Fixed repaint for FMX version
    • +
+

23 Sep 2020: version 2.2.0 (VCL+FMX)

+
    +
  • Added “Cairo” SVG Engine
    • +
  • Added AntialiasColor to perfect antialias effect
    • +
  • Added ImageIndex property editor for SVGIconImage
    • +
  • Added FixedColor and GrayScale to TSVGIconImage component
    • +
+

16 Sep 2020: version 2.1.1 (VCL) 2.1.0 (FMX)

+
    +
  • Fixed issues (#110, #111, #113)
    • +
  • Editing SVG text in editor shows errors without losing content
    • +
+

04 Sep 2020: version 2.1.0 (VCL) 1.5.1 (FMX)

+
    +
  • Added preview for icons when loading svg files
    • +
  • Fixed many issue (#81, #86, #87, #88, #91, #94, #103…)
    • +
  • Refactoring parsing XML to increase performances (using XmlLite)
    • +
+

26 Aug 2020: version 2.0 (VCL) 1.5.0 (FMX)

+
    +
  • Added factory to choose engine
    • +
  • Added interface to use alternative Third-party SVG engine
    • +
  • Redesigned component editor to support Categories for icons
    • +
  • New support for native VirtualImageList (from D10.3)
    • +
  • StoreAsText icons to dfm by default (and unique mode)
    • +
  • Fixed many issues (from #35 to #72) +Take care of TSVGIconVirtualImageList.Collection renamed to SVGIconVirtualImageList.ImageCollection.
    • +
+

17 Aug 2020: version 1.9 (VCL+FMX)

+
    +
  • FixedColor changed from TSVGColor to TColor
    • +
  • Fixed assign FixedColor to icon in component editor
    • +
  • Updated component editor to use TColorBox
    • +
+

13 Aug 2020: version 1.8 (VCL+FMX)

+
    +
  • Complete refactoring for full support of High-DPI
    • +
  • New SVGIconImageCollection component
    • +
  • New SVGIconVirtualImageList component
    • +
  • Redesign of SVGIconImageList component and Component Editor
    • +
  • Demo updated to test multi-monitor with different DPI
    • +
  • Fixed issue #20: Coordinates in double (PaintTo methods)
    • +
  • Fixed issue #25: Transform matrix is wrongly parsed
    • +
  • Fixed issue #26: Error in CalcMartrix
    • +
  • Fixed issue #27: TSVGRadialGradient.ReadIn does not read the gradientTransform matrix
    • +
  • Fixed issue #28: Colors should be reversed in TSVGRadialGradient
    • +
  • Fixed issue #29: Scaling should be based on ViewBox width/height
    • +
  • Fixed issue #31: Empty svg properties cause exceptions
    • +
  • Fixed issue #33: “fill-rule' presentation attribute is not processed
    • +
  • Fixed issue #34: Exception text elements cause exceptions
    • +
+

05 Aug 2020: version 1.7 (VCL+FMX)

+
    +
  • Added DPIChanged method
    • +
  • Enhanced SVGExplorer
    • +
  • Fixed issue #20: replaced Double with Single
    • +
  • Fixed issue #19 and 18#: Load/SaveToStream inefficient and encoding inconsistency
    • +
  • Fixed issue #17: Wrong conversion from pt to px
    • +
  • Fixed issue #14: scaling problem
    • +
  • Fixed issue #11: Incompatible with Drag-Drop of TImageList
    • +
  • Fixed issue #6: Rendering of some SVG images is incorrect
    • +
+

15 July 2020: version 1.6 (VCL+FMX)

+
    +
  • Fixed rendering on TButton! (VCL)
    • +
  • Fixed “Apply” into ImageEditor (VCL)
    • +
  • Added reformat XML to ImageEditor (VCL)
    • +
  • Added utility to explore icons into disk/folder (SVGExplorer)
    • +
  • Fixed inherited color drawing (SVG)
    • +
  • Fixed storing properties into dfm in binary mode (VCL)
    • +
  • Fixed storing for some properties (don't store default values)
    • +
+

13 June 2020: versione 1.5 (VCL+FMX)

+
    +
  • Added support for DisabledGrayScale and DisabledOpacity as in VirtualImageList
    • +
  • Fixed drawing disabled icons also with VCLStyles active
    • +
+

09 June 2020: versione 1.4 (VCL+FMX)

+
    +
  • Added GrayScale and FixedColor to ImageList for every Icons
    • +
  • Added GrayScale and FixedColor for single Icon
    • +
  • Added some complex svg demo images
    • +
  • Updated demos
    • +
+

06 June 2020: version 1.3 (VCL+FMX)

+
    +
  • Added property editor for TSVGIconImage.SVGText and TSVGIconItem.SVGText
    • +
  • Fixed some drawing problems with transform attribute
    • +
  • Fixed rescaling icons when monitor DPI changes
    • +
+

28 May 2020: version 1.2 (VCL+FMX)

+
    +
  • Complete support of Delphi 10.4
    • +
  • Added support for other Delphi versions (VCL): DXE6, DXE8, D10.1
    • +
  • Added position memory of component editor
    • +
  • Fixed Issue: Icon Editor not keeping added icons
    • +
  • Fixed Issue: SVG with exponent notation does not parse correctly and affects image display
    • +
+

25 May 2020: version 1.1 (VCL+FMX)

+
    +
  • Added the component TSVGIconImageListFMX with advanced component editor.
    • +
  • Added the component TSVGIconImageFMX to show SVG into a TImage.
    • +
  • Demos to show how they works.
    • +
  • Very high performance for building hundreds of icons.
    • +
+

24 May 2020: first version 1.0 (VCL)

+
    +
  • Added the component TSVGIconImageList with advanced component editor.
    • +
  • Added the component TSVGIconImage to show SVG into a TImage.
    • +
  • Demos to show how they works.
    • +
  • Very high performance for building hundreds of icons.
    • +
  • Support from Delphi 10.2 to 10.4 Sydney (other Delphi versions coming soon)
    • +
+

THANKS TO

+

These components use the followin libraries:

+
    +
  • SVG library by Martin Walter (Original version (c) 2005, 2008) with license:
    +Use of this file is permitted for commercial and non-commercial. Use, as long as the author is credited.
    +home page: http://www.mwcs.de email: martin.walter@mwcs.de
    +This library is included in the svg folder of this project.
    • +
  • Image32 library by Angus Johnson +These files are included in the Image32/Source and Image32/source/Image32_SVG folders
    • +
  • Skia4Delphi Library by the autohors +These files are included in the Skia4Delphi/Source folder
    • +
+

Many thanks to Vincent Parrett and Kiriakos Vlahos for their great contibution.

+

TSVGIconImageList and TSVGIconImage are similar to TSVGImageList and TSVGImage included into project: https://github.com/ekot1/DelphiSVG.git +but those versions are more efficient in performances, with many fixes added, plus some features like SVGText property, store icons in Text format into dfm, GrayScale and FixedColor, VirtualImageList support and more…

+

TSVGIconImageListFMX and TSVGIconImageFMX are similar to TIconFontsImageListFMX and TIconFontsImage included into similar project made by Ethea for Icon Fonts: https://github.com/EtheaDev/IconFontsImageList

diff --git a/README.md b/README.md index efbbb7a..4ea2b62 100644 --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ ## Three engines to render SVG (Delphi Image32, Skia4Delphi, Direct2D wrapper) and four components to simplify use of SVG images (resize, fixedcolor, grayscale...) -### Actual official version 4.1.2 (VCL+FMX) +### Actual official version 4.1.3 (VCL+FMX) | Component | Description | | - | - | @@ -86,6 +86,11 @@ You can use [SVG Shell Extensions](https://github.com/EtheaDev/SVGShellExtension Follow the [guide in Wiki section](https://github.com/EtheaDev/SVGIconImageList/wiki) to known how to use those components to modernize your Delphi VCL or FMX Windows applications scalable, colored and beautiful with few lines of code. ### RELEASE NOTES +19 Apr 2024: version 4.1.3 (VCL+FMX) +- Aligned To latest Image32 +- Fixed compilation with MacOSX +- Added support for Delphi 12.1 + 08 Jan 2024: version 4.1.2 (VCL+FMX) - Aligned To latest Image32 - Added copy SVG to Clipboard into "Export to png" dialog @@ -100,6 +105,7 @@ Follow the [guide in Wiki section](https://github.com/EtheaDev/SVGIconImageList/ 03 Sep 2023: version 4.1.0 (VCL+FMX) - Aligned Image32 Library released on 03/09/2023 - Fixed demo (removed "obsolete" SVGColor uses) +- Added support for Delphi 12.1 24 Aug 2023: version 4.0.0 (VCL+FMX) - Removed old "native" engine TSVG diff --git a/Source/FMX.SVGIconImageList.pas b/Source/FMX.SVGIconImageList.pas index 5063866..84b06be 100644 --- a/Source/FMX.SVGIconImageList.pas +++ b/Source/FMX.SVGIconImageList.pas @@ -47,7 +47,7 @@ interface ; const - SVGIconImageListVersion = '4.1.2'; + SVGIconImageListVersion = '4.1.3'; DEFAULT_SIZE = 32; ZOOM_DEFAULT = 100; SVG_INHERIT_COLOR = TAlphaColors.Null; diff --git a/Source/Image32SVGFactory.pas b/Source/Image32SVGFactory.pas index bf24c5f..a0fe84d 100644 --- a/Source/Image32SVGFactory.pas +++ b/Source/Image32SVGFactory.pas @@ -166,7 +166,7 @@ procedure TImage32SVG.UpdateSizeInfo(defaultWidth, defaultHeight: integer); //nb: default widths should be the target image's dimensions //since these values will be used for SVG images that simply //specify their widths and heights as percentages - vbox := fSvgReader.GetViewbox(defaultWidth, defaultHeight); + vbox := fSvgReader.RootElement.GetViewbox; FWidth := vbox.Width; FHeight := vbox.Height; end; diff --git a/Source/SVGIconImageListBase.pas b/Source/SVGIconImageListBase.pas index 2b8a68d..d9ef217 100644 --- a/Source/SVGIconImageListBase.pas +++ b/Source/SVGIconImageListBase.pas @@ -48,7 +48,7 @@ interface SvgInterfaces; const - SVGIconImageListVersion = '4.1.2'; + SVGIconImageListVersion = '4.1.3'; DEFAULT_SIZE = 16; type