How to create a lossless jpg using WIC in Delphi

Question

I have the following code working to create a jpg file out of a IWICBitmapSource with defaults options:

function SaveWICBitmapToJpgFile(WICFactory: IWICImagingFactory;
  WICBitmap: IWICBitmapSource; SrcRect: TRect; FileName: string): HRESULT;
var
  hr: HRESULT;
  Encoder: IWICBitmapEncoder;
  Frame: IWICBitmapFrameEncode;
  PropBag: IPropertyBag2;
  S: IWICStream;
  PixelFormatGUID: WICPixelFormatGUID;
  R: WICRect;
begin

  hr := WICFactory.CreateStream(S);

  if Succeeded(hr) then begin
    hr := S.InitializeFromFilename(PChar(FileName), GENERIC_WRITE);
  end;

  if Succeeded(hr) then begin
    hr := WICFactory.CreateEncoder(GUID_ContainerFormatJpeg, GUID_NULL,
      Encoder);
  end;

  if Succeeded(hr) then begin
    hr := Encoder.Initialize(S, WICBitmapEncoderNoCache);
  end;

  if Succeeded(hr) then begin
    hr := Encoder.CreateNewFrame(Frame, PropBag);
  end;

  if Succeeded(hr) then begin
    hr := Frame.Initialize(PropBag);
  end;

  if Succeeded(hr) then begin
    hr := Frame.SetSize(SrcRect.Width, SrcRect.Height);
  end;

  if Succeeded(hr) then begin
    PixelFormatGUID := GUID_WICPixelFormat24bppBGR;
    hr := Frame.SetPixelFormat(PixelFormatGUID);
  end;

  if Succeeded(hr) then begin
    hr := IfThen(PixelFormatGUID = GUID_WICPixelFormat24bppBGR, S_OK, E_FAIL);
  end;

  if Succeeded(hr) then begin
    R.X := SrcRect.Left;
    R.Y := SrcRect.Top;
    R.Width := SrcRect.Width;
    R.Height := SrcRect.Height;
    Frame.WriteSource(WICBitmap, @R);
  end;

  if Succeeded(hr) then begin
    hr := Frame.Commit;
  end;

  if Succeeded(hr) then begin
    hr := Encoder.Commit;
  end;

  Result := hr;

end;

I would like to change the codec options to produce a lossless jpg. As I understood what I read in MSDN, I have to use IPropertyBag2 to achieve this. Despite not having a clue on how to do it, I tried inserting this code between the Frame creation and the Frame initialization:

var
[...]
  PropBagOptions: TPropBag2;
  V: Variant;
[...]

if Succeeded(hr) then begin
  FillChar(PropBagOptions, SizeOf(PropBagOptions), 0);
  PropBagOptions.pstrName := 'ImageQuality';
  V := 1.0;
  hr := PropBag.Write(1, @PropBagOptions, @V);
end;

It did not work: hr = 0x88982F8E (WINCODEC_ERR_PROPERTYUNEXPECTEDTYPE). MSDN says here that the type of the "ImageQuality" property is VT_R4, but as I never used a Variant before, I am not sure how to write that. And I am not even sure that the compression will indeed be lossless.

How could I modify my code to make it produce a quality 1.0 jpg, and will it be lossless?

score 3 · Accepted Answer · edited May 23 '17 at 12:09

I've no experience of this, but here's my best suggestions based on reading the documentation that you have linked to.

First of all, I think you need to specify more of the members of PropBagOptions:

dwType needs to be set to PROPBAG2_TYPE_DATA.
vt needs to be set to VT_R4.

You also need to make sure that the variant really is VT_R4. That's a 4 byte real, in Delphi terms a variant of type varSingle.

V := VarAsType(1.0, varSingle);

I think that should get it done.

Putting it all together, it looks like this:

FillChar(PropBagOptions, SizeOf(PropBagOptions), 0);
PropBagOptions.pstrName := 'ImageQuality';
PropBagOptions.dwType := PROPBAG2_TYPE_DATA;
PropBagOptions.vt := VT_R4;
V := VarAsType(1.0, varSingle);
hr := PropBag.Write(1, @PropBagOptions, @V);

As regards whether or not JPEG quality 1.0 is lossless, it is not. That's a question already well covered here: Is JPEG lossless when quality is set to 100?

It is working. Thanks a lot! I did not even realize that I had to specify the type in both the PropBagOptions and the variant :| I had to declare PROPBAG2_TYPE_DATA though, as I could not find it in the official source. Did I miss it? — Papaya, Jan 29 '13 at 15:16

How to create a lossless jpg using WIC in Delphi

1 Answers1

Linked