TWICImage，如何设置jpeg压缩质量？

我使用 Delphi XE 和 TWICImage 类进行图像处理。 我想知道是否有办法使用 TWICImage 设置 jpeg 压缩质量？

procedure TfrmMain.Button2Click(Sender: TObject);
var
  wic: TWICImage;
begin
  wic := TWICImage.Create;
  try
    wic.LoadFromFile('sample-BMP.bmp');
    wic.ImageFormat := wifJpeg;
    // ... before saving I want to set low compression quality
    wic.SaveToFile('sample-JPG.jpg');
  finally
    wic.Free;
  end;
end;

WIC 的 VCL 包装器有一定的限制。它不为您提供任何指定图像质量的方法。我将对代码中完全没有错误检查的情况视而不见。呃！

我认为您将需要使用原始 COM API 来编写自己的代码。它可能看起来像这样：

uses
  System.SysUtils,
  System.Variants,
  System.Win.ComObj,
  Winapi.Windows,
  Winapi.Wincodec,
  Winapi.ActiveX,
  Vcl.Graphics;

procedure SaveBitmapAsJpeg(Bitmap: TBitmap; ImageQuality: Single; FileName: string);
const
  PROPBAG2_TYPE_DATA = 1;
var
  ImagingFactory: IWICImagingFactory;
  Width, Height: Integer;
  Stream: IWICStream;
  Encoder: IWICBitmapEncoder;
  Frame: IWICBitmapFrameEncode;
  PropBag: IPropertyBag2;
  PropBagOptions: TPropBag2;
  V: Variant;
  PixelFormat: TGUID;
  Buffer: TBytes;
  BitmapInfo: TBitmapInfo;
  hBmp: HBITMAP;
  WICBitmap: IWICBitmap;
  Rect: WICRect;
begin
  Width := Bitmap.Width;
  Height := Bitmap.Height;

  OleCheck(
    CoCreateInstance(CLSID_WICImagingFactory, nil, CLSCTX_INPROC_SERVER 
      or CLSCTX_LOCAL_SERVER, IUnknown, ImagingFactory)
  );

  OleCheck(ImagingFactory.CreateStream(Stream));
  OleCheck(Stream.InitializeFromFilename(PChar(FileName), GENERIC_WRITE));
  OleCheck(ImagingFactory.CreateEncoder(GUID_ContainerFormatJpeg, GUID_NULL, Encoder));
  OleCheck(Encoder.Initialize(Stream, WICBitmapEncoderNoCache));
  OleCheck(Encoder.CreateNewFrame(Frame, PropBag));

  PropBagOptions := Default(TPropBag2);
  PropBagOptions.pstrName := 'ImageQuality';
  PropBagOptions.dwType := PROPBAG2_TYPE_DATA;
  PropBagOptions.vt := VT_R4;
  V := VarAsType(ImageQuality, varSingle);
  OleCheck(PropBag.Write(1, @PropBagOptions, @V));
  OleCheck(Frame.Initialize(PropBag));
  OleCheck(Frame.SetSize(Width, Height));
  if Bitmap.AlphaFormat=afDefined then begin
    PixelFormat := GUID_WICPixelFormat32bppBGRA
  end else begin
    PixelFormat := GUID_WICPixelFormat32bppBGR;
  end;
  Bitmap.PixelFormat := pf32bit;
  SetLength(Buffer, 4*Width*Height);
  BitmapInfo := Default(TBitmapInfo);
  BitmapInfo.bmiHeader.biSize := SizeOf(BitmapInfo);
  BitmapInfo.bmiHeader.biWidth := Width;
  BitmapInfo.bmiHeader.biHeight := -Height;
  BitmapInfo.bmiHeader.biPlanes := 1;
  BitmapInfo.bmiHeader.biBitCount := 32;
  hBmp := Bitmap.Handle;
  GetDIBits(Bitmap.Canvas.Handle, hBmp, 0, Height, @Buffer[0], BitmapInfo, 
    DIB_RGB_COLORS);
  OleCheck(ImagingFactory.CreateBitmapFromMemory(Width, Height, PixelFormat, 
    4*Width, Length(Buffer), @Buffer[0], WICBitmap));
  Rect.X := 0;
  Rect.Y := 0;
  Rect.Width := Width;
  Rect.Height := Height;
  OleCheck(Frame.WriteSource(WICBitmap, @Rect));
  OleCheck(Frame.Commit);
  OleCheck(Encoder.Commit);
end;

传递 0 到 1 之间的图像质量值，0 表示最低质量（最高压缩），1 表示最高质量（最低压缩）。

我广泛使用了这里的问题和答案：如何在 Delphi 中使用 WIC 创建无损 jpg

我还大量借用了 VCL 源代码来创建IWICBitmap。如果您想继续使用TWICBitmap你可以这样做并使用它Handle财产以获得IWICBitmap。这会产生这样的代码：

uses
  System.Variants,
  System.Win.ComObj,
  Winapi.Windows,
  Winapi.Wincodec,
  Winapi.ActiveX,
  Vcl.Graphics;

procedure SaveWICImageAsJpeg(WICImage: TWICImage; ImageQuality: Single; 
  FileName: string);
const
  PROPBAG2_TYPE_DATA = 1;
var
  ImagingFactory: IWICImagingFactory;
  Width, Height: Integer;
  Stream: IWICStream;
  Encoder: IWICBitmapEncoder;
  Frame: IWICBitmapFrameEncode;
  PropBag: IPropertyBag2;
  PropBagOptions: TPropBag2;
  V: Variant;
  PixelFormat: TGUID;
  Rect: WICRect;
begin
  Width := WICImage.Width;
  Height := WICImage.Height;
  ImagingFactory := WICImage.ImagingFactory;
  OleCheck(ImagingFactory.CreateStream(Stream));
  OleCheck(Stream.InitializeFromFilename(PChar(FileName), GENERIC_WRITE));
  OleCheck(ImagingFactory.CreateEncoder(GUID_ContainerFormatJpeg, GUID_NULL, Encoder));
  OleCheck(Encoder.Initialize(Stream, WICBitmapEncoderNoCache));
  OleCheck(Encoder.CreateNewFrame(Frame, PropBag));
  PropBagOptions := Default(TPropBag2);
  PropBagOptions.pstrName := 'ImageQuality';
  PropBagOptions.dwType := PROPBAG2_TYPE_DATA;
  PropBagOptions.vt := VT_R4;
  V := VarAsType(ImageQuality, varSingle);
  OleCheck(PropBag.Write(1, @PropBagOptions, @V));
  OleCheck(Frame.Initialize(PropBag));
  OleCheck(Frame.SetSize(Width, Height));
  Rect.X := 0;
  Rect.Y := 0;
  Rect.Width := Width;
  Rect.Height := Height;
  OleCheck(Frame.WriteSource(WICImage.Handle, @Rect));
  OleCheck(Frame.Commit);
  OleCheck(Encoder.Commit);
end;