galfar.imaginglib/Extensions/ImagingTiff.pas

{
  Vampyre Imaging Library
  by Marek Mauder
  https://github.com/galfar/imaginglib
  https://imaginglib.sourceforge.io
  - - - - -
  This Source Code Form is subject to the terms of the Mozilla Public
  License, v. 2.0. If a copy of the MPL was not distributed with this
  file, You can obtain one at https://mozilla.org/MPL/2.0.
} 

unit ImagingTiff;

{$I ImagingOptions.inc}

interface

uses
  SysUtils, Imaging, ImagingTypes, ImagingUtility, ImagingIO;

type
  { TIFF (Tag Image File Format) loader/saver base class.}
  TBaseTiffFileFormat = class(TImageFileFormat)
  protected
    FCompression: Integer;
    FJpegQuality: Integer;
    procedure Define; override;
  public
    function TestFormat(Handle: TImagingHandle): Boolean; override;
    { Specifies compression scheme used when saving TIFF images. Supported values
      are 0 (Uncompressed), 1 (LZW), 2 (PackBits RLE), 3 (Deflate - ZLib), 4 (JPEG),
      5 (CCITT Group 4 fax encoding - for binary images only).
      Default is 1 (LZW). Note that not all images can be stored with
      JPEG compression - these images will be saved with default compression if
      JPEG is set.}
    property Compression: Integer read FCompression write FCompression;
    { Controls compression quality when selected TIFF compression is Jpeg.
      It is number in range 1..100. 1 means small/ugly file,
      100 means large/nice file. Accessible trough ImagingTiffJpegQuality option.}
    property JpegQuality: Integer read FJpegQuality write FJpegQuality;
  end;

const
  TiffCompressionOptionNone        = 0;
  TiffCompressionOptionLzw         = 1;
  TiffCompressionOptionPackbitsRle = 2;
  TiffCompressionOptionDeflate     = 3;
  TiffCompressionOptionJpeg        = 4;
  TiffCompressionOptionGroup4      = 5;

  { Read only metadata info - name of compression scheme (LZW, none, JPEG, G4, ...)
    used in last loaded TIFF. }
  SMetaTiffCompressionName = 'TiffCompressionName';
  { Original resolution unit of loaded TIFF. Type is UInt.
    RESUNIT_NONE                        = 1;       // no meaningful units
    RESUNIT_INCH                        = 2;       // english
    RESUNIT_CENTIMETER                  = 3;       // metric }
  SMetaTiffResolutionUnit = 'TiffResolutionUnit';

implementation

{$IFNDEF DONT_LINK_FILE_FORMATS}

// So far we have only one TIFF support implementation - libtiff
{$DEFINE USE_LIBTIFF}

// libtiff for FPC ARM is disabled by default due to potential hardfp/softfp
// ABI problems (without linking to any lib FPC generated binary does not call "ld"
// and hardfp exe can run on softfp target). If you know what you're doing enable it.
{$IF Defined(FPC) and Defined(CPUARM)}
  {$UNDEF USE_LIBTIFF}
{$IFEND}

// Not even dynamic linking works at the moment
{$IF Defined(DELPHI) and Defined(MACOS))}
  {$UNDEF USE_LIBTIFF}
{$IFEND}

// Also disable for Delphi ARM targets
{$IF Defined(DELPHI) and Defined(CPUARM))}
  {$UNDEF USE_LIBTIFF}
{$IFEND}

uses
{$IFDEF USE_LIBTIFF}
  ImagingTiffLib,
{$ENDIF}
  ImagingExtFileFormats;

{$ENDIF}

const
  STiffFormatName = 'Tagged Image File Format';
  STiffMasks      = '*.tif,*.tiff';
  TiffDefaultCompression = 1;
  TiffDefaultJpegQuality = 90;

const
  TiffBEMagic: TChar4 = 'MM'#0#42;
  TiffLEMagic: TChar4 = 'II'#42#0;

{
  TBaseTiffFileFormat implementation
}

procedure TBaseTiffFileFormat.Define;
begin
  inherited;
  FName := STiffFormatName;
  FFeatures := [ffLoad, ffSave, ffMultiImage];
  FCompression := TiffDefaultCompression;
  FJpegQuality := TiffDefaultJpegQuality;

  AddMasks(STiffMasks);
  RegisterOption(ImagingTiffCompression, @FCompression);
  RegisterOption(ImagingTiffJpegQuality, @FJpegQuality);
end;

function TBaseTiffFileFormat.TestFormat(Handle: TImagingHandle): Boolean;
var
  Magic: TChar4;
  ReadCount: LongInt;
begin
  Result := False;
  if Handle <> nil then
  begin
    ReadCount := GetIO.Read(Handle, @Magic, SizeOf(Magic));
    GetIO.Seek(Handle, -ReadCount, smFromCurrent);
    Result := (ReadCount >= SizeOf(Magic)) and
      ((Magic = TiffBEMagic) or (Magic = TiffLEMagic));
  end;
end;

end.