2005.02.28 11:51 "[Tiff] Delphi TIFF visualization", by José María Núñez Ortuño

2005.02.28 12:41 "Re: [Tiff] Delphi TIFF visualization", by Joris Van Damme

José,

I wonder if anyone can provide me snippet of Delphi to simply visualize a TIFF image in a Timage control using LibTiffDelphi.

Sure. The easiest way is to use the LibTiff RGBA interface to read the TIFF into a TBitmap, and next assign that TBitmap to the TImage.Picture property.

It's easy this way, but there is a price to pay. The big dissadvantage of this method is that the RGBA interface always returns 32bits RGBA, which we'll transfer to a pf32bit TBitmap next. This means that a huge singlebit black and white image will be read as a 24*huge full color TBitmap. Bad practice, especially if you plan to work with big images, but then again, for big images a single DIB chunck is no good anyway, and when has to start somewhere.

First thing you have to know is that TIFFReadRGBAImage returns 32bit RGBA in exactly that order, R-G-B-A, that is. A Windows DIB and thus a Delphi TBitmap stores things in the slightly different order B-G-R-A. So here's example code for a swopping procedure that will do this conversion.

procedure TIFFReadRGBAImageSwapRB(Width,Height: Cardinal; Memory: Pointer);
{$IFDEF DELPHI_5}
type
  PCardinal = ^Cardinal;
{$ENDIF}
var
  m: PCardinal;
  n: Cardinal;
  o: Cardinal;
begin
  m:=Memory;
  for n:=0 to Width*Height-1 do
  begin
    o:=m^;
    m^:= (o and $FF00FF00) or                {G and A}
        ((o and $00FF0000) shr 16) or        {B}
        ((o and $000000FF) shl 16);          {R}
    Inc(m);
  end;
end;

Strangely, TIFFReadRGBAImage returns the same default scanline order as is used in a Windows DIB and thus Delphi TBitmap, bottom-up that is. So there's no need for scanline swopping. Here's example code for creating a suitable TBitmap and reading a TIFF image into it.

function ReadTiffIntoBitmap(Filename: String): TBitmap;
var
  OpenTiff: PTIFF;
  FirstPageWidth,FirstPageHeight: Cardinal;
  FirstPageBitmap: TBitmap;
begin
  OpenTiff:=TIFFOpen(Filename,'r');
  TIFFGetField(OpenTiff,TIFFTAG_IMAGEWIDTH,@FirstPageWidth);
  TIFFGetField(OpenTiff,TIFFTAG_IMAGELENGTH,@FirstPageHeight);
  FirstPageBitmap:=TBitmap.Create;
  FirstPageBitmap.PixelFormat:=pf32bit;
  FirstPageBitmap.Width:=FirstPageWidth;
  FirstPageBitmap.Height:=FirstPageHeight;
  TIFFReadRGBAImage(OpenTiff,FirstPageWidth,FirstPageHeight,
               FirstPageBitmap.Scanline[FirstPageHeight-1],0);
  TIFFClose(OpenTiff);
  TIFFReadRGBAImageSwapRB(FirstPageWidth,FirstPageheight,
               FirstPageBitmap.Scanline[FirstPageHeight-1]);
  Result:=FirstPageBitmap;
end;

There's no error handling in the above procedure, for clearity. If you value prefer code that is ready for copy-and-paste over clear understanding, here's a version with error handling in the normal Delphi exception raising way. (I don't usually use that system, if anyone sees a way to improve the code below I'll gladly stand corrected.)

function ReadTiffIntoBitmap(Filename: String): TBitmap;
var
  OpenTiff: PTIFF;
  FirstPageWidth,FirstPageHeight: Cardinal;
  FirstPageBitmap: TBitmap;
begin
  OpenTiff:=TIFFOpen(Filename,'r');
  if OpenTiff=nil then raise Exception.Create(
           'Unable to open file '''+Filename+'''');
  TIFFGetField(OpenTiff,TIFFTAG_IMAGEWIDTH,@FirstPageWidth);
  TIFFGetField(OpenTiff,TIFFTAG_IMAGELENGTH,@FirstPageHeight);
  FirstPageBitmap:=nil;
  try
    FirstPageBitmap:=TBitmap.Create;
    FirstPageBitmap.PixelFormat:=pf32bit;
    FirstPageBitmap.Width:=FirstPageWidth;
    FirstPageBitmap.Height:=FirstPageHeight;
  except
    if FirstPageBitmap<>nil then FirstPageBitmap.Destroy;
    TIFFClose(OpenTiff);
    raise Exception.Create('Unable to create TBitmap buffer');
  end;
  TIFFReadRGBAImage(OpenTiff,FirstPageWidth,FirstPageHeight,
               FirstPageBitmap.Scanline[FirstPageHeight-1],0);
  TIFFClose(OpenTiff);
  TIFFReadRGBAImageSwapRB(FirstPageWidth,FirstPageheight,
               FirstPageBitmap.Scanline[FirstPageHeight-1]);
  Result:=FirstPageBitmap;
end;

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