Return-Path: <tiff-bounces@lists.maptools.org>
Received: from inas025.isp.belgacom.be (localhost [127.0.0.1])
        by inav015.isp.belgacom.be (8.12.11.20060308/8.12.11/Skynet-IN-AV-3.00) with ESMTP id k3FArMeg013421
        for <joris.at.lebbeke@skynet.be>; Sat, 15 Apr 2006 12:53:22 +0200
        (envelope-from <tiff-bounces@lists.maptools.org>)
Received: from inmx008.isp.belgacom.be (inmx008.isp.belgacom.be [195.238.5.88])
        by inas025.isp.belgacom.be (8.12.11.20060308/8.12.11/Skynet-IN-AS-2.03) with ESMTP id k3FArG9i019370
        for <joris.at.lebbeke@skynet.be>; Sat, 15 Apr 2006 12:53:16 +0200
        (envelope-from <tiff-bounces@lists.maptools.org>)
Received: from duke.maptools.org (r153.dmsolutions.ca [209.217.116.153] (may be forged))
        by inmx008.isp.belgacom.be (8.12.11.20060308/8.12.11/Skynet-IN-2.32) with ESMTP id k3FArBBv014315
        for <joris.at.lebbeke@skynet.be>; Sat, 15 Apr 2006 12:53:11 +0200
        (envelope-from <tiff-bounces@lists.maptools.org>)
Received: from duke.maptools.org (duke.maptools.org [127.0.0.1])
	by duke.maptools.org (8.12.11/8.12.10) with ESMTP id k3FAkQHa005367;
	Sat, 15 Apr 2006 06:47:11 -0400
Received: from outmx026.isp.belgacom.be (outmx026.isp.belgacom.be
	[195.238.4.91])
	by duke.maptools.org (8.12.11/8.12.10) with ESMTP id k3FAkLUf005364
	for <tiff@lists.maptools.org>; Sat, 15 Apr 2006 06:46:21 -0400
Received: from outmx026.isp.belgacom.be (localhost [127.0.0.1])
	by outmx026.isp.belgacom.be (8.12.11.20060308/8.12.11/Skynet-OUT-2.22)
	with ESMTP id k3FAkDBT012992
	for <tiff@lists.maptools.org>; Sat, 15 Apr 2006 12:46:13 +0200
	(envelope-from <joris.at.lebbeke@skynet.be>)
Received: from dfgrrxsknr4e (175-193.244.81.adsl.skynet.be [81.244.193.175])
	by outmx026.isp.belgacom.be (8.12.11.20060308/8.12.11/Skynet-OUT-2.22)
	with SMTP id k3FAk7Kn012898; Sat, 15 Apr 2006 12:46:08 +0200
	(envelope-from <joris.at.lebbeke@skynet.be>)
Message-ID: <001101c66079$d3934070$afc1f451@dfgrrxsknr4e>
From: "Joris" <joris.at.lebbeke@skynet.be>
To: "Thorsten Hagelstein" <T.Hagelstein@gmx.de>,
        "TIFF mailing list" <tiff@lists.maptools.org>
References: <000c01c65f0b$59eb9c50$0301a8c0@thtoolznb>
	<003501c65fe5$3287fc00$5694f651@dfgrrxsknr4e>
Subject: Re: [Tiff] LibTiffDelphi problem with WriteEncodedStrip Newbee 
Date: Sat, 15 Apr 2006 12:46:04 +0200
MIME-Version: 1.0
Content-Type: text/plain;
	charset="iso-8859-1"
Content-Transfer-Encoding: 7bit
X-Priority: 3
X-MSMail-Priority: Normal
X-Mailer: Microsoft Outlook Express 6.00.2800.1807
X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2800.1807
Cc: 
X-BeenThere: tiff@lists.maptools.org
X-Mailman-Version: 2.1.4
Precedence: list
List-Id: TIFF and libtiff discussion <tiff.lists.maptools.org>
List-Unsubscribe: <http://lists.maptools.org/mailman/listinfo/tiff>,
	<mailto:tiff-request@lists.maptools.org?subject=unsubscribe>
List-Archive: <http://lists.maptools.org/mailman/private/tiff>
List-Post: <mailto:tiff@lists.maptools.org>
List-Help: <mailto:tiff-request@lists.maptools.org?subject=help>
List-Subscribe: <http://lists.maptools.org/mailman/listinfo/tiff>,
	<mailto:tiff-request@lists.maptools.org?subject=subscribe>
Sender: tiff-bounces@lists.maptools.org
Errors-To: tiff-bounces@lists.maptools.org
X-UIDL: 000000000023ceae.000015c1
X-MSP-STORE: Sat, 15 Apr 2006 12:53:28 +0200
Status:   

Thorsten,

Joris wrote:
> Try again. If it still doesn't work, mail me your zipped bitmap and
> relevant code, and I'll take a look.

I've received your code and testfile, made sure I used the distributed
version of LibTiffDelphi, and... Sure enough, I can reproduce your
problem.

Apparently, you need to set the planar config tag, even though
SamplesPerPixel equals 1. I can only assume this is no longer a
requirement in my own LibTiffDelphi, and I thus didn't see the problem.
It is a bit silly requirement anyway, probably it got removed at some
later time.

As after inserting the line...

  TIFFSetField(OpenTiff,TIFFTAG_PLANARCONFIG,PLANARCONFIG_CONTIG);

...before the setting of TIFFTAG_COMPRESSION, all is fine.

Since you had a problem, I was intriged by the fact that the proposed
procedure didn't raise an exception. It was designed to do that, as is
usual in Delphi code. The reason is, I got confused about error return
value of TIFFWriteEncodedStrip (again!), and tested against 0 instead
of -1.

One more thing I noticed in your own code, is that you write with G3
compression, instead of G4. There should be no advantage to G3 over G4,
except for better error recovery in some situations that only possibly
arise after corruption. But it's not as efficient. So I'd recommend you
use G4 instead.

With these corrections in place, the code for writing a pf1bit Delphi
TBitmap to a G4 compressed TIFF should be looking like this:

procedure WriteBitmapToTiff(Bitmap: TBitmap; Filename: String);
var
  OpenTiff: PTIFF;
  RowSize: Longword;
  RowsPerStrip: Longword;
  StripMemory: Pointer;
  StripIndex: Longword;
  StripRowOffset: Longword;
  StripRowCount: Longword;
  mb: PByte;
  ny: Longword;
begin
  if (Bitmap.PixelFormat<>pf1bit) then
    raise Exception.Create('WriteBitmapToTiff is designed for singlebit
                    bitmaps only');
  RowSize:=((Bitmap.Width+7) div 8);
  RowsPerStrip:=((256*1024) div RowSize);
  if RowsPerStrip>Bitmap.Height then
    RowsPerStrip:=Bitmap.Height
  else if RowsPerStrip=0 then
    RowsPerStrip:=1;
  StripMemory:=GetMemory(RowsPerStrip*RowSize);
  OpenTiff:=TIFFOpen(PAnsiChar(Filename),'w');
  if OpenTiff=nil then
  begin
    FreeMemory(StripMemory);
    raise Exception.Create('Unable to create file '''+Filename+'''');
  end;
  TIFFSetField(OpenTiff,TIFFTAG_IMAGEWIDTH,Bitmap.Width);
  TIFFSetField(OpenTiff,TIFFTAG_IMAGELENGTH,Bitmap.Height);
  TIFFSetField(OpenTiff,TIFFTAG_PHOTOMETRIC,PHOTOMETRIC_MINISWHITE);
  TIFFSetField(OpenTiff,TIFFTAG_SAMPLESPERPIXEL,1);
  TIFFSetField(OpenTiff,TIFFTAG_BITSPERSAMPLE,1);

  TIFFSetField(OpenTiff,TIFFTAG_PLANARCONFIG,PLANARCONFIG_CONTIG);
  TIFFSetField(OpenTiff,TIFFTAG_COMPRESSION,COMPRESSION_CCITTFAX4);
  TIFFSetField(OpenTiff,TIFFTAG_ROWSPERSTRIP,RowsPerStrip);
  StripIndex:=0;
  StripRowOffset:=0;
  while StripRowOffset<Bitmap.Height do
  begin
    StripRowCount:=RowsPerStrip;
    if StripRowCount>Bitmap.Height-StripRowOffset then
      StripRowCount:=Bitmap.Height-StripRowOffset;
    mb:=StripMemory;
    for ny:=StripRowOffset to StripRowOffset+StripRowCount-1 do
    begin
      CopyMemory(mb,Bitmap.ScanLine[ny],RowSize);
      Inc(mb,RowSize);
    end;
    if TIFFWriteEncodedStrip(OpenTiff,StripIndex,
        StripMemory,StripRowCount*RowSize)=-1 then
    begin
      TIFFClose(OpenTiff);
      FreeMemory(StripMemory);
      raise Exception.Create('Failed to write '''+Filename+'''');
    end;
    Inc(StripIndex);
    Inc(StripRowOffset,StripRowCount);
  end;
  TIFFClose(OpenTiff);
  FreeMem(StripMemory);
end;


Best regards,

Joris Van Damme
info@awaresystems.be
http://www.awaresystems.be/
Download your free TIFF tag viewer for windows here:
http://www.awaresystems.be/imaging/tiff/astifftagviewer.html

_______________________________________________
Tiff mailing list: Tiff@lists.maptools.org
http://lists.maptools.org/mailman/listinfo/tiff
http://www.remotesensing.org/libtiff/
