2007.09.05 20:58 "[Tiff] Tiff with multiple pages CCITT G3(1D), Black & White from Bitmap.. How?", by Horváth László

Hello!

I have to write tiffs with multiple pages in the next format: CCITT G3(1D),
Black & White

But i wasn't able to produce this. Whith the code below, i was able to
render multipage, 24bit/pixel colored images, with LZW compression.

I have used this example: http://www.asmail.be/msg0054998186.html. It works
fine, but i wasn't able to modify it, to produce the format i mentioned
above.

All my tries were ended in dizzy or black pictures. I have tried either with
1bit/pixel and 24bit/pixel input.

So what should i change in this code? Wich input format should i use?

I will appreciate it if anyone can help me.

Thanks.

procedure TMainForm.WriteBitmapToTiff(B: Array of TBitmap; Filename:
String);

var

  OpenTiff        : PTIFF;

  RowsPerStrip    : Longword;

  StripMemory     : Pointer;

  StripIndex      : Longword;

  StripRowOffset  : Longword;

  StripRowCount   : Longword;

  ma,mb           : PByte;

  nx,ny           : Longword;

  i               : integer;

  Pages           : integer;

begin

  OpenTiff := TIFFOpen(PAnsiChar(Filename), 'w');

  if OpenTiff = nil then

    begin

FreeMemory(StripMemory);

raise Exception.Create('Unable to create file ''' + Filename + '''');

    end;

  Pages := Length(B);

  for i := 0 to Pages - 1 do

    begin

      RowsPerStrip := ((256 * 1024) div (B[i].Width * 3));

      if RowsPerStrip > B[i].Height then

        RowsPerStrip := B[i].Height

      else if RowsPerStrip = 0 then

        RowsPerStrip := 1;

      StripMemory := GetMemory(RowsPerStrip * B[i].Width * 3);

TIFFSetField(OpenTiff, TIFFTAG_IMAGEWIDTH, B[i].Width);

TIFFSetField(OpenTiff, TIFFTAG_IMAGELENGTH, B[i].Height);

TIFFSetField(OpenTiff, TIFFTAG_ROWSPERSTRIP, RowsPerStrip);

TIFFSetField(OpenTiff, TIFFTAG_PHOTOMETRIC, PHOTOMETRIC_RGB);

TIFFSetField(OpenTiff, TIFFTAG_SAMPLESPERPIXEL, 3);

TIFFSetField(OpenTiff, TIFFTAG_BITSPERSAMPLE, 8);

      TIFFSetField(OpenTiff, TIFFTAG_COMPRESSION,   COMPRESSION_LZW);

TIFFSetField(OpenTiff, TIFFTAG_PLANARCONFIG, PLANARCONFIG_CONTIG);

TIFFSetField(OpenTiff, TIFFTAG_PREDICTOR, 2);

TIFFSetField(OpenTiff, TIFFTAG_SUBFILETYPE, FILETYPE_PAGE);

TIFFSetField(OpenTiff, TIFFTAG_PAGENUMBER, i, Pages);

      StripIndex := 0;

      StripRowOffset := 0;

      while StripRowOffset < B[i].Height do

        begin

          StripRowCount := RowsPerStrip;

          if StripRowCount > B[i].Height-StripRowOffset then

            StripRowCount := B[i].Height-StripRowOffset;

            mb := StripMemory;

            for ny := StripRowOffset to StripRowOffset + StripRowCount - 1

do

              begin

                ma := B[i].ScanLine[ny];

                for nx := 0 to B[i].Width - 1 do

                  begin

                    mb^ := PByte(Cardinal(ma) + 2)^;

                    Inc(mb);

                    mb^ := PByte(Cardinal(ma) + 1)^;

                    Inc(mb);

                    mb^ := PByte(Cardinal(ma) + 0)^;

                    Inc(mb);

                    Inc(ma, 3);

                  end;

              end;

          if TIFFWriteEncodedStrip(OpenTiff, StripIndex, StripMemory,
StripRowCount * B[i].Width * 3) = 0 then

            begin

              TIFFClose(OpenTiff);

              FreeMemory(StripMemory);

              raise Exception.Create('Failed to write ''' + Filename +
'''');

            end;

          Inc(StripIndex);

          Inc(StripRowOffset, StripRowCount);

        end;

TIFFWriteDirectory(OpenTiff);

      FreeMem(StripMemory);

    end;

  TIFFClose(OpenTiff);

end;