How to resize image

Asked

Viewed 4,623 times

1

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);
  • I think this may give you a direction: http://stackoverflow.com/questions/1976116/scale--image-nicely-in-delphi

  • You need to resize the image just to display it, or to save ?

  • @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

  • 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!

  • @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

  • 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.

Show 1 more comment

2 answers

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!

-1


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;

Browser other questions tagged

You are not signed in. Login or sign up in order to post.