paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 11:48:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Add TCubicBezierCurve for Delphi compatibility

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-07-05 08:59:16 +02:00
parent 6c656a39a4
commit 7f94fb2a65
1 changed files with 79 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
packages/rtl-objpas/src/inc/system.math.vectors.pp
View File

@ -51,6 +51,20 @@ type
TCubicBezier = array [0..3] of TPointF;
TCubicBezierCurve = record
private
StartPoint: TPointF;
EndPoint: TPointF;
A : Array[1..3] of TPointF;
public
procedure Init(const aA, aB, aC, aD: TPointF);
function CurveLength(aSegments: Integer = 6): Single;
function GetPoint(aIndex, aTotal: Integer): TPointF; overload;
function GetPoint(T: Single): TPointF; overload;
end;
tagVECTOR = record
case Integer of
0: (V: TVectorArray;);
@ -362,6 +376,71 @@ begin
WriteStr(Result,D:7:4);
end;
{ ---------------------------------------------------------------------
TVector
---------------------------------------------------------------------}
procedure TCubicBezierCurve.Init(const aA, aB, aC, aD: TPointF);
begin
StartPoint:=aA;
EndPoint:=aD;
// B(t)=(1-t)^3 * P0 + 3*(1-t)^2 * t * P1 + 3*(1-t)*t^2*P2 + t^3 * P3
// = P0 + 3 (P1-P0)*T + 3 * (P0 -2*P1 + P2) * T^2 + (-P0 + 3*P1 - 3*P2 + P3) * T^3
// = StartPoint + A[1]'*T + A[2]'*T^2 + A[3]*T^3
A[1].X:=(aB.X-aA.X)*3;
A[1].Y:=(aB.Y-aA.Y)*3;
A[2].X:=3*(aA.X - 2 * aB.X + aC.X);
A[2].Y:=3*(aA.Y - 2 * aB.Y + aC.Y);
A[3].X:=-aA.X + aD.X- A[1].X-A[2].X;
A[3].Y:=-aA.Y + aD.Y- A[1].Y-A[2].Y;
end;
function TCubicBezierCurve.GetPoint(aIndex, aTotal: Integer): TPointF;
begin
if aIndex=0 then
Result:=StartPoint
else if aIndex=(aTotal-1) then
Result:=EndPoint
else
Result:=GetPoint(aIndex/(aTotal-1));
end;
function TCubicBezierCurve.GetPoint(T: Single): TPointF;
var
X,Y,T2,T3: Single;
begin
T2:=T*T;
T3:=T*T2;
X:=StartPoint.X+(A[3].X*T3)+(A[2].X*T2)+(A[1].X*T);
Y:=StartPoint.Y+(A[3].Y*T3)+(A[2].Y*T2)+(A[1].Y*T);
Result.X:=X;
Result.Y:=Y;
end;
function TCubicBezierCurve.CurveLength(aSegments: Integer = 6): Single;
var
T, Delta : Single;
I: Integer;
PCurr,PLast: TPointF;
begin
Result:=0;
T:=0;
Delta:=1/aSegments;
PLast:=StartPoint;
for I := 1 to aSegments - 1 do
begin
T:=T+Delta;
PCurr:=GetPoint(T);
Result:=Result+(PCurr-PLast).Length;
PLast:=PCurr;
end;
Result:=Result+(EndPoint-PLast).Length;
end;
{ ---------------------------------------------------------------------
TVector
---------------------------------------------------------------------}