/packages/fcl-image/src/fptiffcmn.pas

  1{
  2    This file is part of the Free Pascal run time library.
  3    Copyright (c) 2012 by the Free Pascal development team
  4
  5    Common stuff for Tiff image format.
  6
  7    See the file COPYING.FPC, included in this distribution,
  8    for details about the copyright.
  9
 10    This program is distributed in the hope that it will be useful,
 11    but WITHOUT ANY WARRANTY; without even the implied warranty of
 12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 13
 14 **********************************************************************
 15}
 16unit FPTiffCmn;
 17
 18{$mode objfpc}{$H+}
 19
 20interface
 21
 22uses
 23  Classes, sysutils, FPimage;
 24
 25type
 26  TTiffRational = packed record
 27    Numerator, Denominator: DWord;
 28  end;
 29
 30const
 31  TiffHandlerName = 'Tagged Image File Format';
 32
 33  TiffRational0: TTiffRational = (Numerator: 0; Denominator: 0);
 34  TiffRational72: TTiffRational = (Numerator: 72; Denominator: 1);
 35
 36  // TFPCustomImage.Extra properties used by TFPReaderTiff and TFPWriterTiff
 37  TiffExtraPrefix = 'Tiff';
 38  TiffPhotoMetric = TiffExtraPrefix+'PhotoMetricInterpretation';
 39  TiffGrayBits = TiffExtraPrefix+'GrayBits'; // CMYK: key plate
 40  TiffRedBits = TiffExtraPrefix+'RedBits'; // CMYK: cyan
 41  TiffGreenBits = TiffExtraPrefix+'GreenBits'; // CMYK: magenta
 42  TiffBlueBits = TiffExtraPrefix+'BlueBits'; // CMYK: yellow
 43  TiffAlphaBits = TiffExtraPrefix+'AlphaBits';
 44  TiffArtist = TiffExtraPrefix+'Artist';
 45  TiffCopyright = TiffExtraPrefix+'Copyright';
 46  TiffDocumentName = TiffExtraPrefix+'DocumentName';
 47  TiffDateTime = TiffExtraPrefix+'DateTime';
 48  TiffImageDescription = TiffExtraPrefix+'ImageDescription';
 49  TiffHostComputer = TiffExtraPrefix+'HostComputer';
 50  TiffMake_ScannerManufacturer = TiffExtraPrefix+'Make_ScannerManufacturer';
 51  TiffModel_Scanner = TiffExtraPrefix+'Model_Scanner';
 52  TiffOrientation = TiffExtraPrefix+'Orientation';
 53  TiffResolutionUnit = TiffExtraPrefix+'ResolutionUnit';
 54  TiffSoftware = TiffExtraPrefix+'Software';
 55  TiffXResolution = TiffExtraPrefix+'XResolution';
 56  TiffYResolution = TiffExtraPrefix+'YResolution';
 57  TiffPageNumber = TiffExtraPrefix+'PageNumber'; // starting at 0
 58  TiffPageCount = TiffExtraPrefix+'PageCount'; // if >0 the image is a page
 59  TiffPageName = TiffExtraPrefix+'PageName';
 60  TiffIsThumbnail = TiffExtraPrefix+'IsThumbnail';
 61  TiffIsMask = TiffExtraPrefix+'IsMask';
 62  TiffTileWidth = TiffExtraPrefix+'TileWidth';
 63  TiffTileLength = TiffExtraPrefix+'TileLength';
 64  TiffCompression = TiffExtraPrefix+'Compression'; // number
 65
 66  TiffCompressionNone = 1; { No Compression, but pack data into bytes as tightly as possible,
 67       leaving no unused bits (except at the end of a row). The component
 68       values are stored as an array of type BYTE. Each scan line (row)
 69       is padded to the next BYTE boundary. }
 70  TiffCompressionCCITTRLE = 2; { CCITT Group 3 1-Dimensional Modified Huffman run length encoding. }
 71  TiffCompressionCCITTFAX3 = 3; { CCITT Group 3 fax encoding }
 72  TiffCompressionCCITTFAX4 = 4; { CCITT Group 4 fax encoding }
 73  TiffCompressionLZW = 5; { LZW }
 74  TiffCompressionOldJPEG = 6; { JPEG old style}
 75  TiffCompressionJPEG = 7; { JPEG new style }
 76  TiffCompressionDeflateAdobe = 8; { Deflate Adobe style }
 77  TiffCompressionJBIGBW = 9; { RFC2301 JBIG black/white }
 78  TiffCompressionJBIGCol = 10; { RFC2301 JBIG color }
 79  TiffCompressionNeXT = 32766; { Next }
 80  TiffCompressionCCITTRLEW = 32771; { CCITTRLEW }
 81  TiffCompressionPackBits = 32773; { PackBits Compression, a simple byte-oriented run length scheme.
 82         See the PackBits section for details. Data Compression applies
 83         only to raster image data. All other TIFF fields are unaffected. }
 84  TiffCompressionThunderScan = 32809; { THUNDERSCAN }
 85  TiffCompressionIT8CTPAD = 32895; { IT8CTPAD }
 86  TiffCompressionIT8LW = 32896; { IT8LW }
 87  TiffCompressionIT8MP = 32897; { IT8MP }
 88  TiffCompressionIT8BL = 32898; { IT8BL }
 89  TiffCompressionPixarFilm = 32908; { PIXARFILM }
 90  TiffCompressionPixarLog = 32909; { PIXARLOG }
 91  TiffCompressionDeflateZLib = 32946; { DeflatePKZip }
 92  TiffCompressionDCS = 32947; { DCS }
 93  TiffCompressionJBIG = 34661; { JBIG }
 94  TiffCompressionSGILog = 34676; { SGILOG }
 95  TiffCompressionSGILog24 = 34677; { SGILOG24 }
 96  TiffCompressionJPEG2000 = 34712; { JP2000 }
 97type
 98  TTiffChunkType = (
 99    tctStrip,
100    tctTile
101    );
102
103  { TTiffIFD - Image File Directory }
104
105  TTiffIFD = class
106  public
107    IFDStart: DWord; // tiff position
108    IFDNext: DWord; // tiff position
109    Artist: String;
110    BitsPerSample: DWord; // tiff position of entry
111    BitsPerSampleArray: array of Word;
112    CellLength: DWord;
113    CellWidth: DWord;
114    ColorMap: DWord;// tiff position of entry
115    Compression: DWord;
116    Predictor: Word;
117    Copyright: string;
118    DateAndTime: string;
119    DocumentName: string;
120    ExtraSamples: DWord;// tiff position of entry
121    FillOrder: DWord;
122    HostComputer: string;
123    ImageDescription: string;
124    ImageHeight: DWord;
125    ImageIsMask: Boolean;
126    ImageIsPage: Boolean;
127    ImageIsThumbNail: Boolean;
128    ImageWidth: DWord;
129    Make_ScannerManufacturer: string;
130    Model_Scanner: string;
131    Orientation: DWord;
132    PageNumber: word; // the page number starting at 0, the total number of pages is PageCount
133    PageCount: word; // see PageNumber
134    PageName: string;
135    PhotoMetricInterpretation: DWord;
136    PlanarConfiguration: DWord;
137    ResolutionUnit: DWord;
138    RowsPerStrip: DWord;
139    SamplesPerPixel: DWord;
140    Software: string;
141    StripByteCounts: DWord;// tiff position of entry
142    StripOffsets: DWord; // tiff position of entry
143    TileWidth: DWord;
144    TileLength: DWord; // = Height
145    TileOffsets: DWord; // tiff position of entry
146    TileByteCounts: DWord; // tiff position of entry
147    Tresholding: DWord;
148    XResolution: TTiffRational;
149    YResolution: TTiffRational;
150    // image
151    Img: TFPCustomImage;
152    FreeImg: boolean;
153    RedBits: word;
154    GreenBits: word;
155    BlueBits: word;
156    GrayBits: word;
157    AlphaBits: word;
158    BytesPerPixel: Word;
159    procedure Clear;
160    procedure Assign(IFD: TTiffIFD);
161    procedure ReadFPImgExtras(Src: TFPCustomImage);
162    function ImageLength: DWord; inline;
163    destructor Destroy; override;
164  end;
165
166function TiffRationalToStr(const r: TTiffRational): string;
167function StrToTiffRationalDef(const s: string; const Def: TTiffRational): TTiffRational;
168procedure ClearTiffExtras(Img: TFPCustomImage);
169procedure CopyTiffExtras(SrcImg, DestImg: TFPCustomImage);
170procedure WriteTiffExtras(Msg: string; Img: TFPCustomImage);
171function TiffCompressionName(c: Word): string;
172
173implementation
174
175function TiffRationalToStr(const r: TTiffRational): string;
176begin
177  Result:=IntToStr(r.Numerator)+'/'+IntToStr(r.Denominator);
178end;
179
180function StrToTiffRationalDef(const s: string; const Def: TTiffRational
181  ): TTiffRational;
182var
183  p: LongInt;
184begin
185  Result:=Def;
186  p:=System.Pos('/',s);
187  if p<1 then exit;
188  Result.Numerator:=StrToIntDef(copy(s,1,p-1),TiffRational0.Numerator);
189  Result.Denominator:=StrToIntDef(copy(s,p+1,length(s)),TiffRational0.Denominator);
190end;
191
192procedure ClearTiffExtras(Img: TFPCustomImage);
193var
194  i: Integer;
195begin
196  for i:=Img.ExtraCount-1 downto 0 do
197    if SysUtils.CompareText(copy(Img.ExtraKey[i],1,4),'Tiff')=0 then
198      Img.RemoveExtra(Img.ExtraKey[i]);
199end;
200
201procedure CopyTiffExtras(SrcImg, DestImg: TFPCustomImage);
202var
203  i: Integer;
204begin
205  ClearTiffExtras(DestImg);
206  for i:=SrcImg.ExtraCount-1 downto 0 do
207    if SysUtils.CompareText(copy(SrcImg.ExtraKey[i],1,4),'Tiff')=0 then
208      DestImg.Extra[SrcImg.ExtraKey[i]]:=SrcImg.ExtraValue[i];
209end;
210
211procedure WriteTiffExtras(Msg: string; Img: TFPCustomImage);
212var
213  i: Integer;
214begin
215  writeln('WriteTiffExtras ',Msg);
216  for i:=0 to Img.ExtraCount-1 do
217    //if SysUtils.CompareText(copy(Img.ExtraKey[i],1,4),'Tiff')=0 then
218      writeln('  ',i,' ',Img.ExtraKey[i],'=',Img.ExtraValue[i]);
219end;
220
221function TiffCompressionName(c: Word): string;
222begin
223  case c of
224  1: Result:='no compression';
225  2: Result:='CCITT Group 3 1-Dimensional Modified Huffman run length encoding';
226  3: Result:='CCITT Group 3 fax encoding';
227  4: Result:='CCITT Group 4 fax encoding';
228  5: Result:='LZW';
229  6: Result:='JPEG old style';
230  7: Result:='JPEG';
231  8: Result:='Deflate Adobe style';
232  9: Result:='RFC2301 JBIG white/black';
233  10: Result:='RFC2301 JBIG color';
234  32766: Result:='NeXT';
235  32771: Result:='CCITTRLEW';
236  32773: Result:='PackBits';
237  32809: Result:='THUNDERSCAN';
238  32895: Result:='IT8CTPAD';
239  32896: Result:='IT8LW';
240  32897: Result:='IT8MP';
241  32898: Result:='IT8BL';
242  32908: Result:='PIXARFILM';
243  32909: Result:='PIXARLOG';
244  32946: Result:='Deflate ZLib';
245  32947: Result:='DCS';
246  34661: Result:='JBIG';
247  34676: Result:='SGILOG';
248  34677: Result:='SGILOG24';
249  34712: Result:='JP2000';
250  else Result:='unknown('+IntToStr(c)+')';
251  end;
252end;
253
254{ TTiffIFD }
255
256procedure TTiffIFD.Clear;
257begin
258  IFDStart:=0;
259  IFDNext:=0;
260  PhotoMetricInterpretation:=High(PhotoMetricInterpretation);
261  PlanarConfiguration:=0;
262  Compression:=TiffCompressionNone;
263  Predictor:=1;
264  ImageHeight:=0;
265  ImageWidth:=0;
266  ImageIsThumbNail:=false;
267  ImageIsPage:=false;
268  ImageIsMask:=false;
269  BitsPerSample:=0;
270  SetLength(BitsPerSampleArray,0);
271  ResolutionUnit:=0;
272  XResolution:=TiffRational0;
273  YResolution:=TiffRational0;
274  RowsPerStrip:=0;
275  StripOffsets:=0;
276  StripByteCounts:=0;
277  SamplesPerPixel:=0;
278  Artist:='';
279  HostComputer:='';
280  ImageDescription:='';
281  Make_ScannerManufacturer:='';
282  Model_Scanner:='';
283  Copyright:='';
284  DateAndTime:='';
285  Software:='';
286  CellWidth:=0;
287  CellLength:=0;
288  FillOrder:=0;
289  Orientation:=0;
290  PageNumber:=0;
291  PageCount:=0;
292  PageName:='';
293
294  // tiles
295  TileWidth:=0;
296  TileLength:=0;
297  TileOffsets:=0;
298  TileByteCounts:=0;
299
300  Tresholding:=0;
301
302  RedBits:=0;
303  GreenBits:=0;
304  BlueBits:=0;
305  GrayBits:=0;
306  AlphaBits:=0;
307  BytesPerPixel:=0;
308
309  if FreeImg then begin
310    FreeImg:=false;
311    FreeAndNil(Img);
312  end;
313end;
314
315procedure TTiffIFD.Assign(IFD: TTiffIFD);
316begin
317  IFDStart:=IFD.IFDStart;
318  IFDNext:=IFD.IFDNext;
319
320  PhotoMetricInterpretation:=IFD.PhotoMetricInterpretation;
321  PlanarConfiguration:=IFD.PlanarConfiguration;
322  Compression:=IFD.Compression;
323  Predictor:=IFD.Predictor;
324  ImageHeight:=IFD.ImageHeight;
325  ImageWidth:=IFD.ImageWidth;
326  ImageIsThumbNail:=IFD.ImageIsThumbNail;
327  ImageIsPage:=IFD.ImageIsPage;
328  ImageIsMask:=IFD.ImageIsMask;
329  BitsPerSample:=IFD.BitsPerSample;
330  BitsPerSampleArray:=IFD.BitsPerSampleArray;
331  ResolutionUnit:=IFD.ResolutionUnit;
332  XResolution:=IFD.XResolution;
333  YResolution:=IFD.YResolution;
334  RowsPerStrip:=IFD.RowsPerStrip;
335  StripOffsets:=IFD.StripOffsets;
336  StripByteCounts:=IFD.StripByteCounts;
337  SamplesPerPixel:=IFD.SamplesPerPixel;
338  Artist:=IFD.Artist;
339  HostComputer:=IFD.HostComputer;
340  ImageDescription:=IFD.ImageDescription;
341  Make_ScannerManufacturer:=IFD.Make_ScannerManufacturer;
342  Model_Scanner:=IFD.Model_Scanner;
343  Copyright:=IFD.Copyright;
344  DateAndTime:=IFD.DateAndTime;
345  Software:=IFD.Software;
346  CellWidth:=IFD.CellWidth;
347  CellLength:=IFD.CellLength;
348  FillOrder:=IFD.FillOrder;
349  Orientation:=IFD.Orientation;
350  PageNumber:=IFD.PageNumber;
351  PageCount:=IFD.PageCount;
352  PageName:=IFD.PageName;
353
354  // tiles
355  TileWidth:=IFD.TileWidth;
356  TileLength:=IFD.TileLength;
357  TileOffsets:=IFD.TileOffsets;
358  TileByteCounts:=IFD.TileByteCounts;
359
360  Tresholding:=IFD.Tresholding;
361
362  RedBits:=IFD.RedBits;
363  GreenBits:=IFD.GreenBits;
364  BlueBits:=IFD.BlueBits;
365  GrayBits:=IFD.GrayBits;
366  AlphaBits:=IFD.AlphaBits;
367  if (Img<>nil) and (IFD.Img<>nil) then
368    Img.Assign(IFD.Img);
369end;
370
371procedure TTiffIFD.ReadFPImgExtras(Src: TFPCustomImage);
372begin
373  Clear;
374  PhotoMetricInterpretation:=2;
375  if Src.Extra[TiffPhotoMetric]<>'' then
376    PhotoMetricInterpretation:=
377      StrToInt64Def(Src.Extra[TiffPhotoMetric],High(PhotoMetricInterpretation));
378  Artist:=Src.Extra[TiffArtist];
379  Copyright:=Src.Extra[TiffCopyright];
380  DocumentName:=Src.Extra[TiffDocumentName];
381  DateAndTime:=Src.Extra[TiffDateTime];
382  HostComputer:=Src.Extra[TiffHostComputer];
383  Make_ScannerManufacturer:=Src.Extra[TiffMake_ScannerManufacturer];
384  Model_Scanner:=Src.Extra[TiffModel_Scanner];
385  ImageDescription:=Src.Extra[TiffImageDescription];
386  Software:=Src.Extra[TiffSoftware];
387  Orientation:=StrToIntDef(Src.Extra[TiffOrientation],1);
388  if not (Orientation in [1..8]) then
389    Orientation:=1;
390  ResolutionUnit:=StrToIntDef(Src.Extra[TiffResolutionUnit],2);
391  if not (ResolutionUnit in [1..3]) then
392    ResolutionUnit:=2;
393  XResolution:=StrToTiffRationalDef(Src.Extra[TiffXResolution],TiffRational72);
394  YResolution:=StrToTiffRationalDef(Src.Extra[TiffYResolution],TiffRational72);
395  PageNumber:=StrToIntDef(Src.Extra[TiffPageNumber],0);
396  PageCount:=StrToIntDef(Src.Extra[TiffPageCount],0);
397  PageName:=Src.Extra[TiffPageName];
398  ImageIsPage:=PageCount>0;
399  ImageIsThumbNail:=Src.Extra[TiffIsThumbnail]<>'';
400  ImageIsMask:=Src.Extra[TiffIsMask]<>'';
401  TileWidth:=StrToIntDef(Src.Extra[TiffTileWidth],0);
402  TileLength:=StrToIntDef(Src.Extra[TiffTileLength],0);
403  Compression:=StrToIntDef(Src.Extra[TiffCompression],TiffCompressionNone);
404end;
405
406function TTiffIFD.ImageLength: DWord;
407begin
408  Result:=ImageHeight;
409end;
410
411destructor TTiffIFD.Destroy;
412begin
413  if FreeImg then
414    FreeAndNil(Img);
415  inherited Destroy;
416end;
417
418end.
419