/packages/fcl-image/src/fptiffcmn.pas
Pascal | 419 lines | 357 code | 34 blank | 28 comment | 13 complexity | ec034f87645ec66b395d15b85d5671fa MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
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