1

我正在使用 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但输出是一个空图像，所以我不确定我是否正确使用它，不幸的是我还没有找到这种方法的任何示例..

4

2 回答 2

5 
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;
于 2021-09-15T13:36:21.290 回答
0

简单一点

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;
于 2022-01-30T07:34:27.437 回答