Skip to content

Commit

Permalink
ver. 3.2.2
Browse files Browse the repository at this point in the history 
- Use of TFormTabsBar component (Delphi 12) for paging
- Use of Styledmessage dialogs
- Updated Setup to show errors registering dlls
  • Loading branch information
@carloBarazzetta
carloBarazzetta committed Aug 27, 2024
1 parent bea9d18 commit 669fa8f
Show file tree
Hide file tree
Showing 95 changed files with 11,262 additions and 2,602 deletions.
93 changes: 75 additions & 18 deletions Ext/SVGIconImageList/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 : 3 May 2024 *
* Date : 12 August 2024 *
* Website : http://www.angusj.com *
* Copyright : Angus Johnson 2010-2024 *
* Purpose : Core Clipper Library module *
Expand All @@ -18,20 +18,24 @@ interface
SysUtils, Classes, Math;

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

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

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

Expand Down Expand Up @@ -154,8 +158,7 @@ function IsPositive(const path: TPath64): Boolean; overload;
function IsPositive(const path: TPathD): Boolean; overload;
{$IFDEF INLINING} inline; {$ENDIF}

function IsCollinear(const pt1, pt2, pt3: TPoint64): Boolean;
{$IFDEF INLINING} inline; {$ENDIF}
function IsCollinear(const pt1, sharedPt, pt2: TPoint64): Boolean;

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

{$IFDEF USINGZ}
function Point64(const X, Y: Int64; Z: Int64 = 0): TPoint64; overload;
function Point64(const X, Y: Int64; Z: ZType = 0): TPoint64; overload;
{$IFDEF INLINING} inline; {$ENDIF}
function Point64(const X, Y: Double; Z: Int64 = 0): TPoint64; overload;
function Point64(const X, Y: Double; Z: ZType = 0): TPoint64; overload;
{$IFDEF INLINING} inline; {$ENDIF}
function PointD(const X, Y: Double; Z: Int64 = 0): TPointD; overload;
function PointD(const X, Y: Double; Z: ZType = 0): TPointD; overload;
{$IFDEF INLINING} inline; {$ENDIF}
{$ELSE}
function Point64(const X, Y: Int64): TPoint64; overload; {$IFDEF INLINING} inline; {$ENDIF}
Expand Down Expand Up @@ -1384,23 +1387,23 @@ function ArrayOfPathsToPaths(const ap: TArrayOfPaths): TPaths64;
//------------------------------------------------------------------------------

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

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

function PointD(const X, Y: Double; Z: Int64): TPointD;
function PointD(const X, Y: Double; Z: ZType): TPointD;
begin
Result.X := X;
Result.Y := Y;
Expand Down Expand Up @@ -1864,16 +1867,70 @@ function IsPositive(const path: TPathD): Boolean;
end;
//------------------------------------------------------------------------------

{$OVERFLOWCHECKS OFF}
function IsCollinear(const pt1, pt2, pt3: TPoint64): Boolean;
function TriSign(val: Int64): integer; // returns 0, 1 or -1
{$IFDEF INLINING} inline; {$ENDIF}
begin
if (val < 0) then Result := -1
else if (val > 1) then Result := 1
else Result := 0;
end;
//------------------------------------------------------------------------------

type
TMultiplyUInt64Result = record
lo64: UInt64;
hi64 : UInt64;
end;

function MultiplyUInt64(a, b: UInt64): TMultiplyUInt64Result; // #834, #835
{$IFDEF INLINING} inline; {$ENDIF}
var
x1, x2, x3: UInt64;
begin
x1 := (a and $FFFFFFFF) * (b and $FFFFFFFF);
x2 := (a shr 32) * (b and $FFFFFFFF) + (x1 shr 32);
x3 := (a and $FFFFFFFF) * (b shr 32) + (x2 and $FFFFFFFF);
Result.lo64 := ((x3 and $FFFFFFFF) shl 32) or (x1 and $FFFFFFFF);
Result.hi64 := hi(a shr 32) * (b shr 32) + (x2 shr 32) + (x3 shr 32);
end;
//------------------------------------------------------------------------------

function ProductsAreEqual(a, b, c, d: Int64): Boolean;
var
absA,absB,absC,absD: UInt64;
absAB, absCD : TMultiplyUInt64Result;
signAB, signCD : integer;
begin
// nb: unsigned values will be needed for CalcOverflowCarry()
absA := UInt64(Abs(a));
absB := UInt64(Abs(b));
absC := UInt64(Abs(c));
absD := UInt64(Abs(d));

absAB := MultiplyUInt64(absA, absB);
absCD := MultiplyUInt64(absC, absD);

// nb: it's important to differentiate 0 values here from other values
signAB := TriSign(a) * TriSign(b);
signCD := TriSign(c) * TriSign(d);

Result := (absAB.lo64 = absCD.lo64) and
(absAB.hi64 = absCD.hi64) and (signAB = signCD);
end;
//------------------------------------------------------------------------------

function IsCollinear(const pt1, sharedPt, pt2: TPoint64): Boolean;
var
a,b: Int64;
a,b,c,d: Int64;
begin
a := (pt2.X - pt1.X) * (pt3.Y - pt2.Y);
b := (pt2.Y - pt1.Y) * (pt3.X - pt2.X);
result := a = b;
a := sharedPt.X - pt1.X;
b := pt2.Y - sharedPt.Y;
c := sharedPt.Y - pt1.Y;
d := pt2.X - sharedPt.X;
// When checking for collinearity with very large coordinate values
// then ProductsAreEqual is more accurate than using CrossProduct.
Result := ProductsAreEqual(a, b, c, d);
end;
{$OVERFLOWCHECKS ON}
//------------------------------------------------------------------------------

function CrossProduct(const pt1, pt2, pt3: TPoint64): double;
Expand Down
61 changes: 32 additions & 29 deletions Ext/SVGIconImageList/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 : 27 April 2024 *
* Date : 12 August 2024 *
* Website : http://www.angusj.com *
* Copyright : Angus Johnson 2010-2024 *
* Purpose : This is the main polygon clipping module *
Expand Down Expand Up @@ -219,7 +219,7 @@ TClipperBase = class
FSucceeded : Boolean;
FReverseSolution : Boolean;
{$IFDEF USINGZ}
fDefaultZ : Int64;
fDefaultZ : Ztype;
fZCallback : TZCallback64;
{$ENDIF}
procedure Reset;
Expand Down Expand Up @@ -287,7 +287,7 @@ TClipperBase = class
{$IFDEF USINGZ}
procedure SetZ( e1, e2: PActive; var intersectPt: TPoint64);
property ZCallback : TZCallback64 read fZCallback write fZCallback;
property DefaultZ : Int64 read fDefaultZ write fDefaultZ;
property DefaultZ : Ztype read fDefaultZ write fDefaultZ;
{$ENDIF}
property Succeeded : Boolean read FSucceeded;
public
Expand Down Expand Up @@ -372,8 +372,7 @@ TClipperD = class(TClipperBase) // for floating point coordinates
FInvScale: double;
{$IFDEF USINGZ}
fZCallback : TZCallbackD;
procedure ZCB(const bot1, top1, bot2, top2: TPoint64;
var intersectPt: TPoint64);
procedure ZCB(const bot1, top1, bot2, top2: TPoint64; var intersectPt: TPoint64);
procedure CheckCallback;
{$ENDIF}
public
Expand Down Expand Up @@ -1017,6 +1016,11 @@ procedure AddPathsToVertexList(const paths: TPaths64;
GetMem(v, sizeof(TVertex) * totalVerts);
vertexList.Add(v);

{$IF not defined(FPC) and (CompilerVersion <= 26.0)}
// Delphi 7-XE5 have a problem with "continue" and the
// code analysis, marking "ascending" as "not initialized"
ascending := False;
{$IFEND}
for i := 0 to High(paths) do
begin
len := Length(paths[i]);
Expand Down Expand Up @@ -2559,9 +2563,8 @@ procedure TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64);
var
e1WindCnt, e2WindCnt, e1WindCnt2, e2WindCnt2: Integer;
e3: PActive;
resultOp, op2: POutPt;
op, op2: POutPt;
begin
resultOp := nil;
// MANAGE OPEN PATH INTERSECTIONS SEPARATELY ...
if FHasOpenPaths and (IsOpen(e1) or IsOpen(e2)) then
begin
Expand All @@ -2586,7 +2589,7 @@ procedure TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64);
// toggle contribution ...
if IsHotEdge(e1) then
begin
resultOp := AddOutPt(e1, pt);
op := AddOutPt(e1, pt);
if IsFront(e1) then
e1.outrec.frontE := nil else
e1.outrec.backE := nil;
Expand All @@ -2610,12 +2613,12 @@ procedure TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64);
SetSides(e3.outrec, e3, e1);
Exit;
end else
resultOp := StartOpenPath(e1, pt);
op := StartOpenPath(e1, pt);
end else
resultOp := StartOpenPath(e1, pt);
op := StartOpenPath(e1, pt);

{$IFDEF USINGZ}
SetZ(e1, e2, resultOp.pt);
SetZ(e1, e2, op.pt);
{$ENDIF}
Exit;
end;
Expand Down Expand Up @@ -2679,31 +2682,31 @@ procedure TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64);
if not (e1WindCnt in [0,1]) or not (e2WindCnt in [0,1]) or
(not IsSamePolyType(e1, e2) and (fClipType <> ctXor)) then
begin
resultOp := AddLocalMaxPoly(e1, e2, pt);
op := AddLocalMaxPoly(e1, e2, pt);
{$IFDEF USINGZ}
if Assigned(Result) then SetZ(e1, e2, Result.pt);
if Assigned(op) then SetZ(e1, e2, op.pt);
{$ENDIF}

end else if IsFront(e1) or (e1.outrec = e2.outrec) then
begin
// this 'else if' condition isn't strictly needed but
// it's sensible to split polygons that ony touch at
// a common vertex (not at common edges).
resultOp := AddLocalMaxPoly(e1, e2, pt);
op := AddLocalMaxPoly(e1, e2, pt);
{$IFDEF USINGZ}
op2 := AddLocalMinPoly(e1, e2, pt);
if Assigned(Result) then SetZ(e1, e2, Result.pt);
if Assigned(op) then SetZ(e1, e2, op.pt);
SetZ(e1, e2, op2.pt);
{$ELSE}
AddLocalMinPoly(e1, e2, pt);
{$ENDIF}
end else
begin
// can't treat as maxima & minima
resultOp := AddOutPt(e1, pt);
op := AddOutPt(e1, pt);
{$IFDEF USINGZ}
op2 := AddOutPt(e2, pt);
SetZ(e1, e2, Result.pt);
SetZ(e1, e2, op.pt);
SetZ(e1, e2, op2.pt);
{$ELSE}
AddOutPt(e2, pt);
Expand All @@ -2715,17 +2718,17 @@ procedure TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64);
// if one or other edge is 'hot' ...
else if IsHotEdge(e1) then
begin
resultOp := AddOutPt(e1, pt);
op := AddOutPt(e1, pt);
{$IFDEF USINGZ}
SetZ(e1, e2, Result.pt);
SetZ(e1, e2, op.pt);
{$ENDIF}
SwapOutRecs(e1, e2);
end
else if IsHotEdge(e2) then
begin
resultOp := AddOutPt(e2, pt);
op := AddOutPt(e2, pt);
{$IFDEF USINGZ}
SetZ(e1, e2, Result.pt);
SetZ(e1, e2, op.pt);
{$ENDIF}
SwapOutRecs(e1, e2);
end
Expand Down Expand Up @@ -2753,32 +2756,32 @@ procedure TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64);

if not IsSamePolyType(e1, e2) then
begin
resultOp := AddLocalMinPoly(e1, e2, pt, false);
op := AddLocalMinPoly(e1, e2, pt, false);
{$IFDEF USINGZ}
SetZ(e1, e2, Result.pt);
SetZ(e1, e2, op.pt);
{$ENDIF}
end
else if (e1WindCnt = 1) and (e2WindCnt = 1) then
begin
resultOp := nil;
op := nil;
case FClipType of
ctIntersection:
if (e1WindCnt2 <= 0) or (e2WindCnt2 <= 0) then Exit
else resultOp := AddLocalMinPoly(e1, e2, pt, false);
else op := AddLocalMinPoly(e1, e2, pt, false);
ctUnion:
if (e1WindCnt2 <= 0) and (e2WindCnt2 <= 0) then
resultOp := AddLocalMinPoly(e1, e2, pt, false);
op := AddLocalMinPoly(e1, e2, pt, false);
ctDifference:
if ((GetPolyType(e1) = ptClip) and
(e1WindCnt2 > 0) and (e2WindCnt2 > 0)) or
((GetPolyType(e1) = ptSubject) and
(e1WindCnt2 <= 0) and (e2WindCnt2 <= 0)) then
resultOp := AddLocalMinPoly(e1, e2, pt, false);
op := AddLocalMinPoly(e1, e2, pt, false);
else // xOr
resultOp := AddLocalMinPoly(e1, e2, pt, false);
op := AddLocalMinPoly(e1, e2, pt, false);
end;
{$IFDEF USINGZ}
if assigned(Result) then SetZ(e1, e2, Result.pt);
if assigned(op) then SetZ(e1, e2, op.pt);
{$ENDIF}
end;
end;
Expand Down
Loading

0 comments on commit 669fa8f

Please sign in to comment.