I would like to know how to resize images in delphi. I will receive images in both JPG, JPEG, GIF and PNG, so I have to resize it to a Timage, but I can not do that, because I get an online URL and I see it in TIMAGE, that works, I just do not know how to resize images in these formats.
jpegimg.LoadFromStream(MS);
Rect.Top := 10;
Rect.Left := 10;
Rect.Bottom := 50;
Rect.Right := 50;
Logo.Canvas.StretchDraw(Rect,jpegimg);
Logo.Picture.Assign(jpegimg);
In this way I was able to size it. ATT
procedure TForm1.Button2Click(Sender: TObject);
var
bmp: TBitmap;
jpg: TJPEGImage;
scale: Double;
widthL, HeightL, pt1, pt2, pt3, pt4: integer;
verdd : boolean;
begin
if OpenDialog1.Execute then
begin
try
jpg := TJPEGImage.Create;
verdd := false;
try
//Dimensões
widthL := 98;
HeightL := 98;
jpg.LoadFromFile(OpenDialog1.FileName);
if (jpg.Height >= jpg.Width) AND (HeightL <= jpg.Height) then begin
scale := widthL / jpg.Height;
end else if (jpg.Height <= jpg.Width) AND (widthL <= jpg.Width) then begin
scale := HeightL / jpg.Width;
end else begin
verdd := true;
end;
bmp := TBitmap.Create;
try
{Create thumbnail bitmap, keep pictures aspect ratio}
bmp.SetSize( widthL,HeightL);
if not verdd then begin
pt1 := (widthL - Round(jpg.Width * scale)) div 2;
pt2 := (HeightL - Round(jpg.Height * scale)) div 2;
pt3 := Round(jpg.Width * scale) + pt1;
pt4 := Round(jpg.Height * scale) + pt2;
bmp.Canvas.StretchDraw(Rect(pt1, pt2, pt3, pt4), jpg);
end else begin
pt1 := (widthL - jpg.Width) div 2;
pt2 := (HeightL - jpg.Height) div 2;
pt3 := jpg.Width + pt1;
pt4 := jpg.Height + pt2;
bmp.Canvas.StretchDraw(Rect(pt1, pt2, pt3, pt4), jpg);
end;
Logo.Picture.Assign(bmp);
{Convert back to JPEG and save to file}
jpg.Assign(bmp);
jpg.SaveToFile(ChangeFileExt(OpenDialog1.FileName, '_thumb.JPG'));
finally
bmp.free;
end;
finally
jpg.free;
end;
except
showMessage('Erro ao carregar imagem'); ///////////////////////////////////
end;
end;
end;
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!