function ScaleRect(var dst: TRect; ref: TRect): Boolean; overload;
var
dw, dh, rw, rh: Integer;
xyscale: Double;
begin
dw := dst.Right - dst.Left;
dh := dst.Bottom - dst.Top;
rw := ref.Right - ref.Left;
rh := ref.Bottom - ref.Top;
Result := (dw > 0) and (dh > 0);
if Result then
begin
xyscale := dw / dh;
if dw > dh then
begin
dw := rw;
dh := Trunc(rw / xyscale);
if dh > rh then
begin
dh := rh;
dw := Trunc(rh * xyscale);
end;
end
else
begin
dh := rh;
dw := Trunc(rh * xyscale);
if dw > rw then
begin
dw := rw;
dh := Trunc(rw / xyscale);
end;
end;
end;
with dst do
begin
Left := ref.Left;
Top := ref.Top;
Right := Left + dw;
Bottom := Top + dh;
end;
OffsetRect(dst, (rw - dw) div 2, (rh - dh) div 2)
end;
function ScaleRect(var rc: TRect; p: TPoint; n: Integer): Boolean; overload;
var
xyscale, xscale, yscale: Double;
w, h, l, t, r, b: Integer;
begin
Result := n <> 0;
if not Result then Exit;
with rc do
begin
if Top = Bottom then xyscale := 0
else xyscale := (Right - Left) / (Bottom - Top);
if p.x = Right then xscale := MaxInt
else xscale := (p.x - Left) / (Right - p.x);
if p.y = Bottom then yscale := MaxInt
else yscale := (p.y - Top) / (Bottom - p.y);
end;
if xyscale < 0 then xyscale := -xyscale;
if xscale < 0 then xscale := 1;
if yscale < 0 then yscale := 1;
if xyscale = 0 then
begin
w := 0; h := 0;
with rc do
begin
if Right - Left = 0 then
h := n * 2;
if Bottom - Top = 0 then
w := n * 2;
end;
end
else
begin
if xyscale < 1 then
begin
w := n * 2;
h := Trunc(w / xyscale);
end
else
begin
h := n * 2;
w := Trunc(h * xyscale);
end;
end;
l := Trunc(xscale / (xscale + 1) * w);
t := Trunc(yscale / (yscale + 1) * h);
r := Trunc(w - l);
b := Trunc(h - t);
with rc do
begin
Result := (Left - l <= Right + r) and (Top - t <= Bottom + b);
if Result then
begin
Left := Left - l;
Top := Top - t;
Right := Right + r;
Bottom := Bottom + b;
end;
end;
end;
function ScaleBitmap(DstBitmap: TBitmap; var RefRect: TRect): Boolean;
var
DstRect: TRect;
tmpBitmap: TBitMap;
begin
DstRect := DstBitmap.Canvas.ClipRect;
Result := ScaleRect(DstRect, RefRect);
if not Result then Exit;
tmpBitmap := TBitMap.Create;
try
tmpBitmap.Width := RefRect.Right - RefRect.Left;
tmpBitmap.Height := RefRect.Bottom - RefRect.Top;
tmpBitmap.Canvas.StretchDraw(DstRect, DstBitmap);
DstBitmap.Assign(tmpBitmap);
finally
tmpBitmap.Free;
end;
end;