Skip to content

Commit

Permalink
versione 4.2.0 (VCL+FMX)
Browse files Browse the repository at this point in the history 
- Updated to Image32 4.6 Released 12 Oct 2024 to fix some drawing issue
- Added components info into About and Splash Screen
  • Loading branch information
@carloBarazzetta
carloBarazzetta committed Oct 12, 2024
1 parent 3a9b408 commit 0073b54
Show file tree
Hide file tree
Showing 36 changed files with 2,135 additions and 1,832 deletions.
1,102 changes: 11 additions & 1,091 deletions Demo/SvgViewer/SvgViewer.dproj
View file

Large diffs are not rendered by default.

16 changes: 11 additions & 5 deletions Image32/ChangeLog.txt
View file
Original file line number Diff line number Diff line change
@@ -1,17 +1,23 @@

Image32 - 2D graphics library for Delphi Pascal
Latest version: 4.3
Released: 27 September 2022
Latest version: 4.6
Released: 18 September 2024

Copyright © 2019-2022 Angus Johnson
Copyright © 2019-2024 Angus Johnson
Freeware released under Boost Software License
https://www.boost.org/LICENSE_1_0.txt

Documentation : http://www.angusj.com/delphi/image32/Docs/
Download : https://sourceforge.net/projects/image32/files/
Documentation : https://www.angusj.com/image32/Docs/Overview.htm
Download : https://github.com/AngusJohnson/Image32

Recent changes:

Version 4.6
* This release contains many bug fixes (see issues #10..#101) in the
GitHub repository.
* Andreas Hausladen has also made multiple contributions to
the library that that have very significantly improved its performance.

Version 4.3
Numerous minor bugfixes

Expand Down
31 changes: 17 additions & 14 deletions Image32/source/Clipper.Core.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@

(*******************************************************************************
* Author : Angus Johnson *
* Date : 12 August 2024 *
* Date : 17 September 2024 *
* Website : http://www.angusj.com *
* Copyright : Angus Johnson 2010-2024 *
* Purpose : Core Clipper Library module *
Expand All @@ -18,24 +18,20 @@ interface
SysUtils, Classes, Math;

type
{$IFDEF USINGZ}
Ztype = type double;//Int64;//
PZtype = ^Ztype;
{$ENDIF}

PPoint64 = ^TPoint64;
TPoint64 = record
X, Y: Int64;
{$IFDEF USINGZ}
Z: Ztype;
Z: Int64;
{$ENDIF}
end;

PPointD = ^TPointD;
TPointD = record
X, Y: double;
{$IFDEF USINGZ}
Z: Ztype;
Z: Int64;
{$ENDIF}
end;

Expand Down Expand Up @@ -133,6 +129,7 @@ TListEx = class
constructor Create(capacity: integer = 0); virtual;
destructor Destroy; override;
procedure Clear; virtual;
procedure DeleteLast;
function Add(item: Pointer): integer;
procedure Swap(idx1, idx2: integer);
procedure Sort(Compare: TListSortCompare);
Expand All @@ -141,7 +138,7 @@ TListEx = class
property Item[idx: integer]: Pointer read UnsafeGet; default;
end;

TClipType = (ctNone, ctIntersection, ctUnion, ctDifference, ctXor);
TClipType = (ctNoClip, ctIntersection, ctUnion, ctDifference, ctXor);

TPointInPolygonResult = (pipOn, pipInside, pipOutside);

Expand Down Expand Up @@ -190,11 +187,11 @@ function PointsNearEqual(const pt1, pt2: TPointD; distanceSqrd: double): Boolean
{$IFDEF INLINING} inline; {$ENDIF}

{$IFDEF USINGZ}
function Point64(const X, Y: Int64; Z: ZType = 0): TPoint64; overload;
function Point64(const X, Y: Int64; Z: Int64 = 0): TPoint64; overload;
{$IFDEF INLINING} inline; {$ENDIF}
function Point64(const X, Y: Double; Z: ZType = 0): TPoint64; overload;
function Point64(const X, Y: Double; Z: Int64 = 0): TPoint64; overload;
{$IFDEF INLINING} inline; {$ENDIF}
function PointD(const X, Y: Double; Z: ZType = 0): TPointD; overload;
function PointD(const X, Y: Double; Z: Int64 = 0): TPointD; overload;
{$IFDEF INLINING} inline; {$ENDIF}
{$ELSE}
function Point64(const X, Y: Int64): TPoint64; overload; {$IFDEF INLINING} inline; {$ENDIF}
Expand Down Expand Up @@ -547,6 +544,12 @@ procedure TListEx.Clear;
end;
//------------------------------------------------------------------------------

procedure TListEx.DeleteLast;
begin
dec(fCount);
end;
//------------------------------------------------------------------------------

function TListEx.Add(item: Pointer): integer;
begin
if fCount = fCapacity then
Expand Down Expand Up @@ -1387,23 +1390,23 @@ function ArrayOfPathsToPaths(const ap: TArrayOfPaths): TPaths64;
//------------------------------------------------------------------------------

{$IFDEF USINGZ}
function Point64(const X, Y: Int64; Z: ZType): TPoint64;
function Point64(const X, Y: Int64; Z: Int64): TPoint64;
begin
Result.X := X;
Result.Y := Y;
Result.Z := Z;
end;
//------------------------------------------------------------------------------

function Point64(const X, Y: Double; Z: ZType): TPoint64;
function Point64(const X, Y: Double; Z: Int64): TPoint64;
begin
Result.X := Round(X);
Result.Y := Round(Y);
Result.Z := Z;
end;
//------------------------------------------------------------------------------

function PointD(const X, Y: Double; Z: ZType): TPointD;
function PointD(const X, Y: Double; Z: Int64): TPointD;
begin
Result.X := X;
Result.Y := Y;
Expand Down
4 changes: 2 additions & 2 deletions Image32/source/Clipper.Engine.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@

(*******************************************************************************
* Author : Angus Johnson *
* Date : 12 August 2024 *
* Date : 17 September 2024 *
* Website : http://www.angusj.com *
* Copyright : Angus Johnson 2010-2024 *
* Purpose : This is the main polygon clipping module *
Expand Down Expand Up @@ -2845,7 +2845,7 @@ procedure TClipperBase.ExecuteInternal(clipType: TClipType;
Y: Int64;
e: PActive;
begin
if clipType = ctNone then Exit;
if clipType = ctNoClip then Exit;
FFillRule := fillRule;
FClipType := clipType;
Reset;
Expand Down
2 changes: 1 addition & 1 deletion Image32/source/Clipper.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -52,7 +52,7 @@ interface
etSquare = Clipper.Offset.etSquare;
etRound = Clipper.Offset.etRound;

ctNone = Clipper.Core.ctNone;
ctNone = Clipper.Core.ctNoClip;
ctIntersection = Clipper.Core.ctIntersection;
ctUnion = Clipper.Core.ctUnion;
ctDifference = Clipper.Core.ctDifference;
Expand Down
4 changes: 2 additions & 2 deletions Image32/source/Img32.CQ.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,8 +2,8 @@

(*******************************************************************************
* Author : Angus Johnson *
* Version : 4.4 *
* Date : 10 April 2024 *
* Version : 4.6 *
* Date : 18 September 2024 *
* Website : http://www.angusj.com *
* Copyright : Angus Johnson 2019-2024 *
* Purpose : Color reduction for TImage32 *
Expand Down
4 changes: 2 additions & 2 deletions Image32/source/Img32.Clipper2.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,8 +2,8 @@

(*******************************************************************************
* Author : Angus Johnson *
* Version : 4.3 *
* Date : 27 September 2022 *
* Version : 4.6 *
* Date : 18 September 2024 *
* Website : http://www.angusj.com *
* Copyright : Angus Johnson 2019-2022 *
* Purpose : Wrapper module for the Clipper library *
Expand Down
4 changes: 2 additions & 2 deletions Image32/source/Img32.Draw.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,8 +2,8 @@

(*******************************************************************************
* Author : Angus Johnson *
* Version : 4.5 *
* Date : 5 July 2024 *
* Version : 4.6 *
* Date : 18 September 2024 *
* Website : http://www.angusj.com *
* Copyright : Angus Johnson 2019-2024 *
* *
Expand Down
66 changes: 43 additions & 23 deletions Image32/source/Img32.Extra.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,8 +2,8 @@

(*******************************************************************************
* Author : Angus Johnson *
* Version : 4.4 *
* Date : 18 August 2024 *
* Version : 4.6 *
* Date : 12 October 2024 *
* Website : http://www.angusj.com *
* Copyright : Angus Johnson 2019-2024 *
* Purpose : Miscellaneous routines that don't belong in other modules. *
Expand Down Expand Up @@ -2248,43 +2248,63 @@ function SmoothPaths(const paths: TPathsD; isClosedPath: Boolean;

procedure GaussianBlur(img: TImage32; rec: TRect; radius: Integer);
var
i, w,h, x,y,yy,z: Integer;
i, w,h, highX, x,y,yy,z,startz: Integer;
gaussTable: array [-MaxBlur .. MaxBlur] of Cardinal;
wc: TWeightedColor;
wca: TArrayOfWeightedColor;
wcaColor: TArrayOfColor32;
row: PColor32Array;
wcRow: PWeightedColorArray;
imgWidth: Integer;
dst, pc: PColor32;
begin
Types.IntersectRect(rec, rec, img.Bounds);
if IsEmptyRect(rec) or (radius < 1) then Exit
else if radius > MaxBlur then radius := MaxBlur;
for i := 0 to radius do

gaussTable[0] := {Sqr}(Radius +1);
for i := 1 to radius do
begin
gaussTable[i] := Sqr(Radius - i +1);
gaussTable[i] := {Sqr}(Radius - i +1);
gaussTable[-i] := gaussTable[i];
end;

RectWidthHeight(rec, w, h);
setLength(wca, w * h);
NewColor32Array(wcaColor, w * h, True);
imgWidth := img.Width;
highX := imgWidth -1;
for y := 0 to h -1 do
begin
row := PColor32Array(@img.Pixels[(y + rec.Top) * img.Width + rec.Left]);
row := PColor32Array(@img.Pixels[(y + rec.Top) * imgWidth + rec.Left]);
wcRow := PWeightedColorArray(@wca[y * w]);
for x := 0 to w -1 do
for z := max(0, x - radius) to min(img.Width -1, x + radius) do
for z := max(0, x - radius) to min(highX, x + radius) do
wcRow[x].Add(row[z], gaussTable[x-z]);
end;

// calculate colors
for x := 0 to w * h - 1 do
wcaColor[x] := wca[x].Color;

dst := @img.Pixels[rec.Left + rec.Top * imgWidth];
imgWidth := imgWidth * SizeOf(TColor32); // convert to byte size
for x := 0 to w -1 do
begin
pc := dst;
inc(pc, x);
for y := 0 to h -1 do
begin
wc.Reset;
yy := max(0, y - radius) * w;
for z := max(0, y - radius) to min(h -1, y + radius) do
startz := max(0, y - radius);
yy := startz * w;
for z := startz to min(h -1, y + radius) do
begin
wc.Add(wca[x + yy].Color, gaussTable[y-z]);
wc.Add(wcaColor[x + yy], gaussTable[y-z]);
inc(yy, w);
end;
img.Pixels[x + rec.Left + (y + rec.Top) * img.Width] := wc.Color;
pc^ := wc.Color;
inc(PByte(pc), imgWidth); // increment by byte size
end;
end;
end;
Expand Down Expand Up @@ -2323,7 +2343,7 @@ procedure FastGaussianBlur(img: TImage32;
end;
//------------------------------------------------------------------------------

procedure BoxBlurH(var src, dst: TArrayOfColor32; w,h, stdDev: integer);
procedure BoxBlurH(const src, dst: TArrayOfColor32; w,h, stdDev: integer);
var
i,j, ti, li, ri, re, ovr: integer;
fv, val: TWeightedColor;
Expand All @@ -2336,17 +2356,16 @@ 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
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
val.Add(src[ti + j]);
if ovr > 0 then val.Add(clNone32, ovr);
for j := 0 to stdDev do
begin
if ri > re then
val.Add(lastColor) else
val.Add(src[ri]);
if ri <= re then
val.Add(src[ri]) else
val.Add(src[re]); // color of last pixel in row
inc(ri);
val.Subtract(fv);
if ti <= re then
Expand All @@ -2367,7 +2386,8 @@ procedure BoxBlurH(var src, dst: TArrayOfColor32; w,h, stdDev: integer);
inc(ri);
inc(li);
end;
dst[ti] := lastColor; inc(ti);
dst[ti] := lastColor;
inc(ti);
end;
while ti <= re do
begin
Expand All @@ -2382,7 +2402,7 @@ procedure BoxBlurH(var src, dst: TArrayOfColor32; w,h, stdDev: integer);
end;
//------------------------------------------------------------------------------

procedure BoxBlurV(var src, dst: TArrayOfColor32; w, h, stdDev: integer);
procedure BoxBlurV(const src, dst: TArrayOfColor32; w, h, stdDev: integer);
var
i,j, ti, li, ri, re, ovr: integer;
fv, val: TWeightedColor;
Expand All @@ -2395,17 +2415,16 @@ 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
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
val.Add(src[ti + j *w]);
if ovr > 0 then val.Add(clNone32, ovr);
for j := 0 to stdDev do
begin
if ri > re then
val.Add(lastColor) else
val.Add(src[ri]);
if ri <= re then
val.Add(src[ri]) else
val.Add(src[re]); // color of last pixel in column
inc(ri, w);
val.Subtract(fv);
if ti <= re then
Expand All @@ -2426,7 +2445,8 @@ procedure BoxBlurV(var src, dst: TArrayOfColor32; w, h, stdDev: integer);
inc(ri, w);
inc(li, w);
end;
dst[ti] := lastColor; inc(ti, w);
dst[ti] := lastColor;
inc(ti, w);
end;
while ti <= re do
begin
Expand Down
4 changes: 2 additions & 2 deletions Image32/source/Img32.FMX.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,8 +2,8 @@

(*******************************************************************************
* Author : Angus Johnson *
* Version : 4.4 *
* Date : 3 September 2023 *
* Version : 4.6 *
* Date : 18 September 2024 *
* Website : http://www.angusj.com *
* Copyright : Angus Johnson 2019-2023 *
* Purpose : Image file format support for TImage32 and FMX *
Expand Down
4 changes: 2 additions & 2 deletions Image32/source/Img32.Fmt.BMP.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,8 +2,8 @@

(*******************************************************************************
* Author : Angus Johnson *
* Version : 4.4 *
* Date : 8 May 2024 *
* Version : 4.6 *
* Date : 18 September 2024 *
* Website : http://www.angusj.com *
* Copyright : Angus Johnson 2019-2024 *
* Purpose : BMP file format extension for TImage32 *
Expand Down
4 changes: 2 additions & 2 deletions Image32/source/Img32.Fmt.GIF.pas
View file
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
unit Img32.Fmt.GIF;
(*******************************************************************************
* Author : Angus Johnson *
* Version : 4.4 *
* Date : 12 March 2023 *
* Version : 4.6 *
* Date : 18 September 2024 *
* Website : http://www.angusj.com *
* Copyright : Angus Johnson 2019-2023 *
* Purpose : GIF file format extension for TImage32 *
Expand Down
Loading

0 comments on commit 0073b54

Please sign in to comment.