Как создать jpg без потерь с помощью WIC в Delphi

Question

У меня есть следующий код, работающий для создания файла jpg из IWICBitmapSource с параметрами по умолчанию:

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;

Я хотел бы изменить параметры кодека для создания JPG без потерь. Как я понял, что я прочитал в MSDN, я должен использовать IPropertyBag2 для достижения этой цели. Несмотря на то, что я понятия не имел, как это сделать, я попытался вставить этот код между созданием Frame и инициализацией Frame:

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;

Это не сработало: hr = 0x88982F8E (WINCODEC_ERR_PROPERTYUNEXPECTEDTYPE). Здесь MSDN говорит, что тип свойства "ImageQuality" - VT_R4, но, поскольку я никогда раньше не использовал вариант, я не уверен, как это написать. И я даже не уверен, что сжатие действительно будет без потерь.

Как я могу изменить свой код, чтобы он получал качество 1,0 JPG, и будет ли он без потерь?

Answer 1

У меня нет такого опыта, но вот мои лучшие предложения, основанные на прочтении документации, на которую вы ссылались.

Прежде всего, я думаю, что вам нужно указать больше членов PropBagOptions:

• dwType должен быть установлен в PROPBAG2_TYPE_DATA,
• vt должен быть установлен в VT_R4,

Вы также должны убедиться, что вариант действительно VT_R4, Это 4-байтовое число, в терминах Delphi вариант типа varSingle,

V := VarAsType(1.0, varSingle);

Я думаю, что это должно быть сделано.

Собрав все это вместе, это выглядит так:

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);

---

Относительно того, является ли качество JPEG 1.0 без потерь, это не так. Этот вопрос уже хорошо освещен здесь: JPEG без потерь, когда качество установлено на 100?