I created this function based on others I found on the internet. I ran tests with several functions of this type, and that was the fastest I found.
Note: The WMax and HMax parameters are used to maintain the aspect ratio of the image.
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;
Hope you can help! Good luck!