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

* Patch from Eric Grange to correct TRectF.FitInto

Browse Source
This commit is contained in:
Michaël Van Canneyt 2025-04-07 14:38:04 +02:00
parent 4b04608a44
commit cbbba25198
1 changed files with 25 additions and 8 deletions

33
rtl/objpas/types.pp
View File

@ -1690,20 +1690,37 @@ begin
end;
function TRectF.FitInto(const Dest: TRectF; out Ratio: Single): TRectF;
var
dw, dh, w, h : Single;
begin
if (Dest.Width<=0) or (Dest.Height<=0) then
dw := Dest.Width;
dh := Dest.Height;
if (dw <= 0) or (dh <= 0) then
begin
Ratio:=1.0;
Ratio := 1.0;
exit(Self);
end;
Ratio:=Max(Self.Width / Dest.Width, Self.Height / Dest.Height);
if Ratio=0 then
w := Self.Width;
h := Self.Height;
if w * dh > h * dw then
Ratio := w / dw
else
Ratio := h / dh;
if Ratio = 0 then
exit(Self);
Result.Width:=Self.Width / Ratio;
Result.Height:=Self.Height / Ratio;
w := w / Ratio;
h := h / Ratio;
// Center the result within the Dest rectangle
Result.Left:=Dest.Left + (Dest.Width - Result.Width) / 2;
Result.Top:=Dest.Top + (Dest.Height - Result.Height) / 2;
Result.Left := (Dest.Left + Dest.Right - w) * 0.5;
Result.Right := Result.Left + w;
Result.Top := (Dest.Top + Dest.Bottom - h) * 0.5;
Result.Bottom := Result.Top + h;
end;
function TRectF.FitInto(const Dest: TRectF): TRectF;