AWARE [SYSTEMS] Imaging expertise for the Delphi developer
AWare Systems, Imaging expertise for the Delphi developer, Home TIFF and LibTiff Mailing List Archive

LibTiff Mailing List

TIFF and LibTiff Mailing List Archive
September 2007

Previous Thread
Next Thread

Previous by Thread
Next by Thread

Previous by Date
Next by Date

Contact

The TIFF Mailing List Homepage
This list is run by Frank Warmerdam
Archive maintained by AWare Systems



Valid HTML 4.01!



2007.09.05 20:58 "Tiff with multiple pages CCITT G3(1D), Black & White from Bitmap.. How?", by <hix2500@gmail.com>

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;