I created this function based on others I found on the internet. I did tests with several functions of this type, and this was the fastest I found.
Note: Wmax and Hmax parameters are used to maintain image ratio.
procedure ResizeBmp(Dest: TBitmap; const WMax, HMax: Word);
type
pRGBArray = ^TRGBArray;
TRGBArray = array[Word] of TRGBTriple;
var
TBmp: TBitmap;
DstGap: Integer;
WNew, HNew: Integer;
X, Y, T3: Integer;
Z1, Z2, IZ2: Integer;
W1, W2, W3, W4: Integer;
XP, XP2, YP, YP2: Integer;
SrcLine1, SrcLine2, DstLine: pRGBArray;
Begin
TBmp := TBitmap.Create;
try
try
WNew := (Dest.Width * HMax) div Dest.Height;
HNew := (WMax * Dest.Height) div Dest.Width;
if (WMax < WNew) then
begin
TBmp.Width := WMax;
TBmp.Height := HNew;
end else
begin
TBmp.Width := WNew;
TBmp.Height := HMax;
end;
Dest.PixelFormat := pf24Bit;
TBmp.PixelFormat := pf24bit;
DstLine := TBmp.ScanLine[0];
DstGap := Integer(TBmp.ScanLine[1]) - Integer(DstLine);
XP2 := MulDiv(Pred(Dest.Width), $10000, TBmp.Width);
YP2 := MulDiv(Pred(Dest.Height), $10000, TBmp.Height);
YP := 0;
for Y := 0 to Pred(TBmp.Height) do
begin
XP := 0;
SrcLine1 := Dest.ScanLine[YP shr 16];
if (YP shr 16 < Pred(Dest.Height))
then SrcLine2 := Dest.ScanLine[Succ(YP shr 16)]
else SrcLine2 := Dest.ScanLine[YP shr 16];
Z2 := Succ(YP and $FFFF);
IZ2 := Succ((not YP) and $FFFF);
for X := 0 to Pred(TBmp.Width) do
begin
T3 := XP shr 16;
Z1 := XP and $FFFF;
W2 := MulDiv(Z1, IZ2, $10000);
W1 := IZ2 - W2;
W4 := MulDiv(Z1, Z2, $10000);
W3 := Z2 - W4;
DstLine[X].rgbtRed := (SrcLine1[T3].rgbtRed * W1 + SrcLine1[T3 + 1].rgbtRed * W2 + SrcLine2[T3].rgbtRed * W3 + SrcLine2[T3 + 1].rgbtRed * W4) shr 16;
DstLine[X].rgbtGreen := (SrcLine1[T3].rgbtGreen * W1 + SrcLine1[T3 + 1].rgbtGreen * W2 + SrcLine2[T3].rgbtGreen * W3 + SrcLine2[T3 + 1].rgbtGreen * W4) shr 16;
DstLine[X].rgbtBlue := (SrcLine1[T3].rgbtBlue * W1 + SrcLine1[T3 + 1].rgbtBlue * W2 + SrcLine2[T3].rgbtBlue * W3 + SrcLine2[T3 + 1].rgbtBlue * W4) shr 16;
Inc(XP, XP2);
end;
Inc(YP, YP2);
DstLine := pRGBArray(Integer(DstLine) + DstGap);
end;
Dest.Assign(TBmp);
except
end;
finally
TBmp.Free;
end;
end;
I hope it helps you! Good luck!
I think this may give you a direction: http://stackoverflow.com/questions/1976116/scale--image-nicely-in-delphi
– cantoni
You need to resize the image just to display it, or to save ?
– Guybrush
@Paruba I managed to do, in my case I showed and saved her. It was a matter of using the RECT, saved in JPG and gave it right... ATT
– abcd
Ok, I have a function here to resize quickly and without losing too much quality, but it only works for the bitmap format. That is, after resizing, you would need to change to the desired format (Jpg, etc.). If you want I send you. Good luck!
– Guybrush
@Paruba If you wish, it will be a good one for those who visit the topic, and maybe I take some ideas of its function. ATT
– abcd
Just a reminder. Maybe you can use the Timage Stretch property with the True value. In that case it would not be necessary to resize the image, the component itself does so dynamically, for display effect.
– Ricardo Alves Carvalho