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

https://github.com/slibre/freepascal · Pascal · 419 lines · 357 code · 34 blank · 28 comment · 13 complexity · ec034f87645ec66b395d15b85d5671fa MD5 · raw file

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