TWICImage: change tiff compression to WICTiffCompressionCCITT3?

[ioan 45]

I'm want to change the compression for a tiff file and I can't find any way to do it. I searched all the code samples from Microsoft, everything I found in Delphi, but no luck.

 

I don't have much to show, everything I tried failed. Here is my code, any idea how to do this?

 

procedure ChangeTiffCompression(tiffFilename: string; tiffNewFileName: string);
var
  Source : TWICImage;
  Factory: IWICImagingFactory;
  Encoder: IWICBitmapEncoder;
begin
  Source:= TWICImage.Create;
  try
    Source.LoadFromFile(tiffFilename);
    Factory := TWICImage.ImagingFactory;
    Factory.CreateEncoder(CLSID_WICTiffEncoder, guid_null, Encoder);
    // black magic here....
    // and set compression to WICTiffCompressionCCITT3
    // ?????
    Source.Handle := IWICBitmap(Encoder);
    Source.SaveToFile(tiffNewFileName);
    Encoder := nil;
    Factory := nil;
  finally
    Source.Free;
  end;
end;

 

Edited October 2, 2020 by ioan

[ioan 45]

I advanced a little with this puzzle, but still the compression method is not changed in the new created tiff. I used this example from Windows documentation:

https://docs.microsoft.com/en-us/windows/win32/wic/-wic-creating-encoder?redirectedfrom=MSDN#tiff-encoding-example

 

Also, I used as a starting point the procedure TWICImage.SaveToStream(Stream: TStream); from unit Vcl.Graphics;

 

The procedure bellow creates a new tiff, but the compression method is the same as the old tiff.  Any idea how to do this right?

 

uses
  avconst,
  activex, varutils, wincodec, consts;

const
  FAX_WIDTH = 1728;
  FAX_HEIGHT = 2150;

procedure ChangeTiffCompression(tiffFilename: string; tiffNewFileName: string);
var
  Encoder: IWICBitmapEncoder;
  Frame: IWICBitmapFrameEncode;
  Props: IPropertyBag2;
  LStreamAdapter: IStream;
  PixelFormat: TGUID;
  LStream: IWICStream;
  Palette: IWICPalette;
  Data: TMemoryStream;
  ImagingFactory: IWICImagingFactory;
  WicBitmap: TWICImage;
  Options: TPropBag2;
  varValue: TPropVariant;
begin
    Data := TMemoryStream.Create;
    WicBitmap := TWICImage.Create;
    try
      WicBitmap.LoadFromFile(tiffFilename);
      LStreamAdapter := TStreamAdapter.Create(Data);

      ImagingFactory := TWICImage.ImagingFactory;
      ImagingFactory.CreateStream(LStream);
      LStream.InitializeFromIStream(LStreamAdapter);
      ImagingFactory.CreateEncoder(GUID_ContainerFormatTiff, guid_null, Encoder);

      Encoder.Initialize(LStream, WICBitmapEncoderNoCache);
      Encoder.CreateNewFrame(Frame, Props);
      
      FillChar(Options, SizeOf(Options), 0);
      Options.pstrName :=  POleStr('TiffCompressionMethod');
      varValue.vt := VT_UI1;
      varValue.bVal := WICTiffCompressionCCITT3;
      Props.Write(1, @Options, @varValue);

      Frame.Initialize(Props);

      WicBitmap.Handle.GetPixelFormat(PixelFormat);
      Frame.SetPixelFormat(PixelFormat);

      Frame.SetSize(FAX_WIDTH, FAX_HEIGHT);

      ImagingFactory.CreatePalette(Palette);
      WicBitmap.Handle.CopyPalette(Palette);
      Frame.SetPalette(Palette);
      Frame.WriteSource(WicBitmap.Handle, nil);
      Frame.Commit;
      Encoder.Commit;
      WicBitmap.SaveToFile(tiffNewFileName);
      Encoder := nil;
      ImagingFactory := nil;
    finally
      Data.Free;
      WicBitmap.Free;
    end;
end;

 

Edited October 2, 2020 by ioan

[ioan 45]

Well, I found the problem... I had to save to file the stream Data, not the original WicImage. Also, I had to keep the width/height as the original:

 

uses
  avconst,
  activex, varutils, wincodec, consts;

procedure ChangeTiffCompression(tiffFilename: string; tiffNewFileName: string);
var
  Encoder: IWICBitmapEncoder;
  Frame: IWICBitmapFrameEncode;
  Props: IPropertyBag2;
  LStreamAdapter: IStream;
  PixelFormat: TGUID;
  LStream: IWICStream;
  Palette: IWICPalette;
  Data: TMemoryStream;
  ImagingFactory: IWICImagingFactory;
  WicImage: TWICImage;
  Options: TPropBag2;
  varValue: TPropVariant;
  hr: HRESULT;
begin
    Data := TMemoryStream.Create;
    WicImage := TWICImage.Create;
    try
      WicImage.LoadFromFile(tiffFilename);

      Data.Clear;
      LStreamAdapter := TStreamAdapter.Create(Data);

      ImagingFactory := TWICImage.ImagingFactory;
      ImagingFactory.CreateStream(LStream);
      LStream.InitializeFromIStream(LStreamAdapter);
      ImagingFactory.CreateEncoder(WicImage.EncoderContainerFormat, guid_null, Encoder);

      Encoder.Initialize(LStream, WICBitmapEncoderNoCache);
      Encoder.CreateNewFrame(Frame, Props);
      FillChar(Options, SizeOf(Options), 0);
      Options.pstrName :=  POleStr('TiffCompressionMethod');
      varValue.vt := VT_UI1;
      varValue.bVal := WICTiffCompressionCCITT3;
      hr := Props.Write(1, @Options, @varValue);
      if not SUCCEEDED(hr) then
        raise Exception.Create('Error Props.Write');

      hr := Frame.Initialize(Props);
      if not SUCCEEDED(hr) then
        raise Exception.Create('Error Frame.Initialize');

      WicImage.Handle.GetPixelFormat(PixelFormat);
      Frame.SetPixelFormat(PixelFormat);

      Frame.SetSize(WicImage.Width, WicImage.Height);

      ImagingFactory.CreatePalette(Palette);
      WicImage.Handle.CopyPalette(Palette);
      Frame.SetPalette(Palette);
      Frame.WriteSource(WicImage.Handle, nil);
      Frame.Commit;
      Encoder.Commit;

      Data.Position := 0;
      Data.SaveToFile(tiffNewFileName);
    finally
      Encoder := nil;
      ImagingFactory := nil;
      Data.Free;
      WicImage.Free;
    end;
end;

 

Edited October 2, 2020 by ioan