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.07 09:56 "Re: LibTiffDelphi problem with WriteEncodedStrip Newbee", by Joris Van Damme
Thorsten,
Thorsten Hagelstein wrote:
> i want to save images as compressed Tiff. For displaying Images I
> use the example posted in this list (ReadTiffIntoBitmap) and it
> really works fine. I read the Faqs, but I can't figure out, how to
> write compressed Tiff. For example, I want to save an Image as
> LZW-compressed Tiff. How can I realize that with
> Delphi/LibTiffDelphi. It may be very easy to make it, but I'm
> really new in this Tiff-things.
I don't pretend the following to be a universal solution, but it may be
a suitable starting point.
procedure WriteBitmapToTiff(Bitmap: TBitmap; Filename: String);
var
OpenTiff: PTIFF;
RowsPerStrip: Longword;
StripMemory: Pointer;
StripIndex: Longword;
StripRowOffset: Longword;
StripRowCount: Longword;
ma,mb: PByte;
nx,ny: Longword;
begin
if (Bitmap.PixelFormat<>pf24bit) and
(Bitmap.PixelFormat<>pf32bit) then
raise Exception.Create('WriteBitmapToTiff is designed for 24bit and
32bit bitmaps only');
RowsPerStrip:=((256*1024) div (Bitmap.Width*3));
if RowsPerStrip>Bitmap.Height then
RowsPerStrip:=Bitmap.Height
else if RowsPerStrip=0 then
RowsPerStrip:=1;
StripMemory:=GetMemory(RowsPerStrip*Bitmap.Width*3);
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_RGB);
TIFFSetField(OpenTiff,TIFFTAG_SAMPLESPERPIXEL,3);
TIFFSetField(OpenTiff,TIFFTAG_BITSPERSAMPLE,8);
TIFFSetField(OpenTiff,TIFFTAG_PLANARCONFIG,PLANARCONFIG_CONTIG);
TIFFSetField(OpenTiff,TIFFTAG_COMPRESSION,COMPRESSION_LZW);
TIFFSetField(OpenTiff,TIFFTAG_PREDICTOR,2);
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;
if Bitmap.PixelFormat=pf24bit then
begin
mb:=StripMemory;
for ny:=StripRowOffset to StripRowOffset+StripRowCount-1 do
begin
ma:=Bitmap.ScanLine[ny];
for nx:=0 to Bitmap.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;
end
else
begin
mb:=StripMemory;
for ny:=StripRowOffset to StripRowOffset+StripRowCount-1 do
begin
ma:=Bitmap.ScanLine[ny];
for nx:=0 to Bitmap.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,4);
end;
end;
end;
if TIFFWriteEncodedStrip(OpenTiff,StripIndex,
StripMemory,StripRowCount*Bitmap.Width*3)=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;
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