Skip to content

Commit 669fa8f

Browse files
carloBarazzettacarloBarazzetta
committed
ver. 3.2.2
- Use of TFormTabsBar component (Delphi 12) for paging - Use of Styledmessage dialogs - Updated Setup to show errors registering dlls
1 parent bea9d18 commit 669fa8f

95 files changed

Lines changed: 11262 additions & 2602 deletions

File tree

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

‎Ext/SVGIconImageList/Image32/source/Clipper.Core.pas‎

Lines changed: 75 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22

33
(*******************************************************************************
44
* Author : Angus Johnson *
5-
* Date : 3 May 2024 *
5+
* Date : 12 August 2024 *
66
* Website : http://www.angusj.com *
77
* Copyright : Angus Johnson 2010-2024 *
88
* Purpose : Core Clipper Library module *
@@ -18,20 +18,24 @@ interface
1818
SysUtils, Classes, Math;
1919

2020
type
21+
{$IFDEF USINGZ}
22+
Ztype = type double;//Int64;//
23+
PZtype = ^Ztype;
24+
{$ENDIF}
2125

2226
PPoint64 = ^TPoint64;
2327
TPoint64 = record
2428
X, Y: Int64;
2529
{$IFDEF USINGZ}
26-
Z: Int64;
30+
Z: Ztype;
2731
{$ENDIF}
2832
end;
2933

3034
PPointD = ^TPointD;
3135
TPointD = record
3236
X, Y: double;
3337
{$IFDEF USINGZ}
34-
Z: Int64;
38+
Z: Ztype;
3539
{$ENDIF}
3640
end;
3741

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

157-
function IsCollinear(const pt1, pt2, pt3: TPoint64): Boolean;
158-
{$IFDEF INLINING} inline; {$ENDIF}
161+
function IsCollinear(const pt1, sharedPt, pt2: TPoint64): Boolean;
159162

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

189192
{$IFDEF USINGZ}
190-
function Point64(const X, Y: Int64; Z: Int64 = 0): TPoint64; overload;
193+
function Point64(const X, Y: Int64; Z: ZType = 0): TPoint64; overload;
191194
{$IFDEF INLINING} inline; {$ENDIF}
192-
function Point64(const X, Y: Double; Z: Int64 = 0): TPoint64; overload;
195+
function Point64(const X, Y: Double; Z: ZType = 0): TPoint64; overload;
193196
{$IFDEF INLINING} inline; {$ENDIF}
194-
function PointD(const X, Y: Double; Z: Int64 = 0): TPointD; overload;
197+
function PointD(const X, Y: Double; Z: ZType = 0): TPointD; overload;
195198
{$IFDEF INLINING} inline; {$ENDIF}
196199
{$ELSE}
197200
function Point64(const X, Y: Int64): TPoint64; overload; {$IFDEF INLINING} inline; {$ENDIF}
@@ -1384,23 +1387,23 @@ function ArrayOfPathsToPaths(const ap: TArrayOfPaths): TPaths64;
13841387
//------------------------------------------------------------------------------
13851388

13861389
{$IFDEF USINGZ}
1387-
function Point64(const X, Y: Int64; Z: Int64): TPoint64;
1390+
function Point64(const X, Y: Int64; Z: ZType): TPoint64;
13881391
begin
13891392
Result.X := X;
13901393
Result.Y := Y;
13911394
Result.Z := Z;
13921395
end;
13931396
//------------------------------------------------------------------------------
13941397

1395-
function Point64(const X, Y: Double; Z: Int64): TPoint64;
1398+
function Point64(const X, Y: Double; Z: ZType): TPoint64;
13961399
begin
13971400
Result.X := Round(X);
13981401
Result.Y := Round(Y);
13991402
Result.Z := Z;
14001403
end;
14011404
//------------------------------------------------------------------------------
14021405

1403-
function PointD(const X, Y: Double; Z: Int64): TPointD;
1406+
function PointD(const X, Y: Double; Z: ZType): TPointD;
14041407
begin
14051408
Result.X := X;
14061409
Result.Y := Y;
@@ -1864,16 +1867,70 @@ function IsPositive(const path: TPathD): Boolean;
18641867
end;
18651868
//------------------------------------------------------------------------------
18661869

1867-
{$OVERFLOWCHECKS OFF}
1868-
function IsCollinear(const pt1, pt2, pt3: TPoint64): Boolean;
1870+
function TriSign(val: Int64): integer; // returns 0, 1 or -1
1871+
{$IFDEF INLINING} inline; {$ENDIF}
1872+
begin
1873+
if (val < 0) then Result := -1
1874+
else if (val > 1) then Result := 1
1875+
else Result := 0;
1876+
end;
1877+
//------------------------------------------------------------------------------
1878+
1879+
type
1880+
TMultiplyUInt64Result = record
1881+
lo64: UInt64;
1882+
hi64 : UInt64;
1883+
end;
1884+
1885+
function MultiplyUInt64(a, b: UInt64): TMultiplyUInt64Result; // #834, #835
1886+
{$IFDEF INLINING} inline; {$ENDIF}
1887+
var
1888+
x1, x2, x3: UInt64;
1889+
begin
1890+
x1 := (a and $FFFFFFFF) * (b and $FFFFFFFF);
1891+
x2 := (a shr 32) * (b and $FFFFFFFF) + (x1 shr 32);
1892+
x3 := (a and $FFFFFFFF) * (b shr 32) + (x2 and $FFFFFFFF);
1893+
Result.lo64 := ((x3 and $FFFFFFFF) shl 32) or (x1 and $FFFFFFFF);
1894+
Result.hi64 := hi(a shr 32) * (b shr 32) + (x2 shr 32) + (x3 shr 32);
1895+
end;
1896+
//------------------------------------------------------------------------------
1897+
1898+
function ProductsAreEqual(a, b, c, d: Int64): Boolean;
1899+
var
1900+
absA,absB,absC,absD: UInt64;
1901+
absAB, absCD : TMultiplyUInt64Result;
1902+
signAB, signCD : integer;
1903+
begin
1904+
// nb: unsigned values will be needed for CalcOverflowCarry()
1905+
absA := UInt64(Abs(a));
1906+
absB := UInt64(Abs(b));
1907+
absC := UInt64(Abs(c));
1908+
absD := UInt64(Abs(d));
1909+
1910+
absAB := MultiplyUInt64(absA, absB);
1911+
absCD := MultiplyUInt64(absC, absD);
1912+
1913+
// nb: it's important to differentiate 0 values here from other values
1914+
signAB := TriSign(a) * TriSign(b);
1915+
signCD := TriSign(c) * TriSign(d);
1916+
1917+
Result := (absAB.lo64 = absCD.lo64) and
1918+
(absAB.hi64 = absCD.hi64) and (signAB = signCD);
1919+
end;
1920+
//------------------------------------------------------------------------------
1921+
1922+
function IsCollinear(const pt1, sharedPt, pt2: TPoint64): Boolean;
18691923
var
1870-
a,b: Int64;
1924+
a,b,c,d: Int64;
18711925
begin
1872-
a := (pt2.X - pt1.X) * (pt3.Y - pt2.Y);
1873-
b := (pt2.Y - pt1.Y) * (pt3.X - pt2.X);
1874-
result := a = b;
1926+
a := sharedPt.X - pt1.X;
1927+
b := pt2.Y - sharedPt.Y;
1928+
c := sharedPt.Y - pt1.Y;
1929+
d := pt2.X - sharedPt.X;
1930+
// When checking for collinearity with very large coordinate values
1931+
// then ProductsAreEqual is more accurate than using CrossProduct.
1932+
Result := ProductsAreEqual(a, b, c, d);
18751933
end;
1876-
{$OVERFLOWCHECKS ON}
18771934
//------------------------------------------------------------------------------
18781935

18791936
function CrossProduct(const pt1, pt2, pt3: TPoint64): double;

‎Ext/SVGIconImageList/Image32/source/Clipper.Engine.pas‎

Lines changed: 32 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22

33
(*******************************************************************************
44
* Author : Angus Johnson *
5-
* Date : 27 April 2024 *
5+
* Date : 12 August 2024 *
66
* Website : http://www.angusj.com *
77
* Copyright : Angus Johnson 2010-2024 *
88
* Purpose : This is the main polygon clipping module *
@@ -219,7 +219,7 @@ TClipperBase = class
219219
FSucceeded : Boolean;
220220
FReverseSolution : Boolean;
221221
{$IFDEF USINGZ}
222-
fDefaultZ : Int64;
222+
fDefaultZ : Ztype;
223223
fZCallback : TZCallback64;
224224
{$ENDIF}
225225
procedure Reset;
@@ -287,7 +287,7 @@ TClipperBase = class
287287
{$IFDEF USINGZ}
288288
procedure SetZ( e1, e2: PActive; var intersectPt: TPoint64);
289289
property ZCallback : TZCallback64 read fZCallback write fZCallback;
290-
property DefaultZ : Int64 read fDefaultZ write fDefaultZ;
290+
property DefaultZ : Ztype read fDefaultZ write fDefaultZ;
291291
{$ENDIF}
292292
property Succeeded : Boolean read FSucceeded;
293293
public
@@ -372,8 +372,7 @@ TClipperD = class(TClipperBase) // for floating point coordinates
372372
FInvScale: double;
373373
{$IFDEF USINGZ}
374374
fZCallback : TZCallbackD;
375-
procedure ZCB(const bot1, top1, bot2, top2: TPoint64;
376-
var intersectPt: TPoint64);
375+
procedure ZCB(const bot1, top1, bot2, top2: TPoint64; var intersectPt: TPoint64);
377376
procedure CheckCallback;
378377
{$ENDIF}
379378
public
@@ -1017,6 +1016,11 @@ procedure AddPathsToVertexList(const paths: TPaths64;
10171016
GetMem(v, sizeof(TVertex) * totalVerts);
10181017
vertexList.Add(v);
10191018

1019+
{$IF not defined(FPC) and (CompilerVersion <= 26.0)}
1020+
// Delphi 7-XE5 have a problem with "continue" and the
1021+
// code analysis, marking "ascending" as "not initialized"
1022+
ascending := False;
1023+
{$IFEND}
10201024
for i := 0 to High(paths) do
10211025
begin
10221026
len := Length(paths[i]);
@@ -2559,9 +2563,8 @@ procedure TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64);
25592563
var
25602564
e1WindCnt, e2WindCnt, e1WindCnt2, e2WindCnt2: Integer;
25612565
e3: PActive;
2562-
resultOp, op2: POutPt;
2566+
op, op2: POutPt;
25632567
begin
2564-
resultOp := nil;
25652568
// MANAGE OPEN PATH INTERSECTIONS SEPARATELY ...
25662569
if FHasOpenPaths and (IsOpen(e1) or IsOpen(e2)) then
25672570
begin
@@ -2586,7 +2589,7 @@ procedure TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64);
25862589
// toggle contribution ...
25872590
if IsHotEdge(e1) then
25882591
begin
2589-
resultOp := AddOutPt(e1, pt);
2592+
op := AddOutPt(e1, pt);
25902593
if IsFront(e1) then
25912594
e1.outrec.frontE := nil else
25922595
e1.outrec.backE := nil;
@@ -2610,12 +2613,12 @@ procedure TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64);
26102613
SetSides(e3.outrec, e3, e1);
26112614
Exit;
26122615
end else
2613-
resultOp := StartOpenPath(e1, pt);
2616+
op := StartOpenPath(e1, pt);
26142617
end else
2615-
resultOp := StartOpenPath(e1, pt);
2618+
op := StartOpenPath(e1, pt);
26162619

26172620
{$IFDEF USINGZ}
2618-
SetZ(e1, e2, resultOp.pt);
2621+
SetZ(e1, e2, op.pt);
26192622
{$ENDIF}
26202623
Exit;
26212624
end;
@@ -2679,31 +2682,31 @@ procedure TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64);
26792682
if not (e1WindCnt in [0,1]) or not (e2WindCnt in [0,1]) or
26802683
(not IsSamePolyType(e1, e2) and (fClipType <> ctXor)) then
26812684
begin
2682-
resultOp := AddLocalMaxPoly(e1, e2, pt);
2685+
op := AddLocalMaxPoly(e1, e2, pt);
26832686
{$IFDEF USINGZ}
2684-
if Assigned(Result) then SetZ(e1, e2, Result.pt);
2687+
if Assigned(op) then SetZ(e1, e2, op.pt);
26852688
{$ENDIF}
26862689

26872690
end else if IsFront(e1) or (e1.outrec = e2.outrec) then
26882691
begin
26892692
// this 'else if' condition isn't strictly needed but
26902693
// it's sensible to split polygons that ony touch at
26912694
// a common vertex (not at common edges).
2692-
resultOp := AddLocalMaxPoly(e1, e2, pt);
2695+
op := AddLocalMaxPoly(e1, e2, pt);
26932696
{$IFDEF USINGZ}
26942697
op2 := AddLocalMinPoly(e1, e2, pt);
2695-
if Assigned(Result) then SetZ(e1, e2, Result.pt);
2698+
if Assigned(op) then SetZ(e1, e2, op.pt);
26962699
SetZ(e1, e2, op2.pt);
26972700
{$ELSE}
26982701
AddLocalMinPoly(e1, e2, pt);
26992702
{$ENDIF}
27002703
end else
27012704
begin
27022705
// can't treat as maxima & minima
2703-
resultOp := AddOutPt(e1, pt);
2706+
op := AddOutPt(e1, pt);
27042707
{$IFDEF USINGZ}
27052708
op2 := AddOutPt(e2, pt);
2706-
SetZ(e1, e2, Result.pt);
2709+
SetZ(e1, e2, op.pt);
27072710
SetZ(e1, e2, op2.pt);
27082711
{$ELSE}
27092712
AddOutPt(e2, pt);
@@ -2715,17 +2718,17 @@ procedure TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64);
27152718
// if one or other edge is 'hot' ...
27162719
else if IsHotEdge(e1) then
27172720
begin
2718-
resultOp := AddOutPt(e1, pt);
2721+
op := AddOutPt(e1, pt);
27192722
{$IFDEF USINGZ}
2720-
SetZ(e1, e2, Result.pt);
2723+
SetZ(e1, e2, op.pt);
27212724
{$ENDIF}
27222725
SwapOutRecs(e1, e2);
27232726
end
27242727
else if IsHotEdge(e2) then
27252728
begin
2726-
resultOp := AddOutPt(e2, pt);
2729+
op := AddOutPt(e2, pt);
27272730
{$IFDEF USINGZ}
2728-
SetZ(e1, e2, Result.pt);
2731+
SetZ(e1, e2, op.pt);
27292732
{$ENDIF}
27302733
SwapOutRecs(e1, e2);
27312734
end
@@ -2753,32 +2756,32 @@ procedure TClipperBase.IntersectEdges(e1, e2: PActive; pt: TPoint64);
27532756

27542757
if not IsSamePolyType(e1, e2) then
27552758
begin
2756-
resultOp := AddLocalMinPoly(e1, e2, pt, false);
2759+
op := AddLocalMinPoly(e1, e2, pt, false);
27572760
{$IFDEF USINGZ}
2758-
SetZ(e1, e2, Result.pt);
2761+
SetZ(e1, e2, op.pt);
27592762
{$ENDIF}
27602763
end
27612764
else if (e1WindCnt = 1) and (e2WindCnt = 1) then
27622765
begin
2763-
resultOp := nil;
2766+
op := nil;
27642767
case FClipType of
27652768
ctIntersection:
27662769
if (e1WindCnt2 <= 0) or (e2WindCnt2 <= 0) then Exit
2767-
else resultOp := AddLocalMinPoly(e1, e2, pt, false);
2770+
else op := AddLocalMinPoly(e1, e2, pt, false);
27682771
ctUnion:
27692772
if (e1WindCnt2 <= 0) and (e2WindCnt2 <= 0) then
2770-
resultOp := AddLocalMinPoly(e1, e2, pt, false);
2773+
op := AddLocalMinPoly(e1, e2, pt, false);
27712774
ctDifference:
27722775
if ((GetPolyType(e1) = ptClip) and
27732776
(e1WindCnt2 > 0) and (e2WindCnt2 > 0)) or
27742777
((GetPolyType(e1) = ptSubject) and
27752778
(e1WindCnt2 <= 0) and (e2WindCnt2 <= 0)) then
2776-
resultOp := AddLocalMinPoly(e1, e2, pt, false);
2779+
op := AddLocalMinPoly(e1, e2, pt, false);
27772780
else // xOr
2778-
resultOp := AddLocalMinPoly(e1, e2, pt, false);
2781+
op := AddLocalMinPoly(e1, e2, pt, false);
27792782
end;
27802783
{$IFDEF USINGZ}
2781-
if assigned(Result) then SetZ(e1, e2, Result.pt);
2784+
if assigned(op) then SetZ(e1, e2, op.pt);
27822785
{$ENDIF}
27832786
end;
27842787
end;

0 commit comments

Comments
 (0)