How to resize image

Question

I would like to know how to resize images in Delhi. I will receive images both in JPG, JPEG, GIF (ANIMATED) and PNG, then I have to resize to a Timage, but I’m not able to do it, because I take a URL online and display it in TIMAGE, it already works, I just don’t know how to resize the 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);

Answer 1

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!

Answer 2

So I was able to scale 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;