LibTiff Mailing List
TIFF and LibTiff Mailing List Archive
April 2006
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
Thread
2006.04.11 22:07 "Re: LibTiffDelphi problem with WriteEncodedStrip Newbee", by Joris Van Damme
Thorsten,
Please keep all mail that can be of public interest inside the mailing
list. This can be a good thread, useful to many.
Thorsten Hagelstein wrote:
> thank you very much for the code you posted. It really worked fine.
> Now I tried to understand the code to alter it, because I want to use
> more kinds of compression. As I understood, to use TIFF-Compression
> CCITT3 or 4 I need for example Bitmaps with PixelFormat=pf1bit. I
> tried to alter the code you posted like this:
>
> TIFFSetField(OpenTiff,TIFFTAG_SAMPLESPERPIXEL,1);
> TIFFSetField(OpenTiff,TIFFTAG_BITSPERSAMPLE,1);
> TIFFSetField(OpenTiff,TIFFTAG_COMPRESSION,COMPRESSION_CCITTFAX3);
>
> And disabled the code for making sure that it is pf24bit or pf32bit.
>
> But it doesn't work so far. I think I forgot something. Or is it just
> because I understood your code false? Can you please explain me? I'm
> really new at this TIFF-things... *confused*
The altered parts you show, seem fine.
My guess is you didn't change the next few parts, and the strip memory
building parts still assume pf24bit or pf32bit bitmap. Is that correct?
A complete adoption to save a pf1bit Bitmap to a G4 compressed TIFF, may
look somewhat 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_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)=0 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;
This is untested, edited directly in mail client. If it seems to works,
but black and white seem to be swapped in the TIFF file, try
PHOTOMETRIC_MINISBLACK instead of PHOTOMETRIC_MINISWHITE.
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