I'm using Delphi 10.4.2 and I'm trying to find a way to scale images that mantains the image quality and doesn't request external libraries.

This is what I tried, you can find the two tests in {$REGION}:

procedure TFrmTestGenImg.Test;
var
  LOldWidth, LOldHeight, LNewWidth, LNewHeight: integer;
  LImageNameIn, LImageNameOut, LExt: string;
  LClass: TGraphicClass;
  LImageIn, LImageOut: TGraphic;
  LBitmap, LResized: TBitmap;
begin
  // Original image: 1366 x 768
  LOldWidth := 1366;
  LOldHeight := 768;
  LNewWidth := 800;
  LNewHeight := 449;

  LImageNameIn := 'C:\temp\Input.png';
  LImageNameOut := 'C:\temp\Output_'   FormatDateTime('yyyy.mm.dd hh.nn.ss.zzz', Now)   '.png';

  LExt := TPath.GetExtension(LImageNameIn);
  Delete(LExt, 1, 1);
  if (CompareText(LExt, 'bmp') = 0) then
    LClass := TBitmap
  else if (CompareText(LExt, 'gif') = 0) then
    LClass := TGIFImage
  else
    LClass := TWICImage;

  LImageIn := LClass.Create;
  try
    LImageOut := LClass.Create;
    try
      LImageIn.Transparent := True;
      LImageIn.LoadFromFile(Trim(LImageNameIn));

      LBitmap := TBitmap.Create;
      try
        LBitmap.PixelFormat := pf24bit;
        LBitmap.Assign(LImageIn);

        {$REGION '1st test'}
        LBitmap.Canvas.StretchDraw(
          Rect(0, 0, LNewWidth, LNewHeight),
          LImageIn);                             // -> poor quality
        LBitmap.SetSize(LNewWidth, LNewHeight);
        LImageOut.Assign(LBitmap);
        {$ENDREGION}

        {$REGION '2nd test'}
        LResized := TBitmap.Create;
        try
          LResized.Assign(LBitmap);
          LResized.Width := LNewWidth;
          LResized.Height := LNewHeight;

          GraphUtil.ScaleImage(LBitmap, LResized, (LNewWidth/LOldWidth));  // -> empty image
          LResized.SetSize(LNewWidth, LNewHeight);

          LImageOut.Assign(LResized);
        finally
          LResized.Free;
        end;
        {$ENDREGION}

        if LImageIn is TWICImage then
        begin
          if (CompareText(LExt, 'jpg') = 0) or (CompareText(LExt, 'jpeg') = 0) then
            TWICImage(LImageOut).ImageFormat := wifJpeg
          else
            TWICImage(LImageOut).ImageFormat := TWICImage(LImageIn).ImageFormat;
        end;
        LImageOut.SaveToFile(LImageNameOut);
      finally
        LBitmap.Free;
      end;
    finally
      LImageOut.Free;
    end;
  finally
    LImageIn.Free;
  end;
end;

As you can see, for the second test I used GraphUtil.ScaleImage but the output is an empty image, so I'm not sure I used it correctly, unfortunately I haven't found any example of this method..

CodePudding user response：

procedure ResizeBitmap(const Bitmap: TBitmap; const NewWidth, NewHeight: integer);
var
  Factory: IWICImagingFactory;
  Scaler: IWICBitmapScaler;
  Source : TWICImage;
begin
    Source := TWICImage.Create;
    try
        Factory := TWICImage.ImagingFactory;
        Source.Assign(Bitmap);
        Factory.CreateBitmapScaler(Scaler);
        Scaler.Initialize(Source.Handle, NewWidth, NewHeight, WICBitmapInterpolationModeHighQualityCubic);
        Source.Handle := IWICBitmap(Scaler);
        Bitmap.Assign(Source);
        Scaler := nil;
        Factory := nil;
    finally
        Source.Free;
    end;
end;