无需外部库即可很好地缩放图像

Question

我正在使用 Delphi 10.4.2，我正在尝试找到一种缩放图像的方法，保持图像质量 和 不请求外部库.

这是我试过的，你可以在{$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;

如您所见，我在第二次测试中使用了 GraphUtil.ScaleImage 但输出是一张空图像，所以我不确定我是否正确使用了它，不幸的是我还没有找到任何这样的例子方法..

Answer 1

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;

Answer 2

简单一点

procedure ResizeBitmap(const Bitmap: TBitmap; const NewWidth, NewHeight: integer);
Var vImage,v2: TWICImage;
begin
  vImage := TWICImage.Create;
  try
    vImage.Assign(Bitmap);
    v2 := vImage.CreateScaledCopy(NewWidth, NewHeight, wipmHighQualityCubic);
    Bitmap.Assign(v2);
  finally
    v2.Free;
    vImage.Free;
  end;
end;

无需外部库即可很好地缩放图像

Nicely scale image withour external libraries

delphi

image-scaling

delphi-10.4-sydney

delphi-10.4.2