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

* Fix epsilon, add TRectF.FitInto

Browse Source
This commit is contained in:
Michaël Van Canneyt 2023-07-09 14:39:18 +02:00
parent a6d3587432
commit b48c67f49f
1 changed files with 26 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
rtl/objpas/types.pp
View File

@ -33,7 +33,7 @@ const
RT_RCDATA = WinTypes.RT_RCDATA deprecated 'Use WinTypes.RT_RCDATA instead';
{$endif}
Type
Const
Epsilon: Single = 1E-40;
Epsilon2: Single = 1E-30;
@ -246,7 +246,8 @@ type
procedure Inflate(DX, DY: Single);
procedure Inflate(DL, DT, DR, DB: Single);
function CenterPoint: TPointF;
function FitInto(const Dest: TRectF; out Ratio: Single): TRectF; overload;
function FitInto(const Dest: TRectF): TRectF; overload;
procedure Union (const r: TRectF); inline;
procedure Offset (const dx,dy : Single); inline;
procedure Offset (DP: TPointF); inline;
@ -1101,6 +1102,29 @@ begin
Result.Y := (Bottom-Top) / 2 + Top;
end;
function TRectF.FitInto(const Dest: TRectF; out Ratio: Single): TRectF;
begin
if (Dest.Width<=0) or (Dest.Height<=0) then
begin
Ratio:=1.0;
exit(Self);
end;
Ratio:=Max(Self.Width / Dest.Width, Self.Height / Dest.Height);
if Ratio=0 then
exit(Self);
Result.Width:=Self.Width / Ratio;
Result.Height:=Self.Height / Ratio;
Result.Left:=Self.Left + (Self.Width - Result.Width) / 2;
Result.Top:=Self.Top + (Self.Height - Result.Height) / 2;
end;
function TRectF.FitInto(const Dest: TRectF): TRectF;
var
Ratio: Single;
begin
Result:=FitInto(Dest,Ratio);
end;
function TRectF.Contains(Pt: TPointF): Boolean;
begin
Result := (Left <= Pt.X) and (Pt.X < Right) and (Top <= Pt.Y) and (Pt.Y < Bottom);