| AWARE [SYSTEMS] | Imaging expertise for the Delphi developer | |||||||
![]() |
TIFF and LibTiff Mailing List Archive | |||||||
LibTiff Mailing List
TIFF and LibTiff Mailing List Archive Contact
The TIFF Mailing List Homepage |
Thread2004.12.13 11:38 "Re: TIFF Pyramid", by Joris Van Damme> Look at the contrib/addtiffo directory. addtiffo output organized a bit
> differently from Photoshop, but it works with major geospatial image
> processing packages. You can easily modify this utility to get results
> you want.
It doesn't write SubIFDs, does it?
I've tested what I found out about writing the SubIFDs tag, and it works as I
expected. You can write a chain of IFDs the normal way, and whenever you write a
value n to the SubIFDs tag, the next n directories you write are appended as a
SubIFD chain instead of being appended in the normal main IFD chain.
The code below is my test code. It's Pascal, of course, using LibTiffDelphi, and
it uses the Delphi VCL TBitmap object which is essentially a Windows DIB
wrapper, and thus needs some RGB swopping and such, but it's still short and
easy to understand and should illustrate the point. There's no error
checking/handling and such though.
It loads a bitmap image, and next writes a chain of first that image, an image
resampled to half that width and height, an image resampled to half previous
width and height, etc. In the first image IFD, the SubIFDs tag is set with value
3, and that yields a file with one main (biggest) image and 3 downsample
SubIFDs. If I change the value 3 of the SubIFDs tag to e.g. 2, it works as
expected, one main image is written, 2 SubIFDs are linked to that main image,
and the last is again written as a top-level IFD.
The images are written tiled. Tile size is fixed 128*128, even though in my test
the last image was smaller. That all works like a charm.
var
m: PTIFF;
n: Integer;
oa,ob: TBitmap;
px,py: Integer;
pt: Integer;
q: Pointer;
qa,qb: PByte;
qx,qy: Integer;
rr,rg,rb: Integer;
begin
GetMem(q,128*128*3);
m:=TIFFOpen('C:\TilePyramid.tif','w');
if m=nil then exit;
for n:=0 to 3 do
begin
if n=0 then
begin
oa:=TBitmap.Create;
oa.LoadFromFile('C:\ImageForTilePyramid.bmp');
end
else
begin
ob:=TBitmap.Create;
ob.Width:=(oa.Width div 2);
ob.Height:=(oa.Height div 2);
ob.PixelFormat:=pf24bit;
ob.Canvas.StretchDraw(Rect(0,0,ob.Width,ob.Height),oa);
oa.Destroy;
oa:=ob;
end;
TIFFSetField(m,TIFFTAG_IMAGEWIDTH,oa.Width);
TIFFSetField(m,TIFFTAG_IMAGELength,oa.Height);
TIFFSetField(m,TIFFTAG_BITSPERSAMPLE,8);
TIFFSetField(m,TIFFTAG_SAMPLESPERPIXEL,3);
TIFFSetField(m,TIFFTAG_PLANARCONFIG,PLANARCONFIG_CONTIG);
TIFFSetField(m,TIFFTAG_PHOTOMETRIC,PHOTOMETRIC_RGB);
TIFFSetField(m,TIFFTAG_TILEWIDTH,128);
TIFFSetField(m,TIFFTAG_TILELENGTH,128);
TIFFSetField(m,TIFFTAG_COMPRESSION,COMPRESSION_LZW);
if n=0 then
TIFFSetField(m,TIFFTAG_SUBIFD,3);
py:=0;
pt:=0;
while py<oa.Height do
begin
px:=0;
while px<oa.Width do
begin
qb:=q;
qy:=0;
while (qy<128) and (py+qy<oa.Height) do
begin
qa:=PByte(Cardinal(oa.Scanline[py+qy])+Cardinal(px*3));
qx:=0;
while (qx<128) and (px+qx<oa.Width) do
begin
rb:=qa^;
Inc(qa);
rg:=qa^;
Inc(qa);
rr:=qa^;
Inc(qa);
qb^:=rr;
Inc(qb);
qb^:=rg;
Inc(qb);
qb^:=rb;
Inc(qb);
Inc(qx);
end;
Inc(qb,(128-qx)*3);
Inc(qy);
end;
TIFFWriteEncodedTile(m,pt,q,128*128*3);
Inc(px,128);
Inc(pt);
end;
Inc(py,128);
end;
TIFFWriteDirectory(m);
end;
oa.Destroy;
TIFFClose(m);
FreeMem(q);
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
|
|||||||