diff --git a/Demo/D12/SVGIconImageDemoFMX.dproj b/Demo/D12/SVGIconImageDemoFMX.dproj index 3692da3..5d68256 100644 --- a/Demo/D12/SVGIconImageDemoFMX.dproj +++ b/Demo/D12/SVGIconImageDemoFMX.dproj @@ -1,7 +1,7 @@ - + {811CEEB7-F182-425F-8AF2-F72E50273C4A} - 20.0 + 20.1 FMX SVGIconImageDemoFMX.dpr True @@ -9,6 +9,7 @@ Win32 32785 Application + SVGIconImageDemoFMX true @@ -391,6 +392,16 @@ 1 + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + res\values @@ -411,6 +422,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 @@ -421,6 +492,16 @@ 1 + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + res\drawable @@ -591,6 +672,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 @@ -721,177 +852,201 @@ 0 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + 1 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 1 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + + ..\ 1 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + ..\ + 1 + + + ..\ 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + + + Contents 1 - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + + Contents + 1 + + + Contents 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + + + Contents\Resources 1 - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + + Contents\Resources + 1 + + + Contents\Resources 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + + library\lib\armeabi-v7a 1 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + library\lib\arm64-v8a + 1 + + 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + Contents\MacOS 1 - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + Contents\MacOS 1 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + Contents\MacOS 1 + + 0 + - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + + library\lib\armeabi-v7a 1 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + + + 1 + + + 1 + + 1 - + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 1 - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 1 - + + + ..\ + 1 + - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + ..\ 1 - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + ..\ 1 - + + + 1 + - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - + - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 + ..\$(PROJECTNAME).launchscreen + 64 - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 + ..\$(PROJECTNAME).launchscreen + 64 - + + + 1 + - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + + Assets 1 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + Assets 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + + Assets 1 - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + + Assets 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -901,7 +1056,7 @@ 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -911,7 +1066,7 @@ 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -921,194 +1076,173 @@ 1 - - + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - + - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - - ..\ - 1 - + - ..\ + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - ..\ + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - - 1 - + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + - ..\$(PROJECTNAME).launchscreen - 64 + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 - ..\$(PROJECTNAME).launchscreen - 64 - - - - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - - ..\ - 1 - - - ..\ + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - ..\ + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - - Contents - 1 - - - Contents + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - Contents + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - - Contents\Resources - 1 - - - Contents\Resources + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - Contents\Resources + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - 1 - - - Contents\MacOS + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - Contents\MacOS + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - Contents\MacOS + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - 0 - - - - - library\lib\armeabi-v7a + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - - Assets + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - Assets + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - - Assets + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - Assets + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -1124,6 +1258,7 @@ + True diff --git a/Image32/source/Img32.Draw.pas b/Image32/source/Img32.Draw.pas index 33c261c..0a67f8a 100644 --- a/Image32/source/Img32.Draw.pas +++ b/Image32/source/Img32.Draw.pas @@ -313,10 +313,6 @@ implementation {$ENDIF CPUX86} type - {$IF not declared(NativeInt)} - NativeInt = Integer; - {$IFEND} - {$IFDEF SUPPORTS_POINTERMATH} // Works for Delphi 2009 and newer. For FPC it is a requirement, // otherwise 32bit and 64bit code behave differently for negative @@ -1690,7 +1686,7 @@ function TLinearGradientRenderer.Initialize(targetImage: TImage32): Boolean; fColorsCnt := Ceil(dy + dxdy * (fEndPt.X - fStartPt.X)); MakeColorGradient(fGradientColors, fColorsCnt, fColors); // get a list of perpendicular offsets for each - SetLength(fPerpendicOffsets, ImgWidth); + NewIntegerArray(fPerpendicOffsets, ImgWidth, True); // from an imaginary line that's through fStartPt and perpendicular to // the gradient line, get a list of Y offsets for each X in image width for i := 0 to ImgWidth -1 do @@ -1715,7 +1711,7 @@ function TLinearGradientRenderer.Initialize(targetImage: TImage32): Boolean; fColorsCnt := Ceil(dx + dydx * (fEndPt.Y - fStartPt.Y)); MakeColorGradient(fGradientColors, fColorsCnt, fColors); - SetLength(fPerpendicOffsets, ImgHeight); + NewIntegerArray(fPerpendicOffsets, ImgHeight, True); // from an imaginary line that's through fStartPt and perpendicular to // the gradient line, get a list of X offsets for each Y in image height for i := 0 to ImgHeight -1 do @@ -1926,11 +1922,13 @@ procedure TSvgRadialGradientRenderer.RenderProc(x1, x2, y: integer; alpha: PByte ellipsePt.X := (-qb -qs)/(2 * qa) else ellipsePt.X := (-qb +qs)/(2 * qa); ellipsePt.Y := m * ellipsePt.X + c; - dist := Hypot(pt.X - fFocusPt.X, pt.Y - fFocusPt.Y); - dist2 := Hypot(ellipsePt.X - fFocusPt.X, ellipsePt.Y - fFocusPt.Y); + + // Use sqr'ed distances (Sqrt(a^2+b^2)/Sqrt(x^2+y^2) => Sqrt((a^2+b^2)/(x^2+y^2)) + dist := Sqr(pt.X - fFocusPt.X) + Sqr(pt.Y - fFocusPt.Y); + dist2 := Sqr(ellipsePt.X - fFocusPt.X) + Sqr(ellipsePt.Y - fFocusPt.Y); if dist2 = 0 then q := 1 else - q := dist/ dist2; + q := Sqrt(dist/dist2); end else q := 1; //shouldn't happen :) end; @@ -2109,7 +2107,7 @@ procedure DrawLine(img: TImage32; lines: TPathsD; begin setLength(lines, 1); - setLength(lines[0], 2); + NewPointDArray(lines[0], 2, True); lines[0][0] := pt1; lines[0][1] := pt2; DrawLine(img, lines, lineWidth, color, esRound); @@ -2473,7 +2471,7 @@ procedure DrawPolygon_ClearType(img: TImage32; const polygons: TPathsD; cr.Free; end; ApplyClearType(tmpImg, color, backColor); - img.CopyBlend(tmpImg, tmpImg.Bounds, rec, BlendToAlpha); + img.CopyBlend(tmpImg, tmpImg.Bounds, rec, BlendToAlphaLine); finally tmpImg.Free; end; diff --git a/Image32/source/Img32.Extra.pas b/Image32/source/Img32.Extra.pas index a16ef40..ed7bacf 100644 --- a/Image32/source/Img32.Extra.pas +++ b/Image32/source/Img32.Extra.pas @@ -3,7 +3,7 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.4 * -* Date : 3 July 2024 * +* Date : 26 July 2024 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2024 * * Purpose : Miscellaneous routines that don't belong in other modules. * @@ -538,7 +538,9 @@ procedure DrawShadow(img: TImage32; const polygons: TPathsD; begin rec := GetBounds(polygons); if IsEmptyRect(rec) or (depth < 1) then Exit; - if not ClockwiseRotationIsAnglePositive then angleRads := -angleRads; +{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES} + angleRads := -angleRads; +{$ENDIF} NormalizeAngle(angleRads); GetSinCos(angleRads, y, x); depth := depth * 0.5; @@ -554,7 +556,7 @@ procedure DrawShadow(img: TImage32; const polygons: TPathsD; DrawPolygon(shadowImg, shadowPolys, fillRule, color); FastGaussianBlur(shadowImg, shadowImg.Bounds, blurSize, 1); if cutoutInsideShadow then EraseInsidePaths(shadowImg, polys, fillRule); - img.CopyBlend(shadowImg, shadowImg.Bounds, rec, BlendToAlpha); + img.CopyBlend(shadowImg, shadowImg.Bounds, rec, BlendToAlphaLine); finally shadowImg.Free; end; @@ -590,7 +592,7 @@ procedure DrawGlow(img: TImage32; const polygons: TPathsD; DrawPolygon(glowImg, glowPolys, fillRule, color); FastGaussianBlur(glowImg, glowImg.Bounds, blurRadius, 2); glowImg.ScaleAlpha(4); - img.CopyBlend(glowImg, glowImg.Bounds, rec, BlendToAlpha); + img.CopyBlend(glowImg, glowImg.Bounds, rec, BlendToAlphaLine); finally glowImg.Free; end; @@ -676,7 +678,7 @@ procedure GridBackground(img: TImage32; majorInterval, minorInterval: integer; begin img.Clear(fillColor); w := img.Width; h := img.Height; - SetLength(path, 2); + NewPointDArray(path, 2, True); if minorInterval > 0 then begin x := minorInterval; @@ -895,7 +897,7 @@ procedure RedEyeRemove(img: TImage32; const rect: TRect); path := Ellipse(cutoutRec); radGrad.SetParameters(rect3, clBlack32, clNone32); DrawPolygon(mask, path, frNonZero, radGrad); - cutout.CopyBlend(mask, mask.Bounds, cutout.Bounds, BlendMask); + cutout.CopyBlend(mask, mask.Bounds, cutout.Bounds, BlendMaskLine); // now remove red from the cutout RemoveColor(cutout, clRed32); // finally replace the cutout ... @@ -935,7 +937,7 @@ procedure EraseOutsidePath(img: TImage32; const path: TPathD; try p := TranslatePath(path, -outsideBounds.Left, -outsideBounds.top); DrawPolygon(mask, p, fillRule, clBlack32); - img.CopyBlend(mask, mask.Bounds, outsideBounds, BlendMask); + img.CopyBlend(mask, mask.Bounds, outsideBounds, BlendMaskLine); finally mask.Free; end; @@ -955,7 +957,7 @@ procedure EraseOutsidePaths(img: TImage32; const paths: TPathsD; try pp := TranslatePath(paths, -outsideBounds.Left, -outsideBounds.top); DrawPolygon(mask, pp, fillRule, clBlack32); - img.CopyBlend(mask, mask.Bounds, outsideBounds, BlendMask); + img.CopyBlend(mask, mask.Bounds, outsideBounds, BlendMaskLine); finally mask.Free; end; @@ -986,7 +988,9 @@ procedure Draw3D(img: TImage32; const polygons: TPathsD; begin rec := GetBounds(polygons); if IsEmptyRect(rec) then Exit; - if not ClockwiseRotationIsAnglePositive then angleRads := -angleRads; +{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES} + angleRads := -angleRads; +{$ENDIF} GetSinCos(angleRads, y, x); paths := TranslatePath(polygons, -rec.Left, -rec.Top); RectWidthHeight(rec, w, h); @@ -999,7 +1003,7 @@ procedure Draw3D(img: TImage32; const polygons: TPathsD; EraseInsidePaths(tmp, paths2, fillRule); FastGaussianBlur(tmp, tmp.Bounds, Round(blurRadius), 0); EraseOutsidePaths(tmp, paths, fillRule, tmp.Bounds); - img.CopyBlend(tmp, tmp.Bounds, rec, BlendToAlpha); + img.CopyBlend(tmp, tmp.Bounds, rec, BlendToAlphaLine); end; if GetAlpha(colorDk) > 0 then begin @@ -1008,7 +1012,7 @@ procedure Draw3D(img: TImage32; const polygons: TPathsD; EraseInsidePaths(tmp, paths2, fillRule); FastGaussianBlur(tmp, tmp.Bounds, Round(blurRadius), 0); EraseOutsidePaths(tmp, paths, fillRule, tmp.Bounds); - img.CopyBlend(tmp, tmp.Bounds, rec, BlendToAlpha); + img.CopyBlend(tmp, tmp.Bounds, rec, BlendToAlphaLine); end; finally tmp.Free; @@ -1087,7 +1091,7 @@ function DrawButton(img: TImage32; const pt: TPointD; case buttonShape of bsDiamond: begin - SetLength(Result, 4); + NewPointDArray(Result, 4, True); for i := 0 to 3 do Result[i] := pt; Result[0].X := Result[0].X -radius; Result[1].Y := Result[1].Y -radius; @@ -1198,8 +1202,8 @@ procedure TraceContours(img: TImage32; intensity: integer); begin w := img.Width; h := img.Height; if w * h = 0 then Exit; - SetLength(tmp, w * h); - SetLength(tmp2, w * h); + NewColor32Array(tmp, w * h); + NewColor32Array(tmp2, w * h); s := img.PixelRow[0]; d := @tmp[0]; for j := 0 to h-1 do begin @@ -1750,7 +1754,7 @@ function SimplifyPath(const path: TPathD; end; if highI +1 < minLen then Exit; if not isClosedPath then first := @srArray[0]; - SetLength(Result, highI +1); + NewPointDArray(Result, highI +1, True); for i := 0 to HighI do begin Result[i] := first.pt; @@ -1873,7 +1877,7 @@ function SimplifyPathEx(const path: TPathD; shapeTolerance: double): TPathD; end; if highI < 2 then Exit; - SetLength(Result, highI +1); + NewPointDArray(Result, highI +1, True); for i := 0 to HighI do begin Result[i] := current.pt; @@ -1921,7 +1925,7 @@ function SmoothToCubicBezier(const path: TPathD; len := Length(path); if len < 3 then Exit; - SetLength(Result, len *3 +1); + NewPointDArray(Result, len *3 +1, True); prev := len-1; SetLength(pl, len); SetLength(unitVecs, len); @@ -1994,7 +1998,7 @@ function SmoothToCubicBezier2(const path: TPathD; len := Length(path); if len < 3 then Exit; - SetLength(Result, len *3 +1); + NewPointDArray(Result, len *3 +1); prev := len-1; SetLength(pl, len); SetLength(unitVecs, len); @@ -2091,7 +2095,7 @@ procedure Append(var path: TPathD; const pt: TPointD); len: integer; begin len := Length(path); - SetLength(path, len +1); + SetLengthUninit(path, len +1); path[len] := pt; end; //------------------------------------------------------------------------------ @@ -2239,7 +2243,7 @@ function BoxesForGauss(stdDev, boxCnt: integer): TArrayOfInteger; i, wl, wu, m: integer; wIdeal, mIdeal: double; begin - SetLength(Result, boxCnt); + NewIntegerArray(Result, boxCnt, True); wIdeal := Sqrt((12*stdDev*stdDev/boxCnt)+1); // Ideal averaging filter width wl := Floor(wIdeal); if not Odd(wl) then dec(wl); mIdeal := @@ -2265,7 +2269,7 @@ procedure BoxBlurH(var src, dst: TArrayOfColor32; w,h, stdDev: integer); var i,j, ti, li, ri, re, ovr: integer; fv, val: TWeightedColor; - ce: TColor32; + lastColor: TColor32; begin ovr := Max(0, stdDev - w); for i := 0 to h -1 do @@ -2274,7 +2278,7 @@ procedure BoxBlurH(var src, dst: TArrayOfColor32; w,h, stdDev: integer); li := ti; ri := ti +stdDev; re := ti +w -1; // idx of last pixel in row - ce := src[re]; // color of last pixel in row + lastColor := src[re]; // color of last pixel in row fv.Reset(src[ti]); val.Reset(src[ti], stdDev +1); for j := 0 to stdDev -1 - ovr do @@ -2283,7 +2287,7 @@ procedure BoxBlurH(var src, dst: TArrayOfColor32; w,h, stdDev: integer); for j := 0 to stdDev do begin if ri > re then - val.Add(ce) else + val.Add(lastColor) else val.Add(src[ri]); inc(ri); val.Subtract(fv); @@ -2291,22 +2295,30 @@ procedure BoxBlurH(var src, dst: TArrayOfColor32; w,h, stdDev: integer); dst[ti] := val.Color; inc(ti); end; - for j := stdDev +1 to w - stdDev -1 do + + // Skip "val.Color" calculation if both for-loops are skipped anyway + if (ti <= re) or (w > stdDev*2 + 1) then begin - if ri <= re then + lastColor := val.Color; + for j := stdDev +1 to w - stdDev -1 do begin - val.Add(src[ri]); inc(ri); - val.Subtract(src[li]); inc(li); + if ri <= re then + begin + if val.AddSubtract(src[ri], src[li]) then + lastColor := val.Color; + inc(ri); + inc(li); + end; + dst[ti] := lastColor; inc(ti); + end; + while ti <= re do + begin + if val.AddNoneSubtract(src[li]) then + lastColor := val.Color; + inc(li); + dst[ti] := lastColor; + inc(ti); end; - dst[ti] := val.Color; inc(ti); - end; - while ti <= re do - begin - if ti > re then Break; - val.Add(clNone32); - val.Subtract(src[li]); inc(li); - dst[ti] := val.Color; - inc(ti); end; end; end; @@ -2316,7 +2328,7 @@ procedure BoxBlurV(var src, dst: TArrayOfColor32; w, h, stdDev: integer); var i,j, ti, li, ri, re, ovr: integer; fv, val: TWeightedColor; - ce: TColor32; + lastColor: TColor32; begin ovr := Max(0, stdDev - h); for i := 0 to w -1 do @@ -2325,7 +2337,7 @@ procedure BoxBlurV(var src, dst: TArrayOfColor32; w, h, stdDev: integer); li := ti; ri := ti + stdDev * w; re := ti +w *(h-1); // idx of last pixel in column - ce := src[re]; // color of last pixel in column + lastColor := src[re]; // color of last pixel in column fv.Reset(src[ti]); val.Reset(src[ti], stdDev +1); for j := 0 to stdDev -1 -ovr do @@ -2334,7 +2346,7 @@ procedure BoxBlurV(var src, dst: TArrayOfColor32; w, h, stdDev: integer); for j := 0 to stdDev do begin if ri > re then - val.Add(ce) else + val.Add(lastColor) else val.Add(src[ri]); inc(ri, w); val.Subtract(fv); @@ -2342,21 +2354,30 @@ procedure BoxBlurV(var src, dst: TArrayOfColor32; w, h, stdDev: integer); dst[ti] := val.Color; inc(ti, w); end; - for j := stdDev +1 to h - stdDev -1 do + + // Skip "val.Color" calculation if both for-loops are skipped anyway + if (ti <= re) or (h > stdDev*2 + 1) then begin - if ri <= re then + lastColor := val.Color; + for j := stdDev +1 to h - stdDev -1 do begin - val.Add(src[ri]); inc(ri, w); - val.Subtract(src[li]); inc(li, w); + if ri <= re then + begin + if val.AddSubtract(src[ri], src[li]) then + lastColor := val.Color; + inc(ri, w); + inc(li, w); + end; + dst[ti] := lastColor; inc(ti, w); + end; + while ti <= re do + begin + if val.AddNoneSubtract(src[li]) then + lastColor := val.Color; + inc(li, w); + dst[ti] := lastColor; + inc(ti, w); end; - dst[ti] := val.Color; inc(ti, w); - end; - while ti <= re do - begin - val.Add(clNone32); - val.Subtract(src[li]); inc(li, w); - dst[ti] := val.Color; - inc(ti, w); end; end; end; @@ -2380,8 +2401,8 @@ procedure FastGaussianBlur(img: TImage32; RectWidthHeight(rec2, w, h); if (Min(w, h) < 2) or ((stdDevX < 1) and (stdDevY < 1)) then Exit; len := w * h; - SetLength(src, len); - SetLength(dst, len); + NewColor32Array(src, len, True); // content is overwritten in BoxBlurH + NewColor32Array(dst, len, True); if blurFullImage then begin // copy the entire image into 'dst' diff --git a/Image32/source/Img32.Fmt.QOI.pas b/Image32/source/Img32.Fmt.QOI.pas index 3f5363c..303ffe4 100644 --- a/Image32/source/Img32.Fmt.QOI.pas +++ b/Image32/source/Img32.Fmt.QOI.pas @@ -132,7 +132,7 @@ function TImageFormat_QOI.LoadFromStream(stream: TStream; inc(src, stream.Position); end else begin - SetLength(srcTmp, size); + NewByteArray(srcTmp, size, True); stream.Read(srcTmp[0], size); src := @srcTmp[0]; end; diff --git a/Image32/source/Img32.Layers.pas b/Image32/source/Img32.Layers.pas index 6d351a7..4af414f 100644 --- a/Image32/source/Img32.Layers.pas +++ b/Image32/source/Img32.Layers.pas @@ -3,7 +3,7 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.5 * -* Date : 3 July 2024 * +* Date : 26 July 2024 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2024 * * Purpose : Layered images support * @@ -1259,7 +1259,7 @@ procedure TLayer32.Merge(hideDesigners: Boolean; updateRect: TRect); TranslateRect(rec2, Floor(childLayer.fOuterMargin -childLayer.Left -fOuterMargin), Floor(childLayer.fOuterMargin -childLayer.Top -fOuterMargin)); - childImg2.CopyBlend(fClipImage, rec, rec2, BlendMask); + childImg2.CopyBlend(fClipImage, rec, rec2, BlendMaskLine); end; end else childImg2 := childImg; @@ -1905,8 +1905,9 @@ procedure TRotatingGroupLayer32.Init(const rec: TRect; rec2: TRectD; begin //startingZeroOffset: default = 0 (ie 3 o'clock) - if not ClockwiseRotationIsAnglePositive then +{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES} startingZeroOffset := -startingZeroOffset; +{$ENDIF} fZeroOffset := startingZeroOffset; if buttonSize <= 0 then buttonSize := DefaultButtonSize; @@ -2376,7 +2377,7 @@ function GetRectEdgeMidPoints(const rec: TRectD): TPathD; mp: TPointD; begin mp := MidPoint(rec); - SetLength(Result, 4); + NewPointDArray(Result, 4, True); Result[0] := PointD(mp.X, rec.Top); Result[1] := PointD(rec.Right, mp.Y); Result[2] := PointD(mp.X, rec.Bottom); @@ -2461,7 +2462,7 @@ function UpdateSizingButtonGroup(movedButton: TLayer32): TRect; group := TSizingGroupLayer32(movedButton.Parent); with group do begin - SetLength(path, ChildCount); + NewPointDArray(path, ChildCount, True); for i := 0 to ChildCount -1 do path[i] := Child[i].MidPoint; end; diff --git a/Image32/source/Img32.Resamplers.pas b/Image32/source/Img32.Resamplers.pas index 0a691f3..94d3482 100644 --- a/Image32/source/Img32.Resamplers.pas +++ b/Image32/source/Img32.Resamplers.pas @@ -741,13 +741,13 @@ procedure BoxDownSampling(Image, TargetImage: TImage32; newWidth, newHeight: Int sx,sy: double; tmp: TArrayOfColor32; pc: PColor32; - scaledX: array of Integer; + scaledX: TArrayOfInteger; begin sx := Image.Width/newWidth * 256; sy := Image.Height/newHeight * 256; - SetLength(tmp, newWidth * newHeight); + NewColor32Array(tmp, newWidth * newHeight, True); - SetLength(scaledX, newWidth +1); //+1 for fractional overrun + NewIntegerArray(scaledX, newWidth, True); for x := 0 to newWidth -1 do scaledX[x] := Round((x+1) * sx); @@ -794,13 +794,13 @@ procedure NearestNeighborResize(Image, TargetImage: TImage32; newWidth, newHeigh if TargetImage <> Image then TargetImage.Assign(Image); Exit; end; - SetLength(tmp, newWidth * newHeight); + NewColor32Array(tmp, newWidth * newHeight, True); //get scaled X & Y values once only (storing them in lookup arrays) ... - SetLength(scaledXi, newWidth); + NewIntegerArray(scaledXi, newWidth, True); for x := 0 to newWidth -1 do scaledXi[x] := Trunc(x * Image.Width / newWidth); - SetLength(scaledYi, newHeight); + NewIntegerArray(scaledYi, newHeight, True); for y := 0 to newHeight -1 do scaledYi[y] := Trunc(y * Image.Height / newHeight); diff --git a/Image32/source/Img32.SVG.Path.pas b/Image32/source/Img32.SVG.Path.pas index 7941f87..99f01f0 100644 --- a/Image32/source/Img32.SVG.Path.pas +++ b/Image32/source/Img32.SVG.Path.pas @@ -56,6 +56,7 @@ TSvgPathSeg = class fCtrlPts : TPathD; fExtend : integer; protected + procedure Changed; {$IFDEF INLINE} inline; {$ENDIF} function GetFlattened: TPathD; virtual; procedure GetFlattenedInternal; virtual; abstract; procedure Scale(value: double); virtual; @@ -410,14 +411,14 @@ procedure TSvgPathSeg.Scale(value: double); begin fCtrlPts := ScalePath(fCtrlPts, value); fFirstPt := ScalePoint(fFirstPt, value); + Changed; end; end; //------------------------------------------------------------------------------ function TSvgPathSeg.DescaleAndOffset(const pt: TPointD): TPointD; begin - Result := pt; - TranslatePoint(Result, -parent.PathOffset.X, -parent.PathOffset.Y); + Result := TranslatePoint(pt, -parent.PathOffset.X, -parent.PathOffset.Y); Result := ScalePoint(Result, 1/Owner.Scale); end; //------------------------------------------------------------------------------ @@ -433,12 +434,14 @@ procedure TSvgPathSeg.Offset(dx, dy: double); begin fFirstPt := TranslatePoint(fFirstPt, dx, dy); fCtrlPts := TranslatePath(fCtrlPts, dx, dy); + Changed; end; //------------------------------------------------------------------------------ procedure TSvgPathSeg.SetCtrlPts(const pts: TPathD); begin fCtrlPts := pts; + Changed; end; //------------------------------------------------------------------------------ @@ -458,9 +461,17 @@ function TSvgPathSeg.GetCtrlBounds: TRectD; end; //------------------------------------------------------------------------------ +procedure TSvgPathSeg.Changed; +begin + if fFlatPath <> nil then + fFlatPath := nil; // DynArrayClear +end; +//------------------------------------------------------------------------------ + function TSvgPathSeg.GetFlattened: TPathD; begin - GetFlattenedInternal; + if fFlatPath = nil then + GetFlattenedInternal; Result := fFlatPath; end; //------------------------------------------------------------------------------ @@ -502,9 +513,13 @@ function TSvgCurvedSeg.GetFlattened: TPathD; //if the image has been rendered previously at a lower resolution, then //redo the flattening otherwise curves my look very rough. if (pendingScale < Parent.fPendingScale) then + begin pendingScale := Parent.fPendingScale; + Changed; + end; - GetFlattenedInternal; + if fFlatPath = nil then + GetFlattenedInternal; Result := fFlatPath; end; //------------------------------------------------------------------------------ @@ -567,6 +582,7 @@ procedure TSvgASegment.SetArcInfo(ai: TArcInfo); end; end; SetCtrlPtsFromArcInfo; + Changed; end; //------------------------------------------------------------------------------ @@ -610,13 +626,14 @@ procedure TSvgASegment.GetRectBtnPoints(out pt1, pt2, pt3: TPointD); procedure TSvgASegment.SetCtrlPtsFromArcInfo; begin - SetLength(fCtrlPts, 5); + NewPointDArray(fCtrlPts, 5, True); with fArcInfo do begin fCtrlPts[0] := startPos; GetRectBtnPoints(fCtrlPts[1], fCtrlPts[2], fCtrlPts[3]); fCtrlPts[4] := endPos; end; + Changed; end; //------------------------------------------------------------------------------ @@ -660,12 +677,13 @@ function TSvgASegment.GetEndAngle: double; procedure TSvgASegment.ReverseArc; begin fArcInfo.sweepClockW := not fArcInfo.sweepClockW; + Changed; end; //------------------------------------------------------------------------------ procedure TSvgASegment.Offset(dx, dy: double); begin - inherited; + inherited; // calls Changed with fArcInfo do begin TranslateRect(rec, dx, dy); @@ -678,7 +696,7 @@ procedure TSvgASegment.Offset(dx, dy: double); procedure TSvgASegment.Scale(value: Double); begin if (value = 0) or (value = 1) then Exit; - inherited; + inherited; // calls Changed with fArcInfo do begin rec := ScaleRect(rec, value); @@ -690,7 +708,7 @@ procedure TSvgASegment.Scale(value: Double); procedure TSvgASegment.SetCtrlPts(const ctrlPts: TPathD); begin - //SetCtrlPtsFromArcInfo; + //SetCtrlPtsFromArcInfo; // calls Changed end; //------------------------------------------------------------------------------ @@ -753,7 +771,7 @@ function TSvgCSegment.GetOnPathCtrlPts: TPathD; i, len: integer; begin len := Length(fCtrlPts) div 3; - SetLength(Result, len); + NewPointDArray(Result, len, True); for i := 0 to High(Result) do Result[i] := fCtrlPts[i*3 +2]; end; @@ -872,7 +890,7 @@ function TSvgQSegment.GetOnPathCtrlPts: TPathD; i, len: integer; begin len := Length(fCtrlPts) div 2; - SetLength(Result, len); + NewPointDArray(Result, len, True); for i := 0 to High(Result) do Result[i] := fCtrlPts[i*2+1]; end; @@ -937,7 +955,7 @@ function TSvgSSegment.GetOnPathCtrlPts: TPathD; i, len: integer; begin len := Length(fCtrlPts) div 2; - SetLength(Result, len); + NewPointDArray(Result, len, True); for i := 0 to High(Result) do Result[i] := fCtrlPts[i*2+1]; end; @@ -1073,13 +1091,17 @@ function TSvgZSegment.GetStringDef(relative: Boolean; function TSvgSubPath.GetFlattenedPath(pendingScale: double): TPathD; var i: integer; + flattenedPaths: TPathsD; begin if pendingScale <= 0 then pendingScale := 1.0; if (pendingScale > fPendingScale) then fPendingScale := pendingScale; + Result := nil; + SetLength(flattenedPaths, Length(fSegs)); for i := 0 to High(fSegs) do - AppendPath(Result, fSegs[i].GetFlattened); + flattenedPaths[i] := fSegs[i].GetFlattened; + ConcatPaths(Result, flattenedPaths); end; //------------------------------------------------------------------------------ @@ -1102,6 +1124,7 @@ function TSvgSubPath.AddSeg(segType: TSvgPathSegType; end; fSegs[i] := Result; Result.fCtrlPts := pts; + Result.fFlatPath := nil; if Result is TSvgCurvedSeg then TSvgCurvedSeg(Result).pendingScale := fPendingScale; end; @@ -1125,7 +1148,7 @@ function TSvgSubPath.AddASeg(const startPt, endPt: TPointD; const rect: TRectD; rectAngle := angle; sweepClockW := isClockwise; end; - Result.SetCtrlPtsFromArcInfo; + Result.SetCtrlPtsFromArcInfo; // calls Changed end; //------------------------------------------------------------------------------ @@ -1179,7 +1202,7 @@ function TSvgSubPath.AddZSeg(const endPt, firstPt: TPointD): TSvgZSegment; SetLength(fSegs, i+1); Result := TSvgZSegment.Create(self, i, endPt); fSegs[i] := Result; - SetLength(Result.fCtrlPts, 1); + NewPointDArray(Result.fCtrlPts, 1, True); Result.fCtrlPts[0] := firstPt; isClosed := true; end; @@ -1213,7 +1236,7 @@ function TSvgSubPath.GetSimplePath: TPathD; var i: integer; begin - Result := Img32.Vector.MakePath([GetFirstPt.X, GetFirstPt.Y]); + Result := Img32.Vector.MakePath(GetFirstPt); for i := 0 to High(fSegs) do AppendPath(Result, fSegs[i].GetOnPathCtrlPts); end; @@ -1390,7 +1413,7 @@ procedure TSvgPath.Parse(const value: UTF8String); if ptCnt = ptCap then begin inc(ptCap, 8); - setLength(pts, ptCap); + SetLengthUninit(pts, ptCap); end; pts[ptCnt] := pt; inc(ptCnt); diff --git a/Image32/source/Img32.SVG.Reader.pas b/Image32/source/Img32.SVG.Reader.pas index b662b2f..f4cac4f 100644 --- a/Image32/source/Img32.SVG.Reader.pas +++ b/Image32/source/Img32.SVG.Reader.pas @@ -89,7 +89,7 @@ TBaseElement = class //GetRelFracLimit: ie when to assume untyped vals are relative vals function GetRelFracLimit: double; virtual; procedure Draw(image: TImage32; drawDat: TDrawData); virtual; - procedure DrawChildren(image: TImage32; drawDat: TDrawData); virtual; + procedure DrawChildren(image: TImage32; const drawDat: TDrawData); public constructor Create(parent: TBaseElement; svgEl: TSvgTreeEl); virtual; destructor Destroy; override; @@ -845,7 +845,7 @@ function MatrixApply(const paths: TPathsD; const matrix: TMatrixD): TPathsD; ove for i := 0 to len -1 do begin len2 := Length(paths[i]); - SetLength(Result[i], len2); + NewPointDArray(Result[i], len2, True); if len2 = 0 then Continue; pp := @paths[i][0]; rr := @Result[i][0]; @@ -1017,7 +1017,7 @@ procedure TGroupElement.Draw(image: TImage32; drawDat: TDrawData); EraseOutsidePaths(tmpImg, clipPaths, frNonZero, clipRec) else EraseOutsidePaths(tmpImg, clipPaths, fDrawData.fillRule, clipRec); end; - image.CopyBlend(tmpImg, clipRec, clipRec, BlendToAlpha); + image.CopyBlend(tmpImg, clipRec, clipRec, BlendToAlphaLine); finally tmpImg.Free; end; @@ -1035,7 +1035,7 @@ procedure TGroupElement.Draw(image: TImage32; drawDat: TDrawData); try DrawChildren(tmpImg, drawDat); TMaskElement(maskEl).ApplyMask(tmpImg, drawDat); - image.CopyBlend(tmpImg, clipRec, clipRec, BlendToAlpha); + image.CopyBlend(tmpImg, clipRec, clipRec, BlendToAlphaLine); finally tmpImg.Free; end; @@ -1234,7 +1234,7 @@ procedure TMaskElement.ApplyMask(img: TImage32; const drawDat: TDrawData); tmpImg := TImage32.Create(img.Width, img.Height); try DrawChildren(tmpImg, drawDat); - img.CopyBlend(tmpImg, maskRec, maskRec, BlendBlueChannel); + img.CopyBlend(tmpImg, maskRec, maskRec, BlendBlueChannelLine); finally tmpImg.Free; end; @@ -1832,8 +1832,8 @@ procedure TFeBlendElement.Apply; srcImg2 := pfe.GetNamedImage(in2); srcRec2 := GetBounds(srcImg2); - dstImg2.CopyBlend(srcImg2, srcRec2, dstRec2, BlendToAlpha); - dstImg2.CopyBlend(srcImg, srcRec, dstRec2, BlendToAlpha); + dstImg2.CopyBlend(srcImg2, srcRec2, dstRec2, BlendToAlphaLine); + dstImg2.CopyBlend(srcImg, srcRec, dstRec2, BlendToAlphaLine); if dstImg = srcImg then dstImg.Copy(dstImg2, dstRec2, dstRec); end; @@ -1942,24 +1942,24 @@ procedure TFeCompositeElement.Apply; coIn: begin dstImg2.Copy(srcImg, srcRec, dstRec2); - dstImg2.CopyBlend(srcImg2, srcRec2, dstRec2, BlendMask); + dstImg2.CopyBlend(srcImg2, srcRec2, dstRec2, BlendMaskLine); end; coOut: begin dstImg2.Copy(srcImg, srcRec, dstRec2); - dstImg2.CopyBlend(srcImg2, srcRec2, dstRec2, BlendInvertedMask); + dstImg2.CopyBlend(srcImg2, srcRec2, dstRec2, BlendInvertedMaskLine); end; coAtop: begin dstImg2.Copy(srcImg2, srcRec2, dstRec2); - dstImg2.CopyBlend(srcImg, srcRec, dstRec2, BlendToAlpha); - dstImg2.CopyBlend(srcImg2, srcRec2, dstRec2, BlendMask); + dstImg2.CopyBlend(srcImg, srcRec, dstRec2, BlendToAlphaLine); + dstImg2.CopyBlend(srcImg2, srcRec2, dstRec2, BlendMaskLine); end; coXOR: begin dstImg2.Copy(srcImg2, srcRec2, dstRec2); - dstImg2.CopyBlend(srcImg, srcRec, dstRec2, BlendToAlpha); - dstImg2.CopyBlend(srcImg2, srcRec2, dstRec2, BlendInvertedMask); + dstImg2.CopyBlend(srcImg, srcRec, dstRec2, BlendToAlphaLine); + dstImg2.CopyBlend(srcImg2, srcRec2, dstRec2, BlendInvertedMaskLine); end; coArithmetic: begin @@ -1968,8 +1968,8 @@ procedure TFeCompositeElement.Apply; end; else //coOver begin - dstImg2.CopyBlend(srcImg2, srcRec2, dstRec2, BlendToAlpha); - dstImg2.CopyBlend(srcImg, srcRec, dstRec2, BlendToAlpha); + dstImg2.CopyBlend(srcImg2, srcRec2, dstRec2, BlendToAlphaLine); + dstImg2.CopyBlend(srcImg, srcRec, dstRec2, BlendToAlphaLine); end; end; if (dstImg <> dstImg2) then @@ -2075,7 +2075,7 @@ procedure TFeDropShadowElement.Apply; if stdDev > 0 then FastGaussianBlur(dstImg, dstRec, Ceil(stdDev *0.75 * ParentFilterEl.fScale) , 1); - dstImg.CopyBlend(dropShadImg, dropShadImg.Bounds, dstRec, BlendToAlpha); + dstImg.CopyBlend(dropShadImg, dropShadImg.Bounds, dstRec, BlendToAlphaLine); end; //------------------------------------------------------------------------------ @@ -2142,7 +2142,7 @@ procedure TFeMergeElement.Apply; begin if not GetSrcAndDst then Continue; if Assigned(tmpImg) then - tmpImg.CopyBlend(srcImg, srcRec, tmpImg.Bounds, BlendToAlpha) + tmpImg.CopyBlend(srcImg, srcRec, tmpImg.Bounds, BlendToAlphaLine) else if srcImg = pfe.fSrcImg then tmpImg := pfe.GetNamedImage(SourceImage) else @@ -2396,7 +2396,7 @@ procedure TShapeElement.Draw(image: TImage32; drawDat: TDrawData); end; if usingTempImage and (img <> image) then - image.CopyBlend(img, clipRec2, clipRec2, BlendToAlpha); + image.CopyBlend(img, clipRec2, clipRec2, BlendToAlphaLine); //todo: enable "paint-order" to change filled/stroked/marker paint order if HasMarkers then DrawMarkers(img, drawDat); @@ -2804,7 +2804,7 @@ procedure TPolyElement.ParsePoints(const value: UTF8String); constructor TLineElement.Create(parent: TBaseElement; svgEl: TSvgTreeEl); begin inherited; - SetLength(path, 2); + NewPointDArray(path, 2, True); path[0] := NullPointD; path[1] := NullPointD; end; //------------------------------------------------------------------------------ @@ -3502,7 +3502,7 @@ procedure TMarkerElement.Draw(img: TImage32; drawDat: TDrawData); procedure TMarkerElement.SetEndPoint(const pt: TPointD; angle: double); begin - SetLength(fPoints, 1); + NewPointDArray(fPoints, 1, True); fPoints[0] := pt; self.angle := angle; end; @@ -3723,7 +3723,7 @@ procedure TBaseElement.Draw(image: TImage32; drawDat: TDrawData); end; //------------------------------------------------------------------------------ -procedure TBaseElement.DrawChildren(image: TImage32; drawDat: TDrawData); +procedure TBaseElement.DrawChildren(image: TImage32; const drawDat: TDrawData); var i: integer; begin diff --git a/Image32/source/Img32.Transform.pas b/Image32/source/Img32.Transform.pas index b64fbc0..3177386 100644 --- a/Image32/source/Img32.Transform.pas +++ b/Image32/source/Img32.Transform.pas @@ -3,7 +3,7 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.4 * -* Date : 17 July 2024 * +* Date : 11 August 2024 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2024 * * Purpose : Affine and projective transformation routines for TImage32 * @@ -22,7 +22,9 @@ interface //Matrix functions function IsIdentityMatrix(const matrix: TMatrixD): Boolean; - function IsValidMatrix(const matrix: TMatrixD): Boolean; {$IFDEF INLINE} inline; {$ENDIF} + {$IFDEF INLINE} inline; {$ENDIF} + function IsValidMatrix(const matrix: TMatrixD): Boolean; + {$IFDEF INLINE} inline; {$ENDIF} function Matrix(const m00, m01, m02, m10, m11, m12, m20, m21, m22: double): TMatrixD; function MatrixDeterminant(const matrix: TMatrixD): double; function MatrixAdjugate(const matrix: TMatrixD): TMatrixD; @@ -112,6 +114,8 @@ interface procedure Subtract(c: TColor32); overload; {$IFDEF INLINE} inline; {$ENDIF} procedure Subtract(const other: TWeightedColor); overload; {$IFDEF INLINE} inline; {$ENDIF} + function AddSubtract(addC, subC: TColor32): Boolean; {$IFDEF INLINE} inline; {$ENDIF} + function AddNoneSubtract(c: TColor32): Boolean; {$IFDEF INLINE} inline; {$ENDIF} procedure AddWeight(w: Integer); {$IFDEF INLINE} inline; {$ENDIF} property AddCount: Integer read fAddCount; property Color: TColor32 read GetColor; @@ -130,7 +134,7 @@ implementation rsInvalidScale = 'Invalid matrix scaling factor (0)'; const - DivOneByXTableSize = 65536; + DivOneByXTableSize = 1024; {$IFDEF CPUX86} // Use faster Trunc for x86 code in this unit. @@ -146,16 +150,10 @@ implementation //------------------------------------------------------------------------------ function IsIdentityMatrix(const matrix: TMatrixD): Boolean; -var - i,j: integer; -const - matVal: array [boolean] of double = (0.0, 1.0); begin - result := false; - for i := 0 to 2 do - for j := 0 to 2 do - if matrix[i][j] <> matVal[j=i] then Exit; - Result := true; + result := (matrix[0,0] = 1) and (matrix[0,1] = 0) and (matrix[0,2] = 0) and + (matrix[1,0] = 0) and (matrix[1,1] = 1) and (matrix[1,2] = 0) and + (matrix[2,0] = 0) and (matrix[2,1] = 0) and (matrix[2,2] = 1); end; //------------------------------------------------------------------------------ @@ -367,17 +365,19 @@ procedure MatrixScale(var matrix: TMatrixD; scale: double); end; //------------------------------------------------------------------------------ -procedure MatrixRotate(var matrix: TMatrixD; const center: TPointD; angRad: double); +procedure MatrixRotate(var matrix: TMatrixD; + const center: TPointD; angRad: double); var m: TMatrixD; sinA, cosA: double; begin - if (center.X <> 0) or (center.Y <> 0) then + if not PointsEqual(center, NullPointD) then begin NormalizeAngle(angRad); if angRad = 0 then Exit; - if ClockwiseRotationIsAnglePositive then - angRad := -angRad; //negated angle because of inverted Y-axis. +{$IFNDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES} + angRad := -angRad; //negated angle because of inverted Y-axis. +{$ENDIF} m := IdentityMatrix; MatrixTranslate(matrix, -center.X, -center.Y); GetSinCos(angRad, sinA, cosA); @@ -386,9 +386,9 @@ procedure MatrixRotate(var matrix: TMatrixD; const center: TPointD; angRad: doub m[0, 1] := -sinA; m[1, 1] := cosA; MatrixMultiply(matrix, m); MatrixTranslate(matrix, center.X, center.Y); - end else - MatrixRotate(matrix, angRad); - + end + else + MatrixRotate(matrix, angRad) end; //------------------------------------------------------------------------------ @@ -399,8 +399,9 @@ procedure MatrixRotate(var matrix: TMatrixD; angRad: double); begin NormalizeAngle(angRad); if angRad = 0 then Exit; - if ClockwiseRotationIsAnglePositive then +{$IFNDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES} angRad := -angRad; //negated angle because of inverted Y-axis. +{$ENDIF} m := IdentityMatrix; GetSinCos(angRad, sinA, cosA); m := IdentityMatrix; @@ -519,15 +520,24 @@ function MatrixExtractAll(const mat: TMatrixD; function CanUseBoxDownsampler(const mat: TMatrixD; sx, sy: double): Boolean; begin // If the matrix looks like this after removing the scale, - // the box downsampler can be used. + // the box downsampler can be used. (only translation and scaling) // cos(0) -sin(0) tx 1 0 tx // sin(0) cos(0) ty => 0 1 ty // 0 0 1 0 0 1 +{ Result := (mat[0,0]/sx = 1) and (mat[0,1]/sx = 0) and (mat[1,0]/sy = 0) and (mat[1,1]/sy = 1) and (mat[2,0] = 0) and (mat[2,1] = 0) and (mat[2,2] = 1); +} + + // We can skip the divisions, because m/s is only zero if m is zero + // and m/s=1 is the same as m=s + Result := (SameValue(mat[0,0], sx)) and (mat[0,1] = 0) and + (mat[1,0] = 0) and (SameValue(mat[1,1], sy)) and + (mat[2,0] = 0) and (mat[2,1] = 0) and + (mat[2,2] = 1); end; {$ENDIF USE_DOWNSAMPLER_AUTOMATICALLY} @@ -621,7 +631,7 @@ function AffineTransformImage(img, targetImg: TImage32; matrix: TMatrixD; Exit; end; - SetLength(tmp, newWidth * newHeight); + NewColor32Array(tmp, newWidth * newHeight, True); pc := @tmp[0]; xLimLo := -0.5/sx; xLimHi := img.Width + 0.5/sx; @@ -806,7 +816,7 @@ function ProjectiveTransform(img, targetImg: TImage32; mat := GetProjectionMatrix(srcPts, dstPts2); RectWidthHeight(rec, w, h); - SetLength(tmp, w * h); + NewColor32Array(tmp, w * h, True); pc := @tmp[0]; for i := 0 to h -1 do for j := 0 to w -1 do @@ -850,7 +860,7 @@ function InterpolateSegX(const pt1, pt2: TPointD): TPathD; if x1 = x2 then Exit; dydx := (pt2.Y - pt1.Y)/(pt2.X - pt1.X); xo := x1 -pt1.X; - SetLength(Result, x2-x1); + NewPointDArray(Result, x2-x1, True); for i:= 0 to x2 - x1 -1 do begin Result[i].X := x1 +i; @@ -863,7 +873,7 @@ function InterpolateSegX(const pt1, pt2: TPointD): TPathD; if x1 = x2 then Exit; dydx := (pt2.Y - pt1.Y)/(pt2.X - pt1.X); xo := x1 -pt1.X; - SetLength(Result, x1-x2); + NewPointDArray(Result, x1-x2, True); for i:= 0 to x1 - x2 -1 do begin Result[i].X := x1 -i; @@ -886,7 +896,7 @@ function InterpolateSegY(const pt1, pt2: TPointD): TPathD; if y1 = y2 then Exit; dxdy := (pt2.X - pt1.X)/(pt2.Y - pt1.Y); yo := y1 -pt1.Y; - SetLength(Result, y2-y1); + NewPointDArray(Result, y2-y1, True); for i:= 0 to y2 - y1 -1 do begin Result[i].Y := y1 +i; @@ -899,7 +909,7 @@ function InterpolateSegY(const pt1, pt2: TPointD): TPathD; if y1 = y2 then Exit; dxdy := (pt2.X - pt1.X)/(pt2.Y - pt1.Y); yo := y1 -pt1.Y; - SetLength(Result, y1-y2); + NewPointDArray(Result, y1-y2, True); for i:= 0 to y1 - y2 -1 do begin Result[i].Y := y1 -i; @@ -987,7 +997,7 @@ function SplineVertTransform(img, targetImg: TImage32; const topSpline: TPathD; len := Length(topPath); inc(rec.Bottom, img.Height); RectWidthHeight(rec, w, h); - SetLength(tmp, (w+1) * h); + NewColor32Array(tmp, (w+1) * h, False); prevX := topPath[0].X; allowBackColoring := GetAlpha(backColor) > 2; @@ -1072,7 +1082,7 @@ function SplineHorzTransform(img, targetImg: TImage32; const leftSpline: TPathD; len := Length(leftPath); inc(rec.Right, img.Width); RectWidthHeight(rec, w, h); - SetLength(tmp, w * (h+1)); + NewColor32Array(tmp, w * (h+1), False); prevY := leftPath[0].Y; allowBackColoring := GetAlpha(backColor) > 2; @@ -1138,10 +1148,9 @@ procedure TWeightedColor.Reset; procedure TWeightedColor.Reset(c: TColor32; w: Integer); var a: Cardinal; - argb: TARGB absolute c; begin fAddCount := w; - a := w * argb.A; + a := w * Byte(c shr 24); if a = 0 then begin fAlphaTot := 0; @@ -1151,9 +1160,9 @@ procedure TWeightedColor.Reset(c: TColor32; w: Integer); end else begin fAlphaTot := a; - fColorTotB := (a * argb.B); - fColorTotG := (a * argb.G); - fColorTotR := (a * argb.R); + fColorTotB := (a * Byte(c)); + fColorTotG := (a * Byte(c shr 8)); + fColorTotR := (a * Byte(c shr 16)); end; end; //------------------------------------------------------------------------------ @@ -1244,6 +1253,58 @@ procedure TWeightedColor.Subtract(const other: TWeightedColor); end; //------------------------------------------------------------------------------ +function TWeightedColor.AddSubtract(addC, subC: TColor32): Boolean; +var + a: Cardinal; +begin + // add+subtract => fAddCount stays the same + + // skip identical colors + Result := False; + if addC = subC then Exit; + + a := Byte(addC shr 24); + if a > 0 then + begin + inc(fAlphaTot, a); + inc(fColorTotB, (a * Byte(addC))); + inc(fColorTotG, (a * Byte(addC shr 8))); + inc(fColorTotR, (a * Byte(addC shr 16))); + Result := True; + end; + + a := Byte(subC shr 24); + if a > 0 then + begin + dec(fAlphaTot, a); + dec(fColorTotB, (a * Byte(subC))); + dec(fColorTotG, (a * Byte(subC shr 8))); + dec(fColorTotR, (a * Byte(subC shr 16))); + Result := True; + end; +end; +//------------------------------------------------------------------------------ + +function TWeightedColor.AddNoneSubtract(c: TColor32): Boolean; +var + a: Cardinal; +begin + // add+subtract => fAddCount stays the same + + a := Byte(c shr 24); + if a > 0 then + begin + dec(fAlphaTot, a); + dec(fColorTotB, (a * Byte(c))); + dec(fColorTotG, (a * Byte(c shr 8))); + dec(fColorTotR, (a * Byte(c shr 16))); + Result := True; + end + else + Result := False; +end; +//------------------------------------------------------------------------------ + function TWeightedColor.GetColor: TColor32; var oneDivAlphaTot: double; @@ -1262,10 +1323,10 @@ function TWeightedColor.GetColor: TColor32; result := TColor32(Min(255, alpha)) shl 24; // alpha weighting has been applied to color channels, so div by fAlphaTot + if fAlphaTot < DivOneByXTableSize then // use precalculated 1/X values - oneDivAlphaTot := DivOneByXTable[fAlphaTot] - else - oneDivAlphaTot := 1/fAlphaTot; + oneDivAlphaTot := DivOneByXTable[fAlphaTot] else + oneDivAlphaTot := 1/(fAlphaTot); // 1. Skip zero calculations. // 2. LimitByte(Integer): Values can't be less than 0, so don't use ClampByte. @@ -1273,11 +1334,11 @@ function TWeightedColor.GetColor: TColor32; // Thus we need to do the calculation and Round call in one expression. // Otherwise the compiler will use a temporary double variable on // the stack that will cause unnecessary store and load operations. - if fColorTotB <> 0 then + if fColorTotB > 0 then result := result or LimitByte(System.Round(fColorTotB * oneDivAlphaTot)); - if fColorTotG <> 0 then + if fColorTotG > 0 then result := result or LimitByte(System.Round(fColorTotG * oneDivAlphaTot)) shl 8; - if fColorTotR <> 0 then + if fColorTotR > 0 then result := result or LimitByte(System.Round(fColorTotR * oneDivAlphaTot)) shl 16; end; diff --git a/Image32/source/Img32.Vector.pas b/Image32/source/Img32.Vector.pas index 9eba9d9..5ee26ff 100644 --- a/Image32/source/Img32.Vector.pas +++ b/Image32/source/Img32.Vector.pas @@ -3,7 +3,7 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.5 * -* Date : 21 June 2024 * +* Date : 26 July 2024 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2024 * * * @@ -220,6 +220,10 @@ interface procedure AppendPath(var paths: TPathsD; const extra: TPathsD); overload; procedure AppendPath(var ppp: TArrayOfPathsD; const extra: TPathsD); overload; + // ConcatPaths concats multiple paths. It skips the start-point + // of a path, if it matches the previous path's end-point. + procedure ConcatPaths(var dstPath: TPathD; const paths: TPathsD); + function GetAngle(const origin, pt: TPoint): double; overload; function GetAngle(const origin, pt: TPointD): double; overload; function GetAngle(const a, b, c: TPoint): double; overload; @@ -249,6 +253,7 @@ interface //function MakePath(const pts: array of integer): TPathD; overload; function MakePath(const pts: array of double): TPathD; overload; + function MakePath(const pt: TPointD): TPathD; overload; function GetBounds(const path: TPathD): TRect; overload; function GetBounds(const paths: TPathsD): TRect; overload; @@ -479,7 +484,6 @@ implementation BuffSize = 64; {$IFDEF CPUX86} -const // Use faster Trunc for x86 code in this unit. Trunc: function(Value: Double): Integer = __Trunc; {$ENDIF CPUX86} @@ -665,7 +669,7 @@ function StripNearDuplicates(const path: TPathD; i,j, len: integer; begin len := length(path); - SetLength(Result, len); + NewPointDArray(Result, len, True); if len = 0 then Exit; Result[0] := path[0]; j := 0; @@ -948,7 +952,7 @@ function MakeArrayOfInteger(const ints: array of integer): TArrayOfInteger; i, len: integer; begin len := Length(ints); - SetLength(Result, len); + NewIntegerArray(Result, len, True); for i := 0 to len -1 do Result[i] := ints[i]; end; //------------------------------------------------------------------------------ @@ -1149,7 +1153,7 @@ function TranslatePath(const path: TPathD; dx, dy: double): TPathD; i, len: integer; begin len := length(path); - setLength(result, len); + NewPointDArray(result, len, True); for i := 0 to len -1 do begin result[i].x := path[i].x + dx; @@ -1207,7 +1211,7 @@ function ScalePath(const path: TPathD; sx, sy: double): TPathD; end else begin len := length(path); - setLength(result, len); + NewPointDArray(result, len, True); for i := 0 to len -1 do begin result[i].x := path[i].x * sx; @@ -1324,7 +1328,7 @@ function ReversePath(const path: TPathD): TPathD; i, highI: integer; begin highI := High(path); - SetLength(result, highI +1); + NewPointDArray(result, highI +1, True); for i := 0 to highI do result[i] := path[highI -i]; end; @@ -1347,7 +1351,7 @@ function OpenPathToFlatPolygon(const path: TPathD): TPathD; begin len := Length(path); len2 := Max(0, len - 2); - setLength(Result, len + len2); + NewPointDArray(Result, len + len2, True); if len = 0 then Exit; Move(path[0], Result[0], len * SizeOf(TPointD)); if len2 = 0 then Exit; @@ -1362,7 +1366,7 @@ function GetVectors(const path: TPathD): TPathD; pt: TPointD; begin len := length(path); - setLength(result, len); + NewPointDArray(result, len, True); if len = 0 then Exit; pt := path[0]; //skip duplicates @@ -1400,7 +1404,7 @@ function GetNormals(const path: TPathD): TPathD; last: TPointD; begin highI := High(path); - setLength(result, highI+1); + NewPointDArray(result, highI+1, True); if highI < 0 then Exit; last := NullPointD; @@ -1842,7 +1846,7 @@ procedure AppendToPath(var path: TPathD; const pt: TPointD); begin len := length(path); if (len > 0) and PointsEqual(pt, path[len -1]) then Exit; - setLength(path, len + 1); + SetLengthUninit(path, len + 1); path[len] := pt; end; //------------------------------------------------------------------------------ @@ -1855,7 +1859,7 @@ procedure AppendPath(var path1: TPathD; const path2: TPathD); len2 := length(path2); if len2 = 0 then Exit; if (len1 > 0) and PointsEqual(path2[0], path1[len1 -1]) then dec(len1); - setLength(path1, len1 + len2); + SetLengthUninit(path1, len1 + len2); Move(path2[0], path1[len1], len2 * SizeOf(TPointD)); end; //------------------------------------------------------------------------------ @@ -1865,7 +1869,7 @@ procedure AppendPoint(var path: TPathD; const extra: TPointD); len: integer; begin len := length(path); - SetLength(path, len +1); + SetLengthUninit(path, len +1); path[len] := extra; end; //------------------------------------------------------------------------------ @@ -1909,6 +1913,46 @@ procedure AppendPath(var ppp: TArrayOfPathsD; const extra: TPathsD); end; //------------------------------------------------------------------------------ +procedure ConcatPaths(var dstPath: TPathD; const paths: TPathsD); +var + i, len, pathLen, offset: integer; +begin + // calculate the length of the final array + len := 0; + for i := 0 to high(paths) do + begin + pathLen := Length(paths[i]); + if pathLen > 0 then + begin + // Skip the start-point if is matches the previous path's end-point + if (i > 0) and PointsEqual(paths[i][0], paths[i -1][high(paths[i -1])]) then + dec(pathLen); + inc(len, pathLen); + end; + end; + SetLengthUninit(dstPath, len); + + // fill the array + len := 0; + for i := 0 to high(paths) do + begin + pathLen := Length(paths[i]); + if pathLen > 0 then + begin + offset := 0; + // Skip the start-point if is matches the previous path's end-point + if (i > 0) and PointsEqual(paths[i][0], paths[i -1][high(paths[i -1])]) then + begin + dec(pathLen); + offset := 1; + end; + Move(paths[i][offset], dstPath[len], pathLen * SizeOf(TPointD)); + inc(len, pathLen); + end; + end; +end; +//------------------------------------------------------------------------------ + procedure RotatePoint(var pt: TPointD; const focalPoint: TPointD; sinA, cosA: double); var @@ -1927,7 +1971,9 @@ procedure RotatePoint(var pt: TPointD; sinA, cosA: double; begin if angleRad = 0 then Exit; - if not ClockwiseRotationIsAnglePositive then angleRad := -angleRad; +{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES} + angleRad := -angleRad; +{$ENDIF} GetSinCos(angleRad, sinA, cosA); RotatePoint(pt, focalPoint, sinA, cosA); end; @@ -1939,7 +1985,7 @@ function RotatePathInternal(const path: TPathD; i: integer; x,y: double; begin - SetLength(Result, length(path)); + NewPointDArray(Result, length(path), True); for i := 0 to high(path) do begin x := path[i].X - focalPoint.X; @@ -1960,7 +2006,9 @@ function RotatePath(const path: TPathD; Result := path; Exit; end; - if not ClockwiseRotationIsAnglePositive then angleRads := -angleRads; +{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES} + angleRads := -angleRads; +{$ENDIF} GetSinCos(angleRads, sinA, cosA); Result := RotatePathInternal(path, focalPoint, sinA, cosA); end; @@ -1977,8 +2025,9 @@ function RotatePath(const paths: TPathsD; if not IsValid(angleRads) then Exit; NormalizeAngle(angleRads); if angleRads = 0 then Exit; - if not ClockwiseRotationIsAnglePositive then - angleRads := -angleRads; +{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES} + angleRads := -angleRads; +{$ENDIF} GetSinCos(angleRads, sinA, cosA); SetLength(Result, length(paths)); if IsValid(focalPoint) then @@ -2006,7 +2055,9 @@ function GetAngle(const origin, pt: TPoint): double; else result := angle180; end else result := arctan2(y, x); //range between -Pi and Pi - if not ClockwiseRotationIsAnglePositive then Result := -Result; +{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES} + Result := -Result; +{$ENDIF} end; //------------------------------------------------------------------------------ @@ -2027,7 +2078,9 @@ function GetAngle(const origin, pt: TPointD): double; else result := angle180; end else result := arctan2(y, x); //range between -Pi and Pi - if not ClockwiseRotationIsAnglePositive then Result := -Result; +{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES} + Result := -Result; +{$ENDIF} end; //------------------------------------------------------------------------------ @@ -2042,7 +2095,9 @@ function GetAngle(const a, b, c: TPoint): double; dp := (ab.x * bc.x + ab.y * bc.y); cp := (ab.x * bc.y - ab.y * bc.x); Result := arctan2(cp, dp); //range between -Pi and Pi - if not ClockwiseRotationIsAnglePositive then Result := -Result; +{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES} + Result := -Result; +{$ENDIF} end; //------------------------------------------------------------------------------ @@ -2057,7 +2112,9 @@ function GetAngle(const a, b, c: TPointD): double; dp := (ab.x * bc.x + ab.y * bc.y); cp := (ab.x * bc.y - ab.y * bc.x); Result := arctan2(cp, dp); //range between -Pi and Pi - if not ClockwiseRotationIsAnglePositive then Result := -Result; +{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES} + Result := -Result; +{$ENDIF} end; //------------------------------------------------------------------------------ @@ -2165,7 +2222,7 @@ function Grow(const path, normals: TPathD; delta: double; if resCnt >= resCap then begin inc(resCap, 64); - setLength(result, resCap); + SetLengthUninit(result, resCap); end; result[resCnt] := pt; inc(resCnt); @@ -2427,7 +2484,7 @@ function GrowOpenLine(const line: TPathD; delta: double; if resCnt >= resCap then begin inc(resCap, 64); - setLength(result, resCap); + SetLengthUninit(result, resCap); end; result[resCnt] := pt; inc(resCnt); @@ -2756,7 +2813,7 @@ function RoughOutline(const lines: TPathsD; lineWidth: double; function Rectangle(const rec: TRect): TPathD; begin - setLength(Result, 4); + NewPointDArray(Result, 4, True); with rec do begin result[0] := PointD(left, top); @@ -2769,7 +2826,7 @@ function Rectangle(const rec: TRect): TPathD; function Rectangle(const rec: TRectD): TPathD; begin - setLength(Result, 4); + NewPointDArray(Result, 4, True); with rec do begin result[0] := PointD(left, top); @@ -2782,7 +2839,7 @@ function Rectangle(const rec: TRectD): TPathD; function Rectangle(l, t, r, b: double): TPathD; begin - setLength(Result, 4); + NewPointDArray(Result, 4, True); result[0] := PointD(l, t); result[1] := PointD(r, t); result[2] := PointD(r, b); @@ -2871,7 +2928,7 @@ function RoundRect(const rec: TRectD; radius: TPointD): TPathD; end; magic.X := radius.X * magicC; magic.Y := radius.Y * magicC; - SetLength(Corners, 4); + NewPointDArray(Corners, 4, True); with rec do begin corners[0] := PointD(Right, Top); @@ -2879,10 +2936,10 @@ function RoundRect(const rec: TRectD; radius: TPointD): TPathD; corners[2] := PointD(Left, Bottom); corners[3] := TopLeft; end; - SetLength(Result, 1); + NewPointDArray(Result, 1, True); Result[0].X := corners[3].X + radius.X; Result[0].Y := corners[3].Y; - SetLength(bezPts, 4); + NewPointDArray(bezPts, 4, True); for i := 0 to High(corners) do begin for j := 0 to 3 do bezPts[j] := corners[i]; @@ -3017,7 +3074,7 @@ function Ellipse(const rec: TRectD; steps: integer): TPathD; steps := Round(CalcRoundingSteps(rec.width + rec.height)); GetSinCos(2 * Pi / Steps, sinA, cosA); delta.x := cosA; delta.y := sinA; - SetLength(Result, Steps); + NewPointDArray(Result, Steps, True); Result[0] := PointD(centre.X + radius.X, centre.Y); for i := 1 to steps -1 do begin @@ -3078,7 +3135,7 @@ function Star(const rec: TRectD; points: integer; indentFrac: double): TPathD; if rec2.IsEmpty then p2 := Ellipse(rec, points*2) else p2 := Ellipse(rec2, points*2); - SetLength(Result, points*2); + NewPointDArray(Result, points*2, True); for i := 0 to points -1 do begin Result[i*2] := p[i]; @@ -3100,7 +3157,7 @@ function Star(const focalPt: TPointD; else points := points * 2; GetSinCos(2 * Pi / points, sinA, cosA); delta.x := cosA; delta.y := sinA; - SetLength(Result, points); + NewPointDArray(Result, points, True); Result[0] := PointD(focalPt.X + innerRadius, focalPt.Y); for i := 1 to points -1 do begin @@ -3130,11 +3187,12 @@ function Arc(const rec: TRectD; Result := nil; if (endAngle = startAngle) or IsEmptyRect(rec) then Exit; if scale <= 0 then scale := 4.0; - if not ClockwiseRotationIsAnglePositive then - begin - startAngle := -startAngle; - endAngle := -endAngle; - end; + +{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES} + startAngle := -startAngle; + endAngle := -endAngle; +{$ENDIF} + NormalizeAngle(startAngle, qtrDeg); NormalizeAngle(endAngle, qtrDeg); with rec do @@ -3149,7 +3207,7 @@ function Arc(const rec: TRectD; steps := Round(CalcRoundingSteps((rec.width + rec.height)/2 * scale)); steps := steps div 2; ///////////////////////////////// if steps < 2 then steps := 2; - SetLength(Result, Steps +1); + NewPointDArray(Result, Steps +1, True); //angle of the first step ... GetSinCos(startAngle, deltaY, deltaX); Result[0].X := centre.X + radius.X * deltaX; @@ -3174,7 +3232,7 @@ function Pie(const rec: TRectD; begin result := Arc(rec, StartAngle, EndAngle, scale); len := length(result); - setLength(result, len +1); + SetLengthUninit(result, len +1); result[len] := PointD((rec.Left + rec.Right)/2, (rec.Top + rec.Bottom)/2); end; //------------------------------------------------------------------------------ @@ -3196,7 +3254,7 @@ function ArrowHead(const arrowTip, ctrlPt: TPointD; size: double; Exit; asSimple: begin - setLength(result, 3); + NewPointDArray(result, 3, True); basePt := TranslatePoint(arrowTip, -unitVec.X * size, -unitVec.Y * size); result[0] := arrowTip; result[1] := TranslatePoint(basePt, -unitVec.Y * sDiv50, unitVec.X * sDiv50); @@ -3204,7 +3262,7 @@ function ArrowHead(const arrowTip, ctrlPt: TPointD; size: double; end; asFancy: begin - setLength(result, 4); + NewPointDArray(result, 4, True); basePt := TranslatePoint(arrowTip, -unitVec.X * sDiv120, -unitVec.Y * sDiv120); result[0] := TranslatePoint(basePt, -unitVec.Y *sDiv50, unitVec.X *sDiv50); @@ -3214,7 +3272,7 @@ function ArrowHead(const arrowTip, ctrlPt: TPointD; size: double; end; asDiamond: begin - setLength(result, 4); + NewPointDArray(result, 4, True); basePt := TranslatePoint(arrowTip, -unitVec.X * sDiv60, -unitVec.Y * sDiv60); result[0] := arrowTip; result[1] := TranslatePoint(basePt, -unitVec.Y * sDiv50, unitVec.X * sDiv50); @@ -3229,7 +3287,7 @@ function ArrowHead(const arrowTip, ctrlPt: TPointD; size: double; end; asTail: begin - setLength(result, 6); + NewPointDArray(result, 6, True); 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); @@ -3530,7 +3588,7 @@ function PrePendPoint(const pt: TPointD; const p: TPathD): TPathD; len: integer; begin len := Length(p); - SetLength(Result, len +1); + NewPointDArray(Result, len +1, True); Result[0] := pt; if len > 0 then Move(p[0], Result[1], len * SizeOf(TPointD)); end; @@ -3541,7 +3599,7 @@ function PrePendPoints(const pt1, pt2: TPointD; const p: TPathD): TPathD; len: integer; begin len := Length(p); - SetLength(Result, len +2); + NewPointDArray(Result, len +2, True); Result[0] := pt1; Result[1] := pt2; if len > 0 then Move(p[0], Result[2], len * SizeOf(TPointD)); @@ -3579,7 +3637,7 @@ function FlattenQBezier(const pts: TPathD; tolerance: double = 0.0): TPathD; if (highI < 2) or Odd(highI) then raise Exception.Create(rsInvalidQBezier); if tolerance <= 0.0 then tolerance := BezierTolerance; - setLength(Result, 1); + NewPointDArray(Result, 1, True); Result[0] := pts[0]; for i := 0 to (highI div 2) -1 do begin @@ -3607,7 +3665,7 @@ function FlattenQBezier(const pt1, pt2, pt3: TPointD; if resultCnt = resultLen then begin inc(resultLen, BuffSize); - setLength(result, resultLen); + SetLengthUninit(result, resultLen); end; result[resultCnt] := pt; inc(resultCnt); @@ -3678,7 +3736,7 @@ function FlattenCBezier(const path: TPathD; tolerance: double = 0.0): TPathD; if (len < 3) or (len mod 3 <> 0) then raise Exception.Create(rsInvalidCBezier); if tolerance <= 0.0 then tolerance := BezierTolerance; - setLength(Result, 1); + NewPointDArray(Result, 1, True); Result[0] := path[0]; for i := 0 to (len div 3) -1 do begin @@ -3718,7 +3776,7 @@ function FlattenCBezier(const pt1, pt2, pt3, pt4: TPointD; if resultCnt = resultLen then begin inc(resultLen, BuffSize); - setLength(result, resultLen); + SetLengthUninit(result, resultLen); end; result[resultCnt] := pt; inc(resultCnt); @@ -3782,7 +3840,7 @@ function FlattenCSpline(const priorCtrlPt, startPt: TPointD; len: integer; begin len := Length(pts); - SetLength(p, len + 2); + NewPointDArray(p, len + 2, True); p[0] := startPt; p[1] := ReflectPoint(priorCtrlPt, startPt); if len > 0 then @@ -3800,7 +3858,7 @@ function FlattenCSpline(const pts: TPathD; tolerance: double = 0.0): TPathD; if resultCnt = resultLen then begin inc(resultLen, BuffSize); - setLength(result, resultLen); + SetLengthUninit(result, resultLen); end; result[resultCnt] := pt; inc(resultCnt); @@ -3813,10 +3871,7 @@ function FlattenCSpline(const pts: TPathD; tolerance: double = 0.0): TPathD; if (abs(p1.x + p3.x - 2*p2.x) + abs(p2.x + p4.x - 2*p3.x) + abs(p1.y + p3.y - 2*p2.y) + abs(p2.y + p4.y - 2*p3.y)) < tolerance then begin - if resultCnt = length(result) then - setLength(result, length(result) +BuffSize); - result[resultCnt] := p4; - inc(resultCnt); + AddPoint(p4); end else begin p12.X := (p1.X + p2.X) / 2; @@ -3870,7 +3925,7 @@ function FlattenQSpline(const priorCtrlPt, startPt: TPointD; len: integer; begin len := Length(pts); - SetLength(p, len + 2); + NewPointDArray(p, len + 2, True); p[0] := startPt; p[1] := ReflectPoint(priorCtrlPt, startPt); if len > 0 then @@ -3888,7 +3943,7 @@ function FlattenQSpline(const pts: TPathD; tolerance: double = 0.0): TPathD; if resultCnt = resultLen then begin inc(resultLen, BuffSize); - setLength(result, resultLen); + SetLengthUninit(result, resultLen); end; result[resultCnt] := pt; inc(resultCnt); @@ -3943,25 +3998,29 @@ function FlattenQSpline(const pts: TPathD; tolerance: double = 0.0): TPathD; function MakePath(const pts: array of double): TPathD; var - i, j, len: Integer; + i, len: Integer; x,y: double; begin Result := nil; len := length(pts) div 2; if len = 0 then Exit; - setlength(Result, len); + NewPointDArray(Result, len, True); Result[0].X := pts[0]; Result[0].Y := pts[1]; - j := 0; for i := 1 to len -1 do begin x := pts[i*2]; y := pts[i*2 +1]; - inc(j); - Result[j].X := x; - Result[j].Y := y; + Result[i].X := x; + Result[i].Y := y; end; - setlength(Result, j+1); +end; +//------------------------------------------------------------------------------ + +function MakePath(const pt: TPointD): TPathD; +begin + SetLengthUninit(Result, 1); + Result[0] := pt; end; //------------------------------------------------------------------------------ diff --git a/Image32/source/Img32.Vectorizer.pas b/Image32/source/Img32.Vectorizer.pas index b965da5..46894bc 100644 --- a/Image32/source/Img32.Vectorizer.pas +++ b/Image32/source/Img32.Vectorizer.pas @@ -93,7 +93,7 @@ function ConvertToPathD(pt: PPt): TPathD; i, len: integer; begin len := GetVertexCount(pt); - SetLength(Result, len); + NewPointDArray(Result, len, True); for i := 0 to len -1 do begin Result[i] := PointD(pt.X, pt.Y); diff --git a/Image32/source/Img32.inc b/Image32/source/Img32.inc index 2a48b48..b83bf03 100644 --- a/Image32/source/Img32.inc +++ b/Image32/source/Img32.inc @@ -4,10 +4,13 @@ // use storage (eg to compile the experimental 'CtrlDemo' in Examples). {$DEFINE NO_STORAGE} -// Image downsampling occurs when images are reduced in size, and the default downsampling +// default rotation direction is clockwise with positive angles +{.$DEFINE CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES} + +// Image downsampling occurs when images are reduced in size, and the default downsampling // function is 'BoxDownSampling'. When downsampling, this function generally produces much // clearer images than general purpose resamplers (which are much better at upsampling, -// and doing other affine transformations). However, if for some reason you do wish to use +// and doing other affine transformations). However, if for some reason you do wish to use // a general purpose resampler while downsampling, then disable this define. {$DEFINE USE_DOWNSAMPLER_AUTOMATICALLY} diff --git a/Image32/source/Img32.pas b/Image32/source/Img32.pas index c413800..e78a71f 100644 --- a/Image32/source/Img32.pas +++ b/Image32/source/Img32.pas @@ -3,7 +3,7 @@ (******************************************************************************* * Author : Angus Johnson * * Version : 4.5 * -* Date : 3 July 2024 * +* Date : 26 July 2024 * * Website : http://www.angusj.com * * Copyright : Angus Johnson 2019-2024 * * Purpose : The core module of the Image32 library * @@ -28,6 +28,10 @@ interface {$IFDEF UITYPES} UITypes,{$ENDIF} Math; type + {$IF not declared(NativeInt)} + NativeInt = Integer; + {$IFEND} + TRect = Types.TRect; TColor32 = type Cardinal; @@ -158,6 +162,7 @@ TImageFormat = class end; TBlendFunction = function(bgColor, fgColor: TColor32): TColor32; + TBlendLineFunction = procedure(bgColor, fgColor: PColor32; width: nativeint); TCompareFunction = function(master, current: TColor32; data: integer): Boolean; TCompareFunctionEx = function(master, current: TColor32): Byte; @@ -194,11 +199,15 @@ TImage32 = class(TObject) function GetMidPoint: TPointD; protected procedure ResetColorCount; - function RectHasTransparency(rec: TRect): Boolean; + function RectHasTransparency(const rec: TRect): Boolean; function CopyPixels(const rec: TRect): TArrayOfColor32; //CopyInternal: Internal routine (has no scaling or bounds checking) procedure CopyInternal(src: TImage32; const srcRec, dstRec: TRect; blendFunc: TBlendFunction); + procedure CopyInternalLine(src: TImage32; + const srcRec, dstRec: TRect; blendLineFunc: TBlendLineFunction); + function CopyBlendInternal(src: TImage32; srcRec, dstRec: TRect; + blendFunc: TBlendFunction = nil; blendLineFunc: TBlendLineFunction = nil): Boolean; overload; procedure Changed; virtual; procedure Resized; virtual; function SetPixels(const newPixels: TArrayOfColor32): Boolean; @@ -247,8 +256,10 @@ TImage32 = class(TObject) //function is specified, that function will determine how the images will //be blended. If srcRec and dstRec have different widths or heights, //then the image in srcRec will also be stretched to fit dstRec. - function CopyBlend(src: TImage32; srcRec, dstRec: TRect; - blendFunc: TBlendFunction = nil): Boolean; + function CopyBlend(src: TImage32; const srcRec, dstRec: TRect; + blendFunc: TBlendFunction = nil): Boolean; overload; {$IFDEF INLINE} inline; {$ENDIF} + function CopyBlend(src: TImage32; const srcRec, dstRec: TRect; + blendLineFunc: TBlendLineFunction): Boolean; overload; {$IFDEF INLINE} inline; {$ENDIF} {$IFDEF MSWINDOWS} //CopyFromDC: Copies an image from a Windows device context, erasing @@ -274,7 +285,7 @@ TImage32 = class(TObject) procedure SetBackgroundColor(bgColor: TColor32); procedure Clear(color: TColor32 = 0); overload; procedure Clear(const rec: TRect; color: TColor32 = 0); overload; - procedure FillRect(rec: TRect; color: TColor32); + procedure FillRect(const rec: TRect; color: TColor32); procedure ConvertToBoolMask(reference: TColor32; tolerance: integer; colorFunc: TCompareFunction; @@ -424,16 +435,20 @@ TImageList32 = class function BlendToOpaque(bgColor, fgColor: TColor32): TColor32; //BlendToAlpha: Blends two semi-transparent images (slower than BlendToOpaque) function BlendToAlpha(bgColor, fgColor: TColor32): TColor32; + procedure BlendToAlphaLine(bgColor, fgColor: PColor32; width: nativeint); //BlendMask: Whereever the mask is, preserves the background function BlendMask(bgColor, alphaMask: TColor32): TColor32; + procedure BlendMaskLine(bgColor, alphaMask: PColor32; width: nativeint); function BlendAltMask(bgColor, alphaMask: TColor32): TColor32; function BlendDifference(color1, color2: TColor32): TColor32; function BlendSubtract(bgColor, fgColor: TColor32): TColor32; function BlendLighten(bgColor, fgColor: TColor32): TColor32; function BlendDarken(bgColor, fgColor: TColor32): TColor32; function BlendInvertedMask(bgColor, alphaMask: TColor32): TColor32; + procedure BlendInvertedMaskLine(bgColor, alphaMask: PColor32; width: nativeint); //BlendBlueChannel: typically useful for white color masks function BlendBlueChannel(bgColor, blueMask: TColor32): TColor32; + procedure BlendBlueChannelLine(bgColor, blueMask: PColor32; width: nativeint); //COMPARE COLOR FUNCTIONS (ConvertToBoolMask, FloodFill, Vectorize etc.) @@ -551,8 +566,6 @@ TImageList32 = class angle360 = TwoPi; var - ClockwiseRotationIsAnglePositive: Boolean = true; - //Resampling function identifiers (initialized in Img32.Resamplers) rNearestResampler : integer; rBilinearResampler: integer; @@ -593,6 +606,26 @@ TImageList32 = class function __Trunc(Value: Double): Integer; {$IFNDEF CPUX86} {$IFDEF INLINE} inline; {$ENDIF} {$ENDIF} + // NewColor32Array creates a new "array of TColor32". "a" is nil'ed + // before allocating the array. If "count" is zero or negative "a" will + // be nil. If "uninitialized" is True, the memory will not be zero'ed. + procedure NewColor32Array(var a: TArrayOfColor32; count: nativeint; + uninitialized: boolean = False); + procedure NewIntegerArray(var a: TArrayOfInteger; count: nativeint; + uninitialized: boolean = False); + procedure NewByteArray(var a: TArrayOfByte; count: nativeint; + uninitialized: boolean = False); + procedure NewPointDArray(var a: TPathD; count: nativeint; + uninitialized: boolean = False); + + // SetLengthUninit changes the dyn. array's length but does not initialize + // the new elements with zeros. It can be used as a replacement for + // SetLength where the zero-initialitation is not required. + procedure SetLengthUninit(var a: TArrayOfColor32; count: nativeint); overload; + procedure SetLengthUninit(var a: TArrayOfInteger; count: nativeint); overload; + procedure SetLengthUninit(var a: TArrayOfByte; count: nativeint); overload; + procedure SetLengthUninit(var a: TPathD; count: nativeint); overload; + implementation uses @@ -617,6 +650,18 @@ implementation TByteArray = array[0..MaxInt -1] of Byte; PByteArray = ^TByteArray; + {$IFDEF SUPPORTS_POINTERMATH} + {$POINTERMATH ON} + PStaticColor32Array = ^TColor32; + PStaticARGBArray = ^TARGB; + {$POINTERMATH OFF} + {$ELSE} // Delphi 7-2007 + PStaticColor32Array = ^TStaticColor32Array; + TStaticColor32Array = array[0..MaxInt div SizeOf(TColor32) - 1] of TColor32; + PStaticARGBArray = ^TStaticARGBArray; + TStaticARGBArray = array[0..MaxInt div SizeOf(TARGB) - 1] of TARGB; + {$ENDIF} + TImgFmtRec = record Fmt: string; SortOrder: TClipboardPriority; @@ -630,6 +675,25 @@ TResamplerObj = class func: TResamplerFunction; end; + PDynArrayRec = ^TDynArrayRec; + {$IFDEF FPC} + tdynarrayindex = sizeint; + TDynArrayRec = packed record + refcount: ptrint; + high: tdynarrayindex; + Data: record end; + end; + {$ELSE} + TDynArrayRec = packed record + {$IFDEF CPU64BITS} + _Padding: Integer; + {$ENDIF} + RefCnt: Integer; + Length: NativeInt; + Data: record end; + end; + {$ENDIF} + var {$IFDEF XPLAT_GENERICS} ImageFormatClassList: TList; //list of supported file extensions @@ -642,6 +706,170 @@ TResamplerObj = class //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ +function NewSimpleDynArray(count: nativeint; elemSize: integer; uninitialized: boolean = False): Pointer; +var + p: PDynArrayRec; +begin + Result := nil; + if (count > 0) and (elemSize > 0) then + begin + if uninitialized then + GetMem(Pointer(p), SizeOf(TDynArrayRec) + count * elemSize) + else + p := AllocMem(SizeOf(TDynArrayRec) + count * elemSize); + {$IFDEF FPC} + p.refcount := 1; + p.high := count -1; + {$ELSE} + p.RefCnt := 1; + p.Length := count; + {$ENDIF} + Result := @p.Data; + end; +end; +//------------------------------------------------------------------------------ + +function InternSetSimpleDynArrayLengthUninit(a: Pointer; count: nativeint; elemSize: integer): Pointer; +var + p: PDynArrayRec; + oldCount: integer; +begin + if a = nil then + Result := NewSimpleDynArray(count, elemSize) + else if (count > 0) and (elemSize > 0) then + begin + p := PDynArrayRec(PByte(a) - SizeOf(TDynArrayRec)); + {$IFDEF FPC} + oldCount := p.high + 1; + if p.refcount = 1 then + {$ELSE} + oldCount := p.Length; + if p.RefCnt = 1 then + {$ENDIF} + begin + // There is only one reference to this array and that is "a", + // so we can use ReallocMem to change the array's length. + if oldCount = count then + begin + Result := a; + Exit; + end; + ReallocMem(Pointer(p), SizeOf(TDynArrayRec) + count * elemSize); + end + else + begin + // SetLength makes a copy of the dyn array to get RefCnt=1 + GetMem(Pointer(p), SizeOf(TDynArrayRec) + count * elemSize); + if oldCount < 0 then oldCount := 0; // data corruption detected + Move(a^, p.Data, Min(oldCount, count) * elemSize); + TArrayOfByte(a) := nil; // use a non-managed dyn.array type + end; + + {$IFDEF FPC} + p.refcount := 1; + p.high := count -1; + {$ELSE} + p.RefCnt := 1; + p.Length := count; + {$ENDIF} + Result := @p.Data; + end + else + begin + TArrayOfByte(a) := nil; // use a non-managed dyn.array type + Result := nil; + end; +end; +//------------------------------------------------------------------------------ + +function CanReuseDynArray(a: Pointer; count: nativeint): Boolean; +// returns True if RefCnt=1 and Length=count +begin + //Assert(a <> nil); + a := PByte(a) - SizeOf(TDynArrayRec); + Result := + {$IFDEF FPC} + (PDynArrayRec(a).refcount = 1) and + (PDynArrayRec(a).high = count - 1); + {$ELSE} + (PDynArrayRec(a).RefCnt = 1) and + (PDynArrayRec(a).Length = count); + {$ENDIF} +end; +//------------------------------------------------------------------------------ + +procedure NewColor32Array(var a: TArrayOfColor32; count: nativeint; uninitialized: boolean); +begin + if a <> nil then + begin + if uninitialized and CanReuseDynArray(a, count) then + Exit; + a := nil; + end; + Pointer(a) := NewSimpleDynArray(count, SizeOf(TColor32), uninitialized); +end; +//------------------------------------------------------------------------------ + +procedure NewIntegerArray(var a: TArrayOfInteger; count: nativeint; uninitialized: boolean); +begin + if a <> nil then + begin + if uninitialized and CanReuseDynArray(a, count) then + Exit; + a := nil; + end; + Pointer(a) := NewSimpleDynArray(count, SizeOf(Integer), uninitialized); +end; +//------------------------------------------------------------------------------ + +procedure NewByteArray(var a: TArrayOfByte; count: nativeint; uninitialized: boolean); +begin + if a <> nil then + begin + if uninitialized and CanReuseDynArray(a, count) then + Exit; + a := nil; + end; + Pointer(a) := NewSimpleDynArray(count, SizeOf(Byte), uninitialized); +end; +//------------------------------------------------------------------------------ + +procedure NewPointDArray(var a: TPathD; count: nativeint; uninitialized: boolean); +begin + if a <> nil then + begin + if uninitialized and CanReuseDynArray(a, count) then + Exit; + a := nil; + end; + Pointer(a) := NewSimpleDynArray(count, SizeOf(TPointD), uninitialized); +end; +//------------------------------------------------------------------------------ + +procedure SetLengthUninit(var a: TArrayOfColor32; count: nativeint); +begin + Pointer(a) := InternSetSimpleDynArrayLengthUninit(Pointer(a), count, SizeOf(TColor32)); +end; +//------------------------------------------------------------------------------ + +procedure SetLengthUninit(var a: TArrayOfInteger; count: nativeint); +begin + Pointer(a) := InternSetSimpleDynArrayLengthUninit(Pointer(a), count, SizeOf(Integer)); +end; +//------------------------------------------------------------------------------ + +procedure SetLengthUninit(var a: TArrayOfByte; count: nativeint); +begin + Pointer(a) := InternSetSimpleDynArrayLengthUninit(Pointer(a), count, SizeOf(Byte)); +end; +//------------------------------------------------------------------------------ + +procedure SetLengthUninit(var a: TPathD; count: nativeint); +begin + Pointer(a) := InternSetSimpleDynArrayLengthUninit(Pointer(a), count, SizeOf(TPointD)); +end; +//------------------------------------------------------------------------------ + procedure CreateImageFormatList; begin if Assigned(ImageFormatClassList) then Exit; @@ -692,7 +920,7 @@ function __Trunc(Value: Double): Integer; // 52 bit fractional value, 11bit ($7FF) exponent, and 1bit sign Result := 0; if i64 = 0 then Exit; - exp := Integer(Cardinal(i64 shr 52) and $7FF) - 1023; + exp := Integer(Cardinal(i64 shr 52) and $7FF) - 1023; // nb: when exp == 1024 then Value == INF or NAN. if exp < 0 then Exit @@ -776,170 +1004,494 @@ function ClampByte(val: double): byte; function BlendToOpaque(bgColor, fgColor: TColor32): TColor32; var - res: TARGB absolute Result; - bg: TARGB absolute bgColor; - fg: TARGB absolute fgColor; + fgA: byte; fw,bw: PByteArray; begin - if fg.A = 0 then Result := bgColor - else if fg.A = 255 then Result := fgColor + fgA := fgColor shr 24; + if fgA = 0 then Result := bgColor + else if fgA = 255 then Result := fgColor else begin //assuming bg.A = 255, use just fg.A for color weighting - res.A := 255; - fw := PByteArray(@MulTable[fg.A]); //ie weight of foreground - bw := PByteArray(@MulTable[not fg.A]); //ie weight of foreground - res.R := fw[fg.R] + bw[bg.R]; - res.G := fw[fg.G] + bw[bg.G]; - res.B := fw[fg.B] + bw[bg.B]; + fw := PByteArray(@MulTable[fgA]); //ie weight of foreground + bw := PByteArray(@MulTable[not fgA]); //ie weight of background + + Result := $FF000000 + or (TColor32(Byte(fw[Byte(fgColor shr 16)] + bw[Byte(bgColor shr 16)])) shl 16) + or (TColor32(Byte(fw[Byte(fgColor shr 8 )] + bw[Byte(bgColor shr 8)])) shl 8) + or (TColor32(Byte(fw[Byte(fgColor )] + bw[Byte(bgColor )])) ); end; end; //------------------------------------------------------------------------------ function BlendToAlpha(bgColor, fgColor: TColor32): TColor32; var - res: TARGB absolute Result; - bg: TARGB absolute bgColor; - fg: TARGB absolute fgColor; fgWeight: byte; R, InvR: PByteArray; + bgA, fgA: byte; begin //(see https://en.wikipedia.org/wiki/Alpha_compositing) - if (bg.A = 0) or (fg.A = 255) then Result := fgColor - else if fg.A = 0 then Result := bgColor + fgA := fgColor shr 24; + bgA := bgColor shr 24; + if (bgA = 0) or (fgA = 255) then Result := fgColor + else if fgA = 0 then Result := bgColor else begin //combine alphas ... - res.A := not MulTable[not fg.A, not bg.A]; - fgWeight := DivTable[fg.A, res.A]; //fgWeight = amount foreground color + Result := not MulTable[not fgA, not bgA]; + fgWeight := DivTable[fgA, Result]; //fgWeight = amount foreground color + //contibutes to total (result) color + + R := PByteArray(@MulTable[fgWeight]); //ie weight of foreground + InvR := PByteArray(@MulTable[not fgWeight]); //ie weight of background + + Result := Result shl 24 + or (TColor32(R[Byte(fgColor shr 16)] + InvR[Byte(bgColor shr 16)]) shl 16) + or (TColor32(R[Byte(fgColor shr 8 )] + InvR[Byte(bgColor shr 8)]) shl 8) + or (TColor32(R[Byte(fgColor) ] + InvR[Byte(bgColor) ]) ); + end; +end; +//------------------------------------------------------------------------------ + +{$RANGECHECKS OFF} // negative array index is used + +{$IFNDEF CPUX64} +function BlendToAlphaLineX86(bgColorArr, fgColorArr: PStaticColor32Array; + idx: nativeint): nativeint; +// Helper function for x86 code, reduces the CPU register pressure in +// BlendToAlphaLine(). +var + fgWeight: byte; + R, InvR: PByteArray; + fgA, bgA, newBgA: byte; + fgCol, bgCol: TColor32; +begin + fgCol := fgColorArr[idx]; + bgCol := bgColorArr[idx]; + Result := idx; // idx - negative offset into color arrays + + while True do + begin + fgA := fgCol shr 24; + bgA := bgCol shr 24; + + //combine alphas ... + newBgA := not MulTable[not fgA, not bgA]; + fgWeight := DivTable[fgA, newBgA]; //fgWeight = amount foreground color //contibutes to total (result) color R := PByteArray(@MulTable[fgWeight]); //ie weight of foreground InvR := PByteArray(@MulTable[not fgWeight]); //ie weight of foreground - res.R := R[fg.R] + InvR[bg.R]; - res.G := R[fg.G] + InvR[bg.G]; - res.B := R[fg.B] + InvR[bg.B]; + + while True do + begin + bgColorArr[Result] := TColor32(newBgA) shl 24 + or (TColor32(R[Byte(fgCol shr 16)] + InvR[Byte(bgCol shr 16)]) shl 16) + or (TColor32(R[Byte(fgCol shr 8 )] + InvR[Byte(bgCol shr 8)]) shl 8) + or (TColor32(R[Byte(fgCol) ] + InvR[Byte(bgCol) ]) ); + inc(Result); + if Result = 0 then exit; + + fgCol := fgColorArr[Result]; + bgCol := bgColorArr[Result]; + + // if both alpha channels are the same in the new pixels, we + // can use the already calculated R/InvR tables. + if (fgCol shr 24 <> fgA) or (bgCol shr 24 <> bgA) then break; + end; + // return if we have alpha channel values for which we have special code + if (fgCol and $FF000000 = 0) or (fgCol and $FF000000 = $FF000000) or (bgCol and $FF000000 = 0) then exit; + end; +end; +//------------------------------------------------------------------------------ +{$ENDIF ~CPUX64} + +procedure BlendToAlphaLine(bgColor, fgColor: PColor32; width: nativeint); +label + LabelBgAlphaIsZero; +var + bgColorArr, fgColorArr: PStaticColor32Array; + bgCol, fgCol: TColor32; + {$IFDEF CPUX64} + fgWeight, fgA, bgA: byte; + R, InvR: PByteArray; + {$ENDIF CPUX64} +begin + //(see https://en.wikipedia.org/wiki/Alpha_compositing) + + // Use the negative offset trick to only increment the array "width" + // until it reaches zero. And by offsetting the arrays by "width", + // the negative "width" values also becomes the index into these arrays. + inc(bgColor, width); + inc(fgColor, width); + width := -width; + + bgColorArr := PStaticColor32Array(bgColor); + fgColorArr := PStaticColor32Array(fgColor); + + while width < 0 do + begin + bgCol := bgColorArr[width]; + fgCol := fgColorArr[width]; + + // bgColor.A is zero => change bgColor to fgColor + while bgCol shr 24 = 0 do + begin +LabelBgAlphaIsZero: + bgColorArr[width] := fgCol; + inc(width); + if width = 0 then exit; + fgCol := fgColorArr[width]; + bgCol := bgColorArr[width]; + end; + + // fgColor.A is zero => don't change bgColor + while fgCol shr 24 = 0 do + begin + // bgColorArr[w] := bgColorArr[w]; + inc(width); + if width = 0 then exit; + fgCol := fgColorArr[width]; + bgCol := bgColorArr[width]; + if bgCol shr 24 = 0 then goto LabelBgAlphaIsZero; + end; + + // fgColor.A is 255 => change bgColor to fgColor + while fgCol shr 24 = 255 do + begin + bgColorArr[width] := fgCol; + inc(width); + if width = 0 then exit; + fgCol := fgColorArr[width]; + bgCol := bgColorArr[width]; + if bgCol shr 24 = 0 then goto LabelBgAlphaIsZero; + end; + + {$IFDEF CPUX64} + // x64 has more CPU registers than x86 and calling BlendToAlphaLineX86 + // is slower, so we inline it. + + //combine alphas ... + fgA := fgCol shr 24; + bgA := bgCol shr 24; + bgA := not MulTable[not fgA, not bgA]; + fgWeight := DivTable[fgA, bgA]; //fgWeight = amount foreground color + //contibutes to total (result) color + + R := PByteArray(@MulTable[fgWeight]); //ie weight of foreground + InvR := PByteArray(@MulTable[not fgWeight]); //ie weight of foreground + + bgColorArr[width] := TColor32(bgA) shl 24 + or (TColor32(R[Byte(fgCol shr 16)] + InvR[Byte(bgCol shr 16)]) shl 16) + or (TColor32(R[Byte(fgCol shr 8 )] + InvR[Byte(bgCol shr 8)]) shl 8) + or (TColor32(R[Byte(fgCol) ] + InvR[Byte(bgCol) ]) ); + inc(width); + {$ELSE} + // x86 has not enough CPU registers and the loops above will suffer if we + // inline the code. So we let the compiler use a "new set" of CPU registers + // by calling a function. + width := BlendToAlphaLineX86(bgColorArr, fgColorArr, width); + {$ENDIF CPUX64} end; end; //------------------------------------------------------------------------------ +{ +// reference implementation +procedure BlendToAlphaLine(bgColor, fgColor: PColor32; width: nativeint); +var + fgWeight: byte; + R, InvR: PByteArray; + bgA, fgA: Byte; + bgColorArr, fgColorArr: PStaticColor32Array; + bgCol, fgCol: TColor32; +begin + //(see https://en.wikipedia.org/wiki/Alpha_compositing) + + // Use the negative offset trick to only increment the array "width" + // until it reaches zero. And by offsetting the arrays by "width", + // the negative "width" values also becomes the index into these arrays. + inc(bgColor, width); + inc(fgColor, width); + width := -width; + + bgColorArr := PStaticColor32Array(bgColor); + fgColorArr := PStaticColor32Array(fgColor); + + while width < 0 do + begin + bgCol := bgColorArr[width]; + fgCol := fgColorArr[width]; + bgA := bgCol shr 24; + if bgA = 0 then bgColorArr[width] := fgCol + else + begin + fgA := fgCol shr 24; + if fgA > 0 then + begin + if fgA = 255 then bgColorArr[width] := fgCol + else if fgA > 0 then + begin + //combine alphas ... + bgA := not MulTable[not fgA, not bgA]; + fgWeight := DivTable[fgA, bgA]; //fgWeight = amount foreground color + //contibutes to total (result) color + + R := PByteArray(@MulTable[fgWeight]); //ie weight of foreground + InvR := PByteArray(@MulTable[not fgWeight]); //ie weight of foreground + + bgColorArr[width] := TColor32(bgA) shl 24 + or (TColor32(R[Byte(fgCol shr 16)] + InvR[Byte(bgCol shr 16)]) shl 16) + or (TColor32(R[Byte(fgCol shr 8 )] + InvR[Byte(bgCol shr 8)]) shl 8) + or (TColor32(R[Byte(fgCol) ] + InvR[Byte(bgCol) ]) ); + end; + end; + end; + + inc(width); + end; +end;} +{$IFDEF RANGECHECKS_ENABLED} + {$RANGECHECKS ON} +{$ENDIF} +//------------------------------------------------------------------------------ + function BlendMask(bgColor, alphaMask: TColor32): TColor32; var - res: TARGB absolute Result; - bg: TARGB absolute bgColor; - fg: TARGB absolute alphaMask; + a: byte; begin - Result := bgColor; - res.A := MulTable[bg.A, fg.A]; - if res.A = 0 then Result := 0; + a := MulTable[bgColor shr 24, alphaMask shr 24]; + if a <> 0 then Result := (TColor32(a) shl 24) or (bgColor and $00FFFFFF) + else Result := 0; +end; +//------------------------------------------------------------------------------ + +{$RANGECHECKS OFF} // negative array index is used + +procedure BlendMaskLine(bgColor, alphaMask: PColor32; width: nativeint); +var + a: byte; +begin + // Use the negative offset trick to only increment the array "width" + // until it reaches zero. And by offsetting the arrays by "width", + // the negative "width" values also becomes the index into these arrays. + inc(bgColor, width); + inc(alphaMask, width); + width := -width; + + // Handle special cases Alpha=0 or 255 as those are the most + // common values. + while width < 0 do + begin + a := PStaticARGBArray(bgColor)[width].A; + // MulTable[0, fgA] -> 0 => replace color with 0 + while a = 0 do + begin + PStaticColor32Array(bgColor)[width] := 0; + inc(width); + if width = 0 then exit; + a := PStaticARGBArray(bgColor)[width].A; + end; + // MulTable[255, fgA] -> fgA => replace alpha with fgA + while a = 255 do + begin + PStaticARGBArray(bgColor)[width].A := PStaticARGBArray(alphaMask)[width].A; + inc(width); + if width = 0 then exit; + a := PStaticARGBArray(bgColor)[width].A; + end; + + a := PStaticARGBArray(alphaMask)[width].A; + // MulTable[bgA, 0] -> 0 => replace color with 0 + while a = 0 do + begin + PStaticColor32Array(bgColor)[width] := 0; + inc(width); + if width = 0 then exit; + a := PStaticARGBArray(alphaMask)[width].A; + end; + // MulTable[bgA, 255] -> bgA => nothing to do + while a = 255 do + begin + inc(width); + if width = 0 then exit; + a := PStaticARGBArray(alphaMask)[width].A; + end; + + a := MulTable[PStaticARGBArray(bgColor)[width].A, a]; + if a <> 0 then PStaticARGBArray(bgColor)[width].A := a + else PStaticColor32Array(bgColor)[width] := 0; + + inc(width); + end; end; //------------------------------------------------------------------------------ +{ +// reference implementation +procedure BlendMaskLine(bgColor, alphaMask: PColor32; width: nativeint); +var + a: byte; +begin + // Use the negative offset trick to only increment the array "width" + // until it reaches zero. And by offsetting the arrays by "width", + // the negative "width" values also becomes the index into these arrays. + inc(bgColor, width); + inc(alphaMask, width); + width := -width; + + while width < 0 do + begin + a := MulTable[PStaticARGBArray(bgColor)[width].A, + PStaticARGBArray(alphaMask)[width].A]; + if a = 0 then PStaticColor32Array(bgColor)[width] := 0 + else PStaticARGBArray(bgColor)[width].A := a; + + inc(width); + end; +end;} +{$IFDEF RANGECHECKS_ENABLED} + {$RANGECHECKS ON} +{$ENDIF} +//------------------------------------------------------------------------------ + function BlendAltMask(bgColor, alphaMask: TColor32): TColor32; var - res: TARGB absolute Result; - bg: TARGB absolute bgColor; - fg: TARGB absolute alphaMask; + a: byte; begin - Result := bgColor; - res.A := MulTable[bg.A, 255-fg.A]; - if res.A = 0 then Result := 0; + a := MulTable[bgColor shr 24, (alphaMask shr 24) xor 255]; + if a <> 0 then Result := (TColor32(a) shl 24) or (bgColor and $00FFFFFF) + else Result := 0; end; //------------------------------------------------------------------------------ function BlendDifference(color1, color2: TColor32): TColor32; var - res: TARGB absolute Result; - bg: TARGB absolute color1; - fg: TARGB absolute color2; + fgA, bgA: byte; begin - if fg.A = 0 then Result := color1 - else if bg.A = 0 then Result := color2 + fgA := color2 shr 24; + bgA := color1 shr 24; + if fgA = 0 then Result := color1 + else if bgA = 0 then Result := color2 else begin - res.A := (((fg.A xor 255) * (bg.A xor 255)) shr 8) xor 255; - res.R := Abs(fg.R - bg.R); - res.G := Abs(fg.G - bg.G); - res.B := Abs(fg.B - bg.B); + Result := TColor32(MulTable[(fgA xor 255), (bgA xor 255)] xor 255) shl 24 + or (TColor32(Abs(Byte(color2 shr 16) - Byte(color1 shr 16))) shl 16) + or (TColor32(Abs(Byte(color2 shr 8) - Byte(color1 shr 8))) shl 8) + or (TColor32(Abs(Byte(color2 ) - Byte(color1 ))) ); end; end; //------------------------------------------------------------------------------ function BlendSubtract(bgColor, fgColor: TColor32): TColor32; var - res: TARGB absolute Result; - bg: TARGB absolute bgColor; - fg: TARGB absolute fgColor; + fgA, bgA: byte; begin - if fg.A = 0 then Result := bgColor - else if bg.A = 0 then Result := fgColor + fgA := fgColor shr 24; + bgA := bgColor shr 24; + if fgA = 0 then Result := bgColor + else if bgA = 0 then Result := fgColor else begin - res.A := (((fg.A xor 255) * (bg.A xor 255)) shr 8) xor 255; - res.R := ClampByte(fg.R - bg.R); - res.G := ClampByte(fg.G - bg.G); - res.B := ClampByte(fg.B - bg.B); + Result := TColor32(MulTable[(fgA xor 255), (bgA xor 255)] xor 255) shl 24 + or (TColor32(ClampByte(Byte(fgColor shr 16) - Byte(bgColor shr 16))) shl 16) + or (TColor32(ClampByte(Byte(fgColor shr 8 ) - Byte(bgColor shr 8))) shl 8) + or (TColor32(ClampByte(Byte(fgColor ) - Byte(bgColor ))) ); end; end; //------------------------------------------------------------------------------ function BlendLighten(bgColor, fgColor: TColor32): TColor32; var - res: TARGB absolute Result; - bg: TARGB absolute bgColor; - fg: TARGB absolute fgColor; + fgA, bgA: byte; begin - if fg.A = 0 then Result := bgColor - else if bg.A = 0 then Result := fgColor + fgA := fgColor shr 24; + bgA := bgColor shr 24; + if fgA = 0 then Result := bgColor + else if bgA = 0 then Result := fgColor else begin - res.A := (((fg.A xor 255) * (bg.A xor 255)) shr 8) xor 255; - res.R := Max(fg.R, bg.R); - res.G := Max(fg.G, bg.G); - res.B := Max(fg.B, bg.B); + Result := TColor32(MulTable[(fgA xor 255), (bgA xor 255)] xor 255) shl 24 + or (TColor32(Max(Byte(fgColor shr 16), Byte(bgColor shr 16))) shl 16) + or (TColor32(Max(Byte(fgColor shr 8 ), Byte(bgColor shr 8))) shl 8) + or (TColor32(Max(Byte(fgColor ), Byte(bgColor ))) ); end; end; //------------------------------------------------------------------------------ function BlendDarken(bgColor, fgColor: TColor32): TColor32; var - res: TARGB absolute Result; - bg: TARGB absolute bgColor; - fg: TARGB absolute fgColor; + fgA, bgA: byte; begin - if fg.A = 0 then Result := bgColor - else if bg.A = 0 then Result := fgColor + fgA := fgColor shr 24; + bgA := bgColor shr 24; + if fgA = 0 then Result := bgColor + else if bgA = 0 then Result := fgColor else begin - res.A := (((fg.A xor 255) * (bg.A xor 255)) shr 8) xor 255; - res.R := Min(fg.R, bg.R); - res.G := Min(fg.G, bg.G); - res.B := Min(fg.B, bg.B); + Result := TColor32(MulTable[(fgA xor 255), (bgA xor 255)] xor 255) shl 24 + or (TColor32(Min(Byte(fgColor shr 16), Byte(bgColor shr 16))) shl 16) + or (TColor32(Min(Byte(fgColor shr 8 ), Byte(bgColor shr 8))) shl 8) + or (TColor32(Min(Byte(fgColor ), Byte(bgColor ))) ); end; end; //------------------------------------------------------------------------------ function BlendBlueChannel(bgColor, blueMask: TColor32): TColor32; -var - res: TARGB absolute Result; - bg: TARGB absolute bgColor; - fg: TARGB absolute blueMask; begin - Result := bgColor; - res.A := MulTable[bg.A, fg.B]; + Result := (bgColor and $00FFFFFF) or + (TColor32(MulTable[bgColor shr 24, blueMask shr 24]) shl 24); +end; +//------------------------------------------------------------------------------ + +procedure BlendBlueChannelLine(bgColor, blueMask: PColor32; width: nativeint); +begin + while width > 0 do + begin + PARGB(bgColor).A := MulTable[PARGB(bgColor).A, PARGB(blueMask).A]; + inc(bgColor); + inc(blueMask); + dec(width); + end; end; //------------------------------------------------------------------------------ function BlendInvertedMask(bgColor, alphaMask: TColor32): TColor32; var - res: TARGB absolute Result; - bg: TARGB absolute bgColor; - fg: TARGB absolute alphaMask; + a: byte; begin - Result := bgColor; - res.A := MulTable[bg.A, 255 - fg.A]; - if res.A < 2 then Result := 0; + a := MulTable[bgColor shr 24, (alphaMask shr 24) xor 255]; + if a < 2 then Result := 0 + else Result := (bgColor and $00FFFFFF) or (TColor32(a) shl 24); end; +//------------------------------------------------------------------------------ + +{$RANGECHECKS OFF} // negative array index is used + +procedure BlendInvertedMaskLine(bgColor, alphaMask: PColor32; width: nativeint); +var + a: byte; +begin + // Use the negative offset trick to only increment the array "width" + // until it reaches zero. And by offsetting the arrays by "width", + // the negative "width" values also becomes the index into these arrays. + inc(bgColor, width); + inc(alphaMask, width); + width := -width; + + while width < 0 do + begin + a := MulTable[PStaticARGBArray(bgColor)[width].A, + PStaticARGBArray(alphaMask)[width].A xor 255]; + if a < 2 then PStaticColor32Array(bgColor)[width] := 0 + else PStaticARGBArray(bgColor)[width].A := a; + + inc(width); + end; +end; +{$IFDEF RANGECHECKS_ENABLED} + {$RANGECHECKS ON} +{$ENDIF} //------------------------------------------------------------------------------ // Compare functions (see ConvertToBoolMask, FloodFill & Vectorize) @@ -1242,7 +1794,7 @@ function GetBoolMask(img: TImage32; reference: TColor32; result := nil; if not assigned(img) or img.IsEmpty then Exit; if not Assigned(compareFunc) then compareFunc := CompareRGB; - SetLength(Result, img.Width * img.Height); + NewByteArray(Result, img.Width * img.Height, True); pa := @Result[0]; pc := img.PixelBase; for i := 0 to img.Width * img.Height -1 do @@ -1270,7 +1822,7 @@ function GetColorMask(img: TImage32; reference: TColor32; result := nil; if not assigned(img) or img.IsEmpty then Exit; if not Assigned(compareFunc) then compareFunc := CompareRGB; - SetLength(Result, img.Width * img.Height); + NewColor32Array(Result, img.Width * img.Height, True); pDstPxl := @Result[0]; pSrcPxl := img.PixelBase; for i := 0 to img.Width * img.Height -1 do @@ -1302,7 +1854,7 @@ function GetByteMask(img: TImage32; reference: TColor32; result := nil; if not assigned(img) or img.IsEmpty then Exit; if not Assigned(compareFunc) then compareFunc := GetAlphaEx; - SetLength(Result, img.Width * img.Height); + NewByteArray(Result, img.Width * img.Height, True); pa := @Result[0]; pc := img.PixelBase; for i := 0 to img.Width * img.Height -1 do @@ -1424,7 +1976,7 @@ function ArrayOfHSLToArrayColor32(const hslArr: TArrayofHSL): TArrayOfColor32; i, len: Integer; begin len := length(hslArr); - setLength(result, len); + NewColor32Array(result, len, True); for i := 0 to len -1 do result[i] := HslToRgb(hslArr[i]); end; @@ -1577,7 +2129,7 @@ constructor TImage32.Create(width: Integer; height: Integer); fResampler := DefaultResampler; fwidth := Max(0, width); fheight := Max(0, height); - SetLength(fPixels, fwidth * fheight); + NewColor32Array(fPixels, fwidth * fheight); end; //------------------------------------------------------------------------------ @@ -1611,9 +2163,8 @@ constructor TImage32.Create(src: TImage32; const srcRec: TRect); fResampler := src.fResampler; types.IntersectRect(rec, src.Bounds, srcRec); RectWidthHeight(rec, fWidth, fHeight); - SetLength(fPixels, fWidth * fHeight); if (fWidth = 0) or (fheight = 0) then Exit; - fPixels := src.CopyPixels(srcRec); + fPixels := src.CopyPixels(rec); end; //------------------------------------------------------------------------------ @@ -1888,23 +2439,47 @@ procedure TImage32.Clear(const rec: TRect; color: TColor32 = 0); end; //------------------------------------------------------------------------------ -procedure TImage32.FillRect(rec: TRect; color: TColor32); +procedure TImage32.FillRect(const rec: TRect; color: TColor32); var - i,j, rw: Integer; + i,j, rw, w: Integer; c: PColor32; + r: TRect; begin - Types.IntersectRect(rec, rec, bounds); - if IsEmptyRect(rec) then Exit; - rw := RectWidth(rec); - c := @Pixels[rec.Top * Width + rec.Left]; - for i := rec.Top to rec.Bottom -1 do + Types.IntersectRect(r, rec, bounds); + if IsEmptyRect(r) then Exit; + rw := RectWidth(r); + w := Width; + c := @Pixels[r.Top * w + r.Left]; + + if (color = 0) and (w = rw) then + FillChar(c^, (r.Bottom - r.Top) * rw * SizeOf(TColor32), 0) + else if rw = 1 then begin - for j := 1 to rw do + for i := r.Top to r.Bottom -1 do begin c^ := color; - inc(c); + inc(c, w); + end; + end + else if (color = 0) and (rw > 15) then + begin + for i := r.Top to r.Bottom -1 do + begin + FillChar(c^, rw * SizeOf(TColor32), 0); + inc(c, w); + end; + end + else + begin + for i := r.Top to r.Bottom -1 do + begin + for j := 1 to rw do + begin + c^ := color; + inc(c); + end; + inc(c, w - rw); end; - inc(c, Width - rw); end; Changed; end; @@ -1916,29 +2491,50 @@ procedure TImage32.ResetColorCount; end; //------------------------------------------------------------------------------ -function TImage32.RectHasTransparency(rec: TRect): Boolean; +{$RANGECHECKS OFF} // negative array index is used + +function TImage32.RectHasTransparency(const rec: TRect): Boolean; var - i,j, rw: Integer; + i, j, rw: Integer; lineByteOffset: nativeint; c: PARGB; + r: TRect; begin Result := True; - Types.IntersectRect(rec, rec, bounds); - if IsEmptyRect(rec) then Exit; - rw := RectWidth(rec); - c := @Pixels[rec.Top * Width + rec.Left]; - lineByteOffset := (Width - rw) * SizeOf(TColor32); - for i := rec.Top to rec.Bottom -1 do + Types.IntersectRect(r, rec, bounds); + if IsEmptyRect(r) then Exit; + rw := RectWidth(r); + c := @Pixels[r.Top * Width + r.Left]; + + if rw = Width then // we can use one loop begin - for j := 1 to rw do + i := (r.Bottom - r.Top) * rw; + inc(c, i); + i := -i; + while i < 0 do begin - if c.A < 254 then Exit; - inc(c); + if PStaticARGBArray(c)[i].A < 254 then Exit; + inc(i); + end; + end + else + begin + lineByteOffset := (Width - rw) * SizeOf(TColor32); + for i := r.Top to r.Bottom -1 do + begin + for j := 1 to rw do + begin + if c.A < 254 then Exit; + inc(c); + end; + inc(PByte(c), lineByteOffset); end; - inc(PByte(c), lineByteOffset); end; Result := False; end; +{$IFDEF RANGECHECKS_ENABLED} + {$RANGECHECKS ON} +{$ENDIF} //------------------------------------------------------------------------------ procedure CheckBlendFill(pc: PColor32; color: TColor32); @@ -1956,7 +2552,7 @@ function TImage32.CopyPixels(const rec: TRect): TArrayOfColor32; recClipped: TRect; begin RectWidthHeight(rec, w,h); - setLength(result, w * h); + NewColor32Array(result, w * h, True); if w * h = 0 then Exit; Types.IntersectRect(recClipped, rec, Bounds); @@ -2061,7 +2657,7 @@ procedure TImage32.SetSize(newWidth, newHeight: Integer; color: TColor32); fwidth := Max(0, newWidth); fheight := Max(0, newHeight); fPixels := nil; //forces a blank image - SetLength(fPixels, fwidth * fheight); + NewColor32Array(fPixels, fwidth * fheight, True); fIsPremultiplied := false; BlockNotify; Clear(color); @@ -2463,7 +3059,9 @@ function TImage32.GetPixelRow(row: Integer): PColor32; procedure TImage32.CopyInternal(src: TImage32; const srcRec, dstRec: TRect; blendFunc: TBlendFunction); var - i, j, srcRecWidth, srcRecHeight: Integer; + i, j: integer; + srcRecWidth, srcRecHeight: nativeint; + srcWidth, dstWidth: nativeint; s, d: PColor32; begin // occasionally, due to rounding, srcRec and dstRec @@ -2473,39 +3071,109 @@ procedure TImage32.CopyInternal(src: TImage32; srcRecHeight := Min(srcRec.Bottom - srcRec.Top, dstRec.Bottom - dstRec.Top); - s := @src.Pixels[srcRec.Top * src.Width + srcRec.Left]; - d := @Pixels[dstRec.top * Width + dstRec.Left]; + srcWidth := src.Width; + dstWidth := Width; + + s := @src.Pixels[srcRec.Top * srcWidth + srcRec.Left]; + d := @Pixels[dstRec.top * dstWidth + dstRec.Left]; if assigned(blendFunc) then - for i := srcRec.Top to srcRec.Top + srcRecHeight -1 do + begin + srcWidth := (srcWidth - srcRecWidth) * SizeOf(TColor32); + dstWidth := (dstWidth - srcRecWidth) * SizeOf(TColor32); + for i := 1 to srcRecHeight do begin for j := 1 to srcRecWidth do begin d^ := blendFunc(d^, s^); inc(s); inc(d); end; - inc(s, src.Width - srcRecWidth); - inc(d, Width - srcRecWidth); - end + inc(PByte(s), srcWidth); // byte offset to the next s line + inc(PByte(d), dstWidth); // byte offset to the next d line + end; + end + //simply overwrite src with dst (ie without blending) + else if (srcRecWidth = dstWidth) and (srcWidth = dstWidth) then + move(s^, d^, srcRecWidth * srcRecHeight * SizeOf(TColor32)) else - //simply overwrite src with dst (ie without blending) - for i := srcRec.Top to srcRec.Top + srcRecHeight -1 do + begin + srcWidth := srcWidth * SizeOf(TColor32); + dstWidth := dstWidth * SizeOf(TColor32); + srcRecWidth := srcRecWidth * SizeOf(TColor32); + for i := 1 to srcRecHeight do begin - move(s^, d^, srcRecWidth * SizeOf(TColor32)); - inc(s, src.Width); - inc(d, Width); + move(s^, d^, srcRecWidth); + inc(PByte(s), srcWidth); // srcWidth is in bytes + inc(PByte(d), dstWidth); // dstWidth is in bytes end; + end; +end; +//------------------------------------------------------------------------------ +procedure TImage32.CopyInternalLine(src: TImage32; + const srcRec, dstRec: TRect; blendLineFunc: TBlendLineFunction); +var + i: integer; + srcRecWidth, srcRecHeight: nativeint; + srcWidth, dstWidth: nativeint; + s, d: PColor32; +begin + if not Assigned(blendLineFunc) then + begin + CopyInternal(src, srcRec, dstRec, nil); + Exit; + end; + + // occasionally, due to rounding, srcRec and dstRec + // don't have exactly the same widths and heights, so ... + srcRecWidth := + Min(srcRec.Right - srcRec.Left, dstRec.Right - dstRec.Left); + srcRecHeight := + Min(srcRec.Bottom - srcRec.Top, dstRec.Bottom - dstRec.Top); + + srcWidth := src.Width; + dstWidth := Width; + + s := @src.Pixels[srcRec.Top * srcWidth + srcRec.Left]; + d := @Pixels[dstRec.top * dstWidth + dstRec.Left]; + + if (srcRecWidth = dstWidth) and (srcWidth = dstWidth) then + blendLineFunc(d, s, srcRecWidth * srcRecHeight) + else + begin + srcWidth := srcWidth * SizeOf(TColor32); + dstWidth := dstWidth * SizeOf(TColor32); + for i := 1 to srcRecHeight do + begin + blendLineFunc(d, s, srcRecWidth); + inc(PByte(s), srcWidth); // srcWidth is in bytes + inc(PByte(d), dstWidth); // dstWidth is in bytes + end; + end; end; //------------------------------------------------------------------------------ function TImage32.Copy(src: TImage32; srcRec, dstRec: TRect): Boolean; begin - Result := CopyBlend(src, srcRec, dstRec, nil); + Result := CopyBlendInternal(src, srcRec, dstRec, nil, nil); end; //------------------------------------------------------------------------------ -function TImage32.CopyBlend(src: TImage32; srcRec, dstRec: TRect; +function TImage32.CopyBlend(src: TImage32; const srcRec, dstRec: TRect; blendFunc: TBlendFunction): Boolean; +begin + Result := CopyBlendInternal(src, srcRec, dstRec, blendFunc, nil); +end; +//------------------------------------------------------------------------------ + +function TImage32.CopyBlend(src: TImage32; const srcRec, dstRec: TRect; + blendLineFunc: TBlendLineFunction): Boolean; +begin + Result := CopyBlendInternal(src, srcRec, dstRec, nil, blendLineFunc); +end; +//------------------------------------------------------------------------------ + +function TImage32.CopyBlendInternal(src: TImage32; srcRec, dstRec: TRect; + blendFunc: TBlendFunction; blendLineFunc: TBlendLineFunction): Boolean; var tmp: TImage32; srcRecClipped, dstRecClipped, r: TRect; @@ -2550,7 +3218,7 @@ function TImage32.CopyBlend(src: TImage32; srcRec, dstRec: TRect; tmp.AssignSettings(src); src.ScaleTo(tmp, scaleX, scaleY); ScaleRect(srcRecClipped, scaleX, scaleY); - result := CopyBlend(tmp, srcRecClipped, dstRec, blendFunc); + result := CopyBlendInternal(tmp, srcRecClipped, dstRec, blendFunc, blendLineFunc); finally tmp.Free; end; @@ -2580,14 +3248,17 @@ function TImage32.CopyBlend(src: TImage32; srcRec, dstRec: TRect; begin tmp := TImage32.Create(self, srcRecClipped); try - result := src.CopyBlend(tmp, tmp.Bounds, dstRecClipped, blendFunc); + result := src.CopyBlendInternal(tmp, tmp.Bounds, dstRecClipped, blendFunc, blendLineFunc); finally tmp.Free; end; Exit; end; - CopyInternal(src, srcRecClipped, dstRecClipped, blendFunc); + if Assigned(blendLineFunc) then + CopyInternalLine(src, srcRecClipped, dstRecClipped, blendLineFunc) + else + CopyInternal(src, srcRecClipped, dstRecClipped, blendFunc); result := true; Changed; end; @@ -2921,7 +3592,7 @@ procedure TImage32.FlipVertical; src, dst: PColor32; begin if IsEmpty then Exit; - SetLength(a, fWidth * fHeight); + NewColor32Array(a, fWidth * fHeight, True); src := @fPixels[(height-1) * width]; dst := @a[0]; for i := 0 to fHeight -1 do @@ -2941,7 +3612,7 @@ procedure TImage32.FlipHorizontal; row: PColor32; begin if IsEmpty then Exit; - SetLength(a, fWidth); + NewColor32Array(a, fWidth, True); widthLess1 := fWidth -1; row := @fPixels[(height-1) * width]; //top row for i := 0 to fHeight -1 do @@ -3251,8 +3922,10 @@ procedure TImage32.Rotate(angleRads: double); var mat: TMatrixD; begin - if not ClockwiseRotationIsAnglePositive then - angleRads := -angleRads; + +{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES} + angleRads := -angleRads; +{$ENDIF} //nb: There's no point rotating about a specific point //since the rotated image will be recentered. diff --git a/Packages/D10_1/SVGIconImageList.dpk b/Packages/D10_1/SVGIconImageList.dpk index bc55d39..8ef185b 100644 --- a/Packages/D10_1/SVGIconImageList.dpk +++ b/Packages/D10_1/SVGIconImageList.dpk @@ -1,5 +1,6 @@ package SVGIconImageList; +{$INCLUDE ..\..\Source\SVGIconImageList.inc} {$R *.res} {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} {$ALIGN 8} @@ -31,10 +32,17 @@ package SVGIconImageList; {$IMPLICITBUILD OFF} requires - vcl, - VclSmp, - SVGImage32Package, - vclimg; + vcl + , VclSmp + , vclimg + {$IFDEF Image32_SVGEngine} + , SVGImage32Package + {$ENDIF} + {$IFDEF Skia_SVGEngine} + , Skia.Package.VCL + , Skia.Package.RTL + {$ENDIF} + ; contains SVGIconImage in '..\..\Source\SVGIconImage.pas', @@ -44,9 +52,16 @@ contains SVGIconItems in '..\..\Source\SVGIconItems.pas', SVGIconVirtualImageList in '..\..\Source\SVGIconVirtualImageList.pas', SVGIconImageListBase in '..\..\Source\SVGIconImageListBase.pas', + {$IFDEF PreferNativeSvgSupport} D2DSVGFactory in '..\..\Source\D2DSVGFactory.pas', Winapi.D2DMissing in '..\..\Source\Winapi.D2DMissing.pas', + {$ENDIF} + {$IFDEF Image32_SVGEngine} Image32SVGFactory in '..\..\Source\Image32SVGFactory.pas', + {$ENDIF} + {$IFDEF Skia_SVGEngine} + SkiaSVGFactory in '..\..\Source\SkiaSVGFactory.pas', + {$ENDIF} SVGInterfaces in '..\..\Source\SVGInterfaces.pas', dlgExportPNG in '..\..\Source\dlgExportPNG.pas' {ExportToPNGDialog}; diff --git a/Packages/D10_1/SVGIconImageList.dproj b/Packages/D10_1/SVGIconImageList.dproj index 33e59d2..636e1ea 100644 --- a/Packages/D10_1/SVGIconImageList.dproj +++ b/Packages/D10_1/SVGIconImageList.dproj @@ -49,7 +49,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 @@ -57,13 +57,12 @@ _D10_1 ..\..\Image32\Source;$(DCC_UnitSearchPath) true + 1033 - 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 @@ -89,7 +88,6 @@ - @@ -98,13 +96,14 @@ - - -
ExportToPNGDialog
 + + Cfg_2 + Base + Base @@ -112,10 +111,6 @@ Cfg_1 Base - - Cfg_2 - Base - Delphi.Personality.12 diff --git a/Packages/D10_1/SVGImage32Package.dproj b/Packages/D10_1/SVGImage32Package.dproj index 840f653..7a47f51 100644 --- a/Packages/D10_1/SVGImage32Package.dproj +++ b/Packages/D10_1/SVGImage32Package.dproj @@ -81,6 +81,7 @@ + diff --git a/Packages/D10_1/dclSVGIconImageList.dproj b/Packages/D10_1/dclSVGIconImageList.dproj index 3961858..31f078a 100644 --- a/Packages/D10_1/dclSVGIconImageList.dproj +++ b/Packages/D10_1/dclSVGIconImageList.dproj @@ -52,6 +52,7 @@ _D10_1 ..\..\Source;..\..\Image32\Source;$(DCC_UnitSearchPath) true + 1033 Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) diff --git a/Packages/D10_2/SVGIconImageList.dpk b/Packages/D10_2/SVGIconImageList.dpk index 965dc4e..8979c4c 100644 --- a/Packages/D10_2/SVGIconImageList.dpk +++ b/Packages/D10_2/SVGIconImageList.dpk @@ -1,5 +1,6 @@ package SVGIconImageList; +{$INCLUDE ..\..\Source\SVGIconImageList.inc} {$R *.res} {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} {$ALIGN 8} @@ -31,10 +32,17 @@ package SVGIconImageList; {$IMPLICITBUILD OFF} requires - vcl, - VclSmp, - SVGImage32Package, - vclimg; + vcl + , VclSmp + , vclimg + {$IFDEF Image32_SVGEngine} + , SVGImage32Package + {$ENDIF} + {$IFDEF Skia_SVGEngine} + , Skia.Package.VCL + , Skia.Package.RTL + {$ENDIF} + ; contains SVGIconImage in '..\..\Source\SVGIconImage.pas', @@ -44,9 +52,16 @@ contains SVGIconItems in '..\..\Source\SVGIconItems.pas', SVGIconVirtualImageList in '..\..\Source\SVGIconVirtualImageList.pas', SVGIconImageListBase in '..\..\Source\SVGIconImageListBase.pas', + {$IFDEF PreferNativeSvgSupport} D2DSVGFactory in '..\..\Source\D2DSVGFactory.pas', Winapi.D2DMissing in '..\..\Source\Winapi.D2DMissing.pas', + {$ENDIF} + {$IFDEF Image32_SVGEngine} Image32SVGFactory in '..\..\Source\Image32SVGFactory.pas', + {$ENDIF} + {$IFDEF Skia_SVGEngine} + SkiaSVGFactory in '..\..\Source\SkiaSVGFactory.pas', + {$ENDIF} SVGInterfaces in '..\..\Source\SVGInterfaces.pas', dlgExportPNG in '..\..\Source\dlgExportPNG.pas' {ExportToPNGDialog}; diff --git a/Packages/D10_2/SVGIconImageList.dproj b/Packages/D10_2/SVGIconImageList.dproj index 7e31bf5..0e9509d 100644 --- a/Packages/D10_2/SVGIconImageList.dproj +++ b/Packages/D10_2/SVGIconImageList.dproj @@ -49,7 +49,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 @@ -57,13 +57,12 @@ _D10_2 ..\..\Image32\Source;$(DCC_UnitSearchPath) true + 1033 - 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 @@ -89,7 +88,6 @@ - @@ -98,13 +96,14 @@ - - -
ExportToPNGDialog
 + + Cfg_2 + Base + Base @@ -112,10 +111,6 @@ Cfg_1 Base - - Cfg_2 - Base - Delphi.Personality.12 diff --git a/Packages/D10_2/SVGImage32Package.dproj b/Packages/D10_2/SVGImage32Package.dproj index 8fc457d..f112688 100644 --- a/Packages/D10_2/SVGImage32Package.dproj +++ b/Packages/D10_2/SVGImage32Package.dproj @@ -81,6 +81,7 @@ + diff --git a/Packages/D10_2/dclSVGIconImageList.dproj b/Packages/D10_2/dclSVGIconImageList.dproj index 48baf75..7e71abd 100644 --- a/Packages/D10_2/dclSVGIconImageList.dproj +++ b/Packages/D10_2/dclSVGIconImageList.dproj @@ -52,6 +52,7 @@ _D10_2 ..\..\Source;..\..\Image32\Source;$(DCC_UnitSearchPath) true + 1033 Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) diff --git a/Packages/D10_3/SVGIconImageList.dpk b/Packages/D10_3/SVGIconImageList.dpk index 0e329ce..3436921 100644 --- a/Packages/D10_3/SVGIconImageList.dpk +++ b/Packages/D10_3/SVGIconImageList.dpk @@ -1,5 +1,6 @@ package SVGIconImageList; +{$INCLUDE ..\..\Source\SVGIconImageList.inc} {$R *.res} {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} {$ALIGN 8} @@ -31,10 +32,17 @@ package SVGIconImageList; {$IMPLICITBUILD OFF} requires - vcl, - VclSmp, - SVGImage32Package, - vclwinx; + vcl + , VclSmp + , vclwinx + {$IFDEF Image32_SVGEngine} + , SVGImage32Package + {$ENDIF} + {$IFDEF Skia_SVGEngine} + , Skia.Package.VCL + , Skia.Package.RTL + {$ENDIF} + ; contains SVGIconImage in '..\..\Source\SVGIconImage.pas', @@ -44,9 +52,16 @@ contains SVGIconItems in '..\..\Source\SVGIconItems.pas', SVGIconVirtualImageList in '..\..\Source\SVGIconVirtualImageList.pas', SVGIconImageListBase in '..\..\Source\SVGIconImageListBase.pas', + {$IFDEF PreferNativeSvgSupport} D2DSVGFactory in '..\..\Source\D2DSVGFactory.pas', Winapi.D2DMissing in '..\..\Source\Winapi.D2DMissing.pas', + {$ENDIF} + {$IFDEF Image32_SVGEngine} Image32SVGFactory in '..\..\Source\Image32SVGFactory.pas', + {$ENDIF} + {$IFDEF Skia_SVGEngine} + SkiaSVGFactory in '..\..\Source\SkiaSVGFactory.pas', + {$ENDIF} SVGInterfaces in '..\..\Source\SVGInterfaces.pas', dlgExportPNG in '..\..\Source\dlgExportPNG.pas' {ExportToPNGDialog}; diff --git a/Packages/D10_3/SVGIconImageList.dproj b/Packages/D10_3/SVGIconImageList.dproj index 55d67ee..a89234b 100644 --- a/Packages/D10_3/SVGIconImageList.dproj +++ b/Packages/D10_3/SVGIconImageList.dproj @@ -49,7 +49,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 @@ -57,13 +57,12 @@ _D10_3 ..\..\Image32\Source;$(DCC_UnitSearchPath) true + 1033 - 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 diff --git a/Packages/D10_3/SVGIconImageListFMX.dpk b/Packages/D10_3/SVGIconImageListFMX.dpk index 50f2ff1..024cd34 100644 --- a/Packages/D10_3/SVGIconImageListFMX.dpk +++ b/Packages/D10_3/SVGIconImageListFMX.dpk @@ -1,6 +1,7 @@ package SVGIconImageListFMX; {$R *.res} +{$INCLUDE ..\..\Source\SVGIconImageList.inc} {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} {$ALIGN 8} {$ASSERTIONS ON} @@ -31,13 +32,25 @@ package SVGIconImageListFMX; {$IMPLICITBUILD OFF} requires - fmx, - SVGImage32Package; + fmx + {$IFDEF Image32_SVGEngine} + , SVGImage32Package + {$ENDIF} + {$IFDEF Skia_SVGEngine} + , Skia.Package.FMX + , Skia.Package.RTL + {$ENDIF} + ; contains - Img32.FMX in '..\..\Image32\Source\Img32.FMX.pas', FMX.ImageSVG in '..\..\Source\FMX.ImageSVG.pas', + {$IFDEF Image32_SVGEngine} + Img32.FMX in '..\..\Image32\Source\Img32.FMX.pas', FMX.Image32SVG in '..\..\Source\FMX.Image32SVG.pas', + {$ENDIF} + {$IFDEF Skia_SVGEngine} + FMX.ImageSkiaSVG in '..\..\Source\FMX.ImageSkiaSVG.pas', + {$ENDIF} FMX.SVGIconImageList in '..\..\Source\FMX.SVGIconImageList.pas', FMX.SVGIconImage in '..\..\Source\FMX.SVGIconImage.pas'; diff --git a/Packages/D10_3/SVGImage32Package.dproj b/Packages/D10_3/SVGImage32Package.dproj index 078d971..84c7753 100644 --- a/Packages/D10_3/SVGImage32Package.dproj +++ b/Packages/D10_3/SVGImage32Package.dproj @@ -81,6 +81,7 @@ + diff --git a/Packages/D10_3/dclSVGIconImageList.dproj b/Packages/D10_3/dclSVGIconImageList.dproj index c7f59c7..5cfaeb3 100644 --- a/Packages/D10_3/dclSVGIconImageList.dproj +++ b/Packages/D10_3/dclSVGIconImageList.dproj @@ -52,6 +52,7 @@ _D10_3 ..\..\Source;..\..\Image32\Source;$(DCC_UnitSearchPath) true + 1033 Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) diff --git a/Packages/D10_4/SVGIconImageList.dpk b/Packages/D10_4/SVGIconImageList.dpk index 3d4a033..4811e8c 100644 --- a/Packages/D10_4/SVGIconImageList.dpk +++ b/Packages/D10_4/SVGIconImageList.dpk @@ -1,5 +1,6 @@ package SVGIconImageList; +{$INCLUDE ..\..\Source\SVGIconImageList.inc} {$R *.res} {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} {$ALIGN 8} @@ -31,10 +32,17 @@ package SVGIconImageList; {$IMPLICITBUILD OFF} requires - vcl, - VclSmp, - SVGImage32Package, - vclwinx; + vcl + , VclSmp + , vclwinx + {$IFDEF Image32_SVGEngine} + , SVGImage32Package + {$ENDIF} + {$IFDEF Skia_SVGEngine} + , Skia.Package.VCL + , Skia.Package.RTL + {$ENDIF} + ; contains SVGIconImage in '..\..\Source\SVGIconImage.pas', @@ -44,9 +52,16 @@ contains SVGIconItems in '..\..\Source\SVGIconItems.pas', SVGIconVirtualImageList in '..\..\Source\SVGIconVirtualImageList.pas', SVGIconImageListBase in '..\..\Source\SVGIconImageListBase.pas', + {$IFDEF PreferNativeSvgSupport} D2DSVGFactory in '..\..\Source\D2DSVGFactory.pas', Winapi.D2DMissing in '..\..\Source\Winapi.D2DMissing.pas', + {$ENDIF} + {$IFDEF Image32_SVGEngine} Image32SVGFactory in '..\..\Source\Image32SVGFactory.pas', + {$ENDIF} + {$IFDEF Skia_SVGEngine} + SkiaSVGFactory in '..\..\Source\SkiaSVGFactory.pas', + {$ENDIF} SVGInterfaces in '..\..\Source\SVGInterfaces.pas', dlgExportPNG in '..\..\Source\dlgExportPNG.pas' {ExportToPNGDialog}; diff --git a/Packages/D10_4/SVGIconImageList.dproj b/Packages/D10_4/SVGIconImageList.dproj index d2db837..3821042 100644 --- a/Packages/D10_4/SVGIconImageList.dproj +++ b/Packages/D10_4/SVGIconImageList.dproj @@ -49,7 +49,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 @@ -57,13 +57,12 @@ $(Auto) ..\..\Image32\Source;$(DCC_UnitSearchPath) true + 1033 - 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 diff --git a/Packages/D10_4/SVGIconImageListFMX.dpk b/Packages/D10_4/SVGIconImageListFMX.dpk index c5e3c2c..3588a74 100644 --- a/Packages/D10_4/SVGIconImageListFMX.dpk +++ b/Packages/D10_4/SVGIconImageListFMX.dpk @@ -1,6 +1,7 @@ package SVGIconImageListFMX; {$R *.res} +{$INCLUDE ..\..\Source\SVGIconImageList.inc} {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} {$ALIGN 8} {$ASSERTIONS ON} @@ -31,13 +32,25 @@ package SVGIconImageListFMX; {$IMPLICITBUILD OFF} requires - fmx, - SVGImage32Package; + fmx + {$IFDEF Image32_SVGEngine} + , SVGImage32Package + {$ENDIF} + {$IFDEF Skia_SVGEngine} + , Skia.Package.FMX + , Skia.Package.RTL + {$ENDIF} + ; contains - Img32.FMX in '..\..\Image32\Source\Img32.FMX.pas', FMX.ImageSVG in '..\..\Source\FMX.ImageSVG.pas', + {$IFDEF Image32_SVGEngine} + Img32.FMX in '..\..\Image32\Source\Img32.FMX.pas', FMX.Image32SVG in '..\..\Source\FMX.Image32SVG.pas', + {$ENDIF} + {$IFDEF Skia_SVGEngine} + FMX.ImageSkiaSVG in '..\..\Source\FMX.ImageSkiaSVG.pas', + {$ENDIF} FMX.SVGIconImageList in '..\..\Source\FMX.SVGIconImageList.pas', FMX.SVGIconImage in '..\..\Source\FMX.SVGIconImage.pas'; diff --git a/Packages/D10_4/SVGImage32Package.dproj b/Packages/D10_4/SVGImage32Package.dproj index 5e67f00..a54ee78 100644 --- a/Packages/D10_4/SVGImage32Package.dproj +++ b/Packages/D10_4/SVGImage32Package.dproj @@ -81,6 +81,7 @@ + diff --git a/Packages/D10_4/dclSVGIconImageList.dproj b/Packages/D10_4/dclSVGIconImageList.dproj index a05dfbd..2a3301c 100644 --- a/Packages/D10_4/dclSVGIconImageList.dproj +++ b/Packages/D10_4/dclSVGIconImageList.dproj @@ -52,6 +52,7 @@ $(Auto) ..\..\Source;..\..\Image32\Source;$(DCC_UnitSearchPath) true + 1033 Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) diff --git a/Packages/D11/SVGIconImageList.dpk b/Packages/D11/SVGIconImageList.dpk index 3d4a033..4811e8c 100644 --- a/Packages/D11/SVGIconImageList.dpk +++ b/Packages/D11/SVGIconImageList.dpk @@ -1,5 +1,6 @@ package SVGIconImageList; +{$INCLUDE ..\..\Source\SVGIconImageList.inc} {$R *.res} {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} {$ALIGN 8} @@ -31,10 +32,17 @@ package SVGIconImageList; {$IMPLICITBUILD OFF} requires - vcl, - VclSmp, - SVGImage32Package, - vclwinx; + vcl + , VclSmp + , vclwinx + {$IFDEF Image32_SVGEngine} + , SVGImage32Package + {$ENDIF} + {$IFDEF Skia_SVGEngine} + , Skia.Package.VCL + , Skia.Package.RTL + {$ENDIF} + ; contains SVGIconImage in '..\..\Source\SVGIconImage.pas', @@ -44,9 +52,16 @@ contains SVGIconItems in '..\..\Source\SVGIconItems.pas', SVGIconVirtualImageList in '..\..\Source\SVGIconVirtualImageList.pas', SVGIconImageListBase in '..\..\Source\SVGIconImageListBase.pas', + {$IFDEF PreferNativeSvgSupport} D2DSVGFactory in '..\..\Source\D2DSVGFactory.pas', Winapi.D2DMissing in '..\..\Source\Winapi.D2DMissing.pas', + {$ENDIF} + {$IFDEF Image32_SVGEngine} Image32SVGFactory in '..\..\Source\Image32SVGFactory.pas', + {$ENDIF} + {$IFDEF Skia_SVGEngine} + SkiaSVGFactory in '..\..\Source\SkiaSVGFactory.pas', + {$ENDIF} SVGInterfaces in '..\..\Source\SVGInterfaces.pas', dlgExportPNG in '..\..\Source\dlgExportPNG.pas' {ExportToPNGDialog}; diff --git a/Packages/D11/SVGIconImageList.dproj b/Packages/D11/SVGIconImageList.dproj index 968223e..a51c2b8 100644 --- a/Packages/D11/SVGIconImageList.dproj +++ b/Packages/D11/SVGIconImageList.dproj @@ -49,7 +49,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 @@ -57,13 +57,12 @@ $(Auto) ..\..\Image32\Source;$(DCC_UnitSearchPath) true + 1033 - 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 @@ -126,6 +125,8 @@ SVGIconImageList.dpk + + True diff --git a/Packages/D11/SVGIconImageListFMX.dpk b/Packages/D11/SVGIconImageListFMX.dpk index c5e3c2c..3588a74 100644 --- a/Packages/D11/SVGIconImageListFMX.dpk +++ b/Packages/D11/SVGIconImageListFMX.dpk @@ -1,6 +1,7 @@ package SVGIconImageListFMX; {$R *.res} +{$INCLUDE ..\..\Source\SVGIconImageList.inc} {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} {$ALIGN 8} {$ASSERTIONS ON} @@ -31,13 +32,25 @@ package SVGIconImageListFMX; {$IMPLICITBUILD OFF} requires - fmx, - SVGImage32Package; + fmx + {$IFDEF Image32_SVGEngine} + , SVGImage32Package + {$ENDIF} + {$IFDEF Skia_SVGEngine} + , Skia.Package.FMX + , Skia.Package.RTL + {$ENDIF} + ; contains - Img32.FMX in '..\..\Image32\Source\Img32.FMX.pas', FMX.ImageSVG in '..\..\Source\FMX.ImageSVG.pas', + {$IFDEF Image32_SVGEngine} + Img32.FMX in '..\..\Image32\Source\Img32.FMX.pas', FMX.Image32SVG in '..\..\Source\FMX.Image32SVG.pas', + {$ENDIF} + {$IFDEF Skia_SVGEngine} + FMX.ImageSkiaSVG in '..\..\Source\FMX.ImageSkiaSVG.pas', + {$ENDIF} FMX.SVGIconImageList in '..\..\Source\FMX.SVGIconImageList.pas', FMX.SVGIconImage in '..\..\Source\FMX.SVGIconImage.pas'; diff --git a/Packages/D11/SVGIconImageListFMX.dproj b/Packages/D11/SVGIconImageListFMX.dproj index 0ea00de..b547cbb 100644 --- a/Packages/D11/SVGIconImageListFMX.dproj +++ b/Packages/D11/SVGIconImageListFMX.dproj @@ -176,6 +176,8 @@ SVGIconImageListFMX.dpk + + False diff --git a/Packages/D11/SVGImage32Package.dproj b/Packages/D11/SVGImage32Package.dproj index dec8d91..37b2518 100644 --- a/Packages/D11/SVGImage32Package.dproj +++ b/Packages/D11/SVGImage32Package.dproj @@ -81,6 +81,7 @@ + @@ -124,6 +125,8 @@ SVGImage32Package.dpk + + True diff --git a/Packages/D11/dclSVGIconImageList.dproj b/Packages/D11/dclSVGIconImageList.dproj index b7e8c99..4e0ed82 100644 --- a/Packages/D11/dclSVGIconImageList.dproj +++ b/Packages/D11/dclSVGIconImageList.dproj @@ -52,6 +52,7 @@ $(Auto) ..\..\Source;..\..\Image32\Source;$(DCC_UnitSearchPath) true + 1033 Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) diff --git a/Packages/D12/SVGIconImageList.dpk b/Packages/D12/SVGIconImageList.dpk index cf2ac44..07edeca 100644 --- a/Packages/D12/SVGIconImageList.dpk +++ b/Packages/D12/SVGIconImageList.dpk @@ -1,5 +1,6 @@ package SVGIconImageList; +{$INCLUDE ..\..\Source\SVGIconImageList.inc} {$R *.res} {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} {$ALIGN 8} @@ -31,10 +32,17 @@ package SVGIconImageList; {$IMPLICITBUILD OFF} requires - vcl, - VclSmp, - SVGImage32Package, - vclwinx; + vcl + , VclSmp + , vclwinx + {$IFDEF Image32_SVGEngine} + , SVGImage32Package + {$ENDIF} + {$IFDEF Skia_SVGEngine} + , Skia.Package.VCL + , Skia.Package.RTL + {$ENDIF} + ; contains SVGIconImage in '..\..\Source\SVGIconImage.pas', @@ -44,9 +52,16 @@ contains SVGIconItems in '..\..\Source\SVGIconItems.pas', SVGIconVirtualImageList in '..\..\Source\SVGIconVirtualImageList.pas', SVGIconImageListBase in '..\..\Source\SVGIconImageListBase.pas', + {$IFDEF PreferNativeSvgSupport} D2DSVGFactory in '..\..\Source\D2DSVGFactory.pas', Winapi.D2DMissing in '..\..\Source\Winapi.D2DMissing.pas', + {$ENDIF} + {$IFDEF Image32_SVGEngine} Image32SVGFactory in '..\..\Source\Image32SVGFactory.pas', + {$ENDIF} + {$IFDEF Skia_SVGEngine} + SkiaSVGFactory in '..\..\Source\SkiaSVGFactory.pas', + {$ENDIF} SVGInterfaces in '..\..\Source\SVGInterfaces.pas', dlgExportPNG in '..\..\Source\dlgExportPNG.pas' {ExportToPNGDialog}; diff --git a/Packages/D12/SVGIconImageList.dproj b/Packages/D12/SVGIconImageList.dproj index 142fa69..def3f71 100644 --- a/Packages/D12/SVGIconImageList.dproj +++ b/Packages/D12/SVGIconImageList.dproj @@ -45,6 +45,12 @@ Base true + + true + Cfg_2 + true + true + ..\..\Lib\D12\$(Platform)\$(Config) .\$(Platform)\$(Config) @@ -63,6 +69,7 @@ $(Auto) ..\..\Image32\Source;$(DCC_UnitSearchPath) true + 1033 Debug @@ -72,9 +79,6 @@ 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) @@ -99,7 +103,6 @@ - @@ -108,9 +111,6 @@ - - -
ExportToPNGDialog
diff --git a/Packages/D12/SVGIconImageListFMX.dpk b/Packages/D12/SVGIconImageListFMX.dpk index ae35143..cd4f7b9 100644 --- a/Packages/D12/SVGIconImageListFMX.dpk +++ b/Packages/D12/SVGIconImageListFMX.dpk @@ -1,6 +1,7 @@ package SVGIconImageListFMX; {$R *.res} +{$INCLUDE ..\..\Source\SVGIconImageList.inc} {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} {$ALIGN 8} {$ASSERTIONS ON} @@ -31,13 +32,25 @@ package SVGIconImageListFMX; {$IMPLICITBUILD OFF} requires - fmx, - SVGImage32Package; + fmx + {$IFDEF Image32_SVGEngine} + , SVGImage32Package + {$ENDIF} + {$IFDEF Skia_SVGEngine} + , Skia.Package.FMX + , Skia.Package.RTL + {$ENDIF} + ; contains - Img32.FMX in '..\..\Image32\Source\Img32.FMX.pas', FMX.ImageSVG in '..\..\Source\FMX.ImageSVG.pas', + {$IFDEF Image32_SVGEngine} + Img32.FMX in '..\..\Image32\Source\Img32.FMX.pas', FMX.Image32SVG in '..\..\Source\FMX.Image32SVG.pas', + {$ENDIF} + {$IFDEF Skia_SVGEngine} + FMX.ImageSkiaSVG in '..\..\Source\FMX.ImageSkiaSVG.pas', + {$ENDIF} FMX.SVGIconImageList in '..\..\Source\FMX.SVGIconImageList.pas', FMX.SVGIconImage in '..\..\Source\FMX.SVGIconImage.pas'; diff --git a/Packages/D12/SVGIconImageListFMX.dproj b/Packages/D12/SVGIconImageListFMX.dproj index 5b14ac0..be11ea6 100644 --- a/Packages/D12/SVGIconImageListFMX.dproj +++ b/Packages/D12/SVGIconImageListFMX.dproj @@ -133,11 +133,6 @@ Debug true - - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - Debug - true - DEBUG;$(DCC_Define) true diff --git a/Packages/D12/SVGImage32Package.dproj b/Packages/D12/SVGImage32Package.dproj index 6369412..9b8f01d 100644 --- a/Packages/D12/SVGImage32Package.dproj +++ b/Packages/D12/SVGImage32Package.dproj @@ -67,12 +67,6 @@ 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 diff --git a/Packages/D12/dclSVGIconImageList.dproj b/Packages/D12/dclSVGIconImageList.dproj index e5947ce..8a3a1af 100644 --- a/Packages/D12/dclSVGIconImageList.dproj +++ b/Packages/D12/dclSVGIconImageList.dproj @@ -58,19 +58,13 @@ $(Auto) ..\..\Source;..\..\Image32\Source;$(DCC_UnitSearchPath) true + 1033 Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 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 diff --git a/Packages/DXE3/SVGIconImageListGroupPackages.groupproj b/Packages/DXE3/SVGIconImageListGroupPackages.groupproj index 3eb11a6..2cb0330 100644 --- a/Packages/DXE3/SVGIconImageListGroupPackages.groupproj +++ b/Packages/DXE3/SVGIconImageListGroupPackages.groupproj @@ -1,6 +1,6 @@  - {25059111-8F77-429C-A2F2-CB529411BC99} + {CA7632FE-2EC3-4AC0-9CC7-D83EF27A531A} diff --git a/Packages/DXE3/SVGImage32Package.dproj b/Packages/DXE3/SVGImage32Package.dproj index b79ccb9..abf4a40 100644 --- a/Packages/DXE3/SVGImage32Package.dproj +++ b/Packages/DXE3/SVGImage32Package.dproj @@ -81,6 +81,7 @@ + diff --git a/Packages/DXE3/dclSVGIconImageList.dproj b/Packages/DXE3/dclSVGIconImageList.dproj index ab2bf91..174a6f1 100644 --- a/Packages/DXE3/dclSVGIconImageList.dproj +++ b/Packages/DXE3/dclSVGIconImageList.dproj @@ -52,6 +52,7 @@ _DXE3 ..\..\Source;..\..\Image32\Source;$(DCC_UnitSearchPath) true + 1033 Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) diff --git a/Packages/DXE6/SVGIconImageList.dproj b/Packages/DXE6/SVGIconImageList.dproj index a12bd7c..6f0634e 100644 --- a/Packages/DXE6/SVGIconImageList.dproj +++ b/Packages/DXE6/SVGIconImageList.dproj @@ -49,7 +49,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 @@ -57,13 +57,12 @@ _DXE6 ..\..\Image32\Source;$(DCC_UnitSearchPath) true + 1033 - 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 diff --git a/Packages/DXE6/SVGImage32Package.dproj b/Packages/DXE6/SVGImage32Package.dproj index 6718296..324fb81 100644 --- a/Packages/DXE6/SVGImage32Package.dproj +++ b/Packages/DXE6/SVGImage32Package.dproj @@ -81,6 +81,7 @@ + diff --git a/Packages/DXE6/dclSVGIconImageList.dproj b/Packages/DXE6/dclSVGIconImageList.dproj index dbec5bf..9685aef 100644 --- a/Packages/DXE6/dclSVGIconImageList.dproj +++ b/Packages/DXE6/dclSVGIconImageList.dproj @@ -52,6 +52,7 @@ _DXE6 ..\..\Source;..\..\Image32\Source;$(DCC_UnitSearchPath) true + 1033 Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) diff --git a/Packages/DXE7/SVGIconImageList.dpk b/Packages/DXE7/SVGIconImageList.dpk index 951bfd4..261600d 100644 --- a/Packages/DXE7/SVGIconImageList.dpk +++ b/Packages/DXE7/SVGIconImageList.dpk @@ -1,5 +1,6 @@ package SVGIconImageList; +{$INCLUDE ..\..\Source\SVGIconImageList.inc} {$R *.res} {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} {$ALIGN 8} @@ -26,15 +27,22 @@ package SVGIconImageList; {$DEFINE RELEASE} {$ENDIF IMPLICITBUILDING} {$DESCRIPTION 'Ethea SVGIconImageList VCL components'} -{$LIBSUFFIX '_DXE7'} +{$LIBSUFFIX '_DXE6'} {$RUNONLY} {$IMPLICITBUILD OFF} requires - vcl, - VclSmp, - SVGImage32Package, - vclimg; + vcl + , VclSmp + , vclimg + {$IFDEF Image32_SVGEngine} + , SVGImage32Package + {$ENDIF} + {$IFDEF Skia_SVGEngine} + , Skia.Package.VCL + , Skia.Package.RTL + {$ENDIF} + ; contains SVGIconImage in '..\..\Source\SVGIconImage.pas', @@ -44,9 +52,16 @@ contains SVGIconItems in '..\..\Source\SVGIconItems.pas', SVGIconVirtualImageList in '..\..\Source\SVGIconVirtualImageList.pas', SVGIconImageListBase in '..\..\Source\SVGIconImageListBase.pas', + {$IFDEF PreferNativeSvgSupport} D2DSVGFactory in '..\..\Source\D2DSVGFactory.pas', Winapi.D2DMissing in '..\..\Source\Winapi.D2DMissing.pas', + {$ENDIF} + {$IFDEF Image32_SVGEngine} Image32SVGFactory in '..\..\Source\Image32SVGFactory.pas', + {$ENDIF} + {$IFDEF Skia_SVGEngine} + SkiaSVGFactory in '..\..\Source\SkiaSVGFactory.pas', + {$ENDIF} SVGInterfaces in '..\..\Source\SVGInterfaces.pas', dlgExportPNG in '..\..\Source\dlgExportPNG.pas' {ExportToPNGDialog}; diff --git a/Packages/DXE7/SVGIconImageList.dproj b/Packages/DXE7/SVGIconImageList.dproj index 49a18f3..1c934b9 100644 --- a/Packages/DXE7/SVGIconImageList.dproj +++ b/Packages/DXE7/SVGIconImageList.dproj @@ -49,7 +49,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 @@ -57,13 +57,12 @@ _DXE7 ..\..\Image32\Source;$(DCC_UnitSearchPath) true + 1033 - 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 @@ -89,7 +88,6 @@ - @@ -98,13 +96,14 @@ - - -
ExportToPNGDialog
 + + Cfg_2 + Base + Base @@ -112,10 +111,6 @@ Cfg_1 Base - - Cfg_2 - Base - Delphi.Personality.12 diff --git a/Packages/DXE7/SVGImage32Package.dproj b/Packages/DXE7/SVGImage32Package.dproj index cc28c3e..6f8ea28 100644 --- a/Packages/DXE7/SVGImage32Package.dproj +++ b/Packages/DXE7/SVGImage32Package.dproj @@ -81,6 +81,7 @@ + diff --git a/Packages/DXE7/dclSVGIconImageList.dpk b/Packages/DXE7/dclSVGIconImageList.dpk index 22ae0d4..6123e66 100644 --- a/Packages/DXE7/dclSVGIconImageList.dpk +++ b/Packages/DXE7/dclSVGIconImageList.dpk @@ -42,3 +42,4 @@ contains SVGTextPropertyEditorUnit in '..\SVGTextPropertyEditorUnit.pas' {SVGTextPropertyEditorForm}; end. + diff --git a/Packages/DXE7/dclSVGIconImageList.dproj b/Packages/DXE7/dclSVGIconImageList.dproj index e12da94..36e3dea 100644 --- a/Packages/DXE7/dclSVGIconImageList.dproj +++ b/Packages/DXE7/dclSVGIconImageList.dproj @@ -52,6 +52,7 @@ _DXE7 ..\..\Source;..\..\Image32\Source;$(DCC_UnitSearchPath) true + 1033 Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) diff --git a/Packages/DXE8/SVGIconImageList.dpk b/Packages/DXE8/SVGIconImageList.dpk index 31d2075..069475a 100644 --- a/Packages/DXE8/SVGIconImageList.dpk +++ b/Packages/DXE8/SVGIconImageList.dpk @@ -1,5 +1,6 @@ package SVGIconImageList; +{$INCLUDE ..\..\Source\SVGIconImageList.inc} {$R *.res} {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} {$ALIGN 8} @@ -31,10 +32,17 @@ package SVGIconImageList; {$IMPLICITBUILD OFF} requires - vcl, - VclSmp, - SVGImage32Package, - vclimg; + vcl + , VclSmp + , vclimg + {$IFDEF Image32_SVGEngine} + , SVGImage32Package + {$ENDIF} + {$IFDEF Skia_SVGEngine} + , Skia.Package.VCL + , Skia.Package.RTL + {$ENDIF} + ; contains SVGIconImage in '..\..\Source\SVGIconImage.pas', @@ -44,9 +52,16 @@ contains SVGIconItems in '..\..\Source\SVGIconItems.pas', SVGIconVirtualImageList in '..\..\Source\SVGIconVirtualImageList.pas', SVGIconImageListBase in '..\..\Source\SVGIconImageListBase.pas', + {$IFDEF PreferNativeSvgSupport} D2DSVGFactory in '..\..\Source\D2DSVGFactory.pas', Winapi.D2DMissing in '..\..\Source\Winapi.D2DMissing.pas', + {$ENDIF} + {$IFDEF Image32_SVGEngine} Image32SVGFactory in '..\..\Source\Image32SVGFactory.pas', + {$ENDIF} + {$IFDEF Skia_SVGEngine} + SkiaSVGFactory in '..\..\Source\SkiaSVGFactory.pas', + {$ENDIF} SVGInterfaces in '..\..\Source\SVGInterfaces.pas', dlgExportPNG in '..\..\Source\dlgExportPNG.pas' {ExportToPNGDialog}; diff --git a/Packages/DXE8/SVGIconImageList.dproj b/Packages/DXE8/SVGIconImageList.dproj index 0048ce9..4dcbb40 100644 --- a/Packages/DXE8/SVGIconImageList.dproj +++ b/Packages/DXE8/SVGIconImageList.dproj @@ -49,7 +49,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 @@ -57,13 +57,12 @@ _DXE8 ..\..\Image32\Source;$(DCC_UnitSearchPath) true + 1033 - 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 @@ -89,7 +88,6 @@ - @@ -98,13 +96,14 @@ - - -
ExportToPNGDialog
 + + Cfg_2 + Base + Base @@ -112,10 +111,6 @@ Cfg_1 Base - - Cfg_2 - Base - Delphi.Personality.12 diff --git a/Packages/DXE8/SVGImage32Package.dproj b/Packages/DXE8/SVGImage32Package.dproj index f52d54a..719569f 100644 --- a/Packages/DXE8/SVGImage32Package.dproj +++ b/Packages/DXE8/SVGImage32Package.dproj @@ -1,6 +1,6 @@  - {B99FE27C-AFB6-4F9D-81C1-CB6C06A5075F} + {6D06E633-2544-45A7-A93F-1E8AAF4A14C9} SVGImage32Package.dpk 19.2 VCL @@ -81,6 +81,7 @@ + diff --git a/Packages/DXE8/dclSVGIconImageList.dpk b/Packages/DXE8/dclSVGIconImageList.dpk index c073ff3..cc932a5 100644 --- a/Packages/DXE8/dclSVGIconImageList.dpk +++ b/Packages/DXE8/dclSVGIconImageList.dpk @@ -42,3 +42,4 @@ contains SVGTextPropertyEditorUnit in '..\SVGTextPropertyEditorUnit.pas' {SVGTextPropertyEditorForm}; end. + diff --git a/Packages/DXE8/dclSVGIconImageList.dproj b/Packages/DXE8/dclSVGIconImageList.dproj index 7f5880c..c269075 100644 --- a/Packages/DXE8/dclSVGIconImageList.dproj +++ b/Packages/DXE8/dclSVGIconImageList.dproj @@ -52,6 +52,7 @@ _DXE8 ..\..\Source;..\..\Image32\Source;$(DCC_UnitSearchPath) true + 1033 Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) diff --git a/Packages/FMX.SVGIconImageListEditorUnit.pas b/Packages/FMX.SVGIconImageListEditorUnit.pas index 38b253c..d78a8ba 100644 --- a/Packages/FMX.SVGIconImageListEditorUnit.pas +++ b/Packages/FMX.SVGIconImageListEditorUnit.pas @@ -150,8 +150,11 @@ implementation , Winapi.Windows , Winapi.shellApi , Xml.XMLDoc + {$IFDEF Image32_SVGEngine} + , Img32.SVG.Core + {$ENDIF} , System.Math - , Img32.SVG.Core; + ; var SavedBounds: TRect = (Left: 0; Top: 0; Right: 0; Bottom: 0); diff --git a/Packages/SVGIconImageRegister.pas b/Packages/SVGIconImageRegister.pas index 1f83cef..ac7e041 100644 --- a/Packages/SVGIconImageRegister.pas +++ b/Packages/SVGIconImageRegister.pas @@ -123,7 +123,9 @@ implementation , SVGIconImageListBase , SVGIconImageList , SVGIconItems + {$IFDEF Image32_SVGEngine} , Img32.Panels + {$ENDIF} , SVGIconVirtualImageList , SVGIconImageCollection , SVGIconImageListEditorUnit diff --git a/README.htm b/README.htm index 1c423e0..8a9e025 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.6 (VCL+FMX)

+

Actual official version 4.1.7 (VCL+FMX)

@@ -126,6 +126,12 @@

DOCUMENTATION

Other similar library

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

RELEASE NOTES

+

13 Aug 2024: version 4.1.7 (VCL+FMX)

+
    +
  • Updated packages for compilation with Skia4Delphi (defined by SVGIconImageList.inc)
    • +
  • Fixed uses for skia unit
    • +
  • Aligned to Image32 4.5 Version of 11 August 2024
    • +

18 Jul 2024: version 4.1.6 (VCL+FMX)

  • Aligned to Image32 4.5 Version of 17 July 2024
    • diff --git a/README.md b/README.md index 9bed19a..4f45bcb 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.6 (VCL+FMX) +### Actual official version 4.1.7 (VCL+FMX) | Component | Description | | - | - | @@ -90,6 +90,11 @@ 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 +13 Aug 2024: version 4.1.7 (VCL+FMX) +- Updated packages for compilation with Skia4Delphi (defined by SVGIconImageList.inc) +- Fixed uses for skia unit +- Aligned to Image32 4.5 Version of 11 August 2024 + 18 Jul 2024: version 4.1.6 (VCL+FMX) - Aligned to Image32 4.5 Version of 17 July 2024 - Fixed color of icons in Android diff --git a/Source/FMX.ImageSkiaSVG.pas b/Source/FMX.ImageSkiaSVG.pas index c96baa1..56779c8 100644 --- a/Source/FMX.ImageSkiaSVG.pas +++ b/Source/FMX.ImageSkiaSVG.pas @@ -42,7 +42,7 @@ interface , FMX.Objects , FMX.ImageSVG , System.Skia - , Skia.FMX; + , FMX.Skia; type TFmxImageSkiaSVG = class(TFmxImageSVG) @@ -79,8 +79,8 @@ procedure TFmxImageSkiaSVG.Draw(const ACanvas: ISkCanvas; const ADest: TRectF; c inherited; //GrayScale and FixedColor FSvg.GrayScale := GrayScale; - if not GrayScale and (FixedColor <> TColors.SysNone) and - (FixedColor <> TColors.SysNone) then + if not GrayScale and (FixedColor <> TAlphaColorRec.Null) and + (FixedColor <> TAlphaColorRec.Null) then FSvg.OverrideColor := FixedColor else FSvg.OverrideColor := Default(TAlphaColor); @@ -135,7 +135,6 @@ procedure TFmxImageSkiaSVG.PaintToBitmap(ABitmap: TBitmap; const AZoom: Integer = 100; const KeepAspectRatio: Boolean = True); var LWidth, LHeight: Integer; - LAbsoluteScale: TPointF; begin Assert(Assigned(FSvg)); Assert(Assigned(ABitmap)); @@ -146,7 +145,6 @@ procedure TFmxImageSkiaSVG.PaintToBitmap(ABitmap: TBitmap; ABitmap.SkiaDraw( procedure(const ACanvas: ISkCanvas) var - LAbsoluteScale: TPointF; LDestRect: TRectF; begin LDestRect := RectF(0, 0, LWidth, LHeight); diff --git a/Source/FMX.SVGIconImageList.pas b/Source/FMX.SVGIconImageList.pas index 64f0fc7..96e8c30 100644 --- a/Source/FMX.SVGIconImageList.pas +++ b/Source/FMX.SVGIconImageList.pas @@ -47,7 +47,7 @@ interface ; const - SVGIconImageListVersion = '4.1.6'; + SVGIconImageListVersion = '4.1.7'; DEFAULT_SIZE = 32; ZOOM_DEFAULT = 100; SVG_INHERIT_COLOR = TAlphaColors.Null; diff --git a/Source/SVGIconImageCollection.pas b/Source/SVGIconImageCollection.pas index 6c6b0d3..e585b74 100644 --- a/Source/SVGIconImageCollection.pas +++ b/Source/SVGIconImageCollection.pas @@ -109,10 +109,12 @@ TSVGIconImageCollection = class(TComponent) constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; - function LoadFromFiles(const AFileNames: TStrings; const AAppend: Boolean = True): Integer; - + function LoadFromFile(const AFileName: string; + out AImageName: string): TSVGIconItem; + function SaveToFile(const AFileName: string; + const AImageName: string): Boolean; function Add(const ASVG: ISVG; const AIconName: string; const AGrayScale: Boolean = False; const AFixedColor: TColor = SVG_INHERIT_COLOR; @@ -268,6 +270,17 @@ function TSVGIconImageCollection.IndexOf(const Name: string): Integer; Result := -1; end; +function TSVGIconImageCollection.LoadFromFile(const AFileName: string; + out AImageName: string): TSVGIconItem; +begin + SVGIconItems.BeginUpdate; + try + Result := SVGIconItems.LoadFromFile(AFileName, AImageName); + finally + SVGIconItems.EndUpdate; + end; +end; + function TSVGIconImageCollection.LoadFromFiles(const AFileNames: TStrings; const AAppend: Boolean): Integer; begin @@ -326,6 +339,23 @@ procedure TSVGIconImageCollection.Remove(const Name: string); Delete(IndexOf(Name)); end; +function TSVGIconImageCollection.SaveToFile(const AFileName, + AImageName: string): Boolean; +var + LOutDir: string; + LItem: TSVGIconItem; +begin + Result := False; + LItem := SVGIconItems.GetIconByName(AImageName); + if Assigned(LItem) then + begin + LOutDir := ExtractFilePath(AFileName); + System.SysUtils.ForceDirectories(LOutDir); + LItem.SVG.SaveToFile(AFileName); + Result := True; + end; +end; + procedure TSVGIconImageCollection.SetAntiAliasColor(const Value: TColor); begin if FAntiAliasColor <> Value then diff --git a/Source/SVGIconImageListBase.pas b/Source/SVGIconImageListBase.pas index 2eabf36..58cf46a 100644 --- a/Source/SVGIconImageListBase.pas +++ b/Source/SVGIconImageListBase.pas @@ -48,7 +48,7 @@ interface SvgInterfaces; const - SVGIconImageListVersion = '4.1.6'; + SVGIconImageListVersion = '4.1.7'; DEFAULT_SIZE = 16; type diff --git a/Source/SVGIconItems.pas b/Source/SVGIconItems.pas index 18689a8..5e3fe9e 100644 --- a/Source/SVGIconItems.pas +++ b/Source/SVGIconItems.pas @@ -107,6 +107,8 @@ TSVGIconItems = class(TOwnedCollection) function Add: TSVGIconItem; procedure Assign(Source: TPersistent); override; function GetIconByName(const AIconName: string): TSVGIconItem; + function LoadFromFile(const AFileName: string; + out AImageName: string): TSVGIconItem; function LoadFromFiles(const AFileNames: TStrings; const AAppend: Boolean = True): Integer; property Items[Index: Integer]: TSVGIconItem read GetItem write SetItem; default; end; @@ -379,9 +381,26 @@ function TSVGIconItems.GetItem( Result := TSVGIconItem(inherited GetItem(Index)); end; +function TSVGIconItems.LoadFromFile(const AFileName: string; + out AImageName: string): TSVGIconItem; +var + LSVG: ISVG; +begin + Result := nil; + if FileExists(AFileName) then + begin + LSVG := GlobalSVGFactory.NewSvg; + LSVG.LoadFromFile(AFileName); + Result := Add; + Result.IconName := ChangeFileExt(ExtractFileName(AFileName), ''); + Result.SVG := LSVG; + AImageName := Result.Name; + end; +end; + function TSVGIconItems.LoadFromFiles(const AFileNames: TStrings; const AAppend: Boolean): Integer; -Var +var LIndex: Integer; LSVG: ISVG; LFileName: string;
Component