TWICImage, how to set jpeg compression quality?

Question

I'm using Delphi XE and TWICImage class for image processing. I would like to know if any way to set jpeg compression quality with TWICImage?

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;

Answer 1

The VCL wrapper of WIC is somewhat limited. It doesn't offer you any means to specify the image quality. And I'm going to turn a blind eye to the total absence of error checking in that code. Ergh!

I think you are going to need to roll your own code, using the raw COM API. It might look something like this:

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;

Pass an image quality value between 0 and 1, with 0 being the lowest quality (highest compression) and 1 being the highest quality (lowest compression).

I have made extensive use of both the question and answer found here: How to create a lossless jpg using WIC in Delphi

I have also borrowed liberally from the VCL source for the code to create the IWICBitmap. If you wished to continue to use TWICBitmap you could do so and use its Handle property to obtain the IWICBitmap. That would yield code like this:

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;