mirrors/doublecmd
2
0
Fork 0
mirror of https://github.com/doublecmd/doublecmd.git synced 2026-06-21 09:58:13 +00:00
Code Issues Projects Releases Packages Wiki Activity
doublecmd/components/Image32/source/Img32.Vector.pas
Alexander Koblov 727d583037 UPD: Image32 library
2025-04-20 16:26:15 +03:00

4202 lines
126 KiB
ObjectPascal
Raw Blame History

unit Img32.Vector;
(*******************************************************************************
* Author : Angus Johnson *
* Version : 4.7 *
* Date : 6 January 2025 *
* Website : http://www.angusj.com *
* Copyright : Angus Johnson 2019-2025 *
* *
* Purpose : Vector drawing for TImage32 *
* *
* License : Use, modification & distribution is subject to *
* Boost Software License Ver 1 *
* http://www.boost.org/LICENSE_1_0.txt *
*******************************************************************************)
interface
{$I Img32.inc}
uses
SysUtils, Classes, Math, Types, Img32;
type
TArrowStyle = (asNone, asSimple, asFancy, asDiamond, asCircle, asTail);
// TJoinStyle:
// jsSquare - Convex joins will be truncated using a 'squaring' edge.
// The mid-points of these squaring edges will also be exactly the offset
// (ie delta) distance away from their origins (ie the starting vertices).
// jsButt - joins are similar to 'squared' joins except that squaring
// won't occur at a fixed distance. While bevelled joins may not be as
// pretty as squared joins, bevelling will be much faster than squaring.
// And perhaps this is why bevelling (rather than squaring) is preferred
// in numerous graphics display formats (including SVG & PDF documents).
TJoinStyle = (jsAuto, jsSquare, jsButt, jsMiter, jsRound);
TEndStyle = (esPolygon = 0, esClosed = 0, esButt, esSquare, esRound);
TPathEnd = (peStart, peEnd, peBothEnds);
TSplineType = (stQuadratic, stCubic);
TFillRule = (frEvenOdd, frNonZero, frPositive, frNegative);
TImg32FillRule = TFillRule; //useful whenever there's ambiguity with Clipper
TSizeD = {$IFDEF RECORD_METHODS} record {$ELSE} object {$ENDIF}
cx : double;
cy : double;
function average: double;
property Width: Double read cx write cx;
property Height: Double read cy write cy;
end;
TRectWH = {$IFDEF RECORD_METHODS} record {$ELSE} object {$ENDIF}
public
Left, Top, Width, Height: double;
function IsEmpty: Boolean;
function IsValid: Boolean;
function Right: double;
function Bottom: double;
function Contains(const Pt: TPoint): Boolean; overload;
function Contains(const Pt: TPointD): Boolean; overload;
function MidPoint: TPointD;
function RectD: TRectD;
function Rect: TRect;
end;
function RectWH(left, top, width, height: integer): TRectWH; overload;
function RectWH(left, top, width, height: double ): TRectWH; overload;
function RectWH(const rec: TRectD): TRectWH; overload;
//InflateRect: missing in Delphi 7
procedure InflateRect(var rec: TRect; dx, dy: integer); overload;
procedure InflateRect(var rec: TRectD; dx, dy: double); overload;
function NormalizeRect(var rect: TRect): Boolean;
function PrePendPoint(const pt: TPointD; const p: TPathD): TPathD; overload;
procedure PrePendPoint(const pt: TPointD; const p: TPathD; var Result: TPathD); overload;
function PrePendPoints(const pt1, pt2: TPointD; const p: TPathD): TPathD;
function Rectangle(const rec: TRect): TPathD; overload;
function Rectangle(const rec: TRectD): TPathD; overload;
function Rectangle(l, t, r, b: double): TPathD; overload;
function RoundRect(const rec: TRect; radius: integer): TPathD; overload;
function RoundRect(const rec: TRectD; radius: double): TPathD; overload;
function RoundRect(const rec: TRect; radius: TPoint): TPathD; overload;
function RoundRect(const rec: TRectD; radius: TPointD): TPathD; overload;
function Ellipse(const rec: TRect; steps: integer = 0): TPathD; overload;
function Ellipse(const rec: TRectD; steps: integer = 0): TPathD; overload;
function Ellipse(const rec: TRectD; pendingScale: double): TPathD; overload;
function RotatedEllipse(const rec: TRectD; angle: double; steps: integer = 0): TPathD; overload;
function RotatedEllipse(const rec: TRectD; angle: double; pendingScale: double): TPathD; overload;
function AngleToEllipticalAngle(const ellRec: TRectD; angle: double): double;
function EllipticalAngleToAngle(const ellRec: TRectD; angle: double): double;
function Circle(const pt: TPoint; radius: double): TPathD; overload;
function Circle(const pt: TPointD; radius: double): TPathD; overload;
function Circle(const pt: TPointD; radius: double; pendingScale: double): TPathD; overload;
function CalcCircleFrom3Points(const p1,p2,p3: TPointD;
out centre: TPointD; out radius: double): Boolean;
function Star(const rec: TRectD; points: integer; indentFrac: double = 0.4): TPathD; overload;
function Star(const focalPt: TPointD;
innerRadius, outerRadius: double; points: integer): TPathD; overload;
function Arc(const rec: TRectD;
startAngle, endAngle: double; scale: double = 0): TPathD;
function Pie(const rec: TRectD;
StartAngle, EndAngle: double; scale: double = 0): TPathD;
function FlattenQBezier(const pt1, pt2, pt3: TPointD;
tolerance: double = 0.0): TPathD; overload;
function FlattenQBezier(const pts: TPathD;
tolerance: double = 0.0): TPathD; overload;
function FlattenQBezier(const firstPt: TPointD; const pts: TPathD;
tolerance: double = 0.0): TPathD; overload;
function GetPointInQuadBezier(const a,b,c: TPointD; t: double): TPointD;
function FlattenCBezier(const pt1, pt2, pt3, pt4: TPointD;
tolerance: double = 0.0): TPathD; overload;
function FlattenCBezier(const path: TPathD;
tolerance: double = 0.0): TPathD; overload;
function FlattenCBezier(const paths: TPathsD;
tolerance: double = 0.0): TPathsD; overload;
function FlattenCBezier(const firstPt: TPointD; const pts: TPathD;
tolerance: double = 0.0): TPathD; overload;
function GetPointInCubicBezier(const a,b,c,d: TPointD; t: double): TPointD;
//FlattenCSpline: Approximates the 'S' command inside the 'd' property of an
//SVG path. (See https://www.w3.org/TR/SVG/paths.html#DProperty)
function FlattenCSpline(const pts: TPathD;
tolerance: double = 0.0): TPathD; overload;
function FlattenCSpline(const priorCtrlPt, startPt: TPointD;
const pts: TPathD; tolerance: double = 0.0): TPathD; overload;
//FlattenQSpline: Approximates the 'T' command inside the 'd' property of an
//SVG path. (See https://www.w3.org/TR/SVG/paths.html#DProperty)
function FlattenQSpline(const pts: TPathD;
tolerance: double = 0.0): TPathD; overload;
function FlattenQSpline(const priorCtrlPt, startPt: TPointD;
const pts: TPathD; tolerance: double = 0.0): TPathD; overload;
//ArrowHead: The ctrlPt's only function is to control the angle of the arrow.
function ArrowHead(const arrowTip, ctrlPt: TPointD; size: double;
arrowStyle: TArrowStyle): TPathD;
function GetDefaultArrowHeadSize(lineWidth: double): double;
procedure AdjustPoint(var pt: TPointD;
const referencePt: TPointD; delta: double);
function ShortenPath(const path: TPathD;
pathEnd: TPathEnd; amount: double): TPathD;
//GetDashPath: Returns a polyline (not polygons)
function GetDashedPath(const path: TPathD;
closed: Boolean; const pattern: TArrayOfDouble;
patternOffset: PDouble): TPathsD;
function GetDashedOutLine(const path: TPathD;
closed: Boolean; const pattern: TArrayOfDouble;
patternOffset: PDouble; lineWidth: double;
joinStyle: TJoinStyle; endStyle: TEndStyle): TPathsD;
function TranslatePoint(const pt: TPoint; dx, dy: integer): TPoint; overload;
function TranslatePoint(const pt: TPointD; dx, dy: double): TPointD; overload;
function TranslatePath(const path: TPathD;
dx, dy: double): TPathD; overload;
function TranslatePath(const paths: TPathsD;
dx, dy: double): TPathsD; overload;
function TranslatePath(const ppp: TArrayOfPathsD;
dx, dy: double): TArrayOfPathsD; overload;
function Paths(const path: TPathD): TPathsD;
{$IFDEF INLINING} inline; {$ENDIF}
//CopyPath: note that only dynamic string arrays are copy-on-write
function CopyPath(const path: TPathD): TPathD;
{$IFDEF INLINING} inline; {$ENDIF}
function CopyPaths(const paths: TPathsD): TPathsD;
function ScalePoint(const pt: TPointD; scale: double): TPointD; overload;
{$IFDEF INLINING} inline; {$ENDIF}
function ScalePoint(const pt: TPointD; sx, sy: double): TPointD; overload;
{$IFDEF INLINING} inline; {$ENDIF}
function ScalePath(const path: TPathD;
sx, sy: double): TPathD; overload;
function ScalePath(const path: TPathD;
scale: double): TPathD; overload;
function ScalePath(const paths: TPathsD;
sx, sy: double): TPathsD; overload;
function ScalePath(const paths: TPathsD;
scale: double): TPathsD; overload;
function ScaleRect(const rec: TRect; scale: double): TRect; overload;
function ScaleRect(const rec: TRectD; scale: double): TRectD; overload;
function ScaleRect(const rec: TRect; sx, sy: double): TRect; overload;
function ScaleRect(const rec: TRectD; sx, sy: double): TRectD; overload;
function ScalePathToFit(const path: TPathD; const rec: TRect): TPathD;
function ScalePathsToFit(const paths: TPathsD; const rec: TRect): TPathsD;
function ReversePath(const path: TPathD): TPathD; overload;
function ReversePath(const paths: TPathsD): TPathsD; overload;
function OpenPathToFlatPolygon(const path: TPathD): TPathD;
procedure AppendPoint(var path: TPathD; const extra: TPointD);
// AppendPath - adds TPathD & TPathsD objects to the end of
// TPathsD (or TArrayOfPathsD) objects
procedure AppendPath(var paths: TPathsD; const extra: TPathD); overload;
procedure AppendPath(var paths: TPathsD; const extra: TPathsD); overload;
procedure AppendPath(var ppp: TArrayOfPathsD; const extra: TPathsD); overload;
// ConcatPaths - concats multiple paths into a single path.
// It also avoids point duplicates where path joins
procedure ConcatPaths(var dstPath: TPathD; const path: TPathD); overload;
procedure ConcatPaths(var dstPath: TPathD; const paths: TPathsD); overload;
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;
function GetAngle(const a, b, c: TPointD): double; overload;
procedure GetSinCos(angle: double; out sinA, cosA: double);
function GetPointAtAngleAndDist(const origin: TPointD;
angle, distance: double): TPointD;
function IntersectPoint(const ln1a, ln1b, ln2a, ln2b: TPointD): TPointD; overload;
function IntersectPoint(const ln1a, ln1b, ln2a, ln2b: TPointD; out ip: TPointD): Boolean; overload;
function SegmentIntersectPt(const ln1a, ln1b, ln2a, ln2b: TPointD): TPointD;
function SegmentsIntersect(const ln1a, ln1b, ln2a, ln2b: TPointD;
out ip: TPointD): Boolean;
procedure RotatePoint(var pt: TPointD;
const focalPoint: TPointD; sinA, cosA: double); overload;
procedure RotatePoint(var pt: TPointD;
const focalPoint: TPointD; angleRad: double); overload;
function RotatePath(const path: TPathD;
const focalPoint: TPointD; angleRads: double): TPathD; overload;
function RotatePath(const paths: TPathsD;
const focalPoint: TPointD; angleRads: double): TPathsD; overload;
//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;
function GetBoundsD(const path: TPathD): TRectD; overload;
function GetBoundsD(const paths: TPathsD): TRectD; overload;
function GetBoundsD(const paths: TArrayOfPathsD): TRectD; overload;
function GetRotatedRectBounds(const rec: TRect; angle: double): TRect; overload;
function GetRotatedRectBounds(const rec: TRectD; angle: double): TRectD; overload;
function Rect(const recD: TRectD): TRect; overload;
function Rect(const left,top,right,bottom: integer): TRect; overload;
function PtInRect(const rec: TRectD; const pt: TPointD): Boolean; overload;
function Size(cx, cy: integer): TSize;
function SizeD(cx, cy: double): TSizeD;
function IsClockwise(const path: TPathD): Boolean;
// IsSimpleRectanglePath returns true if the specified path has only one polygon
// with 4 points that describe a rectangle.
function IsSimpleRectanglePath(const paths: TPathsD; var R: TRect): Boolean; overload;
function IsSimpleRectanglePath(const path: TPathD; var R: TRect): Boolean; overload;
function Area(const path: TPathD): Double; overload;
function RectsEqual(const rec1, rec2: TRect): Boolean;
procedure TranslateRect(var rec: TRect; dx, dy: integer); overload;
procedure TranslateRect(var rec: TRectD; dx, dy: double); overload;
function MakeSquare(rec: TRect): TRect;
function IsValid(value: integer): Boolean; overload;
function IsValid(value: double): Boolean; overload;
function IsValid(const pt: TPoint): Boolean; overload;
function IsValid(const pt: TPointD): Boolean; overload;
function IsValid(const rec: TRect): Boolean; overload;
function Point(X,Y: Integer): TPoint; overload;
function Point(const pt: TPointD): TPoint; overload;
function PointsEqual(const pt1, pt2: TPointD): Boolean; overload;
{$IFDEF INLINING} inline; {$ENDIF}
function PointsNearEqual(const pt1, pt2: TPoint;
dist: integer): Boolean; overload;
function PointsNearEqual(const pt1, pt2: TPointD;
distSqrd: double): Boolean; overload;
{$IFDEF INLINING} inline; {$ENDIF}
function StripNearDuplicates(const path: TPathD;
minDist: double; isClosedPath: Boolean): TPathD; overload;
function StripNearDuplicates(const paths: TPathsD;
minLength: double; isClosedPaths: Boolean): TPathsD; overload;
function MidPoint(const rec: TRect): TPoint; overload;
function MidPoint(const rec: TRectD): TPointD; overload;
function MidPoint(const pt1, pt2: TPoint): TPoint; overload;
function MidPoint(const pt1, pt2: TPointD): TPointD; overload;
function Average(val1, val2: integer): integer; overload;
function Average(val1, val2: double): double; overload;
function ReflectPoint(const pt, pivot: TPointD): TPointD;
{$IFDEF INLINING} inline; {$ENDIF}
function RectsOverlap(const rec1, rec2: TRect): Boolean;
function IsSameRect(const rec1, rec2: TRect): Boolean;
function RectsIntersect(const rec1, rec2: TRect): Boolean; overload;
function RectsIntersect(const rec1, rec2: TRectD): Boolean; overload;
function IntersectRect(const rec1, rec2: TRectD): TRectD; overload;
// UnionRect: this behaves differently to types.UnionRect
// in that if either parameter is empty the other parameter is returned
function UnionRect(const rec1, rec2: TRect): TRect; overload;
function UnionRect(const rec1, rec2: TRectD): TRectD; overload;
//these 2 functions are only needed to support older versions of Delphi
function MakeArrayOfInteger(const ints: array of integer): TArrayOfInteger;
function MakeArrayOfDouble(const doubles: array of double): TArrayOfDouble;
function CrossProduct(const vector1, vector2: TPointD): double; overload;
{$IFDEF INLINING} inline; {$ENDIF}
function CrossProduct(const pt1, pt2, pt3: TPointD): double; overload;
{$IFDEF INLINING} inline; {$ENDIF}
function CrossProduct(const pt1, pt2, pt3, pt4: TPointD): double; overload;
{$IFDEF INLINING} inline; {$ENDIF}
function DotProduct(const vector1, vector2: TPointD): double; overload;
{$IFDEF INLINING} inline; {$ENDIF}
function DotProduct(const pt1, pt2, pt3: TPointD): double; overload;
{$IFDEF INLINING} inline; {$ENDIF}
function TurnsLeft(const pt1, pt2, pt3: TPointD): boolean;
{$IFDEF INLINING} inline; {$ENDIF}
function TurnsRight(const pt1, pt2, pt3: TPointD): boolean;
{$IFDEF INLINING} inline; {$ENDIF}
function IsPathConvex(const path: TPathD): Boolean;
function NormalizeVector(const vec: TPointD): TPointD;
{$IFDEF INLINING} inline; {$ENDIF}
//GetUnitVector: Used internally
function GetUnitVector(const pt1, pt2: TPointD): TPointD;
//GetUnitNormal: Used internally
function GetUnitNormal(const pt1, pt2: TPointD): TPointD; overload;
{$IFDEF INLINING} inline; {$ENDIF}
function GetUnitNormal(const pt1, pt2: TPointD; out norm: TPointD): Boolean; overload;
{$IFDEF INLINING} inline; {$ENDIF}
function GetAvgUnitVector(const vec1, vec2: TPointD): TPointD;
{$IFDEF INLINING} inline; {$ENDIF}
//GetVectors: Used internally
function GetVectors(const path: TPathD): TPathD;
//GetNormals: Used internally
function GetNormals(const path: TPathD): TPathD;
//DistanceSqrd: Used internally
function DistanceSqrd(const pt1, pt2: TPoint): double; overload;
{$IFDEF INLINE} inline; {$ENDIF}
//DistanceSqrd: Used internally
function DistanceSqrd(const pt1, pt2: TPointD): double; overload;
{$IFDEF INLINE} inline; {$ENDIF}
function Distance(const pt1, pt2: TPoint): double; overload;
{$IFDEF INLINE} inline; {$ENDIF}
function Distance(const pt1, pt2: TPointD): double; overload;
{$IFDEF INLINE} inline; {$ENDIF}
function Distance(const path: TPathD; stopAt: integer = 0): double; overload;
function GetDistances(const path: TPathD): TArrayOfDouble;
function GetCumulativeDistances(const path: TPathD): TArrayOfDouble;
function PerpendicularDistSqrd(const pt, line1, line2: TPointD): double;
function PointInPolygon(const pt: TPointD;
const polygon: TPathD; fillRule: TFillRule): Boolean;
function PointInPolygons(const pt: TPointD;
const polygons: TPathsD; fillRule: TFillRule): Boolean;
function PerpendicularDist(const pt, line1, line2: TPointD): double;
function ClosestPointOnLine(const pt, linePt1, linePt2: TPointD): TPointD;
function ClosestPointOnSegment(const pt, segPt1, segPt2: TPointD): TPointD;
function IsPointInEllipse(const ellipseRec: TRect; const pt: TPoint): Boolean;
//GetLineEllipseIntersects: Gets the intersection of a line and
//an ellipse. The function succeeds when the line either touches
//tangentially or passes through the ellipse. If the line touches
//tangentially, the coordintates returned in pt1 and pt2 will match.
function GetLineEllipseIntersects(const ellipseRec: TRect;
var linePt1, linePt2: TPointD): Boolean;
function GetPtOnEllipseFromAngle(const ellipseRect: TRectD; angle: double): TPointD;
function GetPtOnRotatedEllipseFromAngle(const ellipseRect: TRectD;
ellipseRotAngle, angle: double): TPointD;
function GetEllipticalAngleFromPoint(const ellipseRect: TRectD;
const pt: TPointD): double;
function GetRotatedEllipticalAngleFromPoint(const ellipseRect: TRectD;
ellipseRotAngle: double; pt: TPointD): double;
function GetClosestPtOnRotatedEllipse(const ellipseRect: TRectD;
ellipseRotation: double; const pt: TPointD): TPointD;
// RoughOutline: outlines are **rough** because they will contain numerous
// self-intersections and negative area regions. (This untidiness will be
// hidden as long as the NonZero fill rule is applied when rendering, and
// this function will be **much** faster than Img32.Clipper.InflatePaths.)
// The 'scale' parameter doesn't actually scale the returned outline, it's
// only a warning of future scaling and used to guide the returned precision.
// RoughOutline is intended mostly for internal use.
function RoughOutline(const line: TPathD; lineWidth: double;
joinStyle: TJoinStyle; endStyle: TEndStyle;
miterLim: double = 0; scale: double = 1.0): TPathsD; overload;
function RoughOutline(const lines: TPathsD; lineWidth: double;
joinStyle: TJoinStyle; endStyle: TEndStyle;
miterLim: double = 0; scale: double = 1.0): TPathsD; overload;
// Grow: For the same reasons stated in RoughOutline's comments above,
// this function is also intended mostly for internal use
function Grow(const path, normals: TPathD; delta: double;
joinStyle: TJoinStyle; miterLim: double = 0; scale: double = 1.0; isOpen: Boolean = false): TPathD;
function ValueAlmostZero(val: double; epsilon: double = 0.001): Boolean;
function ValueAlmostOne(val: double; epsilon: double = 0.001): Boolean;
const
Invalid = -MaxInt;
InvalidD = -Infinity;
NullPoint : TPoint = (X: 0; Y: 0);
NullPointD : TPointD = (X: 0; Y: 0);
InvalidPoint : TPoint = (X: -MaxInt; Y: -MaxInt);
InvalidPointD : TPointD = (X: -Infinity; Y: -Infinity);
NullRect : TRect = (left: 0; top: 0; right: 0; Bottom: 0);
NullRectD : TRectD = (left: 0; top: 0; right: 0; Bottom: 0);
InvalidRect : TRect = (left: MaxInt; top: MaxInt; right: 0; Bottom: 0);
BezierTolerance: double = 0.25;
DoubleTolerance: double = 1.0e-12;
var
//AutoWidthThreshold: When JoinStyle = jsAuto, this is the threshold at
//which line joins will be rounded instead of squared. With wider strokes,
//rounded joins generally look better, but as rounding is more complex it
//also requries more processing and hence is slower to execute.
AutoWidthThreshold: double = 5.0;
//When lines are too narrow, they become too faint to sensibly draw
MinStrokeWidth: double = 0.5;
//Miter limit avoids excessive spikes when line offsetting
DefaultMiterLimit: double = 4.0;
resourcestring
rsInvalidMatrix = 'Invalid matrix.'; //nb: always start with IdentityMatrix
implementation
uses
Img32.Transform;
resourcestring
rsInvalidQBezier = 'Invalid number of control points for a QBezier';
rsInvalidCBezier = 'Invalid number of control points for a CBezier';
const
BuffSize = 64;
{$IFDEF CPUX86}
// Use faster Trunc for x86 code in this unit.
Trunc: function(Value: Double): Integer = __Trunc;
{$ENDIF CPUX86}
//------------------------------------------------------------------------------
// TSizeD
//------------------------------------------------------------------------------
function TSizeD.average: double;
begin
Result := (cx + cy) * 0.5;
end;
//------------------------------------------------------------------------------
// TRectWH record/object.
//------------------------------------------------------------------------------
function TRectWH.IsEmpty: Boolean;
begin
Result := (Width <= 0) or (Height <= 0);
end;
//------------------------------------------------------------------------------
function TRectWH.IsValid: Boolean;
begin
Result := (Left <> InvalidD) and (Top <> InvalidD)
and (Width >= 0) and (Height >= 0);
end;
//------------------------------------------------------------------------------
function TRectWH.Right: double;
begin
Result := Left + Width;
end;
//------------------------------------------------------------------------------
function TRectWH.Bottom: double;
begin
Result := Top + Height;
end;
//------------------------------------------------------------------------------
function TRectWH.Contains(const Pt: TPoint): Boolean;
begin
Result := (pt.X >= Left) and (pt.X <= Left + Width) and
(pt.Y >= Top) and (pt.Y <= Top + Height)
end;
//------------------------------------------------------------------------------
function TRectWH.Contains(const Pt: TPointD): Boolean;
begin
Result := (pt.X >= Left) and (pt.X <= Left + Width) and
(pt.Y >= Top) and (pt.Y <= Top + Height)
end;
//------------------------------------------------------------------------------
function TRectWH.MidPoint: TPointD;
begin
Result := PointD(left + Width * 0.5, top + Height * 0.5);
end;
//------------------------------------------------------------------------------
function TRectWH.RectD: TRectD;
begin
Result := Img32.RectD(left, top, left + Width, top + Height);
end;
//------------------------------------------------------------------------------
function TRectWH.Rect: TRect;
begin
Result := Img32.Vector.Rect(RectD);
end;
//------------------------------------------------------------------------------
function RectWH(left, top, width, height: integer): TRectWH;
begin
Result.Left := left;
Result.Top := top;
Result.Width := width;
Result.Height := height;
end;
//------------------------------------------------------------------------------
function RectWH(left, top, width, height: double): TRectWH;
begin
Result.Left := left;
Result.Top := top;
Result.Width := width;
Result.Height := height;
end;
//------------------------------------------------------------------------------
function RectWH(const rec: TRectD): TRectWH;
begin
Result.Left := rec.left;
Result.Top := rec.top;
Result.Width := rec.width;
Result.Height := rec.height;
end;
//------------------------------------------------------------------------------
function RectsEqual(const rec1, rec2: TRect): Boolean;
begin
result := (rec1.Left = rec2.Left) and (rec1.Top = rec2.Top) and
(rec1.Right = rec2.Right) and (rec1.Bottom = rec2.Bottom);
end;
//------------------------------------------------------------------------------
function Rect(const left, top, right, bottom: integer): TRect;
begin
Result.Left := left;
Result.Top := top;
Result.Right := right;
Result.Bottom := bottom;
end;
//------------------------------------------------------------------------------
function IsValid(value: integer): Boolean;
begin
Result := value <> -MaxInt;
end;
//------------------------------------------------------------------------------
function IsValid(value: double): Boolean;
begin
Result := value <> InvalidD;
end;
//------------------------------------------------------------------------------
function IsValid(const pt: TPoint): Boolean;
begin
result := (pt.X <> Invalid) and (pt.Y <> Invalid);
end;
//------------------------------------------------------------------------------
function IsValid(const pt: TPointD): Boolean;
begin
result := (pt.X <> -Infinity) and (pt.Y <> -Infinity);
end;
//------------------------------------------------------------------------------
function IsValid(const rec: TRect): Boolean;
begin
result := (rec.Left <> MaxInt) and (rec.Top <> MaxInt);
end;
//------------------------------------------------------------------------------
function Point(X,Y: Integer): TPoint;
begin
result.X := X;
result.Y := Y;
end;
//------------------------------------------------------------------------------
function Point(const pt: TPointD): TPoint;
begin
result.X := Round(pt.x);
result.Y := Round(pt.y);
end;
//------------------------------------------------------------------------------
function PointsEqual(const pt1, pt2: TPointD): Boolean;
begin
result := (pt1.X = pt2.X) and (pt1.Y = pt2.Y);
end;
//------------------------------------------------------------------------------
function PointsNearEqual(const pt1, pt2: TPoint; dist: integer): Boolean;
begin
Result := (Abs(pt1.X - pt2.X) <= dist) and (Abs(pt1.Y - pt2.Y) < dist);
end;
//------------------------------------------------------------------------------
function PointsNearEqual(const pt1, pt2: TPointD; distSqrd: double): Boolean;
begin
Result := Sqr(pt1.X - pt2.X) + Sqr(pt1.Y - pt2.Y) < distSqrd;
end;
//------------------------------------------------------------------------------
function StripNearDuplicates(const path: TPathD;
minDist: double; isClosedPath: Boolean): TPathD;
var
i,j, len: integer;
begin
len := length(path);
NewPointDArray(Result, len, True);
if len = 0 then Exit;
Result[0] := path[0];
j := 0;
minDist := minDist * minDist;
for i := 1 to len -1 do
if not PointsNearEqual(Result[j], path[i], minDist) then
begin
inc(j);
Result[j] := path[i];
end;
if isClosedPath and
PointsNearEqual(Result[j], Result[0], minDist) then dec(j);
SetLength(Result, j +1);
end;
//------------------------------------------------------------------------------
function StripNearDuplicates(const paths: TPathsD;
minLength: double; isClosedPaths: Boolean): TPathsD;
var
i, len: integer;
begin
len := Length(paths);
SetLength(Result, len);
for i := 0 to len -1 do
Result[i] := StripNearDuplicates(paths[i], minLength, isClosedPaths);
end;
//------------------------------------------------------------------------------
function ValueAlmostZero(val: double; epsilon: double = 0.001): Boolean;
{$IFDEF INLINE} inline; {$ENDIF}
begin
Result := Abs(val) < epsilon;
end;
//------------------------------------------------------------------------------
function ValueAlmostOne(val: double; epsilon: double = 0.001): Boolean;
{$IFDEF INLINE} inline; {$ENDIF}
begin
Result := Abs(val-1) < epsilon;
end;
//------------------------------------------------------------------------------
procedure GetSinCos(angle: double; out sinA, cosA: double);
{$IFDEF INLINE} inline; {$ENDIF}
{$IFNDEF FPC}
var s, c: extended;
{$ENDIF}
begin
{$IFDEF FPC}
Math.SinCos(angle, sinA, cosA);
{$ELSE}
Math.SinCos(angle, s, c);
sinA := s; cosA := c;
{$ENDIF}
end;
//------------------------------------------------------------------------------
function GetRotatedRectBounds(const rec: TRect; angle: double): TRect;
var
p: TPathD;
mp: TPointD;
begin
p := Rectangle(rec);
mp := PointD((rec.Left + rec.Right)/2, (rec.Top + rec.Bottom)/2);
if angle <> 0 then
p := RotatePath(p, mp, angle);
Result := GetBounds(p);
end;
//------------------------------------------------------------------------------
function GetRotatedRectBounds(const rec: TRectD; angle: double): TRectD;
var
p: TPathD;
mp: TPointD;
begin
p := Rectangle(rec);
mp := PointD((rec.Left + rec.Right)/2, (rec.Top + rec.Bottom)/2);
if angle <> 0 then
p := RotatePath(p, mp, angle);
Result := GetBoundsD(p);
end;
//------------------------------------------------------------------------------
function Rect(const recD: TRectD): TRect;
begin
// see https://github.com/AngusJohnson/Image32/issues/15
Result.Left := Floor(recD.Left + DoubleTolerance);
Result.Top := Floor(recD.Top + DoubleTolerance);
Result.Right := Ceil(recD.Right - DoubleTolerance);
Result.Bottom := Ceil(recD.Bottom - DoubleTolerance);
end;
//------------------------------------------------------------------------------
function PtInRect(const rec: TRectD; const pt: TPointD): Boolean;
begin
Result := (pt.X >= rec.Left) and (pt.X < rec.Right) and
(pt.Y >= rec.Top) and (pt.Y < rec.Bottom);
end;
//------------------------------------------------------------------------------
function Size(cx, cy: integer): TSize;
begin
Result.cx := cx;
Result.cy := cy;
end;
//------------------------------------------------------------------------------
function SizeD(cx, cy: double): TSizeD;
begin
Result.cx := cx;
Result.cy := cy;
end;
//------------------------------------------------------------------------------
function IsClockwise(const path: TPathD): Boolean;
begin
Result := Area(path) > 0;
end;
//------------------------------------------------------------------------------
function IsSimpleRectanglePath(const path: TPathD; var R: TRect): Boolean;
type
TLastMatch = (lmX, lmY);
var
i: Integer;
lastMatch: TLastMatch;
begin
Result := False;
// If we have a single path with 4 points, it could be a rectangle
if Length(path) = 4 then
begin
// For a rectangle the X and Y coordinates of the points alternate
// in being equal
if path[0].X = path[3].X then
lastMatch := lmX
else if path[0].Y = path[3].Y then
lastMatch := lmY
else
Exit;
R.Left := Trunc(path[0].X);
R.Top := Trunc(path[0].Y);
R.Right := Ceil(path[0].X);
R.Bottom := Ceil(path[0].Y);
for i := 1 to 3 do
begin
case lastMatch of
lmY: // now the X-coordinates must be equal
begin
if path[i].X <> path[i - 1].X then Exit;
lastMatch := lmX;
R.Top := Min(R.Top, Trunc(path[i].Y));
R.Bottom := Max(R.Bottom, Ceil(path[i].Y));
end;
lmX: // now the Y-coordinates must be equal
begin
if path[i].Y <> path[i - 1].Y then Exit;
lastMatch := lmY;
R.Left := Min(R.Left, Trunc(path[i].X));
R.Right := Max(R.Right, Ceil(path[i].X));
end;
end;
end;
Result := True;
end;
end;
//------------------------------------------------------------------------------
function IsSimpleRectanglePath(const paths: TPathsD; var R: TRect): Boolean;
begin
if (Length(paths) = 1) and (Length(paths[0]) = 4) then
Result := IsSimpleRectanglePath(paths[0], r)
else
Result := False;
end;
//------------------------------------------------------------------------------
function Area(const path: TPathD): Double;
var
i, j, highI: Integer;
d: Double;
begin
Result := 0.0;
highI := High(path);
if (highI < 2) then Exit;
j := highI;
for i := 0 to highI do
begin
d := (path[j].X + path[i].X);
Result := Result + d * (path[j].Y - path[i].Y);
j := i;
end;
Result := -Result * 0.5;
end;
//------------------------------------------------------------------------------
procedure TranslateRect(var rec: TRect; dx, dy: integer);
begin
rec.Left := rec.Left + dx;
rec.Top := rec.Top + dy;
rec.Right := rec.Right + dx;
rec.Bottom := rec.Bottom + dy;
end;
//------------------------------------------------------------------------------
procedure TranslateRect(var rec: TRectD; dx, dy: double);
begin
rec.Left := rec.Left + dx;
rec.Top := rec.Top + dy;
rec.Right := rec.Right + dx;
rec.Bottom := rec.Bottom + dy;
end;
//------------------------------------------------------------------------------
function MakeSquare(rec: TRect): TRect;
var
i: integer;
begin
Result := rec;
i := ((rec.Right - rec.Left) + (rec.Bottom - rec.Top)) div 2;
Result.Right := Result.Left + i;
Result.Bottom := Result.Top + i;
end;
//------------------------------------------------------------------------------
function MidPoint(const rec: TRect): TPoint;
begin
Result.X := (rec.Left + rec.Right) div 2;
Result.Y := (rec.Top + rec.Bottom) div 2;
end;
//------------------------------------------------------------------------------
function MidPoint(const rec: TRectD): TPointD;
begin
Result.X := (rec.Left + rec.Right) * 0.5;
Result.Y := (rec.Top + rec.Bottom) * 0.5;
end;
//------------------------------------------------------------------------------
function MidPoint(const pt1, pt2: TPoint): TPoint;
begin
Result.X := (pt1.X + pt2.X) div 2;
Result.Y := (pt1.Y + pt2.Y) div 2;
end;
//------------------------------------------------------------------------------
function MidPoint(const pt1, pt2: TPointD): TPointD;
begin
Result.X := (pt1.X + pt2.X) * 0.5;
Result.Y := (pt1.Y + pt2.Y) * 0.5;
end;
//------------------------------------------------------------------------------
function Average(val1, val2: integer): integer;
begin
Result := (val1 + val2) div 2;
end;
//------------------------------------------------------------------------------
function Average(val1, val2: double): double;
begin
Result := (val1 + val2) * 0.5;
end;
//------------------------------------------------------------------------------
function RectsOverlap(const rec1, rec2: TRect): Boolean;
begin
Result := (rec1.Left < rec2.Right) and (rec1.Right > rec2.Left) and
(rec1.Top < rec2.Bottom) and (rec1.Bottom > rec2.Top);
end;
//------------------------------------------------------------------------------
function IsSameRect(const rec1, rec2: TRect): Boolean;
begin
Result := (rec1.Left = rec2.Left) and (rec1.Top = rec2.Top) and
(rec1.Right = rec2.Right) and (rec1.Bottom = rec2.Bottom);
end;
//------------------------------------------------------------------------------
function RectsIntersect(const rec1, rec2: TRect): Boolean;
var
dummy: TRect;
begin
Result := Types.IntersectRect(dummy, rec1, rec2);
end;
//------------------------------------------------------------------------------
function RectsIntersect(const rec1, rec2: TRectD): Boolean;
begin
Result := not IntersectRect(rec1, rec2).IsEmpty;
end;
//------------------------------------------------------------------------------
function IntersectRect(const rec1, rec2: TRectD): TRectD;
begin
result.Left := Max(rec1.Left, rec2.Left);
result.Top := Max(rec1.Top, rec2.Top);
result.Right := Min(rec1.Right, rec2.Right);
result.Bottom := Min(rec1.Bottom, rec2.Bottom);
end;
//------------------------------------------------------------------------------
function UnionRect(const rec1, rec2: TRect): TRect;
begin
if IsEmptyRect(rec1) then
Result := rec2
else if IsEmptyRect(rec2) then
Result := rec1
else
begin
result.Left := Min(rec1.Left, rec2.Left);
result.Top := Min(rec1.Top, rec2.Top);
result.Right := Max(rec1.Right, rec2.Right);
result.Bottom := Max(rec1.Bottom, rec2.Bottom);
end;
end;
//------------------------------------------------------------------------------
function UnionRect(const rec1, rec2: TRectD): TRectD;
begin
if IsEmptyRect(rec1) then
Result := rec2
else if IsEmptyRect(rec2) then
Result := rec1
else
begin
result.Left := Min(rec1.Left, rec2.Left);
result.Top := Min(rec1.Top, rec2.Top);
result.Right := Max(rec1.Right, rec2.Right);
result.Bottom := Max(rec1.Bottom, rec2.Bottom);
end;
end;
//------------------------------------------------------------------------------
function MakeArrayOfInteger(const ints: array of integer): TArrayOfInteger;
var
i, len: integer;
begin
len := Length(ints);
NewIntegerArray(Result, len, True);
for i := 0 to len -1 do Result[i] := ints[i];
end;
//------------------------------------------------------------------------------
function MakeArrayOfDouble(const doubles: array of double): TArrayOfDouble;
var
i, len: integer;
begin
len := Length(doubles);
SetLength(Result, len);
for i := 0 to len -1 do Result[i] := doubles[i];
end;
//------------------------------------------------------------------------------
function CrossProduct(const vector1, vector2: TPointD): double;
begin
result := vector1.X * vector2.Y - vector2.X * vector1.Y;
end;
//------------------------------------------------------------------------------
function CrossProduct(const pt1, pt2, pt3: TPointD): double;
var
x1,x2,y1,y2: double;
begin
x1 := pt2.X - pt1.X;
y1 := pt2.Y - pt1.Y;
x2 := pt3.X - pt2.X;
y2 := pt3.Y - pt2.Y;
result := (x1 * y2 - y1 * x2);
end;
//---------------------------------------------------------------------------
function CrossProduct(const pt1, pt2, pt3, pt4: TPointD): double;
var
x1,x2,y1,y2: double;
begin
x1 := pt2.X - pt1.X;
y1 := pt2.Y - pt1.Y;
x2 := pt4.X - pt3.X;
y2 := pt4.Y - pt3.Y;
result := (x1 * y2 - y1 * x2);
end;
//---------------------------------------------------------------------------
function DotProduct(const vector1, vector2: TPointD): double;
begin
result := vector1.X * vector2.X + vector1.Y * vector2.Y;
end;
//------------------------------------------------------------------------------
function DotProduct(const pt1, pt2, pt3: TPointD): double;
var
x1,x2,y1,y2: double;
begin
x1 := pt2.X - pt1.X;
y1 := pt2.Y - pt1.Y;
x2 := pt2.X - pt3.X;
y2 := pt2.Y - pt3.Y;
result := (x1 * x2 + y1 * y2);
end;
//------------------------------------------------------------------------------
function TurnsLeft(const pt1, pt2, pt3: TPointD): boolean;
begin
result := CrossProduct(pt1, pt2, pt3) < 0;
end;
//------------------------------------------------------------------------------
function TurnsRight(const pt1, pt2, pt3: TPointD): boolean;
begin
result := CrossProduct(pt1, pt2, pt3) > 0;
end;
//------------------------------------------------------------------------------
function IsPathConvex(const path: TPathD): Boolean;
var
i, pathLen: integer;
dir: boolean;
begin
result := false;
pathLen := length(path);
if pathLen < 3 then Exit;
//get the winding direction of the first angle
dir := TurnsRight(path[0], path[1], path[2]);
//check that each other angle has the same winding direction
for i := 1 to pathLen -1 do
if TurnsRight(path[i], path[(i+1) mod pathLen],
path[(i+2) mod pathLen]) <> dir then Exit;
result := true;
end;
//------------------------------------------------------------------------------
function GetUnitVector(const pt1, pt2: TPointD): TPointD;
var
dx, dy, inverseHypot: Double;
begin
if (pt1.x = pt2.x) and (pt1.y = pt2.y) then
begin
Result.X := 0;
Result.Y := 0;
Exit;
end;
dx := (pt2.X - pt1.X);
dy := (pt2.Y - pt1.Y);
inverseHypot := 1 / Hypot(dx, dy);
dx := dx * inverseHypot;
dy := dy * inverseHypot;
Result.X := dx;
Result.Y := dy;
end;
//------------------------------------------------------------------------------
function GetUnitNormal(const pt1, pt2: TPointD): TPointD;
begin
if not GetUnitNormal(pt1, pt2, Result) then
Result := NullPointD;
end;
//------------------------------------------------------------------------------
function GetUnitNormal(const pt1, pt2: TPointD; out norm: TPointD): Boolean;
var
dx, dy, inverseHypot: Double;
begin
result := not PointsNearEqual(pt1, pt2, 0.001);
if not result then Exit;
dx := (pt2.X - pt1.X);
dy := (pt2.Y - pt1.Y);
inverseHypot := 1 / Hypot(dx, dy);
dx := dx * inverseHypot;
dy := dy * inverseHypot;
norm.X := dy;
norm.Y := -dx
end;
//------------------------------------------------------------------------------
function NormalizeVector(const vec: TPointD): TPointD;
var
h, inverseHypot: Double;
begin
h := Hypot(vec.X, vec.Y);
if ValueAlmostZero(h, 0.001) then
begin
Result := NullPointD;
Exit;
end;
inverseHypot := 1 / h;
Result.X := vec.X * inverseHypot;
Result.Y := vec.Y * inverseHypot;
end;
//------------------------------------------------------------------------------
function GetAvgUnitVector(const vec1, vec2: TPointD): TPointD;
begin
Result := NormalizeVector(PointD(vec1.X + vec2.X, vec1.Y + vec2.Y));
end;
//------------------------------------------------------------------------------
function Paths(const path: TPathD): TPathsD;
begin
SetLength(Result, 1);
result[0] := Copy(path, 0, length(path));
end;
//------------------------------------------------------------------------------
function CopyPath(const path: TPathD): TPathD;
begin
Result := Copy(path, 0, Length(path));
end;
//------------------------------------------------------------------------------
function CopyPaths(const paths: TPathsD): TPathsD;
var
i, len1: integer;
begin
len1 := length(paths);
setLength(result, len1);
for i := 0 to len1 -1 do
result[i] := Copy(paths[i], 0, length(paths[i]));
end;
//------------------------------------------------------------------------------
function TranslatePoint(const pt: TPoint; dx, dy: integer): TPoint;
begin
result.x := pt.x + dx;
result.y := pt.y + dy;
end;
//------------------------------------------------------------------------------
function TranslatePoint(const pt: TPointD; dx, dy: double): TPointD;
begin
result.x := pt.x + dx;
result.y := pt.y + dy;
end;
//------------------------------------------------------------------------------
function TranslatePath(const path: TPathD; dx, dy: double): TPathD;
var
i, len: integer;
begin
len := length(path);
NewPointDArray(result, len, True);
for i := 0 to len -1 do
begin
result[i].x := path[i].x + dx;
result[i].y := path[i].y + dy;
end;
end;
//------------------------------------------------------------------------------
function TranslatePath(const paths: TPathsD;
dx, dy: double): TPathsD;
var
i,len: integer;
begin
len := length(paths);
setLength(result, len);
for i := 0 to len -1 do
result[i] := TranslatePath(paths[i], dx, dy);
end;
//------------------------------------------------------------------------------
function TranslatePath(const ppp: TArrayOfPathsD; dx, dy: double): TArrayOfPathsD;
var
i,len: integer;
begin
len := length(ppp);
setLength(result, len);
for i := 0 to len -1 do
result[i] := TranslatePath(ppp[i], dx, dy);
end;
//------------------------------------------------------------------------------
function ScalePoint(const pt: TPointD; scale: double): TPointD;
begin
Result.X := pt.X * scale;
Result.Y := pt.Y * scale;
end;
//------------------------------------------------------------------------------
function ScalePoint(const pt: TPointD; sx, sy: double): TPointD;
begin
Result.X := pt.X * sx;
Result.Y := pt.Y * sy;
end;
//------------------------------------------------------------------------------
function ScalePath(const path: TPathD; sx, sy: double): TPathD;
var
i, len: integer;
begin
if (sx = 0) or (sy = 0) then
Result := nil
else if ((sx = 1) and (sy = 1)) then
begin
Result := Copy(path, 0, Length(path));
end else
begin
len := length(path);
NewPointDArray(result, len, True);
for i := 0 to len -1 do
begin
result[i].x := path[i].x * sx;
result[i].y := path[i].y * sy;
end;
end;
end;
//------------------------------------------------------------------------------
function ScalePath(const path: TPathD;
scale: double): TPathD;
begin
result := ScalePath(path, scale, scale);
end;
//------------------------------------------------------------------------------
function ScalePath(const paths: TPathsD;
sx, sy: double): TPathsD;
var
i,len: integer;
begin
len := length(paths);
setLength(result, len);
for i := 0 to len -1 do
result[i] := ScalePath(paths[i], sx, sy);
end;
//------------------------------------------------------------------------------
function ScalePath(const paths: TPathsD;
scale: double): TPathsD;
begin
result := ScalePath(paths, scale, scale);
end;
//------------------------------------------------------------------------------
function ScaleRect(const rec: TRect; scale: double): TRect;
begin
result := rec;
Result.Left := Round(Result.Left * scale);
Result.Top := Round(Result.Top * scale);
Result.Right := Round(Result.Right * scale);
Result.Bottom := Round(Result.Bottom * scale);
end;
//------------------------------------------------------------------------------
function ScaleRect(const rec: TRect; sx, sy: double): TRect;
begin
result := rec;
Result.Left := Round(Result.Left * sx);
Result.Top := Round(Result.Top * sy);
Result.Right := Round(Result.Right * sx);
Result.Bottom := Round(Result.Bottom * sy);
end;
//------------------------------------------------------------------------------
function ScaleRect(const rec: TRectD; scale: double): TRectD;
begin
result := rec;
Result.Left := Result.Left * scale;
Result.Top := Result.Top * scale;
Result.Right := Result.Right * scale;
Result.Bottom := Result.Bottom * scale;
end;
//------------------------------------------------------------------------------
function ScaleRect(const rec: TRectD; sx, sy: double): TRectD;
begin
result := rec;
Result.Left := Result.Left * sx;
Result.Top := Result.Top * sy;
Result.Right := Result.Right * sx;
Result.Bottom := Result.Bottom * sy;
end;
//------------------------------------------------------------------------------
function ScalePathToFit(const path: TPathD; const rec: TRect): TPathD;
var
pathWidth, pathHeight, outHeight, outWidth: integer;
pathBounds: TRect;
scale: double;
begin
pathBounds := GetBounds(path);
RectWidthHeight(pathBounds, pathWidth, pathHeight);
RectWidthHeight(rec, outWidth, outHeight);
Result := TranslatePath(path,
rec.Left - pathBounds.Left, rec.Top - pathBounds.Top);
if outWidth / pathWidth < outHeight / pathHeight then
scale := outWidth / pathWidth else
scale := outHeight / pathHeight;
Result := ScalePath(Result, scale, scale);
end;
//------------------------------------------------------------------------------
function ScalePathsToFit(const paths: TPathsD; const rec: TRect): TPathsD;
var
pathWidth, pathHeight, outHeight, outWidth: integer;
pathBounds: TRect;
scale: double;
begin
pathBounds := GetBounds(paths);
RectWidthHeight(pathBounds, pathWidth, pathHeight);
RectWidthHeight(rec, outWidth, outHeight);
Result := TranslatePath(paths,
rec.Left - pathBounds.Left, rec.Top - pathBounds.Top);
if outWidth / pathWidth < outHeight / pathHeight then
scale := outWidth / pathWidth else
scale := outHeight / pathHeight;
Result := ScalePath(Result, scale, scale);
end;
//------------------------------------------------------------------------------
function ReversePath(const path: TPathD): TPathD;
var
i, highI: integer;
begin
highI := High(path);
NewPointDArray(result, highI +1, True);
for i := 0 to highI do
result[i] := path[highI -i];
end;
//------------------------------------------------------------------------------
function ReversePath(const paths: TPathsD): TPathsD;
var
i, len: integer;
begin
len := Length(paths);
SetLength(result, len);
for i := 0 to len -1 do
result[i] := ReversePath(paths[i]);
end;
//------------------------------------------------------------------------------
function OpenPathToFlatPolygon(const path: TPathD): TPathD;
var
i, len, len2: integer;
begin
len := Length(path);
len2 := Max(0, len - 2);
NewPointDArray(Result, len + len2, True);
if len = 0 then Exit;
Move(path[0], Result[0], len * SizeOf(TPointD));
if len2 = 0 then Exit;
for i := 0 to len - 3 do
result[len + i] := path[len - 2 -i];
end;
//------------------------------------------------------------------------------
function GetVectors(const path: TPathD): TPathD;
var
i,j, len: cardinal;
pt: TPointD;
begin
len := length(path);
NewPointDArray(result, len, True);
if len = 0 then Exit;
pt := path[0];
//skip duplicates
i := len -1;
while (i > 0) and
(path[i].X = pt.X) and (path[i].Y = pt.Y) do dec(i);
if (i = 0) then
begin
//all points are equal!
for i := 0 to len -1 do result[i] := PointD(0,0);
Exit;
end;
result[i] := GetUnitVector(path[i], pt);
//fix up any duplicates at the end of the path
for j := i +1 to len -1 do
result[j] := result[j-1];
//with at least one valid vector, we can now
//safely get the remaining vectors
pt := path[i];
for i := i -1 downto 0 do
begin
if (path[i].X <> pt.X) or (path[i].Y <> pt.Y) then
begin
result[i] := GetUnitVector(path[i], pt);
pt := path[i];
end else
result[i] := result[i+1]
end;
end;
//------------------------------------------------------------------------------
function GetNormals(const path: TPathD): TPathD;
var
i, highI: integer;
last: TPointD;
begin
highI := High(path);
NewPointDArray(result, highI+1, True);
if highI < 0 then Exit;
last := NullPointD;
for i := 0 to highI -1 do
begin
if GetUnitNormal(path[i], path[i+1], result[i]) then
last := result[i] else
result[i] := last;
end;
if GetUnitNormal(path[highI], path[0], result[highI]) then
last := result[highI];
for i := 0 to highI do
begin
if (result[i].X <> 0) or (result[i].Y <> 0) then Break;
result[i] := last;
end;
end;
//------------------------------------------------------------------------------
function DistanceSqrd(const pt1, pt2: TPoint): double;
begin
result := Sqr(pt1.X - pt2.X) + Sqr(pt1.Y - pt2.Y);
end;
//------------------------------------------------------------------------------
function DistanceSqrd(const pt1, pt2: TPointD): double;
begin
result := Sqr(pt1.X - pt2.X) + Sqr(pt1.Y - pt2.Y);
end;
//------------------------------------------------------------------------------
function Distance(const pt1, pt2: TPoint): double;
begin
Result := Sqrt(DistanceSqrd(pt1, pt2));
end;
//------------------------------------------------------------------------------
function Distance(const pt1, pt2: TPointD): double;
begin
Result := Sqrt(DistanceSqrd(pt1, pt2));
end;
//------------------------------------------------------------------------------
function Distance(const path: TPathD; stopAt: integer): double;
var
i, highI: integer;
begin
Result := 0;
highI := High(path);
if (stopAt > 0) and (stopAt < HighI) then highI := stopAt;
for i := 1 to highI do
Result := Result + Distance(path[i-1],path[i]);
end;
//------------------------------------------------------------------------------
function GetDistances(const path: TPathD): TArrayOfDouble;
var
i, len: integer;
begin
len := Length(path);
SetLength(Result, len);
if len = 0 then Exit;
Result[0] := 0;
for i := 1 to len -1 do
Result[i] := Distance(path[i-1], path[i]);
end;
//------------------------------------------------------------------------------
function GetCumulativeDistances(const path: TPathD): TArrayOfDouble;
var
i, len: integer;
begin
len := Length(path);
SetLength(Result, len);
if len = 0 then Exit;
Result[0] := 0;
for i := 1 to len -1 do
Result[i] := Result[i-1] + Distance(path[i-1], path[i]);
end;
//------------------------------------------------------------------------------
function PerpendicularDistSqrd(const pt, line1, line2: TPointD): double;
var
a,b,c,d: double;
begin
if PointsEqual(line1, line2) then
begin
Result := DistanceSqrd(pt, line1);
end else
begin
a := pt.X - line1.X;
b := pt.Y - line1.Y;
c := line2.X - line1.X;
d := line2.Y - line1.Y;
if (c = 0) and (d = 0) then
result := 0 else
result := Sqr(a * d - c * b) / (c * c + d * d);
end;
end;
//------------------------------------------------------------------------------
function PointInPolyWindingCount(const pt: TPointD;
const path: TPathD; out PointOnEdgeDir: integer): integer;
var
i, len: integer;
prevPt: TPointD;
isAbove: Boolean;
crossProd: double;
begin
//nb: PointOnEdgeDir == 0 unless 'pt' is on 'path'
Result := 0;
PointOnEdgeDir := 0;
i := 0;
len := Length(path);
if len = 0 then Exit;
prevPt := path[len-1];
while (i < len) and (path[i].Y = prevPt.Y) do inc(i);
if i = len then Exit;
isAbove := (prevPt.Y < pt.Y);
while (i < len) do
begin
if isAbove then
begin
while (i < len) and (path[i].Y < pt.Y) do inc(i);
if i = len then break
else if i > 0 then prevPt := path[i -1];
crossProd := CrossProduct(prevPt, path[i], pt);
if crossProd = 0 then
begin
PointOnEdgeDir := -1;
//nb: could safely exit here with frNonZero or frEvenOdd fill rules
end
else if crossProd < 0 then dec(Result);
end else
begin
while (i < len) and (path[i].Y > pt.Y) do inc(i);
if i = len then break
else if i > 0 then prevPt := path[i -1];
crossProd := CrossProduct(prevPt, path[i], pt);
if crossProd = 0 then
begin
PointOnEdgeDir := 1;
//nb: could safely exit here with frNonZero or frEvenOdd fill rules
end
else if crossProd > 0 then inc(Result);
end;
inc(i);
isAbove := not isAbove;
end;
end;
//------------------------------------------------------------------------------
function PointInPolygon(const pt: TPointD;
const polygon: TPathD; fillRule: TFillRule): Boolean;
var
wc: integer;
PointOnEdgeDir: integer;
begin
wc := PointInPolyWindingCount(pt, polygon, PointOnEdgeDir);
case fillRule of
frEvenOdd: result := (PointOnEdgeDir <> 0) or Odd(wc);
frNonZero: result := (PointOnEdgeDir <> 0) or (wc <> 0);
frPositive: result := (PointOnEdgeDir + wc > 0);
else {frNegative} result := (PointOnEdgeDir + wc < 0);
end;
end;
//------------------------------------------------------------------------------
function PointInPolysWindingCount(const pt: TPointD;
const paths: TPathsD; out PointOnEdgeDir: integer): integer;
var
i,j, len: integer;
p: TPathD;
prevPt: TPointD;
isAbove: Boolean;
crossProd: double;
begin
//nb: PointOnEdgeDir == 0 unless 'pt' is on 'path'
Result := 0;
PointOnEdgeDir := 0;
for i := 0 to High(paths) do
begin
j := 0;
p := paths[i];
len := Length(p);
if len < 3 then Continue;
prevPt := p[len-1];
while (j < len) and (p[j].Y = prevPt.Y) do inc(j);
if j = len then continue;
isAbove := (prevPt.Y < pt.Y);
while (j < len) do
begin
if isAbove then
begin
while (j < len) and (p[j].Y < pt.Y) do inc(j);
if j = len then break
else if j > 0 then prevPt := p[j -1];
crossProd := CrossProduct(prevPt, p[j], pt);
if crossProd = 0 then PointOnEdgeDir := -1
else if crossProd < 0 then dec(Result);
end else
begin
while (j < len) and (p[j].Y > pt.Y) do inc(j);
if j = len then break
else if j > 0 then prevPt := p[j -1];
crossProd := CrossProduct(prevPt, p[j], pt);
if crossProd = 0 then PointOnEdgeDir := 1
else if crossProd > 0 then inc(Result);
end;
inc(j);
isAbove := not isAbove;
end;
end;
end;
//------------------------------------------------------------------------------
function PointInPolygons(const pt: TPointD;
const polygons: TPathsD; fillRule: TFillRule): Boolean;
var
wc: integer;
PointOnEdgeDir: integer;
begin
wc := PointInPolysWindingCount(pt, polygons, PointOnEdgeDir);
case fillRule of
frEvenOdd: result := (PointOnEdgeDir <> 0) or Odd(wc);
frNonZero: result := (PointOnEdgeDir <> 0) or (wc <> 0);
frPositive: result := (PointOnEdgeDir + wc > 0);
else {frNegative} result := (PointOnEdgeDir + wc < 0);
end;
end;
//------------------------------------------------------------------------------
function PerpendicularDist(const pt, line1, line2: TPointD): double;
var
a,b,c,d: double;
begin
//given: cross product of 2 vectors = area of parallelogram
//and given: area of parallelogram = length base * height
//height (ie perpendic. dist.) = cross product of 2 vectors / length base
a := pt.X - line1.X;
b := pt.Y - line1.Y;
c := line2.X - line1.X;
d := line2.Y - line1.Y;
result := abs(a * d - c * b) / Sqrt(c * c + d * d);
end;
//------------------------------------------------------------------------------
function ClosestPoint(const pt, linePt1, linePt2: TPointD;
constrainToSegment: Boolean): TPointD;
var
q: double;
begin
if (linePt1.X = linePt2.X) and (linePt1.Y = linePt2.Y) then
begin
Result := linePt1;
end else
begin
q := ((pt.X-linePt1.X)*(linePt2.X-linePt1.X) +
(pt.Y-linePt1.Y)*(linePt2.Y-linePt1.Y)) /
(sqr(linePt2.X-linePt1.X) + sqr(linePt2.Y-linePt1.Y));
if constrainToSegment then
begin
if q < 0 then q := 0 else if q > 1 then q := 1;
end;
Result.X := (1-q)*linePt1.X + q*linePt2.X;
Result.Y := (1-q)*linePt1.Y + q*linePt2.Y;
end;
end;
//------------------------------------------------------------------------------
function ClosestPointOnLine(const pt, linePt1, linePt2: TPointD): TPointD;
begin
result := ClosestPoint(pt, linePt1, linePt2, false);
end;
//------------------------------------------------------------------------------
function ClosestPointOnSegment(const pt, segPt1, segPt2: TPointD): TPointD;
begin
result := ClosestPoint(pt, segPt1, segPt2, true);
end;
//------------------------------------------------------------------------------
function GetPtOnEllipseFromAngle(const ellipseRect: TRectD;
angle: double): TPointD;
var
sn, co: double;
begin
NormalizeAngle(angle);
GetSinCos(angle, sn, co);
Result.X := ellipseRect.MidPoint.X + ellipseRect.Width/2 * co;
Result.Y := ellipseRect.MidPoint.Y + ellipseRect.Height/2 * sn;
end;
//------------------------------------------------------------------------------
function GetEllipticalAngleFromPoint(const ellipseRect: TRectD;
const pt: TPointD): double;
begin
with ellipseRect do
Result := ArcTan2(Width/Height * (pt.Y - MidPoint.Y), (pt.X - MidPoint.X));
end;
//------------------------------------------------------------------------------
function GetRotatedEllipticalAngleFromPoint(const ellipseRect: TRectD;
ellipseRotAngle: double; pt: TPointD): double;
begin
Result := 0;
if ellipseRect.IsEmpty then Exit;
RotatePoint(pt, ellipseRect.MidPoint, -ellipseRotAngle);
Result := GetEllipticalAngleFromPoint(ellipseRect, pt);
end;
//------------------------------------------------------------------------------
function GetPtOnRotatedEllipseFromAngle(const ellipseRect: TRectD;
ellipseRotAngle, angle: double): TPointD;
begin
Result := GetPtOnEllipseFromAngle(ellipseRect, angle);
if ellipseRotAngle <> 0 then
img32.Vector.RotatePoint(Result, ellipseRect.MidPoint, ellipseRotAngle);
end;
//------------------------------------------------------------------------------
function GetClosestPtOnRotatedEllipse(const ellipseRect: TRectD;
ellipseRotation: double; const pt: TPointD): TPointD;
var
pt2: TPointD;
angle: double;
begin
pt2 := pt;
Img32.Vector.RotatePoint(pt2, ellipseRect.MidPoint, -ellipseRotation);
angle := GetEllipticalAngleFromPoint(ellipseRect, pt2);
Result := GetPtOnEllipseFromAngle(ellipseRect, angle);
Img32.Vector.RotatePoint(Result, ellipseRect.MidPoint, ellipseRotation);
end;
//------------------------------------------------------------------------------
function IsPointInEllipse(const ellipseRec: TRect; const pt: TPoint): Boolean;
var
rec: TRectD;
w,h: integer;
x,y, y2, a,b, dx,dy: double;
begin
RectWidthHeight(ellipseRec, w, h);
a := w * 0.5;
b := h * 0.5;
dx := ellipseRec.Left + a;
dy := ellipseRec.Top + b;
rec := RectD(ellipseRec);
TranslateRect(rec, -dx, -dy);
x := pt.X -dx; y := pt.Y -dy;
//first make sure pt is inside rect
Result := (abs(x) <= a) and (abs(y) <= b);
if not result then Exit;
//given (x*x)/(a*a) + (y*y)/(b*b) = 1
//then y*y = b*b(1 - (x*x)/(a*a))
//nb: contents of Sqrt below will always be positive
//since the substituted x must be within ellipseRec bounds
y2 := Sqrt((b*b*(1 - (x*x)/(a*a))));
Result := (y >= -y2) and (y <= y2);
end;
//------------------------------------------------------------------------------
function GetLineEllipseIntersects(const ellipseRec: TRect;
var linePt1, linePt2: TPointD): Boolean;
var
dx, dy, m,a,b,c,q: double;
qa,qb,qc,qs: double;
rec: TRectD;
pt1, pt2: TPointD;
begin
rec := RectD(ellipseRec);
a := rec.Width *0.5;
b := rec.Height *0.5;
//offset ellipseRect so it's centered over the coordinate origin
dx := ellipseRec.Left + a; dy := ellipseRec.Top + b;
TranslateRect(rec, -dx, -dy);
pt1 := TranslatePoint(linePt1, -dx, -dy);
pt2 := TranslatePoint(linePt2, -dx, -dy);
//equation of ellipse = (x*x)/(a*a) + (y*y)/(b*b) = 1
//equation of line = y = mx + c;
if (pt1.X = pt2.X) then //vertical line (ie infinite slope)
begin
//given x = K, then y*y = b*b(1 - (x*x)/(a*a))
q := (b*b)*(1 - Sqr(pt1.X)/(a*a));
result := q >= 0;
if not result then Exit;
q := Sqrt(q);
pt1.Y := q;
pt2.Y := -q;
end else
begin
//using simultaneous equations and substitution
//given y = mx + c
m := (pt1.Y - pt2.Y)/(pt1.X - pt2.X);
c := pt1.Y - m * pt1.X;
//given (x*x)/(a*a) + (y*y)/(b*b) = 1
//(x*x)/(a*a)*(b*b) + (y*y) = (b*b)
//(b*b)/(a*a) *(x*x) + Sqr(m*x +c) = (b*b)
//(b*b)/(a*a) *(x*x) + (m*m)*(x*x) + 2*m*x*c +c*c = b*b
//((b*b)/(a*a) +(m*m)) *(x*x) + 2*m*c*(x) + (c*c) - (b*b) = 0
//solving quadratic equation
qa := ((b*b)/(a*a) +(m*m));
qb := 2*m*c;
qc := (c*c) - (b*b);
qs := (qb*qb) - 4*qa*qc;
Result := qs >= 0;
if not result then Exit;
qs := Sqrt(qs);
pt1.X := (-qb +qs)/(2 * qa);
pt1.Y := m * pt1.X + c;
pt2.X := (-qb -qs)/(2 * qa);
pt2.Y := m * pt2.X + c;
end;
//finally reverse initial offset
linePt1 := TranslatePoint(pt1, dx, dy);
linePt2 := TranslatePoint(pt2, dx, dy);
end;
//------------------------------------------------------------------------------
function Sign(const value: Double): integer; {$IFDEF INLINE} inline; {$ENDIF}
begin
if value < 0 then Result := -1
else if value > 0 then Result := 1
else Result := 0;
end;
//------------------------------------------------------------------------------
function ApplyNormal(const pt, norm: TPointD; delta: double): TPointD;
{$IFDEF INLINE} inline; {$ENDIF}
begin
result := PointD(pt.X + norm.X * delta, pt.Y + norm.Y * delta);
end;
//------------------------------------------------------------------------------
procedure AppendPoint(var path: TPathD; const extra: TPointD);
var
len: integer;
begin
len := length(path);
SetLengthUninit(path, len +1);
path[len] := extra;
end;
//------------------------------------------------------------------------------
procedure AppendPath(var paths: TPathsD; const extra: TPathD);
var
len1, len2: integer;
begin
len2 := length(extra);
if len2 = 0 then Exit;
len1 := length(paths);
setLength(paths, len1 + 1);
paths[len1] := Copy(extra, 0, len2);
end;
//------------------------------------------------------------------------------
procedure AppendPath(var paths: TPathsD; const extra: TPathsD);
var
i, len1, len2: integer;
begin
len2 := length(extra);
if len2 = 0 then Exit;
len1 := length(paths);
setLength(paths, len1 + len2);
for i := 0 to len2 -1 do
paths[len1+i] := Copy(extra[i], 0, length(extra[i]));
end;
//------------------------------------------------------------------------------
procedure AppendPath(var ppp: TArrayOfPathsD; const extra: TPathsD);
var
len: integer;
begin
len := length(ppp);
setLength(ppp, len + 1);
if Assigned(extra) then
AppendPath(ppp[len], extra) else
ppp[len] := nil;
end;
//------------------------------------------------------------------------------
procedure ConcatPaths(var dstPath: TPathD; const path: TPathD); overload;
var
len, pathLen: integer;
begin
// calculate the length of the final array
len := Length(dstPath);
pathLen := Length(path);
if pathLen = 0 then Exit;
// Avoid point duplicates where paths join
if (len > 0) and PointsEqual(dstPath[len -1], path[0]) then dec(len);
// fill the array
SetLengthUninit(dstPath, len + pathLen);
Move(path[0], dstPath[len], pathLen * SizeOf(TPointD));
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 it 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 it 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;
// Skip if we have a path with only one point and that point also matches
// the previous path's end-point.
if pathLen > 0 then
begin
Move(paths[i][offset], dstPath[len], pathLen * SizeOf(TPointD));
inc(len, pathLen);
end;
end;
end;
end;
//------------------------------------------------------------------------------
procedure RotatePoint(var pt: TPointD;
const focalPoint: TPointD; sinA, cosA: double);
var
tmpX, tmpY: double;
begin
tmpX := pt.X-focalPoint.X;
tmpY := pt.Y-focalPoint.Y;
pt.X := tmpX * cosA - tmpY * sinA + focalPoint.X;
pt.Y := tmpX * sinA + tmpY * cosA + focalPoint.Y;
end;
//------------------------------------------------------------------------------
procedure RotatePoint(var pt: TPointD;
const focalPoint: TPointD; angleRad: double);
var
sinA, cosA: double;
begin
if angleRad = 0 then Exit;
{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
angleRad := -angleRad;
{$ENDIF}
GetSinCos(angleRad, sinA, cosA);
RotatePoint(pt, focalPoint, sinA, cosA);
end;
//------------------------------------------------------------------------------
function RotatePathInternal(const path: TPathD;
const focalPoint: TPointD; sinA, cosA: double): TPathD;
var
i: integer;
x,y: double;
begin
NewPointDArray(Result, length(path), True);
for i := 0 to high(path) do
begin
x := path[i].X - focalPoint.X;
y := path[i].Y - focalPoint.Y;
Result[i].X := x * cosA - y * sinA + focalPoint.X;
Result[i].Y := x * sinA + y * cosA + focalPoint.Y;
end;
end;
//------------------------------------------------------------------------------
function RotatePath(const path: TPathD;
const focalPoint: TPointD; angleRads: double): TPathD;
var
sinA, cosA: double;
begin
if angleRads = 0 then
begin
Result := path;
Exit;
end;
{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
angleRads := -angleRads;
{$ENDIF}
GetSinCos(angleRads, sinA, cosA);
Result := RotatePathInternal(path, focalPoint, sinA, cosA);
end;
//------------------------------------------------------------------------------
function RotatePath(const paths: TPathsD;
const focalPoint: TPointD; angleRads: double): TPathsD;
var
i: integer;
sinA, cosA: double;
fp: TPointD;
begin
Result := paths;
if not IsValid(angleRads) then Exit;
NormalizeAngle(angleRads);
if angleRads = 0 then Exit;
{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
angleRads := -angleRads;
{$ENDIF}
GetSinCos(angleRads, sinA, cosA);
SetLength(Result, length(paths));
if IsValid(focalPoint) then
fp := focalPoint else
fp := GetBoundsD(paths).MidPoint;
for i := 0 to high(paths) do
Result[i] := RotatePathInternal(paths[i], fp, sinA, cosA);
end;
//------------------------------------------------------------------------------
function GetAngle(const origin, pt: TPoint): double;
var
x,y: double;
begin
x := pt.X - origin.X;
y := pt.Y - origin.Y;
if x = 0 then
begin
if y > 0 then result := angle90
else result := -angle90;
end
else if y = 0 then
begin
if x > 0 then result := 0
else result := angle180;
end else
result := arctan2(y, x); //range between -Pi and Pi
{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
Result := -Result;
{$ENDIF}
end;
//------------------------------------------------------------------------------
function GetAngle(const origin, pt: TPointD): double;
var
x,y: double;
begin
x := pt.X - origin.X;
y := pt.Y - origin.Y;
if x = 0 then
begin
if y > 0 then result := angle90
else result := -angle90;
end
else if y = 0 then
begin
if x > 0 then result := 0
else result := angle180;
end else
result := arctan2(y, x); //range between -Pi and Pi
{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
Result := -Result;
{$ENDIF}
end;
//------------------------------------------------------------------------------
function GetAngle(const a, b, c: TPoint): double;
var
ab, bc: TPointD;
dp, cp: double;
begin
//https://stackoverflow.com/a/3487062/359538
ab := PointD(b.x - a.x, b.y - a.y);
bc := PointD(b.x - c.x, b.y - c.y);
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
{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
Result := -Result;
{$ENDIF}
end;
//------------------------------------------------------------------------------
function GetAngle(const a, b, c: TPointD): double;
var
ab, bc: TPointD;
dp, cp: double;
begin
//https://stackoverflow.com/a/3487062/359538
ab := PointD(b.x - a.x, b.y - a.y);
bc := PointD(b.x - c.x, b.y - c.y);
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
{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
Result := -Result;
{$ENDIF}
end;
//------------------------------------------------------------------------------
function GetPointAtAngleAndDist(const origin: TPointD;
angle, distance: double): TPointD;
begin
Result := origin;
Result.X := Result.X + distance;
RotatePoint(Result, origin, angle);
end;
//------------------------------------------------------------------------------
function IntersectPoint(const ln1a, ln1b, ln2a, ln2b: TPointD): TPointD;
var
m1,b1,m2,b2: double;
begin
result := InvalidPointD;
//see http://paulbourke.net/geometry/pointlineplane/
if (ln1B.X = ln1A.X) then
begin
if (ln2B.X = ln2A.X) then exit; //parallel lines
m2 := (ln2B.Y - ln2A.Y)/(ln2B.X - ln2A.X);
b2 := ln2A.Y - m2 * ln2A.X;
Result.X := ln1A.X;
Result.Y := m2*ln1A.X + b2;
end
else if (ln2B.X = ln2A.X) then
begin
m1 := (ln1B.Y - ln1A.Y)/(ln1B.X - ln1A.X);
b1 := ln1A.Y - m1 * ln1A.X;
Result.X := ln2A.X;
Result.Y := m1*ln2A.X + b1;
end else
begin
m1 := (ln1B.Y - ln1A.Y)/(ln1B.X - ln1A.X);
b1 := ln1A.Y - m1 * ln1A.X;
m2 := (ln2B.Y - ln2A.Y)/(ln2B.X - ln2A.X);
b2 := ln2A.Y - m2 * ln2A.X;
if m1 = m2 then exit; //parallel lines
Result.X := (b2 - b1)/(m1 - m2);
Result.Y := m1 * Result.X + b1;
end;
end;
//------------------------------------------------------------------------------
function IntersectPoint(const ln1a, ln1b, ln2a, ln2b: TPointD;
out ip: TPointD): Boolean;
begin
ip := IntersectPoint(ln1a, ln1b, ln2a, ln2b);
Result := IsValid(ip);
end;
//------------------------------------------------------------------------------
function SegmentIntersectPt(const ln1a, ln1b, ln2a, ln2b: TPointD): TPointD;
var
pqd,r,s : TPointD; //scalar vectors;
rs, t : double;
begin
//https://stackoverflow.com/a/565282/359538
Result := InvalidPointD;
r := PointD(ln1b.X - ln1a.X, ln1b.Y - ln1a.Y);
s := PointD(ln2b.X - ln2a.X, ln2b.Y - ln2a.Y);
rs := CrossProduct(r,s);
if Abs(rs) < 1 then Exit;
pqd.X := ln2a.X - ln1a.X;
pqd.y := ln2a.Y - ln1a.Y;
t := CrossProduct(pqd, s) / rs;
if (t < -0.025) or (t > 1.025) then Exit;
Result.X := ln1a.X + t * r.X;
Result.Y := ln1a.Y + t * r.Y;
// pqd.X := -pqd.X; pqd.Y := -pqd.Y;
// u := CrossProduct(pqd, r) / rs;
// if (u < -0.05) or (u > 1.05) then Exit;
end;
//------------------------------------------------------------------------------
function SegmentsIntersect(const ln1a, ln1b, ln2a, ln2b: TPointD;
out ip: TPointD): Boolean;
begin
ip := SegmentIntersectPt(ln1a, ln1b, ln2a, ln2b);
Result := IsValid(ip);
end;
//------------------------------------------------------------------------------
function CalcRoundingSteps(radius: double): double;
begin
//the results of this function have been derived empirically
//and may need further adjustment
if radius < 0.55 then result := 4
else result := Pi * Sqrt(radius *2);
end;
//------------------------------------------------------------------------------
function Grow(const path, normals: TPathD; delta: double;
joinStyle: TJoinStyle; miterLim: double; scale: double; isOpen: Boolean): TPathD;
var
resCnt, resCap : integer;
norms : TPathD;
stepsPerRadian : double;
stepSin, stepCos : double;
asin, acos : double;
procedure AddPoint(const pt: TPointD);
begin
if resCnt >= resCap then
begin
inc(resCap, 64);
SetLengthUninit(result, resCap);
end;
result[resCnt] := pt;
inc(resCnt);
end;
procedure DoMiter(j, k: Integer; cosA: Double);
var
q: Double;
begin
q := delta / (cosA +1);
AddPoint(PointD(
path[j].X + (norms[k].X + norms[j].X) *q,
path[j].Y + (norms[k].Y + norms[j].Y) *q));
end;
procedure DoBevel(j, k: Integer);
var
absDelta: double;
begin
if k = j then
begin
absDelta := Abs(delta);
AddPoint(PointD(
path[j].x - absDelta * norms[j].x,
path[j].y - absDelta * norms[j].y));
AddPoint(PointD(
path[j].x + absDelta * norms[j].x,
path[j].y + absDelta * norms[j].y));
end else
begin
AddPoint(PointD(
path[j].x + delta * norms[k].x,
path[j].y + delta * norms[k].y));
AddPoint(PointD(
path[j].x + delta * norms[j].x,
path[j].y + delta * norms[j].y));
end;
end;
procedure DoSquare(j, k: Integer);
var
vec, ptQ, ptR, ptS, ptT, ptU, ip: TPointD;
absDelta: double;
begin
if k = j then
begin
vec.X := norms[j].Y; //squaring a line end
vec.Y := -norms[j].X;
end else
begin
// using the reciprocal of unit normals (as unit vectors)
// get the average unit vector ...
vec := GetAvgUnitVector(
PointD(-norms[k].Y, norms[k].X),
PointD(norms[j].Y, -norms[j].X));
end;
absDelta := Abs(delta);
ptQ := PointD(path[j].X + absDelta * vec.X, path[j].Y + absDelta * vec.Y);
ptR := PointD(ptQ.X + delta * vec.Y, ptQ.Y + delta * -vec.X);
ptS := ReflectPoint(ptR, ptQ);
// get 2 vertices along one edge offset
ptT := PointD(
path[k].X + norms[k].X * delta,
path[k].Y + norms[k].Y * delta);
if (j = k) then
begin
ptU.X := ptT.X + vec.X * delta;
ptU.Y := ptT.Y + vec.Y * delta;
ip := IntersectPoint(ptR, ptS, ptT, ptU);
AddPoint(ReflectPoint(ip, ptQ));
AddPoint(ip);
end else
begin
ptU := PointD(
path[j].X + norms[k].X * delta,
path[j].Y + norms[k].Y * delta);
ip := IntersectPoint(ptR, ptS, ptT, ptU);
AddPoint(ip);
AddPoint(ReflectPoint(ip, ptQ));
end;
end;
procedure DoRound(j, k: Integer);
var
i, steps: Integer;
pt: TPointD;
dx, dy, oldDx: double;
angle: double;
begin
// nb: angles may be negative but this will always be a convex join
pt := path[j];
if j = k then
begin
dx := -norms[k].X * delta;
dy := -norms[k].Y * delta;
end else
begin
dx := norms[k].X * delta;
dy := norms[k].Y * delta;
end;
AddPoint(PointD(pt.X + dx, pt.Y + dy));
angle := ArcTan2(asin, acos);
steps := Ceil(stepsPerRadian * abs(angle));
for i := 2 to steps do
begin
oldDx := dx;
dx := oldDx * stepCos - stepSin * dy;
dy := oldDx * stepSin + stepCos * dy;
AddPoint(PointD(pt.X + dx, pt.Y + dy));
end;
AddPoint(PointD(
pt.X + norms[j].X * delta,
pt.Y + norms[j].Y * delta));
end;
var
j, k : cardinal;
len : cardinal;
steps : double;
highI : cardinal;
iLo,iHi : cardinal;
absDelta : double;
begin
Result := nil;
if not Assigned(path) then exit;
len := Length(path);
if not isOpen then
while (len > 2) and
PointsNearEqual(path[len -1], path[0], 0.001) do
dec(len);
if len < 2 then Exit;
if scale = 0 then scale := 1.0;
absDelta := Abs(delta);
if absDelta * scale < 1 then
joinStyle := jsButt
else if joinStyle = jsAuto then
begin
if delta < AutoWidthThreshold / 2 then
joinStyle := jsSquare else
joinStyle := jsRound;
end;
if absDelta < MinStrokeWidth/2 then
begin
if delta < 0 then
delta := -MinStrokeWidth/2 else
delta := MinStrokeWidth/2;
end;
if assigned(normals) then
norms := normals else
norms := GetNormals(path);
highI := len -1;
stepsPerRadian := 0;
if joinStyle = jsRound then
begin
steps := CalcRoundingSteps(delta * scale);
stepSin := sin(TwoPi/steps);
stepCos := cos(TwoPi/steps);
if (delta < 0) then stepSin := -stepSin;
stepsPerRadian := steps / TwoPi;
end;
if miterLim <= 0 then miterLim := DefaultMiterLimit
else if miterLim < 2 then miterLim := 2;
miterLim := 2 /(sqr(miterLim));
resCnt := 0;
resCap := 0;
if isOpen then
begin
iLo := 1; iHi := highI -1;
k := 0;
AddPoint(PointD(
path[0].X + norms[0].X * delta,
path[0].Y + norms[0].Y * delta));
end else
begin
iLo := 0; iHi := highI;
k := highI;
end;
for j := iLo to iHi do
begin
if PointsNearEqual(path[j], path[k], 0.01) then
begin
k := j; // todo - check if needed
Continue;
end;
asin := CrossProduct(norms[k], norms[j]);
if (asin > 1.0) then asin := 1.0
else if (asin < -1.0) then asin := -1.0;
acos := DotProduct(norms[k], norms[j]);
if (acos > -0.999) and (asin * delta < 0) then
begin
// is concave
AddPoint(PointD(
path[j].X + norms[k].X * delta, path[j].Y + norms[k].Y * delta));
AddPoint(path[j]);
AddPoint(PointD(
path[j].X + norms[j].X * delta, path[j].Y + norms[j].Y * delta));
end
else if (acos > 0.999) and (joinStyle <> jsRound) then
begin
// almost straight - less than 2.5 degree, so miter
DoMiter(j, k, acos);
end
else if (joinStyle = jsMiter) then
begin
if (1 + acos > miterLim) then
DoMiter(j, k, acos) else
DoSquare(j, k);
end
else if (joinStyle = jsRound) then
DoRound(j, k)
else if (joinStyle = jsSquare) then
DoSquare(j, k)
else
DoBevel(j, k);
k := j;
end;
if isOpen then
AddPoint(PointD(
path[highI].X + norms[highI].X * delta, //todo - check this !!!
path[highI].Y + norms[highI].Y * delta));
SetLength(Result, resCnt);
end;
//------------------------------------------------------------------------------
function GrowOpenLine(const line: TPathD; delta: double;
joinStyle: TJoinStyle; endStyle: TEndStyle;
miterLim: double = 0; scale: double = 1.0): TPathD;
var
len : integer;
resCnt, resCap : integer;
asin, acos : double;
stepSin, stepCos : double;
stepsPerRadian : double;
path, norms : TPathD;
procedure AddPoint(const pt: TPointD);
begin
if resCnt >= resCap then
begin
inc(resCap, 64);
SetLengthUninit(result, resCap);
end;
result[resCnt] := pt;
inc(resCnt);
end;
procedure DoMiter(j, k: Integer; cosA: Double);
var
q: Double;
begin
q := delta / (cosA +1);
AddPoint(PointD(
path[j].X + (norms[k].X + norms[j].X) *q,
path[j].Y + (norms[k].Y + norms[j].Y) *q));
end;
procedure DoBevel(j, k: Integer);
var
absDelta: double;
begin
if k = j then
begin
absDelta := Abs(delta);
AddPoint(PointD(
path[j].x - absDelta * norms[j].x,
path[j].y - absDelta * norms[j].y));
AddPoint(PointD(
path[j].x + absDelta * norms[j].x,
path[j].y + absDelta * norms[j].y));
end else
begin
AddPoint(PointD(
path[j].x + delta * norms[k].x,
path[j].y + delta * norms[k].y));
AddPoint(PointD(
path[j].x + delta * norms[j].x,
path[j].y + delta * norms[j].y));
end;
end;
procedure DoSquare(j, k: Integer);
var
vec, ptQ, ptR, ptS, ptT, ptU, ip: TPointD;
absDelta: double;
begin
if k = j then
begin
vec.X := norms[j].Y; //squaring a line end
vec.Y := -norms[j].X;
end else
begin
// using the reciprocal of unit normals (as unit vectors)
// get the average unit vector ...
vec := GetAvgUnitVector(
PointD(-norms[k].Y, norms[k].X),
PointD(norms[j].Y, -norms[j].X));
end;
absDelta := Abs(delta);
ptQ := PointD(path[j].X + absDelta * vec.X, path[j].Y + absDelta * vec.Y);
ptR := PointD(ptQ.X + delta * vec.Y, ptQ.Y + delta * -vec.X);
ptS := ReflectPoint(ptR, ptQ);
// get 2 vertices along one edge offset
ptT := PointD(
path[k].X + norms[k].X * delta,
path[k].Y + norms[k].Y * delta);
if (j = k) then
begin
ptU.X := ptT.X + vec.X * delta;
ptU.Y := ptT.Y + vec.Y * delta;
ip := IntersectPoint(ptR, ptS, ptT, ptU);
AddPoint(ReflectPoint(ip, ptQ));
AddPoint(ip);
end else
begin
ptU := PointD(
path[j].X + norms[k].X * delta,
path[j].Y + norms[k].Y * delta);
ip := IntersectPoint(ptR, ptS, ptT, ptU);
AddPoint(ip);
AddPoint(ReflectPoint(ip, ptQ));
end;
end;
procedure DoRound(j, k: Integer);
var
i, steps: Integer;
pt: TPointD;
dx, dy, oldDx: double;
angle: double;
begin
// nb: angles may be negative but this will always be a convex join
pt := path[j];
if j = k then
begin
dx := -norms[k].X * delta;
dy := -norms[k].Y * delta;
angle := PI;
end else
begin
dx := norms[k].X * delta;
dy := norms[k].Y * delta;
angle := ArcTan2(asin, acos);
end;
AddPoint(PointD(pt.X + dx, pt.Y + dy));
steps := Ceil(stepsPerRadian * abs(angle));
for i := 2 to steps do
begin
oldDx := dx;
dx := oldDx * stepCos - stepSin * dy;
dy := oldDx * stepSin + stepCos * dy;
AddPoint(PointD(pt.X + dx, pt.Y + dy));
end;
AddPoint(PointD(
pt.X + norms[j].X * delta,
pt.Y + norms[j].Y * delta));
end;
procedure DoPoint(j: Cardinal; var k: Cardinal);
begin
asin := CrossProduct(norms[k], norms[j]);
if (asin > 1.0) then asin := 1.0
else if (asin < -1.0) then asin := -1.0;
acos := DotProduct(norms[k], norms[j]);
if (acos > -0.999) and (asin * delta < 0) then
begin
// is concave
AddPoint(PointD(
path[j].X + norms[k].X * delta, path[j].Y + norms[k].Y * delta));
AddPoint(path[j]);
AddPoint(PointD(
path[j].X + norms[j].X * delta, path[j].Y + norms[j].Y * delta));
end
else if (acos > 0.999) and (joinStyle <> jsRound) then
// almost straight - less than 2.5 degree, so miter
DoMiter(j, k, acos)
else if (joinStyle = jsMiter) then
begin
if (1 + acos > miterLim) then
DoMiter(j, k, acos) else
DoSquare(j, k);
end
else if (joinStyle = jsRound) then
DoRound(j, k)
else if (joinStyle = jsSquare) then
DoSquare(j, k)
else
DoBevel(j, k);
k := j;
end;
var
highJ : cardinal;
j, k : cardinal;
steps : double;
begin
Result := nil;
path := StripNearDuplicates(line, 0.1, false);
len := length(path);
if (len = 0) or (delta <= 0) then Exit;
// don't specify a minimum delta as this path may be scaled later
// if delta < MinStrokeWidth then
// delta := MinStrokeWidth;
delta := delta * 0.5;
if len = 1 then
begin
with path[0] do
result := Ellipse(RectD(x-delta, y-delta, x+delta, y+delta));
Exit;
end;
//Assert(endStyle <> esClosed);
//with very narrow lines, don't get fancy with joins and line ends
if (delta <= 1) then
begin
if (joinStyle = jsRound) and (delta * scale <= 1) then
joinStyle := jsButt;
if (endStyle = esRound) and (delta * scale <= 1) then
endStyle := esSquare;
end
else if joinStyle = jsAuto then
begin
if (endStyle = esRound) and (delta * scale >= AutoWidthThreshold) then
joinStyle := jsRound else
joinStyle := jsSquare;
end;
stepsPerRadian := 0;
if (joinStyle = jsRound) or (endStyle = esRound) then
begin
steps := CalcRoundingSteps(delta * scale);
stepSin := sin(TwoPi/steps);
stepCos := cos(TwoPi/steps);
if (delta < 0) then stepSin := -stepSin;
stepsPerRadian := steps / TwoPi;
end;
if miterLim <= 0 then miterLim := DefaultMiterLimit
else if miterLim < 2 then miterLim := 2;
miterLim := 2 /(sqr(miterLim));
norms := GetNormals(path);
resCnt := 0; resCap := 0;
case endStyle of
esButt: DoBevel(0,0);
esRound: DoRound(0,0);
else DoSquare(0, 0);
end;
// offset the left side going **forward**
k := 0;
highJ := len -1;
for j := 1 to highJ -1 do DoPoint(j,k);
// reverse the normals ...
for j := highJ downto 1 do
begin
norms[j].X := -norms[j-1].X;
norms[j].Y := -norms[j-1].Y;
end;
norms[0] := norms[len -1];
case endStyle of
esButt: DoBevel(highJ,highJ);
esRound: DoRound(highJ,highJ);
else DoSquare(highJ,highJ);
end;
// offset the left side going **backward**
k := highJ;
for j := highJ -1 downto 1 do
DoPoint(j, k);
SetLength(Result, resCnt);
end;
//------------------------------------------------------------------------------
function GrowClosedLine(const line: TPathD; width: double;
joinStyle: TJoinStyle; miterLim: double = 0; scale: double = 1.0): TPathsD;
var
norms: TPathD;
rec: TRectD;
skipHole: Boolean;
begin
rec := GetBoundsD(line);
skipHole := (rec.Width <= width) or (rec.Height <= width);
if skipHole then
begin
SetLength(Result, 1);
norms := GetNormals(line);
Result[0] := Grow(line, norms, width/2, joinStyle, miterLim, scale, false);
end else
begin
SetLength(Result, 2);
norms := GetNormals(line);
Result[0] := Grow(line, norms, width/2, joinStyle, miterLim, scale, false);
Result[1] := ReversePath(
Grow(line, norms, -width/2, joinStyle, miterLim, scale, false));
end;
end;
//------------------------------------------------------------------------------
function RoughOutline(const line: TPathD; lineWidth: double;
joinStyle: TJoinStyle; endStyle: TEndStyle;
miterLim: double = 0; scale: double = 1.0): TPathsD;
var
lines: TPathsD;
begin
SetLength(lines,1);
lines[0] := line;
Result := RoughOutline(lines, lineWidth, joinStyle, endStyle, miterLim, scale);
end;
//------------------------------------------------------------------------------
function RoughOutline(const lines: TPathsD; lineWidth: double;
joinStyle: TJoinStyle; endStyle: TEndStyle;
miterLim: double = 0; scale: double = 1.0): TPathsD;
var
i: integer;
lwDiv2: double;
p: TPathD;
begin
result := nil;
if not assigned(lines) then exit;
if joinStyle = jsAuto then
begin
if endStyle in [esPolygon, esRound] then
joinStyle := jsRound else
joinStyle := jsSquare;
end;
if scale = 0 then scale := 1;
if endStyle = esPolygon then
begin
for i := 0 to high(lines) do
begin
if Length(lines[i]) = 1 then
begin
lwDiv2 := lineWidth/2;
with lines[i][0] do
AppendPath(Result,
Ellipse(RectD(x-lwDiv2, y-lwDiv2, x+lwDiv2, y+lwDiv2)));
end else
begin
p := StripNearDuplicates(lines[i], 0.1, true);
if Length(p) = 2 then AppendPoint(p, p[0]);
AppendPath(Result,
GrowClosedLine(p, lineWidth, joinStyle, miterLim, scale));
end;
end;
end
else
begin
SetLength(Result, Length(lines));
for i := 0 to high(lines) do
Result[i] := GrowOpenLine(lines[i], lineWidth,
joinStyle, endStyle, miterLim, scale);
end;
end;
//------------------------------------------------------------------------------
function Rectangle(const rec: TRect): TPathD;
begin
NewPointDArray(Result, 4, True);
with rec do
begin
result[0] := PointD(left, top);
result[1] := PointD(right, top);
result[2] := PointD(right, bottom);
result[3] := PointD(left, bottom);
end;
end;
//------------------------------------------------------------------------------
function Rectangle(const rec: TRectD): TPathD;
begin
NewPointDArray(Result, 4, True);
with rec do
begin
result[0] := PointD(left, top);
result[1] := PointD(right, top);
result[2] := PointD(right, bottom);
result[3] := PointD(left, bottom);
end;
end;
//------------------------------------------------------------------------------
function Rectangle(l, t, r, b: double): TPathD;
begin
NewPointDArray(Result, 4, True);
result[0] := PointD(l, t);
result[1] := PointD(r, t);
result[2] := PointD(r, b);
result[3] := PointD(l, b);
end;
//------------------------------------------------------------------------------
procedure InflateRect(var rec: TRect; dx, dy: integer);
begin
rec.Left := rec.Left - dx;
rec.Top := rec.Top - dy;
rec.Right := rec.Right + dx;
rec.Bottom := rec.Bottom + dy;
end;
//------------------------------------------------------------------------------
procedure InflateRect(var rec: TRectD; dx, dy: double);
begin
rec.Left := rec.Left - dx;
rec.Top := rec.Top - dy;
rec.Right := rec.Right + dx;
rec.Bottom := rec.Bottom + dy;
end;
//------------------------------------------------------------------------------
function NormalizeRect(var rect: TRect): Boolean;
var
i: integer;
begin
Result := False;
with rect do
begin
if Left > Right then
begin
i := Left;
Left := Right;
Right := i;
Result := True;
end;
if Top > Bottom then
begin
i := Top;
Top := Bottom;
Bottom := i;
Result := True;
end;
end;
end;
//------------------------------------------------------------------------------
function RoundRect(const rec: TRect; radius: integer): TPathD;
begin
Result := RoundRect(RectD(rec), PointD(radius, radius));
end;
//------------------------------------------------------------------------------
function RoundRect(const rec: TRect; radius: TPoint): TPathD;
begin
Result := RoundRect(RectD(rec), PointD(radius));
end;
//------------------------------------------------------------------------------
function RoundRect(const rec: TRectD; radius: double): TPathD;
begin
Result := RoundRect(rec, PointD(radius, radius));
end;
//------------------------------------------------------------------------------
function RoundRect(const rec: TRectD; radius: TPointD): TPathD;
var
i,j : integer;
corners : TPathD;
bezPts : TPathD;
magic : TPointD;
const
magicC: double = 0.55228475; // =4/3 * (sqrt(2)-1)
begin
Result := nil;
if rec.IsEmpty then Exit;
radius.X := Min(radius.X, rec.Width/2);
radius.Y := Min(radius.Y, rec.Height/2);
if (radius.X < 1) and (radius.Y < 1) then
begin
Result := Rectangle(rec);
Exit;
end;
magic.X := radius.X * magicC;
magic.Y := radius.Y * magicC;
NewPointDArray(Corners, 4, True);
with rec do
begin
corners[0] := PointD(Right, Top);
corners[1] := BottomRight;
corners[2] := PointD(Left, Bottom);
corners[3] := TopLeft;
end;
NewPointDArray(Result, 1, True);
Result[0].X := corners[3].X + radius.X;
Result[0].Y := corners[3].Y;
NewPointDArray(bezPts, 4, True);
for i := 0 to High(corners) do
begin
for j := 0 to 3 do bezPts[j] := corners[i];
case i of
3:
begin
bezPts[0].Y := bezPts[0].Y + radius.Y;
bezPts[1].Y := bezPts[0].Y - magic.Y;
bezPts[3].X := bezPts[3].X + radius.X;
bezPts[2].X := bezPts[3].X - magic.X;
end;
0:
begin
bezPts[0].X := bezPts[0].X - radius.X;
bezPts[1].X := bezPts[0].X + magic.X;
bezPts[3].Y := bezPts[3].Y + radius.Y;
bezPts[2].Y := bezPts[3].Y - magic.Y;
end;
1:
begin
bezPts[0].Y := bezPts[0].Y - radius.Y;
bezPts[1].Y := bezPts[0].Y + magic.Y;
bezPts[3].X := bezPts[3].X - radius.X;
bezPts[2].X := bezPts[3].X + magic.X;
end;
2:
begin
bezPts[0].X := bezPts[0].X + radius.X;
bezPts[1].X := bezPts[0].X - magic.X;
bezPts[3].Y := bezPts[3].Y - radius.Y;
bezPts[2].Y := bezPts[3].Y + magic.Y;
end;
end;
ConcatPaths(Result, FlattenCBezier(bezPts));
end;
end;
//------------------------------------------------------------------------------
function Circle(const pt: TPoint; radius: double): TPathD;
var
rec: TRectD;
begin
rec.Left := pt.X - radius;
rec.Right := pt.X + radius;
rec.Top := pt.Y - radius;
rec.Bottom := pt.Y + radius;
Result := Ellipse(rec);
end;
//------------------------------------------------------------------------------
function Circle(const pt: TPointD; radius: double): TPathD;
var
rec: TRectD;
begin
rec.Left := pt.X - radius;
rec.Right := pt.X + radius;
rec.Top := pt.Y - radius;
rec.Bottom := pt.Y + radius;
Result := Ellipse(rec);
end;
//------------------------------------------------------------------------------
function Circle(const pt: TPointD; radius: double; pendingScale: double): TPathD;
var
rec: TRectD;
begin
rec.Left := pt.X - radius;
rec.Right := pt.X + radius;
rec.Top := pt.Y - radius;
rec.Bottom := pt.Y + radius;
Result := Ellipse(rec, pendingScale);
end;
//------------------------------------------------------------------------------
function CalcCircleFrom3Points(const p1,p2,p3: TPointD;
out centre: TPointD; out radius: double): Boolean;
var
mat11, mat12, mat13, mat14: TMatrixD;
m11,m12,m13,m14: double;
begin
mat11 := Matrix(p1.X, p1.Y, 1, p2.X, p2.Y, 1, p3.X, p3.Y, 1);
m11 := MatrixDeterminant(mat11);
Result := m11 <> 0;
if not Result then Exit;
mat12 := Matrix(Sqr(p1.X)+Sqr(p1.Y), p1.Y, 1,
Sqr(p2.X)+Sqr(p2.Y), p2.Y, 1, Sqr(p3.X)+Sqr(p3.Y), p3.Y, 1);
mat12 := Matrix(2, 1, 1, 20, 4, 1, 34, 3, 1);
m12 := MatrixDeterminant(mat12);
mat13 := Matrix(Sqr(p1.X)+Sqr(p1.Y), p1.X, 1,
Sqr(p2.X)+Sqr(p2.Y), p2.X, 1, Sqr(p3.X)+Sqr(p3.Y), p3.X, 1);
m13 := MatrixDeterminant(mat13);
mat14 := Matrix(Sqr(p1.X)+Sqr(p1.Y), p1.X, p1.Y,
Sqr(p2.X)+Sqr(p2.Y), p2.X, p2.Y, Sqr(p3.X)+Sqr(p3.Y), p3.X, p3.Y);
m14 := MatrixDeterminant(mat14);
centre.X := 0.5 * m12/m11;
centre.Y := -0.5 * m13/m11;
radius := Sqrt(Sqr(centre.X) + Sqr(centre.Y) + m14/m11);
end;
//------------------------------------------------------------------------------
function Ellipse(const rec: TRectD; pendingScale: double): TPathD;
var
steps: integer;
begin
if pendingScale <= 0 then pendingScale := 1;
steps := Round(CalcRoundingSteps((rec.width + rec.Height) * pendingScale));
Result := Ellipse(rec, steps);
end;
//------------------------------------------------------------------------------
function Ellipse(const rec: TRect; steps: integer): TPathD;
begin
Result := Ellipse(RectD(rec), steps);
end;
//------------------------------------------------------------------------------
function Ellipse(const rec: TRectD; steps: integer): TPathD;
var
i: Integer;
sinA, cosA: double;
centre, radius, delta: TPointD;
begin
result := nil;
if rec.IsEmpty then Exit;
with rec do
begin
centre := rec.MidPoint;
radius := PointD(Width * 0.5, Height * 0.5);
end;
if steps < 4 then
steps := Round(CalcRoundingSteps(rec.width + rec.height));
GetSinCos(2 * Pi / Steps, sinA, cosA);
delta.x := cosA; delta.y := sinA;
NewPointDArray(Result, Steps, True);
Result[0] := PointD(centre.X + radius.X, centre.Y);
for i := 1 to steps -1 do
begin
Result[i] := PointD(centre.X + radius.X * delta.x,
centre.Y + radius.y * delta.y);
delta := PointD(delta.X * cosA - delta.Y * sinA,
delta.Y * cosA + delta.X * sinA);
end; //rotates clockwise
end;
//------------------------------------------------------------------------------
function RotatedEllipse(const rec: TRectD; angle: double; steps: integer = 0): TPathD;
begin
Result := Ellipse(rec, steps);
if angle = 0 then Exit;
Result := RotatePath(Result, rec.MidPoint, angle);
end;
//------------------------------------------------------------------------------
function RotatedEllipse(const rec: TRectD; angle: double; pendingScale: double): TPathD;
begin
Result := Ellipse(rec, pendingScale);
if angle = 0 then Exit;
Result := RotatePath(Result, rec.MidPoint, angle);
end;
//------------------------------------------------------------------------------
function AngleToEllipticalAngle(const ellRec: TRectD; angle: double): double;
begin
Result := arctan2(ellRec.Height/ellRec.Width * sin(angle), cos(angle));
end;
//------------------------------------------------------------------------------
function EllipticalAngleToAngle(const ellRec: TRectD; angle: double): double;
begin
Result := ArcTan2(sin(angle) *ellRec.Width, cos(angle) * ellRec.Height);
end;
//------------------------------------------------------------------------------
function Star(const rec: TRectD; points: integer; indentFrac: double): TPathD;
var
i: integer;
innerOff: double;
p, p2: TPathD;
rec2: TRectD;
begin
Result := nil;
if points < 5 then points := 5
else if points > 15 then points := 15;
if indentFrac < 0.2 then indentFrac := 0.2
else if indentFrac > 0.8 then indentFrac := 0.8;
innerOff := Min(rec.Width, rec.Height) * indentFrac * 0.5;
if not Odd(points) then inc(points);
p := Ellipse(rec, points);
if not Assigned(p) then Exit;
rec2 := rec;
Img32.Vector.InflateRect(rec2, -innerOff, -innerOff);
if rec2.IsEmpty then
p2 := Ellipse(rec, points*2) else
p2 := Ellipse(rec2, points*2);
NewPointDArray(Result, points*2, True);
for i := 0 to points -1 do
begin
Result[i*2] := p[i];
Result[i*2+1] := p2[i*2+1];
end;
end;
//------------------------------------------------------------------------------
function Star(const focalPt: TPointD;
innerRadius, outerRadius: double; points: integer): TPathD;
var
i: Integer;
sinA, cosA: double;
delta: TPointD;
begin
result := nil;
if (innerRadius <= 0) or (outerRadius <= 0) then Exit;
if points <= 5 then points := 10
else points := points * 2;
GetSinCos(2 * Pi / points, sinA, cosA);
delta.x := cosA; delta.y := sinA;
NewPointDArray(Result, points, True);
Result[0] := PointD(focalPt.X + innerRadius, focalPt.Y);
for i := 1 to points -1 do
begin
if Odd(i) then
Result[i] := PointD(focalPt.X + outerRadius * delta.x,
focalPt.Y + outerRadius * delta.y)
else
Result[i] := PointD(focalPt.X + innerRadius * delta.x,
focalPt.Y + innerRadius * delta.y);
delta := PointD(delta.X * cosA - delta.Y * sinA,
delta.Y * cosA + delta.X * sinA);
end;
end;
//------------------------------------------------------------------------------
function Arc(const rec: TRectD;
startAngle, endAngle: double; scale: double): TPathD;
var
i, steps: Integer;
angle: double;
sinA, cosA: double;
centre, radius: TPointD;
deltaX, deltaX2, deltaY: double;
const
qtrDeg = PI/1440;
begin
Result := nil;
if (endAngle = startAngle) or IsEmptyRect(rec) then Exit;
if scale <= 0 then scale := 4.0;
{$IFDEF CLOCKWISE_ROTATION_WITH_NEGATIVE_ANGLES}
startAngle := -startAngle;
endAngle := -endAngle;
{$ENDIF}
NormalizeAngle(startAngle, qtrDeg);
NormalizeAngle(endAngle, qtrDeg);
with rec do
begin
centre := MidPoint;
radius := PointD(Width * 0.5, Height * 0.5);
end;
if endAngle < startAngle then
angle := endAngle - startAngle + angle360 else
angle := endAngle - startAngle;
//steps = (No. steps for a whole ellipse) * angle/(2*Pi)
steps := Round(CalcRoundingSteps((rec.width + rec.height)/2 * scale));
steps := steps div 2; /////////////////////////////////
if steps < 2 then steps := 2;
NewPointDArray(Result, Steps +1, True);
//angle of the first step ...
GetSinCos(startAngle, deltaY, deltaX);
Result[0].X := centre.X + radius.X * deltaX;
Result[0].Y := centre.Y + radius.y * deltaY;
//angle of each subsequent step ...
GetSinCos(angle / Steps, sinA, cosA);
for i := 1 to steps do
begin
deltaX2 := deltaX * cosA - deltaY * sinA;
deltaY := deltaY * cosA + deltaX * sinA;
deltaX := deltaX2;
Result[i].X := centre.X + radius.X * deltaX;
Result[i].Y := centre.Y + radius.y * deltaY;
end; //progresses clockwise from start to end
end;
//------------------------------------------------------------------------------
function Pie(const rec: TRectD;
StartAngle, EndAngle: double; scale: double): TPathD;
var
len: integer;
begin
result := Arc(rec, StartAngle, EndAngle, scale);
len := length(result);
SetLengthUninit(result, len +1);
result[len] := PointD((rec.Left + rec.Right)/2, (rec.Top + rec.Bottom)/2);
end;
//------------------------------------------------------------------------------
function ArrowHead(const arrowTip, ctrlPt: TPointD; size: double;
arrowStyle: TArrowStyle): TPathD;
var
unitVec, basePt: TPointD;
sDiv40, sDiv50, sDiv60, sDiv120: double;
begin
result := nil;
sDiv40 := size * 0.40;
sDiv50 := size * 0.50;
sDiv60 := size * 0.60;
sDiv120 := sDiv60 * 2;
unitVec := GetUnitVector(ctrlPt, arrowTip);
case arrowStyle of
asNone:
Exit;
asSimple:
begin
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);
result[2] := TranslatePoint(basePt, unitVec.Y * sDiv50, -unitVec.X * sDiv50);
end;
asFancy:
begin
NewPointDArray(result, 4, True);
basePt := TranslatePoint(arrowTip,
-unitVec.X * sDiv120, -unitVec.Y * sDiv120);
result[0] := TranslatePoint(basePt, -unitVec.Y *sDiv50, unitVec.X *sDiv50);
result[1] := TranslatePoint(arrowTip, -unitVec.X *size, -unitVec.Y *size);
result[2] := TranslatePoint(basePt, unitVec.Y *sDiv50, -unitVec.X *sDiv50);
result[3] := arrowTip;
end;
asDiamond:
begin
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);
result[2] := TranslatePoint(arrowTip, -unitVec.X * sDiv120, -unitVec.Y * sDiv120);
result[3] := TranslatePoint(basePt, unitVec.Y * sDiv50, -unitVec.X * sDiv50);
end;
asCircle:
begin
basePt := TranslatePoint(arrowTip, -unitVec.X * sDiv50, -unitVec.Y * sDiv50);
with Point(basePt) do
result := Ellipse(RectD(x - sDiv50, y - sDiv50, x + sDiv50, y + sDiv50));
end;
asTail:
begin
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);
result[2] := TranslatePoint(basePt, -unitVec.Y * sDiv40, unitVec.X * sDiv40);
result[3] := TranslatePoint(arrowTip, -unitVec.X * sDiv120, -unitVec.Y * sDiv120);
result[4] := TranslatePoint(basePt, unitVec.Y * sDiv40, -unitVec.X * sDiv40);
result[5] := TranslatePoint(arrowTip, unitVec.Y * sDiv40, -unitVec.X * sDiv40);
end;
end;
end;
//------------------------------------------------------------------------------
function GetDefaultArrowHeadSize(lineWidth: double): double;
begin
Result := lineWidth *3 + 7;
end;
//------------------------------------------------------------------------------
procedure AdjustPoint(var pt: TPointD; const referencePt: TPointD; delta: double);
var
vec: TPointD;
begin
//Positive delta moves pt away from referencePt, and
//negative delta moves pt toward referencePt.
vec := GetUnitVector(referencePt, pt);
pt.X := pt.X + (vec.X * delta);
pt.Y := pt.Y + (vec.Y * delta);
end;
//------------------------------------------------------------------------------
function ShortenPath(const path: TPathD;
pathEnd: TPathEnd; amount: double): TPathD;
var
len, amount2: double;
vec: TPointD;
i, highPath: integer;
begin
result := path;
highPath := high(path);
if highPath < 1 then Exit;
amount2 := amount;
if pathEnd <> peEnd then
begin
//shorten start
i := 0;
while (i < highPath) do
begin
len := Distance(result[i], result[i+1]);
if (len >= amount) then Break;
amount := amount - len;
inc(i);
end;
if i > 0 then
begin
Move(path[i], Result[0], (highPath - i +1) * SizeOf(TPointD));
dec(highPath, i);
SetLength(Result, highPath +1);
end;
if amount > 0 then
begin
vec := GetUnitVector(result[0], result[1]);
result[0].X := result[0].X + vec.X * amount;
result[0].Y := result[0].Y + vec.Y * amount;
end;
end;
if pathEnd <> peStart then
begin
//shorten end
while (highPath > 1) do
begin
len := Distance(result[highPath], result[highPath -1]);
if (len >= amount2) then Break;
amount2 := amount2 - len;
dec(highPath);
end;
SetLength(Result, highPath +1);
if amount2 > 0 then
begin
vec := GetUnitVector(result[highPath], result[highPath -1]);
result[highPath].X := result[highPath].X + vec.X * amount2;
result[highPath].Y := result[highPath].Y + vec.Y * amount2;
end;
end;
end;
//------------------------------------------------------------------------------
function GetDashedPath(const path: TPathD;
closed: Boolean; const pattern: TArrayOfDouble;
patternOffset: PDouble): TPathsD;
var
i, highI, paIdx: integer;
vecs, path2, dash: TPathD;
patCnt: integer;
patLen: double;
dashCapacity, dashCnt, ptsCapacity, ptsCnt: integer;
segLen, residualPat, patOff: double;
filling: Boolean;
pt, pt2: TPointD;
procedure NewDash;
begin
if ptsCnt = 1 then ptsCnt := 0;
if ptsCnt = 0 then Exit;
if dashCnt = dashCapacity then
begin
inc(dashCapacity, BuffSize);
setLength(result, dashCapacity);
end;
result[dashCnt] := Copy(dash, 0, ptsCnt);
inc(dashCnt);
ptsCapacity := BuffSize;
setLength(dash, ptsCapacity);
ptsCnt := 0;
end;
procedure ExtendDash(const pt: TPointD);
begin
if ptsCnt = ptsCapacity then
begin
inc(ptsCapacity, BuffSize);
setLength(dash, ptsCapacity);
end;
dash[ptsCnt] := pt;
inc(ptsCnt);
end;
begin
Result := nil;
paIdx := 0;
patCnt := length(pattern);
path2 := path;
highI := high(path2);
if (highI < 1) or (patCnt = 0) then Exit;
if closed and
((path2[highI].X <> path2[0].X) or (path2[highI].Y <> path2[0].Y)) then
begin
inc(highI);
setLength(path2, highI +2);
path2[highI] := path2[0];
end;
vecs := GetVectors(path2);
if (vecs[0].X = 0) and (vecs[0].Y = 0) then Exit; //not a line
if not assigned(patternOffset) then
patOff := 0 else
patOff := patternOffset^;
patLen := 0;
for i := 0 to patCnt -1 do
patLen := patLen + pattern[i];
if patOff < 0 then
begin
patOff := patLen + patOff;
while patOff < 0 do
patOff := patOff + patLen;
end
else while patOff > patLen do
patOff := patOff - patLen;
//nb: each dash is made up of 2 or more pts
dashCnt := 0;
dashCapacity := 0;
ptsCnt := 0;
ptsCapacity := 0;
filling := true;
while patOff >= pattern[paIdx] do
begin
filling := not filling;
patOff := patOff - pattern[paIdx];
paIdx := (paIdx + 1) mod patCnt;
end;
residualPat := pattern[paIdx] - patOff;
pt := path2[0];
ExtendDash(pt);
i := 0;
while (i < highI) do
begin
segLen := Distance(pt, path2[i+1]);
if residualPat > segLen then
begin
if filling then ExtendDash(path2[i+1]);
residualPat := residualPat - segLen;
pt := path2[i+1];
inc(i);
end else
begin
pt2.X := pt.X + vecs[i].X * residualPat;
pt2.Y := pt.Y + vecs[i].Y * residualPat;
if filling then ExtendDash(pt2);
filling := not filling;
NewDash;
paIdx := (paIdx + 1) mod patCnt;
residualPat := pattern[paIdx];
pt := pt2;
ExtendDash(pt);
end;
end;
NewDash;
SetLength(Result, dashCnt);
if not assigned(patternOffset) then Exit;
patOff := 0;
for i := 0 to paIdx -1 do
patOff := patOff + pattern[i];
patternOffset^ := patOff + (pattern[paIdx] - residualPat);
end;
//------------------------------------------------------------------------------
function GetDashedOutLine(const path: TPathD;
closed: Boolean; const pattern: TArrayOfDouble;
patternOffset: PDouble; lineWidth: double;
joinStyle: TJoinStyle; endStyle: TEndStyle): TPathsD;
var
i: integer;
tmp: TPathsD;
begin
Result := nil;
for i := 0 to High(pattern) do
if pattern[i] <= 0 then pattern[i] := 1;
tmp := GetDashedPath(path, closed, pattern, patternOffset);
for i := 0 to high(tmp) do
// AppendPath(Result, GrowOpenLine(tmp[i],
// lineWidth, joinStyle, endStyle, 2));
AppendPath(Result, GrowClosedLine(tmp[i], lineWidth, joinStyle, 2));
end;
//------------------------------------------------------------------------------
function GetBoundsD(const paths: TArrayOfPathsD): TRectD;
var
i, len: integer;
rec: TRectD;
begin
len := Length(paths);
i := 0;
while (i < len) do
begin
rec := GetBoundsD(paths[i]);
if not IsEmptyRect(rec) then Break;
inc(i);
end;
if i = len then
begin
Result := NullRectD;
Exit;
end;
Result := rec;
for i := i + 1 to len -1 do
begin
rec := GetBoundsD(paths[i]);
if IsEmptyRect(rec) then Continue;
Result := UnionRect(Result, rec);
end;
end;
//------------------------------------------------------------------------------
function GetBoundsD(const paths: TPathsD): TRectD;
var
i,j: integer;
p: PPointD;
{$IFDEF CPUX64}
l,t,r,b,x,y: double;
{$ENDIF CPUX64}
begin
if paths = nil then
begin
Result := NullRectD;
Exit;
end;
{$IFDEF CPUX64}
l := MaxDouble; t := l;
r := -MaxDouble; b := r;
{$ELSE}
Result.Left := MaxDouble;
Result.Top := MaxDouble;
Result.Right := -MaxDouble;
Result.Bottom := -MaxDouble;
{$ENDIF CPUX64}
for i := 0 to high(paths) do
begin
p := PPointD(paths[i]);
if not assigned(p) then Continue;
for j := 0 to high(paths[i]) do
begin
{$IFDEF CPUX64}
// load p.X and p.Y into xmm registers
x := p.X;
y := p.Y;
if x < l then l := x;
if x > r then r := x;
if y < t then t := y;
if y > b then b := y;
{$ELSE}
// If we must use the FPU and memory then we should write directly
// to the target memory.
if p.x < Result.Left then Result.Left := p.x;
if p.x > Result.Right then Result.Right := p.x;
if p.y < Result.Top then Result.Top := p.y;
if p.y > Result.Bottom then Result.Bottom := p.y;
{$ENDIF CPUX64}
inc(p);
end;
end;
{$IFDEF CPUX64}
if r < l then
Result := NullRectD
else
begin
// Inline the RectD() call by hand
Result.Left := l;
Result.Top := t;
Result.Right := r;
Result.Bottom := b;
end;
{$ELSE}
if Result.Right < Result.Left then
Result := NullRectD;
{$ENDIF CPUX64}
end;
//------------------------------------------------------------------------------
function GetBoundsD(const path: TPathD): TRectD;
var
i,highI: integer;
p: PPointD;
{$IFDEF CPUX64}
l,t,r,b,x,y: double;
{$ENDIF CPUX64}
begin
highI := High(path);
if highI < 0 then
begin
Result := NullRectD;
Exit;
end;
{$IFDEF CPUX64}
l := path[0].X; r := l;
t := path[0].Y; b := t;
p := PPointD(path);
for i := 1 to highI do
begin
inc(p);
// load p.X and p.Y into xmm registers
x := p.X;
y := p.Y;
if x < l then l := x;
if x > r then r := x;
if y < t then t := y;
if y > b then b := y;
end;
// Inline the RectD() call by hand
Result.Left := l;
Result.Top := t;
Result.Right := r;
Result.Bottom := b;
{$ELSE}
// If we must use the FPU and memory then we should write directly
// to the target memory.
{$IFDEF RECORD_METHODS}
Result.TopLeft := path[0]; // uses "rep movsd"
Result.BottomRight := Result.TopLeft;
{$ELSE}
Result.Left := path[0].X; // uses "fld" and "fstp"
Result.Top := path[0].Y;
Result.Right := Result.Left;
Result.Bottom := Result.Right;
{$ENDIF RECORD_METHODS}
p := PPointD(path);
for i := 1 to highI do
begin
inc(p);
if p.x < Result.Left then Result.Left := p.x;
if p.x > Result.Right then Result.Right := p.x;
if p.y < Result.Top then Result.Top := p.y;
if p.y > Result.Bottom then Result.Bottom := p.y;
end;
{$ENDIF CPUX64}
end;
//------------------------------------------------------------------------------
function GetBounds(const path: TPathD): TRect;
var
recD: TRectD;
begin
recD := GetBoundsD(path);
Result := Rect(recD);
end;
//------------------------------------------------------------------------------
function GetBounds(const paths: TPathsD): TRect;
var
recD: TRectD;
begin
recD := GetBoundsD(paths);
Result := Rect(recD);
end;
//------------------------------------------------------------------------------
procedure PrePendPoint(const pt: TPointD; const p: TPathD; var Result: TPathD);
var
len: integer;
begin
len := Length(p);
SetLengthUninit(Result, len +1);
Result[0] := pt;
if len > 0 then Move(p[0], Result[1], len * SizeOf(TPointD));
end;
//------------------------------------------------------------------------------
function PrePendPoint(const pt: TPointD; const p: TPathD): TPathD;
begin
PrePendPoint(pt, p, Result);
end;
//------------------------------------------------------------------------------
function PrePendPoints(const pt1, pt2: TPointD; const p: TPathD): TPathD;
var
len: integer;
begin
len := Length(p);
NewPointDArray(Result, len +2, True);
Result[0] := pt1;
Result[1] := pt2;
if len > 0 then Move(p[0], Result[2], len * SizeOf(TPointD));
end;
//------------------------------------------------------------------------------
function GetPointInQuadBezier(const a,b,c: TPointD; t: double): TPointD;
var
omt: double;
begin
if t > 1 then t := 1
else if t < 0 then t := 0;
omt := 1 - t;
Result.X := a.X*omt*omt + b.X*2*omt*t + c.X*t*t;
Result.Y := a.Y*omt*omt + b.Y*2*omt*t + c.Y*t*t;
end;
//------------------------------------------------------------------------------
function FlattenQBezier(const firstPt: TPointD; const pts: TPathD;
tolerance: double = 0.0): TPathD; overload;
begin
if tolerance <= 0.0 then tolerance := BezierTolerance;
Result := FlattenQBezier(PrePendPoint(firstPt, pts), tolerance);
end;
//------------------------------------------------------------------------------
function FlattenQBezier(const pts: TPathD; tolerance: double = 0.0): TPathD;
var
i, highI: integer;
p: TPathD;
begin
Result := nil;
highI := high(pts);
if highI < 0 then Exit;
if (highI < 2) or Odd(highI) then
raise Exception.CreateRes(@rsInvalidQBezier);
if tolerance <= 0.0 then tolerance := BezierTolerance;
NewPointDArray(Result, 1, True);
Result[0] := pts[0];
for i := 0 to (highI div 2) -1 do
begin
if PointsEqual(pts[i*2], pts[i*2+1]) and
PointsEqual(pts[i*2+1], pts[i*2+2]) then
begin
AppendPoint(Result, pts[i*2]);
AppendPoint(Result, pts[i*2 +2]);
end else
begin
p := FlattenQBezier(pts[i*2], pts[i*2+1], pts[i*2+2], tolerance);
ConcatPaths(Result, Copy(p, 1, Length(p) -1));
end;
end;
end;
//------------------------------------------------------------------------------
function FlattenQBezier(const pt1, pt2, pt3: TPointD;
tolerance: double = 0.0): TPathD;
var
resultCnt, resultLen: integer;
procedure AddPoint(const pt: TPointD);
begin
if resultCnt = resultLen then
begin
inc(resultLen, BuffSize);
SetLengthUninit(result, resultLen);
end;
result[resultCnt] := pt;
inc(resultCnt);
end;
procedure DoCurve(const p1, p2, p3: TPointD);
var
p12, p23, p123: TPointD;
begin
if (abs(p1.x + p3.x - 2 * p2.x) +
abs(p1.y + p3.y - 2 * p2.y) < tolerance) then
begin
AddPoint(p3);
end else
begin
P12.X := (P1.X + P2.X) * 0.5;
P12.Y := (P1.Y + P2.Y) * 0.5;
P23.X := (P2.X + P3.X) * 0.5;
P23.Y := (P2.Y + P3.Y) * 0.5;
P123.X := (P12.X + P23.X) * 0.5;
P123.Y := (P12.Y + P23.Y) * 0.5;
DoCurve(p1, p12, p123);
DoCurve(p123, p23, p3);
end;
end;
begin
resultLen := 0; resultCnt := 0;
if tolerance <= 0.0 then tolerance := BezierTolerance;
AddPoint(pt1);
if ((pt1.X = pt2.X) and (pt1.Y = pt2.Y)) or
((pt2.X = pt3.X) and (pt2.Y = pt3.Y)) then
begin
AddPoint(pt3)
end else
DoCurve(pt1, pt2, pt3);
SetLength(result, resultCnt);
end;
//------------------------------------------------------------------------------
function GetPointInCubicBezier(const a,b,c,d: TPointD; t: double): TPointD;
var
omt: double;
begin
if t > 1 then t := 1
else if t < 0 then t := 0;
omt := 1 - t;
Result.X := a.X*omt*omt*omt +b.X*3*omt*omt*t +c.X*3*omt*t*t +d.X*t*t*t;
Result.Y := a.Y*omt*omt*omt +b.Y*3*omt*omt*t +c.Y*3*omt*t*t +d.Y*t*t*t;
end;
//------------------------------------------------------------------------------
function FlattenCBezier(const firstPt: TPointD; const pts: TPathD;
tolerance: double = 0.0): TPathD; overload;
begin
Result := FlattenCBezier(PrePendPoint(firstPt, pts), tolerance);
end;
//------------------------------------------------------------------------------
function FlattenCBezier(const path: TPathD; tolerance: double = 0.0): TPathD;
var
i, len: integer;
p: TPathD;
begin
Result := nil;
len := Length(path) -1;
if len < 0 then Exit;
if (len < 3) or (len mod 3 <> 0) then
raise Exception.Create(rsInvalidCBezier);
if tolerance <= 0.0 then tolerance := BezierTolerance;
NewPointDArray(Result, 1, True);
Result[0] := path[0];
for i := 0 to (len div 3) -1 do
begin
if PointsEqual(path[i*3], path[i*3+1]) and
PointsEqual(path[i*3+2], path[i*3+3]) then
begin
AppendPoint(Result, path[i*3]);
AppendPoint(Result, path[i*3 +3]);
end else
begin
p := FlattenCBezier(path[i*3], path[i*3+1],
path[i*3+2], path[i*3+3], tolerance);
ConcatPaths(Result, Copy(p, 1, Length(p) -1));
end;
end;
end;
//------------------------------------------------------------------------------
function FlattenCBezier(const paths: TPathsD; tolerance: double): TPathsD;
var
i, len: integer;
begin
len := Length(paths);
SetLength(Result, len);
for i := 0 to len -1 do
Result[i] := FlattenCBezier(paths[i], tolerance);
end;
//------------------------------------------------------------------------------
function FlattenCBezier(const pt1, pt2, pt3, pt4: TPointD;
tolerance: double = 0.0): TPathD;
var
resultCnt, resultLen: integer;
procedure AddPoint(const pt: TPointD);
begin
if resultCnt = resultLen then
begin
inc(resultLen, BuffSize);
SetLengthUninit(result, resultLen);
end;
result[resultCnt] := pt;
inc(resultCnt);
end;
procedure DoCurve(const p1, p2, p3, p4: TPointD);
var
p12, p23, p34, p123, p234, p1234: TPointD;
begin
if ((abs(p1.x +p3.x - 2*p2.x) < tolerance) and
(abs(p2.x +p4.x - 2*p3.x) < tolerance)) and
((abs(p1.y +p3.y - 2*p2.y) < tolerance) and
(abs(p2.y +p4.y - 2*p3.y) < tolerance)) then
begin
AddPoint(p4);
end else
begin
p12.X := (p1.X + p2.X) / 2;
p12.Y := (p1.Y + p2.Y) / 2;
p23.X := (p2.X + p3.X) / 2;
p23.Y := (p2.Y + p3.Y) / 2;
p34.X := (p3.X + p4.X) / 2;
p34.Y := (p3.Y + p4.Y) / 2;
p123.X := (p12.X + p23.X) / 2;
p123.Y := (p12.Y + p23.Y) / 2;
p234.X := (p23.X + p34.X) / 2;
p234.Y := (p23.Y + p34.Y) / 2;
p1234.X := (p123.X + p234.X) / 2;
p1234.Y := (p123.Y + p234.Y) / 2;
DoCurve(p1, p12, p123, p1234);
DoCurve(p1234, p234, p34, p4);
end;
end;
begin
result := nil;
resultLen := 0; resultCnt := 0;
if tolerance <= 0.0 then tolerance := BezierTolerance;
AddPoint(pt1);
if ValueAlmostZero(pt1.X - pt2.X) and ValueAlmostZero(pt1.Y - pt2.Y) and
ValueAlmostZero(pt3.X - pt4.X) and ValueAlmostZero(pt3.Y - pt4.Y) then
begin
AddPoint(pt4)
end else
DoCurve(pt1, pt2, pt3, pt4);
SetLength(result,resultCnt);
end;
//------------------------------------------------------------------------------
function ReflectPoint(const pt, pivot: TPointD): TPointD;
begin
Result.X := pivot.X + (pivot.X - pt.X);
Result.Y := pivot.Y + (pivot.Y - pt.Y);
end;
//------------------------------------------------------------------------------
function FlattenCSpline(const priorCtrlPt, startPt: TPointD;
const pts: TPathD; tolerance: double = 0.0): TPathD;
var
p: TPathD;
len: integer;
begin
len := Length(pts);
NewPointDArray(p, len + 2, True);
p[0] := startPt;
p[1] := ReflectPoint(priorCtrlPt, startPt);
if len > 0 then
Move(pts[0], p[2], len * SizeOf(TPointD));
Result := FlattenCSpline(p, tolerance);
end;
//------------------------------------------------------------------------------
function FlattenCSpline(const pts: TPathD; tolerance: double = 0.0): TPathD;
var
resultCnt, resultLen: integer;
procedure AddPoint(const pt: TPointD);
begin
if resultCnt = resultLen then
begin
inc(resultLen, BuffSize);
SetLengthUninit(result, resultLen);
end;
result[resultCnt] := pt;
inc(resultCnt);
end;
procedure DoCurve(const p1, p2, p3, p4: TPointD);
var
p12, p23, p34, p123, p234, p1234: TPointD;
begin
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
AddPoint(p4);
end else
begin
p12.X := (p1.X + p2.X) / 2;
p12.Y := (p1.Y + p2.Y) / 2;
p23.X := (p2.X + p3.X) / 2;
p23.Y := (p2.Y + p3.Y) / 2;
p34.X := (p3.X + p4.X) / 2;
p34.Y := (p3.Y + p4.Y) / 2;
p123.X := (p12.X + p23.X) / 2;
p123.Y := (p12.Y + p23.Y) / 2;
p234.X := (p23.X + p34.X) / 2;
p234.Y := (p23.Y + p34.Y) / 2;
p1234.X := (p123.X + p234.X) / 2;
p1234.Y := (p123.Y + p234.Y) / 2;
DoCurve(p1, p12, p123, p1234);
DoCurve(p1234, p234, p34, p4);
end;
end;
var
i, len: integer;
p: PPointD;
pt1,pt2,pt3,pt4: TPointD;
begin
result := nil;
len := Length(pts); resultLen := 0; resultCnt := 0;
if (len < 4) then Exit;
if tolerance <= 0.0 then tolerance := BezierTolerance;
//ignore incomplete trailing control points
if Odd(len) then dec(len);
p := @pts[0];
AddPoint(p^);
pt1 := p^; inc(p);
pt2 := p^; inc(p);
for i := 0 to (len shr 1) - 2 do
begin
pt3 := p^; inc(p);
pt4 := p^; inc(p);
DoCurve(pt1, pt2, pt3, pt4);
pt1 := pt4;
pt2 := ReflectPoint(pt3, pt1);
end;
SetLength(result,resultCnt);
end;
//------------------------------------------------------------------------------
function FlattenQSpline(const priorCtrlPt, startPt: TPointD;
const pts: TPathD; tolerance: double = 0.0): TPathD;
var
p: TPathD;
len: integer;
begin
len := Length(pts);
NewPointDArray(p, len + 2, True);
p[0] := startPt;
p[1] := ReflectPoint(priorCtrlPt, startPt);
if len > 0 then
Move(pts[0], p[2], len * SizeOf(TPointD));
Result := FlattenQSpline(p, tolerance);
end;
//------------------------------------------------------------------------------
function FlattenQSpline(const pts: TPathD; tolerance: double = 0.0): TPathD;
var
resultCnt, resultLen: integer;
procedure AddPoint(const pt: TPointD);
begin
if resultCnt = resultLen then
begin
inc(resultLen, BuffSize);
SetLengthUninit(result, resultLen);
end;
result[resultCnt] := pt;
inc(resultCnt);
end;
procedure DoCurve(const p1, p2, p3: TPointD);
var
p12, p23, p123: TPointD;
begin
if (abs(p1.x + p3.x - 2 * p2.x) +
abs(p1.y + p3.y - 2 * p2.y) < tolerance) then
begin
AddPoint(p3);
end else
begin
P12.X := (P1.X + P2.X) * 0.5;
P12.Y := (P1.Y + P2.Y) * 0.5;
P23.X := (P2.X + P3.X) * 0.5;
P23.Y := (P2.Y + P3.Y) * 0.5;
P123.X := (P12.X + P23.X) * 0.5;
P123.Y := (P12.Y + P23.Y) * 0.5;
DoCurve(p1, p12, p123);
DoCurve(p123, p23, p3);
end;
end;
var
i, len: integer;
p: PPointD;
pt1, pt2, pt3: TPointD;
begin
result := nil;
len := Length(pts);
if (len < 3) then Exit;
resultLen := 0;
resultCnt := 0;
if tolerance <= 0.0 then tolerance := BezierTolerance;
p := @pts[0];
AddPoint(p^);
pt1 := p^; inc(p);
pt2 := p^; inc(p);
for i := 0 to len - 3 do
begin
pt3 := p^; inc(p);
DoCurve(pt1, pt2, pt3);
pt1 := pt3;
pt2 := ReflectPoint(pt2, pt1);
end;
SetLength(result,resultCnt);
end;
//------------------------------------------------------------------------------
function MakePath(const pts: array of double): TPathD;
var
i, len: Integer;
x,y: double;
begin
Result := nil;
len := length(pts) div 2;
if len = 0 then Exit;
NewPointDArray(Result, len, True);
Result[0].X := pts[0];
Result[0].Y := pts[1];
for i := 1 to len -1 do
begin
x := pts[i*2];
y := pts[i*2 +1];
Result[i].X := x;
Result[i].Y := y;
end;
end;
//------------------------------------------------------------------------------
function MakePath(const pt: TPointD): TPathD;
begin
SetLengthUninit(Result, 1);
Result[0] := pt;
end;
//------------------------------------------------------------------------------
end.
Reference in a new issue View git blame Copy permalink