From 310214fcb4bb7a74c55418f70e2416a7eb50185c Mon Sep 17 00:00:00 2001 From: Carlo Barazzetta Date: Wed, 22 May 2024 18:46:13 +0200 Subject: [PATCH] version 4.1.5 (VCL+FMX) - Fixed TSVGIconImageListBase.Assign - Fixed TSVGIconImageCollection registration for FMX projects - Aligned to Image32 version of 14 May 2024 --- Image32/source/Clipper.Core.pas | 100 ++++++++++++++++++--------- Image32/source/Clipper.Engine.pas | 85 ++++++++++++----------- Image32/source/Clipper.Offset.pas | 102 ++++++++++++++++------------ Image32/source/Clipper.RectClip.pas | 6 +- Image32/source/Clipper.pas | 15 ++-- Image32/source/Img32.Extra.pas | 7 +- Image32/source/Img32.Fmt.BMP.pas | 11 ++- Image32/source/Img32.pas | 43 +++++++----- README.htm | 10 ++- README.md | 9 ++- Source/FMX.SVGIconImageList.pas | 2 +- Source/SVGIconImageListBase.pas | 11 ++- 12 files changed, 238 insertions(+), 163 deletions(-) diff --git a/Image32/source/Clipper.Core.pas b/Image32/source/Clipper.Core.pas index 0a76571..84b7a14 100644 --- a/Image32/source/Clipper.Core.pas +++ b/Image32/source/Clipper.Core.pas @@ -2,7 +2,7 @@ (******************************************************************************* * Author : Angus Johnson * -* Date : 14 February 2024 * +* Date : 3 May 2024 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2010-2024 * * Purpose : Core Clipper Library module * @@ -154,7 +154,8 @@ function IsPositive(const path: TPath64): Boolean; overload; function IsPositive(const path: TPathD): Boolean; overload; {$IFDEF INLINING} inline; {$ENDIF} -function __Trunc(val: double): Int64; {$IFDEF INLINE} inline; {$ENDIF} +function IsCollinear(const pt1, pt2, pt3: TPoint64): Boolean; + {$IFDEF INLINING} inline; {$ENDIF} function CrossProduct(const pt1, pt2, pt3: TPoint64): double; overload; {$IFDEF INLINING} inline; {$ENDIF} @@ -829,6 +830,9 @@ function ScalePath(const path: TPath64; sx, sy: double): TPath64; begin result[i].X := Round(path[i].X * sx); result[i].Y := Round(path[i].Y * sy); +{$IFDEF USINGZ} + result[i].Z := path[i].Z; +{$ENDIF} end; end; //------------------------------------------------------------------------------ @@ -845,10 +849,16 @@ function ScalePath(const path: TPathD; sx, sy: double): TPath64; j := 1; result[0].X := Round(path[0].X * sx); result[0].Y := Round(path[0].Y * sy); +{$IFDEF USINGZ} + result[0].Z := path[0].Z; +{$ENDIF} for i := 1 to len -1 do begin result[j].X := Round(path[i].X * sx); result[j].Y := Round(path[i].Y * sy); +{$IFDEF USINGZ} + result[j].Z := path[i].Z; +{$ENDIF} if (result[j].X <> result[j-1].X) or (result[j].Y <> result[j-1].Y) then inc(j); end; @@ -866,10 +876,16 @@ function ScalePath(const path: TPath64; scale: double): TPath64; j := 1; result[0].X := Round(path[0].X * scale); result[0].Y := Round(path[0].Y * scale); +{$IFDEF USINGZ} + result[0].Z := path[0].Z; +{$ENDIF} for i := 1 to len -1 do begin result[j].X := Round(path[i].X * scale); result[j].Y := Round(path[i].Y * scale); +{$IFDEF USINGZ} + result[j].Z := path[i].Z; +{$ENDIF} if (result[j].X <> result[j-1].X) or (result[j].Y <> result[j-1].Y) then inc(j); end; @@ -887,6 +903,9 @@ function ScalePath(const path: TPathD; scale: double): TPath64; begin result[i].X := Round(path[i].X * scale); result[i].Y := Round(path[i].Y * scale); +{$IFDEF USINGZ} + result[i].Z := path[i].Z; +{$ENDIF} end; end; //------------------------------------------------------------------------------ @@ -926,6 +945,9 @@ function ScalePathD(const path: TPath64; sx, sy: double): TPathD; begin result[i].X := path[i].X * sx; result[i].Y := path[i].Y * sy; +{$IFDEF USINGZ} + result[i].Z := path[i].Z; +{$ENDIF} end; end; //------------------------------------------------------------------------------ @@ -939,6 +961,9 @@ function ScalePathD(const path: TPathD; sx, sy: double): TPathD; begin result[i].X := path[i].X * sx; result[i].Y := path[i].Y * sy; +{$IFDEF USINGZ} + result[i].Z := path[i].Z; +{$ENDIF} end; end; //------------------------------------------------------------------------------ @@ -989,6 +1014,9 @@ function ScalePathsD(const paths: TPaths64; sx, sy: double): TPathsD; begin result[i][j].X := (paths[i][j].X * sx); result[i][j].Y := (paths[i][j].Y * sy); +{$IFDEF USINGZ} + result[i][j].Z := paths[i][j].Z; +{$ENDIF} end; end; end; @@ -1008,6 +1036,9 @@ function ScalePathsD(const paths: TPathsD; sx, sy: double): TPathsD; begin result[i][j].X := paths[i][j].X * sx; result[i][j].Y := paths[i][j].Y * sy; +{$IFDEF USINGZ} + result[i][j].Z := paths[i][j].Z; +{$ENDIF} end; end; end; @@ -1103,6 +1134,9 @@ function Path64(const pathD: TPathD): TPath64; begin Result[i].X := Round(pathD[i].X); Result[i].Y := Round(pathD[i].Y); +{$IFDEF USINGZ} + Result[i].Z := pathD[i].Z; +{$ENDIF} end; end; //------------------------------------------------------------------------------ @@ -1117,6 +1151,9 @@ function PathD(const path: TPath64): TPathD; begin Result[i].X := path[i].X; Result[i].Y := path[i].Y; +{$IFDEF USINGZ} + Result[i].Z := path[i].Z; +{$ENDIF} end; end; //------------------------------------------------------------------------------ @@ -1827,6 +1864,18 @@ function IsPositive(const path: TPathD): Boolean; end; //------------------------------------------------------------------------------ +{$OVERFLOWCHECKS OFF} +function IsCollinear(const pt1, pt2, pt3: TPoint64): Boolean; +var + a,b: Int64; +begin + a := (pt2.X - pt1.X) * (pt3.Y - pt2.Y); + b := (pt2.Y - pt1.Y) * (pt3.X - pt2.X); + result := a = b; +end; +{$OVERFLOWCHECKS ON} +//------------------------------------------------------------------------------ + function CrossProduct(const pt1, pt2, pt3: TPoint64): double; begin result := CrossProduct( @@ -1925,14 +1974,14 @@ function CleanPath(const path: TPath64): TPath64; Result := nil; len := Length(path); while (len > 2) and - (CrossProduct(path[len-2], path[len-1], path[0]) = 0) do dec(len); + (IsCollinear(path[len-2], path[len-1], path[0])) do dec(len); SetLength(Result, len); if (len < 2) then Exit; prev := path[len -1]; j := 0; for i := 0 to len -2 do begin - if CrossProduct(prev, path[i], path[i+1]) = 0 then Continue; + if IsCollinear(prev, path[i], path[i+1]) then Continue; Result[j] := path[i]; inc(j); prev := path[i]; @@ -1942,6 +1991,14 @@ function CleanPath(const path: TPath64): TPath64; end; //------------------------------------------------------------------------------ +function GetSign(const val: double): integer; {$IFDEF INLINING} inline; {$ENDIF} +begin + if val = 0 then Result := 0 + else if val < 0 then Result := -1 + else Result := 1; +end; +//------------------------------------------------------------------------------ + function SegmentsIntersect(const s1a, s1b, s2a, s2b: TPoint64; inclusive: Boolean): boolean; var @@ -1961,38 +2018,14 @@ function SegmentsIntersect(const s1a, s1b, s2a, s2b: TPoint64; (res3 <> 0) or (res4 <> 0); // ensures not collinear end else begin - result := (CrossProduct(s1a, s2a, s2b) * CrossProduct(s1b, s2a, s2b) < 0) and - (CrossProduct(s2a, s1a, s1b) * CrossProduct(s2b, s1a, s1b) < 0); + result := (GetSign(CrossProduct(s1a, s2a, s2b)) * + GetSign(CrossProduct(s1b, s2a, s2b)) < 0) and + (GetSign(CrossProduct(s2a, s1a, s1b)) * + GetSign(CrossProduct(s2b, s1a, s1b)) < 0); end; end; //------------------------------------------------------------------------------ -function __Trunc(val: double): Int64; {$IFDEF INLINE} inline; {$ENDIF} -var - exp: integer; - i64: UInt64 absolute val; -const - shl51: UInt64 = UInt64(1) shl 51; -begin - 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 - begin - Result := ((i64 and $1FFFFFFFFFFFFF) shl (exp - 52)) or (UInt64(1) shl exp) - end else - begin - Result := ((i64 and $1FFFFFFFFFFFFF) shr (52 - exp)) or (UInt64(1) shl exp); - //the following line will round - //if (i64 and (shl51 shr (exp)) <> 0) then inc(Result); - end; - if val < 0 then Result := -Result; -end; -//------------------------------------------------------------------------------ - function GetSegmentIntersectPt(const ln1a, ln1b, ln2a, ln2b: TPoint64; out ip: TPoint64): Boolean; var @@ -2011,6 +2044,9 @@ function GetSegmentIntersectPt(const ln1a, ln1b, ln2a, ln2b: TPoint64; else if t >= 1.0 then ip := ln1b; ip.X := Trunc(ln1a.X + t * dx1); ip.Y := Trunc(ln1a.Y + t * dy1); +{$IFDEF USINGZ} + ip.Z := 0; +{$ENDIF} end; //------------------------------------------------------------------------------ diff --git a/Image32/source/Clipper.Engine.pas b/Image32/source/Clipper.Engine.pas index 26ac220..950e847 100644 --- a/Image32/source/Clipper.Engine.pas +++ b/Image32/source/Clipper.Engine.pas @@ -2,7 +2,7 @@ (******************************************************************************* * Author : Angus Johnson * -* Date : 14 February 2024 * +* Date : 27 April 2024 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2010-2024 * * Purpose : This is the main polygon clipping module * @@ -239,7 +239,7 @@ TClipperBase = class function PopHorz(out e: PActive): Boolean; {$IFDEF INLINING} inline; {$ENDIF} function StartOpenPath(e: PActive; const pt: TPoint64): POutPt; procedure UpdateEdgeIntoAEL(var e: PActive); - function IntersectEdges(e1, e2: PActive; pt: TPoint64): POutPt; + procedure IntersectEdges(e1, e2: PActive; pt: TPoint64); procedure DeleteEdges(var e: PActive); procedure DeleteFromAEL(e: PActive); procedure AdjustCurrXAndCopyToSEL(topY: Int64); @@ -282,12 +282,12 @@ TClipperBase = class function ClearSolutionOnly: Boolean; procedure ExecuteInternal(clipType: TClipType; fillRule: TFillRule; usingPolytree: Boolean); - function BuildPaths(out closedPaths, openPaths: TPaths64): Boolean; + function BuildPaths(var closedPaths, openPaths: TPaths64): Boolean; function BuildTree(polytree: TPolyPathBase; out openPaths: TPaths64): Boolean; {$IFDEF USINGZ} procedure SetZ( e1, e2: PActive; var intersectPt: TPoint64); property ZCallback : TZCallback64 read fZCallback write fZCallback; - property DefaultZ : Int64 READ fDefaultZ write fDefaultZ; + property DefaultZ : Int64 read fDefaultZ write fDefaultZ; {$ENDIF} property Succeeded : Boolean read FSucceeded; public @@ -1462,7 +1462,11 @@ function XYCoordsEqual(const pt1, pt2: TPoint64): Boolean; procedure TClipperBase.SetZ(e1, e2: PActive; var intersectPt: TPoint64); begin - if not Assigned(fZCallback) then Exit; + if not Assigned(fZCallback) then + begin + intersectPt.Z := 0; + Exit; + end; // prioritize subject vertices over clip vertices // and pass the subject vertices before clip vertices in the callback @@ -1834,8 +1838,8 @@ function IsValidAelOrder(resident, newcomer: PActive): Boolean; // resident must also have just been inserted else if IsLeftBound(resident) <> newcomerIsLeft then Result := newcomerIsLeft - else if (CrossProduct(PrevPrevVertex(resident).pt, - resident.bot, resident.top) = 0) then + else if IsCollinear(PrevPrevVertex(resident).pt, + resident.bot, resident.top) then Result := true else // otherwise compare turning direction of the alternate bound @@ -2105,7 +2109,7 @@ procedure TClipperBase.CleanCollinear(outRec: POutRec); // a duplicate point OR // not preserving collinear points OR // is a 180 degree 'spike' - if (CrossProduct(op2.prev.pt, op2.pt, op2.next.pt) = 0) and + if IsCollinear(op2.prev.pt, op2.pt, op2.next.pt) and (PointsEqual(op2.pt,op2.prev.pt) or PointsEqual(op2.pt,op2.next.pt) or not FPreserveCollinear or @@ -2381,7 +2385,7 @@ procedure TClipperBase.CheckJoinLeft(e: PActive; 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; + if not IsCollinear(e.top, pt, prev.top) then Exit; if (e.outrec.idx = prev.outrec.idx) then AddLocalMaxPoly(prev, e, pt) @@ -2413,7 +2417,7 @@ procedure TClipperBase.CheckJoinRight(e: PActive; end else if (e.currX <> next.currX) then Exit; - if (CrossProduct(e.top, pt, next.top) <> 0) then Exit; + if not IsCollinear(e.top, pt, next.top) then Exit; if e.outrec.idx = next.outrec.idx then AddLocalMaxPoly(e, next, pt) else if e.outrec.idx < next.outrec.idx then @@ -2551,14 +2555,13 @@ function FindEdgeWithMatchingLocMin(e: PActive): PActive; {$IFNDEF USINGZ} {$HINTS OFF} {$ENDIF} -function TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64): POutPt; +procedure TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64); var e1WindCnt, e2WindCnt, e1WindCnt2, e2WindCnt2: Integer; e3: PActive; - op2: POutPt; + resultOp, op2: POutPt; begin - Result := nil; - + resultOp := nil; // MANAGE OPEN PATH INTERSECTIONS SEPARATELY ... if FHasOpenPaths and (IsOpen(e1) or IsOpen(e2)) then begin @@ -2583,7 +2586,7 @@ function TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64): POutPt; // toggle contribution ... if IsHotEdge(e1) then begin - Result := AddOutPt(e1, pt); + resultOp := AddOutPt(e1, pt); if IsFront(e1) then e1.outrec.frontE := nil else e1.outrec.backE := nil; @@ -2605,15 +2608,14 @@ function TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64): POutPt; if e1.windDx > 0 then SetSides(e3.outrec, e1, e3) else SetSides(e3.outrec, e3, e1); - Result := e3.outrec.pts; Exit; end else - Result := StartOpenPath(e1, pt); + resultOp := StartOpenPath(e1, pt); end else - Result := StartOpenPath(e1, pt); + resultOp := StartOpenPath(e1, pt); {$IFDEF USINGZ} - SetZ(e1, e2, Result.pt); + SetZ(e1, e2, resultOp.pt); {$ENDIF} Exit; end; @@ -2677,7 +2679,7 @@ function TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64): POutPt; if not (e1WindCnt in [0,1]) or not (e2WindCnt in [0,1]) or (not IsSamePolyType(e1, e2) and (fClipType <> ctXor)) then begin - Result := AddLocalMaxPoly(e1, e2, pt); + resultOp := AddLocalMaxPoly(e1, e2, pt); {$IFDEF USINGZ} if Assigned(Result) then SetZ(e1, e2, Result.pt); {$ENDIF} @@ -2687,7 +2689,7 @@ function TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64): POutPt; // this 'else if' condition isn't strictly needed but // it's sensible to split polygons that ony touch at // a common vertex (not at common edges). - Result := AddLocalMaxPoly(e1, e2, pt); + resultOp := AddLocalMaxPoly(e1, e2, pt); {$IFDEF USINGZ} op2 := AddLocalMinPoly(e1, e2, pt); if Assigned(Result) then SetZ(e1, e2, Result.pt); @@ -2698,7 +2700,7 @@ function TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64): POutPt; end else begin // can't treat as maxima & minima - Result := AddOutPt(e1, pt); + resultOp := AddOutPt(e1, pt); {$IFDEF USINGZ} op2 := AddOutPt(e2, pt); SetZ(e1, e2, Result.pt); @@ -2713,7 +2715,7 @@ function TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64): POutPt; // if one or other edge is 'hot' ... else if IsHotEdge(e1) then begin - Result := AddOutPt(e1, pt); + resultOp := AddOutPt(e1, pt); {$IFDEF USINGZ} SetZ(e1, e2, Result.pt); {$ENDIF} @@ -2721,7 +2723,7 @@ function TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64): POutPt; end else if IsHotEdge(e2) then begin - Result := AddOutPt(e2, pt); + resultOp := AddOutPt(e2, pt); {$IFDEF USINGZ} SetZ(e1, e2, Result.pt); {$ENDIF} @@ -2751,29 +2753,29 @@ function TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64): POutPt; if not IsSamePolyType(e1, e2) then begin - Result := AddLocalMinPoly(e1, e2, pt, false); + resultOp := AddLocalMinPoly(e1, e2, pt, false); {$IFDEF USINGZ} SetZ(e1, e2, Result.pt); {$ENDIF} end else if (e1WindCnt = 1) and (e2WindCnt = 1) then begin - Result := nil; + resultOp := nil; case FClipType of ctIntersection: if (e1WindCnt2 <= 0) or (e2WindCnt2 <= 0) then Exit - else Result := AddLocalMinPoly(e1, e2, pt, false); + else resultOp := AddLocalMinPoly(e1, e2, pt, false); ctUnion: if (e1WindCnt2 <= 0) and (e2WindCnt2 <= 0) then - Result := AddLocalMinPoly(e1, e2, pt, false); + resultOp := AddLocalMinPoly(e1, e2, pt, false); ctDifference: if ((GetPolyType(e1) = ptClip) and (e1WindCnt2 > 0) and (e2WindCnt2 > 0)) or ((GetPolyType(e1) = ptSubject) and (e1WindCnt2 <= 0) and (e2WindCnt2 <= 0)) then - Result := AddLocalMinPoly(e1, e2, pt, false); + resultOp := AddLocalMinPoly(e1, e2, pt, false); else // xOr - Result := AddLocalMinPoly(e1, e2, pt, false); + resultOp := AddLocalMinPoly(e1, e2, pt, false); end; {$IFDEF USINGZ} if assigned(Result) then SetZ(e1, e2, Result.pt); @@ -3665,17 +3667,15 @@ function TClipperBase.DoMaxima(e: PActive): PActive; end; //------------------------------------------------------------------------------ -function TClipperBase.BuildPaths(out closedPaths, openPaths: TPaths64): Boolean; +function TClipperBase.BuildPaths(var closedPaths, openPaths: TPaths64): Boolean; var - i, cntClosed, cntOpen: Integer; + i: Integer; + closedCnt, openCnt: integer; outRec: POutRec; begin + closedCnt := Length(closedPaths); + openCnt := Length(openPaths); try - cntClosed := 0; cntOpen := 0; - SetLength(closedPaths, FOutRecList.Count); - if FHasOpenPaths then - SetLength(openPaths, FOutRecList.Count); - i := 0; while i < FOutRecList.Count do begin @@ -3685,22 +3685,21 @@ function TClipperBase.BuildPaths(out closedPaths, openPaths: TPaths64): Boolean; if outRec.isOpen then begin + SetLength(openPaths, openCnt +1); if BuildPath(outRec.pts, FReverseSolution, - true, openPaths[cntOpen]) then - inc(cntOpen); + true, openPaths[openCnt]) then inc(openCnt); end else begin // nb: CleanCollinear can add to FOutRecList CleanCollinear(outRec); // closed paths should always return a Positive orientation // except when ReverseSolution == true + SetLength(closedPaths, closedCnt +1); if BuildPath(outRec.pts, FReverseSolution, - false, closedPaths[cntClosed]) then - inc(cntClosed); + false, closedPaths[closedCnt]) then + inc(closedCnt); end; end; - SetLength(closedPaths, cntClosed); - SetLength(openPaths, cntOpen); result := true; except result := false; diff --git a/Image32/source/Clipper.Offset.pas b/Image32/source/Clipper.Offset.pas index bf95bf8..3fd9e9a 100644 --- a/Image32/source/Clipper.Offset.pas +++ b/Image32/source/Clipper.Offset.pas @@ -2,7 +2,7 @@ (******************************************************************************* * Author : Angus Johnson * -* Date : 14 March 2024 * +* Date : 17 April 2024 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2010-2024 * * Purpose : Path Offset (Inflate/Shrink) * @@ -41,8 +41,6 @@ TGroup = class endType : TEndType; reversed : Boolean; lowestPathIdx : integer; - areasList : TDoubleArray; - isHoleList : BooleanArray; constructor Create(const pathsIn: TPaths64; jt: TJoinType; et: TEndType); end; @@ -72,12 +70,18 @@ TClipperOffset = class fDeltaCallback64 : TDeltaCallback64; {$IFDEF USINGZ} fZCallback64 : TZCallback64; + procedure ZCB(const bot1, top1, bot2, top2: TPoint64; + var intersectPt: TPoint64); procedure AddPoint(x,y: double; z: Int64); overload; + procedure AddPoint(const pt: TPoint64); overload; + {$IFDEF INLINING} inline; {$ENDIF} + procedure AddPoint(const pt: TPoint64; newZ: Int64); overload; + {$IFDEF INLINING} inline; {$ENDIF} {$ELSE} procedure AddPoint(x,y: double); overload; -{$ENDIF} procedure AddPoint(const pt: TPoint64); overload; {$IFDEF INLINING} inline; {$ENDIF} +{$ENDIF} procedure DoSquare(j, k: Integer); procedure DoBevel(j, k: Integer); procedure DoMiter(j, k: Integer; cosA: Double); @@ -86,7 +90,7 @@ TClipperOffset = class procedure BuildNormals; procedure DoGroupOffset(group: TGroup); - procedure OffsetPolygon(isShrinking: Boolean; area_: double); + procedure OffsetPolygon; procedure OffsetOpenJoined; procedure OffsetOpenPath; function CalcSolutionCapacity: integer; @@ -232,9 +236,7 @@ function UnsafeGet(List: TList; Index: Integer): Pointer; 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; @@ -246,29 +248,13 @@ constructor TGroup.Create(const pathsIn: TPaths64; jt: TJoinType; et: TEndType); 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; + reversed := (lowestPathIdx >= 0) and (Area(pathsIn[lowestPathIdx]) < 0); end else lowestPathIdx := -1; end; @@ -357,7 +343,6 @@ procedure TClipperOffset.DoGroupOffset(group: TGroup); i,j, len, steps: Integer; r, stepsPer360, arcTol: Double; absDelta: double; - isShrinking: Boolean; rec: TRect64; pt0: TPoint64; begin @@ -397,9 +382,6 @@ procedure TClipperOffset.DoGroupOffset(group: TGroup); for i := 0 to High(group.paths) do begin - isShrinking := (group.endType = etPolygon) and - (group.reversed = ((fGroupDelta < 0) = group.isHoleList[i])); - fInPath := group.paths[i]; fNorms := nil; len := Length(fInPath); @@ -450,7 +432,7 @@ procedure TClipperOffset.DoGroupOffset(group: TGroup); BuildNormals; if fEndType = etPolygon then - OffsetPolygon(isShrinking, group.areasList[i]) + OffsetPolygon else if fEndType = etJoined then OffsetOpenJoined else @@ -495,33 +477,26 @@ function TClipperOffset.CalcSolutionCapacity: integer; end; //------------------------------------------------------------------------------ -procedure TClipperOffset.OffsetPolygon(isShrinking: Boolean; area_: double); +procedure TClipperOffset.OffsetPolygon; 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(false, 0); + OffsetPolygon; fInPath := ReversePath(fInPath); // Rebuild normals // BuildNormals; fNorms := ReversePath(fNorms); fNorms := ShiftPath(fNorms, 1); fNorms := NegatePath(fNorms); - OffsetPolygon(true, 0); + OffsetPolygon; end; //------------------------------------------------------------------------------ @@ -647,6 +622,10 @@ procedure TClipperOffset.ExecuteInternal(delta: Double); PreserveCollinear := fPreserveCollinear; // the solution should retain the orientation of the input ReverseSolution := fReverseSolution <> pathsReversed; +{$IFDEF USINGZ} + ZCallback := ZCB; +{$ENDIF} + AddSubject(fSolution); if assigned(fSolutionTree) then Execute(ctUnion, fillRule, fSolutionTree, dummy); @@ -700,6 +679,20 @@ procedure TClipperOffset.Execute(delta: Double; polytree: TPolyTree64); end; //------------------------------------------------------------------------------ +{$IFDEF USINGZ} +procedure TClipperOffset.ZCB(const bot1, top1, bot2, top2: TPoint64; + var intersectPt: TPoint64); +begin + if (bot1.Z <> 0) and + ((bot1.Z = bot2.Z) or (bot1.Z = top2.Z)) then intersectPt.Z := bot1.Z + else if (bot2.Z <> 0) and (bot2.Z = top1.Z) then intersectPt.Z := bot2.Z + else if (top1.Z <> 0) and (top1.Z = top2.Z) then intersectPt.Z := top1.Z + else if Assigned(ZCallback) then + ZCallback(bot1, top1, bot2, top2, intersectPt); +end; +{$ENDIF} +//------------------------------------------------------------------------------ + {$IFDEF USINGZ} procedure TClipperOffset.AddPoint(x,y: double; z: Int64); {$ELSE} @@ -724,15 +717,26 @@ procedure TClipperOffset.AddPoint(x,y: double); end; //------------------------------------------------------------------------------ +{$IFDEF USINGZ} +procedure TClipperOffset.AddPoint(const pt: TPoint64; newZ: Int64); +begin + AddPoint(pt.X, pt.Y, newZ); +end; +//------------------------------------------------------------------------------ + procedure TClipperOffset.AddPoint(const pt: TPoint64); begin -{$IFDEF USINGZ} AddPoint(pt.X, pt.Y, pt.Z); +end; +//------------------------------------------------------------------------------ + {$ELSE} +procedure TClipperOffset.AddPoint(const pt: TPoint64); +begin AddPoint(pt.X, pt.Y); -{$ENDIF} end; //------------------------------------------------------------------------------ +{$ENDIF} function IntersectPoint(const ln1a, ln1b, ln2a, ln2b: TPointD): TPointD; var @@ -984,11 +988,21 @@ procedure TClipperOffset.DoRound(j, k: Integer; angle: double); if (cosA > -0.999) and (sinA * fGroupDelta < 0) then begin // is concave +{$IFDEF USINGZ} + AddPoint(GetPerpendic(fInPath[j], fNorms[k], fGroupDelta), fInPath[j].Z); +{$ELSE} AddPoint(GetPerpendic(fInPath[j], fNorms[k], fGroupDelta)); - // this extra point is the only (simple) way to ensure that - // path reversals are fully cleaned with the trailing clipper - AddPoint(fInPath[j]); // (#405) +{$ENDIF} + // this extra point is the only simple way to ensure that path reversals + // (ie over-shrunk paths) are fully cleaned out with the trailing union op. + // However it's probably safe to skip this whenever an angle is almost flat. + if (cosA < 0.99) then + AddPoint(fInPath[j]); // (#405) +{$IFDEF USINGZ} + AddPoint(GetPerpendic(fInPath[j], fNorms[j], fGroupDelta), fInPath[j].Z); +{$ELSE} AddPoint(GetPerpendic(fInPath[j], fNorms[j], fGroupDelta)); +{$ENDIF} end else if (cosA > 0.999) and (fJoinType <> jtRound) then begin diff --git a/Image32/source/Clipper.RectClip.pas b/Image32/source/Clipper.RectClip.pas index 4e2da7d..8a0cf05 100644 --- a/Image32/source/Clipper.RectClip.pas +++ b/Image32/source/Clipper.RectClip.pas @@ -2,7 +2,7 @@ (******************************************************************************* * Author : Angus Johnson * -* Date : 14 February 2024 * +* Date : 27 April 2024 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2010-2024 * * Purpose : FAST rectangular clipping * @@ -840,7 +840,7 @@ procedure TRectClip64.CheckEdges; op2 := op; repeat - if (CrossProduct(op2.prev.pt, op2.pt, op2.next.pt) = 0) then + if IsCollinear(op2.prev.pt, op2.pt, op2.next.pt) then begin if op2 = op then begin @@ -1082,7 +1082,7 @@ function TRectClip64.GetPath(resultIdx: integer): TPath64; op2 := op.next; while Assigned(op2) and (op2 <> op) do begin - if (CrossProduct(op2.prev.pt, op2.pt, op2.next.pt) = 0) then + if IsCollinear(op2.prev.pt, op2.pt, op2.next.pt) then begin op := op2.prev; op2 := DisposeOp(op2); diff --git a/Image32/source/Clipper.pas b/Image32/source/Clipper.pas index 1c36223..0c2fe87 100644 --- a/Image32/source/Clipper.pas +++ b/Image32/source/Clipper.pas @@ -2,9 +2,9 @@ (******************************************************************************* * Author : Angus Johnson * -* Date : 21 December 2023 * +* Date : 7 May 2024 * * Website : http://www.angusj.com * -* Copyright : Angus Johnson 2010-2023 * +* Copyright : Angus Johnson 2010-2024 * * Purpose : This module provides a simple interface to the Clipper Library * * License : http://www.boost.org/LICENSE_1_0.txt * *******************************************************************************) @@ -42,6 +42,7 @@ interface frNonZero = Clipper.Core.frNonZero; frPositive = Clipper.Core.frPositive; frNegative = Clipper.Core.frNegative; + jtBevel = Clipper.Offset.jtBevel; jtSquare = Clipper.Offset.jtSquare; jtRound = Clipper.Offset.jtRound; jtMiter = Clipper.Offset.jtMiter; @@ -753,9 +754,9 @@ function TrimCollinear(const p: TPath64; isOpenPath: Boolean = false): TPath64; if not isOpenPath then begin while (i < len -1) and - (CrossProduct(p[len -1], p[i], p[i+1]) = 0) do inc(i); + IsCollinear(p[len -1], p[i], p[i+1]) do inc(i); while (i < len -1) and - (CrossProduct(p[len -2], p[len -1], p[i]) = 0) do dec(len); + IsCollinear(p[len -2], p[len -1], p[i]) do dec(len); end; if (len - i < 3) then begin @@ -770,7 +771,7 @@ function TrimCollinear(const p: TPath64; isOpenPath: Boolean = false): TPath64; Result[0] := p[i]; j := 0; for i := i+1 to len -2 do - if CrossProduct(result[j], p[i], p[i+1]) <> 0 then + if not IsCollinear(result[j], p[i], p[i+1]) then begin inc(j); result[j] := p[i]; @@ -781,14 +782,14 @@ function TrimCollinear(const p: TPath64; isOpenPath: Boolean = false): TPath64; inc(j); result[j] := p[len-1]; end - else if CrossProduct(result[j], p[len-1], result[0]) <> 0 then + else if not IsCollinear(result[j], p[len-1], result[0]) then begin inc(j); result[j] := p[len-1]; end else begin while (j > 1) and - (CrossProduct(result[j-1], result[j], result[0]) = 0) do dec(j); + IsCollinear(result[j-1], result[j], result[0]) do dec(j); if j < 2 then j := -1; end; SetLength(Result, j +1); diff --git a/Image32/source/Img32.Extra.pas b/Image32/source/Img32.Extra.pas index b0f5b5d..4e8a576 100644 --- a/Image32/source/Img32.Extra.pas +++ b/Image32/source/Img32.Extra.pas @@ -3,7 +3,7 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.4 * -* Date : 2 May 2024 * +* Date : 11 May 2024 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2024 * * Purpose : Miscellaneous routines that don't belong in other modules. * @@ -646,13 +646,12 @@ procedure HatchBackground(img: TImage32; const rec: TRect; try for i := rec.Top to rec.Bottom -1 do begin - pc := img.PixelRow[i]; - inc(pc, rec.Left); + pc := @img.Pixels[i * img.Width + rec.Left]; hatch := Odd(i div hatchSize); for j := rec.Left to rec.Right -1 do begin if (j + 1) mod hatchSize = 0 then hatch := not hatch; - pc^ := BlendToOpaque(pc^, colors[hatch]); + pc^ := BlendToOpaque(colors[hatch], pc^); inc(pc); end; end; diff --git a/Image32/source/Img32.Fmt.BMP.pas b/Image32/source/Img32.Fmt.BMP.pas index c1c0837..80c1a3e 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 : 28 March 2024 * +* Date : 8 May 2024 * * Website : http://www.angusj.com * -* Copyright : Angus Johnson 2010-2024 * +* Copyright : Angus Johnson 2019-2024 * * Purpose : BMP file format extension for TImage32 * * License : http://www.boost.org/LICENSE_1_0.txt * *******************************************************************************) @@ -729,6 +729,7 @@ procedure StreamWrite24BitImage(img32: TImage32; stream: TStream); pc: PColor32; pb: PByte; begin + //rowSize = img32.Width *3 then rounded up to a multiple of 4 rowSize := GetRowSize(24, img32.Width); delta := rowSize - (img32.Width *3); totalBytes := rowSize * img32.Height; @@ -758,7 +759,6 @@ procedure TImageFormat_BMP.SaveToStream(stream: TStream; UsesAlpha: Boolean; pals: TArrayOfColor32; tmp: TImage32; - writeValue: TTriColor32; begin //write everything except a BMP file header because some streams //(eg resource streams) don't need a file header @@ -825,10 +825,9 @@ procedure TImageFormat_BMP.SaveToStream(stream: TStream; end; 24: begin - bih.bV4V4Compression := BI_BITFIELDS; stream.Write(bih, bih.bV4Size); - writeValue := MakeBitfields; - stream.Write(writeValue, SizeOf(TTriColor32)); + // nb: BI_BITFIELDS only used in 16bpp and 32bpp formats + // See BITMAPINFOHEADER structure StreamWrite24BitImage(tmp, stream); end else diff --git a/Image32/source/Img32.pas b/Image32/source/Img32.pas index 023f8b1..58eddd0 100644 --- a/Image32/source/Img32.pas +++ b/Image32/source/Img32.pas @@ -3,7 +3,7 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.4 * -* Date : 25 April 2024 * +* Date : 7 May 2024 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2024 * * Purpose : The core module of the Image32 library * @@ -1075,7 +1075,7 @@ function Get32bitBitmapInfoHeader(width, height: Integer): TBitmapInfoHeader; Result.biHeight := height; Result.biPlanes := 1; Result.biBitCount := 32; - Result.biSizeImage := width * height * SizeOf(TColor32); + Result.biSizeImage := width * Abs(height) * SizeOf(TColor32); Result.biCompression := BI_RGB; end; //------------------------------------------------------------------------------ @@ -2539,7 +2539,7 @@ procedure TImage32.CopyFromDC(srcDc: HDC; const srcRect: TRect); try RectWidthHeight(srcRect, w,h); SetSize(w, h); - bi := Get32bitBitmapInfoHeader(w, h); + bi := Get32bitBitmapInfoHeader(w, -h); // -h => avoids need to flip image dc := GetDC(0); memDc := CreateCompatibleDC(dc); try @@ -2559,7 +2559,7 @@ procedure TImage32.CopyFromDC(srcDc: HDC; const srcRect: TRect); ReleaseDc(0, dc); end; if IsBlank then SetAlpha(255); - FlipVertical; + //FlipVertical; finally EndUpdate; end; @@ -2586,12 +2586,12 @@ procedure TImage32.CopyToDc(const srcRect: TRect; dstDc: HDC; procedure TImage32.CopyToDc(const srcRect, dstRect: TRect; dstDc: HDC; transparent: Boolean = true); var - i, x,y, wSrc ,hSrc, wDest, hDest: integer; + i, x,y, wSrc ,hSrc, wDest, hDest, wBytes: integer; rec: TRect; bi: TBitmapInfoHeader; bm, oldBm: HBitmap; dibBits: Pointer; - pc: PARGB; + pDst, pSrc: PARGB; memDc: HDC; isTransparent: Boolean; bf: BLENDFUNCTION; @@ -2616,11 +2616,15 @@ procedure TImage32.CopyToDc(const srcRect, dstRect: TRect; try //copy Image to dibBits (with vertical flip) - pc := dibBits; + wBytes := wSrc * SizeOf(TColor32); + pDst := dibBits; + pSrc := PARGB(PixelRow[rec.Bottom -1]); + inc(pSrc, rec.Left); for i := rec.Bottom -1 downto rec.Top do begin - Move(Pixels[i * Width + rec.Left], pc^, wSrc * SizeOf(TColor32)); - inc(pc, wSrc); + Move(pSrc^, pDst^, wBytes); + dec(pSrc, Width); + inc(pDst, wSrc); end; oldBm := SelectObject(memDC, bm); @@ -2628,17 +2632,17 @@ procedure TImage32.CopyToDc(const srcRect, dstRect: TRect; begin //premultiplied alphas are required when alpha blending - pc := dibBits; + pDst := dibBits; for i := 0 to wSrc * hSrc -1 do begin - if pc.A > 0 then + if pDst.A > 0 then begin - pc.R := MulTable[pc.R, pc.A]; - pc.G := MulTable[pc.G, pc.A]; - pc.B := MulTable[pc.B, pc.A]; + pDst.R := MulTable[pDst.R, pDst.A]; + pDst.G := MulTable[pDst.G, pDst.A]; + pDst.B := MulTable[pDst.B, pDst.A]; end else - pc.Color := 0; - inc(pc); + pDst.Color := 0; + inc(pDst); end; bf.BlendOp := AC_SRC_OVER; @@ -2648,10 +2652,13 @@ procedure TImage32.CopyToDc(const srcRect, dstRect: TRect; AlphaBlend(dstDc, x,y, wDest,hDest, memDC, 0,0, wSrc,hSrc, bf); end else if (wDest = wSrc) and (hDest = hSrc) then + begin BitBlt(dstDc, x,y, wSrc, hSrc, memDc, 0,0, SRCCOPY) - else + end else + begin + SetStretchBltMode(dstDc, COLORONCOLOR); StretchBlt(dstDc, x,y, wDest, hDest, memDc, 0,0, wSrc,hSrc, SRCCOPY); - + end; SelectObject(memDC, oldBm); finally DeleteObject(bm); diff --git a/README.htm b/README.htm index 5572321..5ffb9e9 100644 --- a/README.htm +++ b/README.htm @@ -31,7 +31,7 @@

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.4 (VCL+FMX)

+

Actual official version 4.1.5 (VCL+FMX)

@@ -126,7 +126,13 @@

DOCUMENTATION

Other similar library

A similar project made by Ethea for Icon Fonts: https://github.com/EtheaDev/IconFontsImageList

RELEASE NOTES

-

05 Mag 2024: version 4.1.4 (VCL+FMX)

+

22 May 2024: version 4.1.5 (VCL+FMX)

+ +

05 May 2024: version 4.1.4 (VCL+FMX)

diff --git a/README.md b/README.md index 43e6813..8d51851 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.4 (VCL+FMX) +### Actual official version 4.1.5 (VCL+FMX) | Component | Description | | - | - | @@ -90,7 +90,12 @@ Follow the [guide in Wiki section](https://github.com/EtheaDev/SVGIconImageList/ A similar project made by Ethea for Icon Fonts: [https://github.com/EtheaDev/IconFontsImageList](https://github.com/EtheaDev/IconFontsImageList) ### RELEASE NOTES -05 Mag 2024: version 4.1.4 (VCL+FMX) +22 May 2024: version 4.1.5 (VCL+FMX) +- Fixed TSVGIconImageListBase.Assign +- Fixed TSVGIconImageCollection registration for FMX projects +- Aligned to Image32 version of 14 May 2024 + +05 May 2024: version 4.1.4 (VCL+FMX) - Aligned To latest Image32 ver. 4.4 19 Apr 2024: version 4.1.3 (VCL+FMX) diff --git a/Source/FMX.SVGIconImageList.pas b/Source/FMX.SVGIconImageList.pas index f7fd7a0..18718db 100644 --- a/Source/FMX.SVGIconImageList.pas +++ b/Source/FMX.SVGIconImageList.pas @@ -47,7 +47,7 @@ interface ; const - SVGIconImageListVersion = '4.1.4'; + SVGIconImageListVersion = '4.1.5'; DEFAULT_SIZE = 32; ZOOM_DEFAULT = 100; SVG_INHERIT_COLOR = TAlphaColors.Null; diff --git a/Source/SVGIconImageListBase.pas b/Source/SVGIconImageListBase.pas index 5d81348..9b0ed36 100644 --- a/Source/SVGIconImageListBase.pas +++ b/Source/SVGIconImageListBase.pas @@ -48,7 +48,7 @@ interface SvgInterfaces; const - SVGIconImageListVersion = '4.1.4'; + SVGIconImageListVersion = '4.1.5'; DEFAULT_SIZE = 16; type @@ -186,6 +186,15 @@ procedure TSVGIconImageListBase.Assign(Source: TPersistent); FFixedColor := TSVGIconImageListBase(Source).FFixedColor; FAntiAliasColor := TSVGIconImageListBase(Source).FAntiAliasColor; FGrayScale := TSVGIconImageListBase(Source).FGrayScale; + FApplyFixedColorToRootOnly := TSVGIconImageListBase(Source).FApplyFixedColorToRootOnly; + FAntiAliasColor := TSVGIconImageListBase(Source).FAntiAliasColor; + FDisabledGrayScale := TSVGIconImageListBase(Source).FDisabledGrayScale; + FDisabledOpacity := TSVGIconImageListBase(Source).FDisabledOpacity; + {$IFDEF HiDPISupport} + {$IFNDEF D10_4+} + FScaled := TSVGIconImageListBase(Source).FScaled; + {$ENDIF} + {$ENDIF} DoAssign(Source); finally EndUpdate;
Component