Repo for the search and displace ingest module that takes odf, docx and pdf and transforms it into .md to be used with search and displace operations
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

104 lines
3.4 KiB

3 years ago
  1. unit ImagingTiff;
  2. {$I ImagingOptions.inc}
  3. interface
  4. uses
  5. SysUtils, Imaging, ImagingTypes, ImagingUtility, ImagingIO, ImagingExtras;
  6. type
  7. { TIFF (Tag Image File Format) loader/saver base class.}
  8. TBaseTiffFileFormat = class(TImageFileFormat)
  9. protected
  10. FCompression: Integer;
  11. FJpegQuality: Integer;
  12. procedure Define; override;
  13. public
  14. function TestFormat(Handle: TImagingHandle): Boolean; override;
  15. { Specifies compression scheme used when saving TIFF images. Supported values
  16. are 0 (Uncompressed), 1 (LZW), 2 (PackBits RLE), 3 (Deflate - ZLib), 4 (JPEG),
  17. 5 (CCITT Group 4 fax encoding - for binary images only).
  18. Default is 1 (LZW). Note that not all images can be stored with
  19. JPEG compression - these images will be saved with default compression if
  20. JPEG is set.}
  21. property Compression: Integer read FCompression write FCompression;
  22. { Controls compression quality when selected TIFF compression is Jpeg.
  23. It is number in range 1..100. 1 means small/ugly file,
  24. 100 means large/nice file. Accessible trough ImagingTiffJpegQuality option.}
  25. property JpegQuality: Integer read FJpegQuality write FJpegQuality;
  26. end;
  27. const
  28. TiffCompressionOptionNone = 0;
  29. TiffCompressionOptionLzw = 1;
  30. TiffCompressionOptionPackbitsRle = 2;
  31. TiffCompressionOptionDeflate = 3;
  32. TiffCompressionOptionJpeg = 4;
  33. TiffCompressionOptionGroup4 = 5;
  34. { Read only metadata info - name of compression scheme (LZW, none, JPEG, G4, ...)
  35. used in last loaded TIFF. }
  36. SMetaTiffCompressionName = 'TiffCompressionName';
  37. { Original resolution unit of loaded TIFF. Type is UInt.
  38. RESUNIT_NONE = 1; // no meaningful units
  39. RESUNIT_INCH = 2; // english
  40. RESUNIT_CENTIMETER = 3; // metric }
  41. SMetaTiffResolutionUnit = 'TiffResolutionUnit';
  42. implementation
  43. {$IFNDEF DONT_LINK_FILE_FORMATS}
  44. // So far we have only one TIFF support implementation - libtiff
  45. // Note that libtiff for FPC ARM is disabled by default due to potential hardfp/softfp
  46. // ABI problems (without linking to any lib FPC generated binary does not call "ld"
  47. // and hardfp exe can run on softfp target). If you know what you're doing enable it.
  48. {$IF (Defined(DELPHI) and not Defined(CPUX64)) or (Defined(FPC) and not Defined(CPUARM)))}
  49. uses
  50. ImagingTiffLib;
  51. {$IFEND}
  52. {$ENDIF}
  53. const
  54. STiffFormatName = 'Tagged Image File Format';
  55. STiffMasks = '*.tif,*.tiff';
  56. TiffDefaultCompression = 1;
  57. TiffDefaultJpegQuality = 90;
  58. const
  59. TiffBEMagic: TChar4 = 'MM'#0#42;
  60. TiffLEMagic: TChar4 = 'II'#42#0;
  61. {
  62. TBaseTiffFileFormat implementation
  63. }
  64. procedure TBaseTiffFileFormat.Define;
  65. begin
  66. inherited;
  67. FName := STiffFormatName;
  68. FFeatures := [ffLoad, ffSave, ffMultiImage];
  69. FCompression := TiffDefaultCompression;
  70. FJpegQuality := TiffDefaultJpegQuality;
  71. AddMasks(STiffMasks);
  72. RegisterOption(ImagingTiffCompression, @FCompression);
  73. RegisterOption(ImagingTiffJpegQuality, @FJpegQuality);
  74. end;
  75. function TBaseTiffFileFormat.TestFormat(Handle: TImagingHandle): Boolean;
  76. var
  77. Magic: TChar4;
  78. ReadCount: LongInt;
  79. begin
  80. Result := False;
  81. if Handle <> nil then
  82. begin
  83. ReadCount := GetIO.Read(Handle, @Magic, SizeOf(Magic));
  84. GetIO.Seek(Handle, -ReadCount, smFromCurrent);
  85. Result := (ReadCount >= SizeOf(Magic)) and
  86. ((Magic = TiffBEMagic) or (Magic = TiffLEMagic));
  87. end;
  88. end;
  89. end.