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
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



Valid HTML 4.01!



Thread

2006.04.06 19:40 "LibTiffDelphi problem with WriteEncodedStrip Newbee", by Thorsten Hagelstein
2006.04.07 09:56 "Re: LibTiffDelphi problem with WriteEncodedStrip Newbee", by Joris Van Damme
2006.04.11 16:43 "Re: LibTiffDelphi problem with WriteEncodedStrip Newbee", by Thorsten Hagelstein
2006.04.11 22:07 "Re: LibTiffDelphi problem with WriteEncodedStrip Newbee", by Joris Van Damme
2006.04.13 15:02 "Re: LibTiffDelphi problem with WriteEncodedStrip Newbee", by Thorsten Hagelstein
2006.04.13 19:53 "Re: LibTiffDelphi problem with WriteEncodedStrip Newbee", by Bernie Pallek
2006.04.14 17:02 "Re: LibTiffDelphi problem with WriteEncodedStrip Newbee", by Joris Van Damme
2006.04.15 10:46 "Re: LibTiffDelphi problem with WriteEncodedStrip Newbee", by Joris Van Damme
2006.04.18 09:22 "Re: LibTiffDelphi problem with WriteEncodedStrip Newbee", by Thorsten Hagelstein

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