galfar.imaginglib/Extras/Extensions/ImagingJpegIJL.pas

{
  Vampyre Imaging Library
  by Marek Mauder
  http://imaginglib.sourceforge.net

  The contents of this file are used with permission, subject to the Mozilla
  Public License Version 1.1 (the "License"); you may not use this file except
  in compliance with the License. You may obtain a copy of the License at
  http://www.mozilla.org/MPL/MPL-1.1.html

  Software distributed under the License is distributed on an "AS IS" basis,
  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
  the specific language governing rights and limitations under the License.

  Alternatively, the contents of this file may be used under the terms of the
  GNU Lesser General Public License (the  "LGPL License"), in which case the
  provisions of the LGPL License are applicable instead of those above.
  If you wish to allow use of your version of this file only under the terms
  of the LGPL License and not to allow others to use your version of this file
  under the MPL, indicate your decision by deleting  the provisions above and
  replace  them with the notice and other provisions required by the LGPL
  License.  If you do not delete the provisions above, a recipient may use
  your version of this file under either the MPL or the LGPL License.

  For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
}

{ This unit contains image format alternative loader/saver for Jpeg images
  using Intel Jpeg Library (Win32 only).}
unit ImagingJpegIJL;

{$I ImagingOptions.inc}

{$IFNDEF WIN32}
  {$ERROR 'IJL 1.5 only for Win32'}
{$ENDIF}

interface

uses
  SysUtils, ImagingTypes, Imaging, ImagingUtility, ImagingIO;

type
  { Class for loading/saving Jpeg images. This is alternative to
    default built-in Jpeg handler (which uses JpegLib).
    This handler uses Intel Jpeg Library 1.5 (DLL needed) and is
    much faster than JpegLib (2-4x). Also supports reading and writing of
    alpha channels in Jpeg files.}
  TJpegFileFormatIJL = class(TImageFileFormat)
  private
    FQuality: LongInt;
    procedure JpegError(Code: Integer);
  protected
    procedure Define; override;
    function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
      OnlyFirstLevel: Boolean): Boolean; override;
    function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
      Index: LongInt): Boolean; override;
    procedure ConvertToSupported(var Image: TImageData;
      const Info: TImageFormatInfo); override;
  public
    function TestFormat(Handle: TImagingHandle): Boolean; override;
    procedure CheckOptionsValidity; override;
  published
    { Controls Jpeg save compression quality. It is number in range 1..100.
      1 means small/ugly file, 100 means large/nice file. Accessible trough
      ImagingJpegQuality option.}
    property Quality: LongInt read FQuality write FQuality;
  end;

implementation

{$MINENUMSIZE 4}          // Min enum size: 4 B

uses
  Types;

const
  SJpegFormatName = 'JPEG Image (IJL)';
  SJpegMasks      = '*.jpg,*.jpeg,*.jfif,*.jpe,*.jif,*.jpa';
  JpegSupportedFormats: TImageFormats = [ifGray8, ifR8G8B8, ifA8R8G8B8];
  JpegDefaultQuality = 90;
  JpegDefaultProgressive = False;

resourcestring
  SJpegError = 'JPEG Error';

const
  { Jpeg file identifiers.}
  JpegMagic: TChar2 = #$FF#$D8;
  SIJLLibrary = 'ijl15.dll';

const
  IJL_SETUP = -1;
  IJL_OK    = 0;
  IJL_NONE  = 0;
  IJL_OTHER = 255;
  JBUFSIZE  = 4096;    // Size of file I/O buffer (4K).

type
  {
   Purpose:     Possible types of data read/write/other operations to be
                performed by the functions IJL_Read and IJL_Write.
                See the Developer's Guide for details on appropriate usage.
   Fields:
    IJL_JFILE_XXXXXXX   Indicates JPEG data in a stdio file.
    IJL_JBUFF_XXXXXXX   Indicates JPEG data in an addressable buffer.
  }
  TIJLIOType = (
    // Read JPEG parameters (i.e., height, width, channels, sampling, etc.)
    // from a JPEG bit stream.
    IJL_JFILE_READPARAMS       =  0,
    IJL_JBUFF_READPARAMS       =  1,
    // Read a JPEG Interchange Format image.
    IJL_JFILE_READWHOLEIMAGE   =  2,
    IJL_JBUFF_READWHOLEIMAGE   =  3,
    // Read JPEG tables from a JPEG Abbreviated Format bit stream.
    IJL_JFILE_READHEADER       =  4,
    IJL_JBUFF_READHEADER       =  5,
    // Read image info from a JPEG Abbreviated Format bit stream.
    IJL_JFILE_READENTROPY      =  6,
    IJL_JBUFF_READENTROPY      =  7,
    // Write an entire JFIF bit stream.
    IJL_JFILE_WRITEWHOLEIMAGE  =  8,
    IJL_JBUFF_WRITEWHOLEIMAGE  =  9,
    // Write a JPEG Abbreviated Format bit stream.
    IJL_JFILE_WRITEHEADER      = 10,
    IJL_JBUFF_WRITEHEADER      = 11,
    // Write image info to a JPEG Abbreviated Format bit stream.
    IJL_JFILE_WRITEENTROPY     = 12,
    IJL_JBUFF_WRITEENTROPY     = 13,

    // Scaled Decoding Options:
    // Reads a JPEG image scaled to 1/2 size.
    IJL_JFILE_READONEHALF      = 14,
    IJL_JBUFF_READONEHALF      = 15,
    // Reads a JPEG image scaled to 1/4 size.
    IJL_JFILE_READONEQUARTER   = 16,
    IJL_JBUFF_READONEQUARTER   = 17,
    // Reads a JPEG image scaled to 1/8 size.
    IJL_JFILE_READONEEIGHTH    = 18,
    IJL_JBUFF_READONEEIGHTH    = 19,
    // Reads an embedded thumbnail from a JFIF bit stream.
    IJL_JFILE_READTHUMBNAIL    = 20,
    IJL_JBUFF_READTHUMBNAIL    = 21
  );

  {
   Purpose:     Possible color space formats.
                Note these formats do *not* necessarily denote
                the number of channels in the color space.
                There exists separate "channel" fields in the
                JPEG_CORE_PROPERTIES data structure specifically
                for indicating the number of channels in the
                JPEG and/or DIB color spaces.}
  TIJL_COLOR = (
    IJL_RGB         = 1,  // Red-Green-Blue color space.
    IJL_BGR         = 2,  // Reversed channel ordering from IJL_RGB.
    IJL_YCBCR       = 3,  // Luminance-Chrominance color space as defined
                          // by CCIR Recommendation 601.
    IJL_G           = 4,  // Grayscale color space.
    IJL_RGBA_FPX    = 5,  // FlashPix RGB 4 channel color space that
                          // has pre-multiplied opacity.
    IJL_YCBCRA_FPX  = 6   // FlashPix YCbCr 4 channel color space that
                          // has pre-multiplied opacity.
    //IJL_OTHER  = 255    // Some other color space not defined by the IJL.
                          // (This means no color space conversion will
                          //  be done by the IJL.)
  );

  { Purpose:     Possible subsampling formats used in the JPEG.}
  TIJL_JPGSUBSAMPLING = (
    IJL_NOSUBSAMP  = 0,
    IJL_411        = 1,    // Valid on a JPEG w/ 3 channels.
    IJL_422        = 2,    // Valid on a JPEG w/ 3 channels.
    IJL_4114       = 3,    // Valid on a JPEG w/ 4 channels.
    IJL_4224       = 4     // Valid on a JPEG w/ 4 channels.
  );

  { Purpose:     Possible subsampling formats used in the DIB. }
  TIJL_DIBSUBSAMPLING = TIJL_JPGSUBSAMPLING;

  { Purpose:    This is the primary data structure between the IJL and
                the external user.  It stores JPEG state information
                and controls the IJL.  It is user-modifiable.
   Context:     Used by all low-level IJL routines to store
                pseudo-global information.}
  TJpegCoreProperties = packed record
    UseJPEGPROPERTIES : LongBool;            // default = 0
    // DIB specific I/O data specifiers.
    DIBBytes          : PByte;               // default = NULL
    DIBWidth          : UInt32;              // default = 0
    DIBHeight         : UInt32;              // default = 0
    DIBPadBytes       : UInt32;              // default = 0
    DIBChannels       : UInt32;              // default = 3
    DIBColor          : TIJL_COLOR;          // default = IJL_BGR
    DIBSubsampling    : TIJL_DIBSUBSAMPLING; // default = IJL_NONE
    // JPEG specific I/O data specifiers.
    JPGFile           : PAnsiChar;           // default = NULL
    JPGBytes          : PByte;               // default = NULL
    JPGSizeBytes      : UInt32;              // default = 0
    JPGWidth          : UInt32;              // default = 0
    JPGHeight         : UInt32;              // default = 0
    JPGChannels       : UInt32;              // default = 3
    JPGColor          : TIJL_COLOR;          // default = IJL_YCBCR
    JPGSubsampling    : TIJL_JPGSUBSAMPLING; // default = IJL_411
    JPGThumbWidth     : UInt32;              // default = 0
    JPGThumbHeight    : UInt32;              // default = 0
    // JPEG conversion properties.
    NeedsConvert      : LongBool;            // default = TRUE
    NeedsResample     : LongBool;            // default = TRUE
    Quality           : UInt32;              // default = 75
    // Low-level properties.
    PropsAndUnused    : array[0..19987] of Byte;
  end;
  PJpegCoreProperties = ^TJpegCoreProperties;

function ijlInit(var Props: TJpegCoreProperties): Integer; stdcall; external SIJLLibrary;
function ijlFree(var Props: TJpegCoreProperties): Integer; stdcall; external SIJLLibrary;
function ijlRead(var Props: TJpegCoreProperties; IoType  : TIJLIOTYPE): Integer; stdcall; external SIJLLibrary;
function ijlWrite(var Props: TJpegCoreProperties; IoType  : TIJLIOTYPE): Integer; stdcall; external SIJLLibrary;
function ijlErrorStr(Code : Integer) : PAnsiChar; stdcall; external SIJLLibrary;

{ TJpegFileFormatIJL class implementation }

procedure TJpegFileFormatIJL.Define;
begin
  inherited;
  FName := SJpegFormatName;
  FCanLoad := True;
  FCanSave := True;
  FIsMultiImageFormat := False;
  FSupportedFormats := JpegSupportedFormats;

  FQuality := JpegDefaultQuality;

  AddMasks(SJpegMasks);
  RegisterOption(ImagingJpegQuality, @FQuality);
end;

procedure TJpegFileFormatIJL.CheckOptionsValidity;
begin
  // Check if option values are valid
  if not (FQuality in [1..100]) then
    FQuality := JpegDefaultQuality;
end;

procedure TJpegFileFormatIJL.ConvertToSupported(var Image: TImageData;
  const Info: TImageFormatInfo);
begin
  if Info.HasAlphaChannel then
    ConvertImage(Image, ifA8R8G8B8)
  else if Info.HasGrayChannel then
    ConvertImage(Image, ifGray8)
  else
    ConvertImage(Image, ifR8G8B8);
end;

function TJpegFileFormatIJL.TestFormat(Handle: TImagingHandle): Boolean;
var
  ReadCount: LongInt;
  ID: array[0..9] of AnsiChar;
begin
  Result := False;
  if Handle <> nil then
  with GetIO do
  begin
    FillChar(ID, SizeOf(ID), 0);
    ReadCount := Read(Handle, @ID, SizeOf(ID));
    Seek(Handle, -ReadCount, smFromCurrent);
    Result := (ReadCount = SizeOf(ID)) and
      CompareMem(@ID, @JpegMagic, SizeOf(JpegMagic));
  end;
end;

procedure TJpegFileFormatIJL.JpegError(Code: Integer);
begin
  raise EImagingError.Create(SJpegError + ': ' + ijlErrorStr(Code));
end;

function TJpegFileFormatIJL.LoadData(Handle: TImagingHandle;
  var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
var
  Props: TJpegCoreProperties;
  Status: Integer;
  Buffer: TDynByteArray;
  InputLen: Integer;
  JpegFmt: TImageFormat;
begin
  // Copy IO functions to global var used in JpegLib callbacks
  Result := False;
  SetLength(Images, 1);

  with Images[0] do
  try
    InputLen := GetInputSize(GetIO, Handle);

    Status := IjlInit(Props);
    if Status = IJL_OK then
    begin
      // Load input to memory and read Jpeg props
      SetLength(Buffer, InputLen);
      Props.JPGSizeBytes := InputLen;
      Props.JPGBytes := @Buffer[0];
      GetIO.Read(Handle, @Buffer[0], InputLen);
      Status := ijlRead(Props, IJL_JBUFF_READPARAMS);
    end;

    if Status = IJL_OK then
    begin
      // Set image and DIB props based on Jpeg params read from input
      case Props.JPGChannels of
        1:
          begin
            JpegFmt := ifGray8;
            Props.DIBColor := IJL_G;
          end;
        3:
          begin
            JpegFmt := ifR8G8B8;
            Props.DIBColor := IJL_BGR;
          end;
        4:
          begin
            JpegFmt := ifA8R8G8B8;
            Props.DIBColor := IJL_RGBA_FPX;
          end
      else
        Exit;
      end;

      NewImage(Props.JPGWidth, Props.JPGHeight, JpegFmt, Images[0]);

      Props.DIBWidth := Props.JPGWidth;
      Props.DIBHeight := Props.JPGHeight;
      Props.DIBChannels := Props.JPGChannels;
      Props.DIBPadBytes := 0;
      Props.DIBBytes := Bits;

      // Now read the image bits
      Status := ijlRead(Props, IJL_JBUFF_READWHOLEIMAGE);
    end;

    if Status <> IJL_OK then
      JpegError(Status);

    // Decoded images with alpha are in ABGR format so R and B chanels are switched
    if JpegFmt = ifA8R8G8B8 then
      SwapChannels(Images[0], ChannelRed, ChannelBlue);

    Result := True;
  finally
    ijlFree(Props);
  end;
end;

function TJpegFileFormatIJL.SaveData(Handle: TImagingHandle;
  const Images: TDynImageDataArray; Index: LongInt): Boolean;
var
  Props: TJpegCoreProperties;
  Status: Integer;
  Info: TImageFormatInfo;
  ImageToSave: TImageData;
  MustBeFreed: Boolean;
  Buffer: TDynByteArray;
begin
  Result := False;
  // Makes image to save compatible with Jpeg saving capabilities
  if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then
  with ImageToSave do
  try
    Status := ijlInit(Props);
    if Status = IJL_OK then
    begin
      Info := GetFormatInfo(Format);
      // Set all the needed props
      Props.DIBWidth := Width;
      Props.DIBHeight := Height;
      Props.DIBChannels := Info.ChannelCount;
      Props.DIBPadBytes := 0;
      Props.DIBBytes := Bits;

      Props.Quality := FQuality;

      Props.JPGWidth := Width;
      Props.JPGHeight := Height;
      Props.JPGChannels := Info.ChannelCount;
      SetLength(Buffer, Size);
      Props.JPGSizeBytes := Size;
      Props.JPGBytes := @Buffer[0];

      case Info.ChannelCount of
        1:
          begin
            Props.DIBColor := IJL_G;
            Props.JPGColor := IJL_G;
            Props.JPGSubsampling := IJL_NOSUBSAMP;
          end;
        3:
          begin
            Props.DIBColor := IJL_BGR;
            Props.JPGColor := IJL_YCBCR;
            Props.JPGSubsampling := IJL_411;
          end;
        4:
          begin
            Props.DIBColor := IJL_RGBA_FPX;
            Props.JPGColor := IJL_YCBCRA_FPX;
            Props.JPGSubsampling := IJL_4114;
            SwapChannels(ImageToSave, ChannelRed, ChannelBlue); // IJL expects ABGR order
          end;
      end;

      // Encode image
      Status := ijlWrite(Props, IJL_JBUFF_WRITEWHOLEIMAGE);
    end;

    if Status <> IJL_OK then
      JpegError(Status);

    // Write temp buffer to file
    GetIO.Write(Handle, @Buffer[0], Props.JPGSizeBytes);

    Result := True;
  finally
    ijlFree(Props);
    if MustBeFreed then
      FreeImage(ImageToSave)
    else if Format = ifA8R8G8B8 then
      SwapChannels(ImageToSave, ChannelRed, ChannelBlue); // Swap image back to ARGB if not temp
  end;
end;

initialization
  RegisterImageFileFormat(TJpegFileFormatIJL);

{
  File Notes:

 -- TODOS ----------------------------------------------------
    - nothing now

  -- 0.26.3 Changes/Bug Fixes ---------------------------------
    - Initial version created.
}

end.