CentrED

{

  $Id: Imaging.pas 99 2007-06-26 04:12:01Z galfar $

  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 is heart of Imaging library. It contains basic functions for

  manipulating image data as well as various image file format support.}

unit Imaging;

{$I ImagingOptions.inc}

interface

uses

  ImagingTypes, SysUtils, Classes;

type

  { Default Imaging excepton class.}

  EImagingError = class(Exception);

  { Dynamic array of TImageData records.}

  TDynImageDataArray = array of TImageData;

{ ------------------------------------------------------------------------

                       Low Level Interface Functions

  ------------------------------------------------------------------------}

{ General Functions }

{ Initializes image (all is set to zeroes). Call this for each image

  before using it (before calling every other function) to be sure there

  are no random-filled bytes (which would cause errors later).}

procedure InitImage(var Image: TImageData);

{ Creates empty image of given dimensions and format. Image is filled with

  transparent black color (A=0, R=0, G=0, B=0).}

function NewImage(Width, Height: LongInt; Format: TImageFormat;

  var Image: TImageData): Boolean;

{ Returns True if given TImageData record is valid.}

function TestImage(const Image: TImageData): Boolean;

{ Frees given image data. Ater this call image is in the same state

  as after calling InitImage. If image is not valid (dost not pass TestImage

  test) it is only zeroed by calling InitImage.}

procedure FreeImage(var Image: TImageData);

{ Call FreeImage() on all images in given dynamic array and sets its

  length to zero.}

procedure FreeImagesInArray(var Images: TDynImageDataArray);

{ Returns True if all TImageData records in given array are valid. Returns False

  if at least one is invalid or if array is empty.}

function TestImagesInArray(const Images: TDynImageDataArray): Boolean;

{ Checks given file for every supported image file format and if

  the file is in one of them returns its string identifier

  (which can be used in LoadFromStream/LoadFromMem type functions).

  If file is not in any of the supported formats empty string is returned.}

function DetermineFileFormat(const FileName: string): string;

{ Checks given stream for every supported image file format and if

  the stream is in one of them returns its string identifier

  (which can be used in LoadFromStream/LoadFromMem type functions).

  If stream is not in any of the supported formats empty string is returned.}

function DetermineStreamFormat(Stream: TStream): string;

{ Checks given memory for every supported image file format and if

  the memory is in one of them returns its string identifier

  (which can be used in LoadFromStream/LoadFromMem type functions).

  If memory is not in any of the supported formats empty string is returned.}

function DetermineMemoryFormat(Data: Pointer; Size: LongInt): string;

{ Checks that an apropriate file format is supported purely from inspecting

  the given file name's extension (not contents of the file itself).

  The file need not exist.}

function IsFileFormatSupported(const FileName: string): Boolean;

{ Enumerates all registered image file formats. Descriptive name,

  default extension, masks (like '*.jpg,*.jfif') and some capabilities

  of each format are returned. To enumerate all formats start with Index at 0 and

  call EnumFileFormats with given Index in loop until it returns False (Index is

  automatically increased by 1 in function's body on successful call).}

function EnumFileFormats(var Index: LongInt; var Name, DefaultExt, Masks: string;

  var CanSaveImages, IsMultiImageFormat: Boolean): Boolean;

{ Loading Functions }

{ Loads single image from given file.}

function LoadImageFromFile(const FileName: string; var Image: TImageData): Boolean;

{ Loads single image from given stream. If function fails stream position

  is not changed.}

function LoadImageFromStream(Stream: TStream; var Image: TImageData): Boolean;

{ Loads single image from given memory location.}

function LoadImageFromMemory(Data: Pointer; Size: LongInt; var Image: TImageData): Boolean;

{ Loads multiple images from given file.}

function LoadMultiImageFromFile(const FileName: string;

  var Images: TDynImageDataArray): Boolean;

{ Loads multiple images from given stream. If function fails stream position

  is not changed.}

function LoadMultiImageFromStream(Stream: TStream;

  var Images: TDynImageDataArray): Boolean;

{ Loads multiple images from given memory location.}

function LoadMultiImageFromMemory(Data: Pointer; Size: LongInt;

  var Images: TDynImageDataArray): Boolean;

{ Saving Functions }

{ Saves single image to given file.}

function SaveImageToFile(const FileName: string; const Image: TImageData): Boolean;

{ Saves single image to given stream. If function fails stream position

  is not changed. Ext identifies desired image file format (jpg, png, dds, ...).}

function SaveImageToStream(const Ext: string; Stream: TStream;

  const Image: TImageData): Boolean;

{ Saves single image to given memory location. Memory must be allocated and its

  size is passed in Size parameter in which number of written bytes is returned.

  Ext identifies desired image file format (jpg, png, dds, ...).}

function SaveImageToMemory(const Ext: string; Data: Pointer; var Size: LongInt;

  const Image: TImageData): Boolean;

{ Saves multiple images to given file. If format supports

  only single level images and there are multiple images to be saved,

  they are saved as sequence of files img000.jpg, img001.jpg ....).}

function SaveMultiImageToFile(const FileName: string;

  const Images: TDynImageDataArray): Boolean;

{ Saves multiple images to given stream. If format supports

  only single level images and there are multiple images to be saved,

  they are saved one after another to the stream. If function fails stream

  position is not changed. Ext identifies desired image file format (jpg, png, dds, ...).}

function SaveMultiImageToStream(const Ext: string; Stream: TStream;

  const Images: TDynImageDataArray): Boolean;

{ Saves multiple images to given memory location. If format supports

  only single level images and there are multiple images to be saved,

  they are saved one after another to the memory. Memory must be allocated and

  its size is passed in Size parameter in which number of written bytes is returned.

  Ext identifies desired image file format (jpg, png, dds, ...).}

function SaveMultiImageToMemory(const Ext: string; Data: Pointer;

  var Size: LongInt; const Images: TDynImageDataArray): Boolean;

{ Manipulation Functions }

{ Creates identical copy of image data. Clone should be initialized

  by InitImage or it should be vaild image which will be freed by CloneImage.}

function CloneImage(const Image: TImageData; var Clone: TImageData): Boolean;

{ Converts image to the given format.}

function ConvertImage(var Image: TImageData; DestFormat: TImageFormat): Boolean;

{ Flips given image. Reverses the image along its horizontal axis ? the top

  becomes the bottom and vice versa.}

function FlipImage(var Image: TImageData): Boolean;

{ Mirrors given image. Reverses the image along its vertical axis ? the left

  side becomes the right and vice versa.}

function MirrorImage(var Image: TImageData): Boolean;

{ Resizes given image to new dimensions. Nearest, bilinear, or bicubic filtering

  can be used. Input Image must already be created - use NewImage to create new images.}

function ResizeImage(var Image: TImageData; NewWidth, NewHeight: LongInt;

  Filter: TResizeFilter): Boolean;

{ Swaps SrcChannel and DstChannel color or alpha channels of image.

  Use ChannelRed, ChannelBlue, ChannelGreen, ChannelAlpha constants to

  identify channels.}

function SwapChannels(var Image: TImageData; SrcChannel, DstChannel: LongInt): Boolean;

{ Reduces the number of colors of the Image. Currently MaxColors must be in

  range <2, 4096>. Color reduction works also for alpha channel. Note that for

  large images and big number of colors it can be very slow.

  Output format of the image is the same as input format.}

function ReduceColors(var Image: TImageData; MaxColors: LongInt): Boolean;

{ Generates mipmaps for image. Levels is the number of desired mipmaps levels

  with zero (or some invalid number) meaning all possible levels.}

function GenerateMipMaps(const Image: TImageData; Levels: LongInt;

  var MipMaps: TDynImageDataArray): Boolean;

{ Maps image to existing palette producing image in ifIndex8 format.

  Pal must be allocated to at least Entries * SizeOf(TColor32Rec) bytes.

  As resulting image is in 8bit indexed format Entries must be lower or

  equal to 256.}

function MapImageToPalette(var Image: TImageData; Pal: PPalette32;

  Entries: LongInt): Boolean;

{ Splits image into XChunks x YChunks subimages. Default size of each chunk is

  ChunkWidth x ChunkHeight. If PreserveSize si True chunks at the edges of

  the image are also ChunkWidth x ChunkHeight sized and empty space is filled

  with Fill pixels. After calling this function XChunks contains number of

  chunks along x axis and YChunks along y axis. To access chunk [X, Y] use this

  index: Chunks[Y * XChunks + X].}

function SplitImage(var Image: TImageData; var Chunks: TDynImageDataArray;

  ChunkWidth, ChunkHeight: LongInt; var XChunks, YChunks: LongInt;

  PreserveSize: Boolean; Fill: Pointer): Boolean;

{ Creates palette with MaxColors based on the colors of images in Images array.

  Use it when you want to convert several images to indexed format using

  single palette for all of them. If ConvertImages is True images in array

  are converted to indexed format using resulting palette. if it is False

  images are left intact and only resulting palatte is returned in Pal.

  Pal must be allocated to have at least MaxColors entries.}

function MakePaletteForImages(var Images: TDynImageDataArray; Pal: PPalette32;

  MaxColors: LongInt; ConvertImages: Boolean): Boolean;

{ Rotates image by 90, 180, 270, -90, -180, or -270 degrees counterclockwise.

  Only multiples of 90 degrees are allowed.}

function RotateImage(var Image: TImageData; Angle: LongInt): Boolean;

{ Drawing/Pixel functions }

{ Copies rectangular part of SrcImage to DstImage. No blending is performed -

  alpha is simply copied to destination image. Operates also with

  negative X and Y coordinates.

  Note that copying is fastest for images in the same data format

  (and slowest for images in special formats).}

function CopyRect(const SrcImage: TImageData; SrcX, SrcY, Width, Height: LongInt;

  var DstImage: TImageData; DstX, DstY: LongInt): Boolean;

{ Fills given rectangle of image with given pixel fill data. Fill should point

  to the pixel in the same format as the given image is in.}

function FillRect(var Image: TImageData; X, Y, Width, Height: LongInt; FillColor: Pointer): Boolean;

{ Replaces pixels with OldPixel in the given rectangle by NewPixel.

  OldPixel and NewPixel should point to the pixels in the same format

  as the given image is in.}

function ReplaceColor(var Image: TImageData; X, Y, Width, Height: LongInt;

  OldColor, NewColor: Pointer): Boolean;

{ Stretches the contents of the source rectangle to the destination rectangle

  with optional resampling. No blending is performed - alpha is

  simply copied/resampled to destination image. Note that stretching is

  fastest for images in the same data format (and slowest for

  images in special formats).}

function StretchRect(const SrcImage: TImageData; SrcX, SrcY, SrcWidth,

  SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth,

  DstHeight: LongInt; Filter: TResizeFilter): Boolean;

{ Copies pixel of Image at [X, Y] to memory pointed at by Pixel. Doesn't

  work with special formats.}

procedure GetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer);

{ Copies pixel from memory pointed at by Pixel to Image at position [X, Y].

  Doesn't work with special formats.}

procedure SetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer);

{ Function for getting pixel colors. Native pixel is read from Image and

  then translated to 32 bit ARGB. Works for all image formats (except special)

  so it is not very fast.}

function GetPixel32(const Image: TImageData; X, Y: LongInt): TColor32Rec;

{ Procedure for setting pixel colors. Input 32 bit ARGB color is translated to

  native format and then written to Image. Works for all image formats (except special)

  so it is not very fast.}

procedure SetPixel32(const Image: TImageData; X, Y: LongInt; const Color: TColor32Rec);

{ Function for getting pixel colors. Native pixel is read from Image and

  then translated to FP ARGB. Works for all image formats (except special)

  so it is not very fast.}

function GetPixelFP(const Image: TImageData; X, Y: LongInt): TColorFPRec;

{ Procedure for setting pixel colors. Input FP ARGB color is translated to

  native format and then written to Image. Works for all image formats (except special)

  so it is not very fast.}

procedure SetPixelFP(const Image: TImageData; X, Y: LongInt; const Color: TColorFPRec); 

{ Palette Functions }

{ Allocates new palette with Entries ARGB color entries.}

procedure NewPalette(Entries: LongInt; var Pal: PPalette32);

{ Frees given palette.}

procedure FreePalette(var Pal: PPalette32);

{ Copies Count palette entries from SrcPal starting at index SrcIdx to

  DstPal at index DstPal.}

procedure CopyPalette(SrcPal, DstPal: PPalette32; SrcIdx, DstIdx, Count: LongInt);

{ Returns index of color in palette or index of nearest color if exact match

  is not found. Pal must have at least Entries color entries.}

function FindColor(Pal: PPalette32; Entries: LongInt; Color: TColor32): LongInt;

{ Creates grayscale palette where each color channel has the same value.

  Pal must have at least Entries color entries.}

procedure FillGrayscalePalette(Pal: PPalette32; Entries: LongInt);

{ Creates palette with given bitcount for each channel.

  2^(RBits + GBits + BBits) should be equl to Entries. Examples:

  (3, 3, 2) will create palette with all possible colors of R3G3B2 format

  and (8, 0, 0) will create palette with 256 shades of red.

  Pal must be allocated to at least Entries * SizeOf(TColor32Rec) bytes.}

procedure FillCustomPalette(Pal: PPalette32; Entries: LongInt; RBits, GBits,

  BBits: Byte; Alpha: Byte = $FF);

{ Swaps SrcChannel and DstChannel color or alpha channels of palette.

  Use ChannelRed, ChannelBlue, ChannelGreen, ChannelAlpha constants to

  identify channels. Pal must be allocated to at least

  Entries * SizeOf(TColor32Rec) bytes.}

procedure SwapChannelsOfPalette(Pal: PPalette32; Entries, SrcChannel,

  DstChannel: LongInt);

{ Options Functions }

{ Sets value of integer option specified by OptionId parameter.

  Option Ids are constans starting ImagingXXX.}

function SetOption(OptionId, Value: LongInt): Boolean;

{ Returns value of integer option specified by OptionId parameter. If OptionId is

  invalid, InvalidOption is returned. Option Ids are constans

  starting ImagingXXX.}

function GetOption(OptionId: LongInt): LongInt;

{ Pushes current values of all options on the stack. Returns True

  if successfull (max stack depth is 8 now). }

function PushOptions: Boolean;

{ Pops back values of all options from the top of the stack. Returns True

  if successfull (max stack depth is 8 now). }

function PopOptions: Boolean;

{ Image Format Functions }

{ Returns short information about given image format.}

function GetImageFormatInfo(Format: TImageFormat; var Info: TImageFormatInfo): Boolean;

{ Returns size in bytes of Width x Height area of pixels. Works for all formats.}

function GetPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt;

{ IO Functions }

{ User can set his own file IO functions used when loading from/saving to

  files by this function.}

procedure SetUserFileIO(OpenReadProc: TOpenReadProc; OpenWriteProc:

  TOpenWriteProc; CloseProc: TCloseProc; EofProc: TEofProc; SeekProc:

  TSeekProc; TellProc: TTellProc; ReadProc: TReadProc; WriteProc: TWriteProc);

{ Sets file IO functions to Imaging default.}

procedure ResetFileIO;

{ ------------------------------------------------------------------------

                           Other Imaging Stuff

  ------------------------------------------------------------------------}

type

  { Set of TImageFormat enum.}

  TImageFormats = set of TImageFormat;

  { Record containg set of IO functions internaly used by image loaders/savers.}

  TIOFunctions = record

    OpenRead: TOpenReadProc;

    OpenWrite: TOpenWriteProc;

    Close: TCloseProc;

    Eof: TEofProc;

    Seek: TSeekProc;

    Tell: TTellProc;

    Read: TReadProc;

    Write: TWriteProc;

  end;

  PIOFunctions = ^TIOFunctions;

  { Base class for various image file format loaders/savers which

    descend from this class. If you want to add support for new image file

    format the best way is probably to look at TImageFileFormat descendants'

    implementations that are already part of Imaging.}

  {$TYPEINFO ON}

  TImageFileFormat = class(TObject)

  private

    FExtensions: TStringList;

    FMasks: TStringList;

    { Does various checks and actions before LoadData method is called.}

    function PrepareLoad(Handle: TImagingHandle; var Images: TDynImageDataArray;

      OnlyFirstFrame: Boolean): Boolean;

    { Processes some actions according to result of LoadData.}

    function PostLoadCheck(var Images: TDynImageDataArray; LoadResult: Boolean): Boolean;

    { Helper function to be called in SaveData methods of descendants (ensures proper

      index and sets FFirstIdx and FLastIdx for multi-images).}

    function PrepareSave(Handle: TImagingHandle; const Images: TDynImageDataArray;

      var Index: LongInt): Boolean;

  protected

    FName: string;

    FCanLoad: Boolean;

    FCanSave: Boolean;

    FIsMultiImageFormat: Boolean;

    FSupportedFormats: TImageFormats;

    FFirstIdx, FLastIdx: LongInt;

    { Defines filename masks for this image file format. AMasks should be

      in format '*.ext1,*.ext2,umajo.*'.}

    procedure AddMasks(const AMasks: string);

    function GetFormatInfo(Format: TImageFormat): TImageFormatInfo;

    { Returns set of TImageData formats that can be saved in this file format

      without need for conversion.}

    function GetSupportedFormats: TImageFormats; virtual;

    { Method which must be overrided in descendants if they' are be capable

      of loading images. Images are already freed and length is set to zero

      whenever this method gets called. Also Handle is assured to be valid

      and contains data that passed TestFormat method's check.}

    function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;

      OnlyFirstFrame: Boolean): Boolean; virtual;

    { Method which must be overrided in descendants if they are be capable

      of saving images. Images are checked to have length >0 and

      that they contain valid images. For single-image file formats

      Index contain valid index to Images array (to image which should be saved).

      Multi-image formats should use FFirstIdx and FLastIdx fields to

      to get all images that are to be saved.}

    function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;

      Index: LongInt): Boolean; virtual;

    { This method is called internaly by MakeCompatible when input image

      is in format not supported by this file format. Image is clone of

      MakeCompatible's input and Info is its extended format info.}

    procedure ConvertToSupported(var Image: TImageData;

      const Info: TImageFormatInfo); virtual;

    { Returns True if given image is supported for saving by this file format.

      Most file formats don't need to override this method. It checks

      (in this base class) if Image's format is in SupportedFromats set.

      But you may override it if you want further checks

      (proper widht and height for example).}

    function IsSupported(const Image: TImageData): Boolean; virtual;

  public

    constructor Create; virtual;

    destructor Destroy; override;

    { Loads images from file source.}

    function LoadFromFile(const FileName: string; var Images: TDynImageDataArray;

      OnlyFirstLevel: Boolean = False): Boolean;

    { Loads images from stream source.}

    function LoadFromStream(Stream: TStream; var Images: TDynImageDataArray;

      OnlyFirstLevel: Boolean = False): Boolean;

    { Loads images from memory source.}

    function LoadFromMemory(Data: Pointer; Size: LongInt;

      var Images: TDynImageDataArray; OnlyFirstLevel: Boolean = False): Boolean;

    { Saves images to file. If format supports only single level images and

      there are multiple images to be saved, they are saved as sequence of

      independent images (for example SaveToFile saves sequence of

      files img000.jpg, img001.jpg ....).}

    function SaveToFile(const FileName: string; const Images: TDynImageDataArray;

      OnlyFirstLevel: Boolean = False): Boolean;

    { Saves images to stream. If format supports only single level images and

      there are multiple images to be saved, they are saved as sequence of

      independent images.}

    function SaveToStream(Stream: TStream; const Images: TDynImageDataArray;

      OnlyFirstLevel: Boolean = False): Boolean;

    { Saves images to memory. If format supports only single level images and

      there are multiple images to be saved, they are saved as sequence of

      independent images. Data must be already allocated and their size passed

      as Size parameter, number of written bytes is then returned in the same

      parameter.}

    function SaveToMemory(Data: Pointer; var Size: LongInt;

      const Images: TDynImageDataArray; OnlyFirstLevel: Boolean = False): Boolean;

    { Makes Image compatible with this file format (that means it is in one

      of data formats in Supported formats set). If input is already

      in supported format then Compatible just use value from input

      (Compatible := Image) so must not free it after you are done with it

      (image bits pointer points to input image's bits).

      If input is not in supported format then it is cloned to Compatible

      and concerted to one of supported formats (which one dependeds on

      this file format). If image is cloned MustBeFreed is set to True

      to indicated that you must free Compatible after you are done with it.}

    function MakeCompatible(const Image: TImageData; var Compatible: TImageData;

      out MustBeFreed: Boolean): Boolean;   

    { Returns True if data located in source identified by Handle

      represent valid image in current format.}

    function TestFormat(Handle: TImagingHandle): Boolean; virtual;

    { Resturns True if the given FileName matches filter for this file format.

      For most formats it just checks filename extensions.

      It uses filename masks in from Masks property so it can recognize

      filenames like this 'umajoXXXumajo.j0j' if one of themasks is

      'umajo*umajo.j?j'.}

    function TestFileName(const FileName: string): Boolean;

    { Descendants use this method to check if their options (registered with

      constant Ids for SetOption/GetOption interface or accessible as properties

      of descendants) have valid values and make necessary changes.}

    procedure CheckOptionsValidity; virtual;

    { Description of this format.}

    property Name: string read FName;

    { Indicates whether images in this format can be loaded.}

    property CanLoad: Boolean read FCanLoad;

    { Indicates whether images in this format can be saved.}

    property CanSave: Boolean read FCanSave;

    { Indicates whether images in this format can contain multiple image levels.}

    property IsMultiImageFormat: Boolean read FIsMultiImageFormat;

    { List of filename extensions for this format.}

    property Extensions: TStringList read FExtensions;

    { List of filename mask that are used to associate filenames

      with TImageFileFormat descendants. Typical mask looks like

      '*.bmp' or 'texture.*' (supports file formats which use filename instead

      of extension to identify image files).}

    property Masks: TStringList read FMasks;

    { Set of TImageFormats supported by saving functions of this format. Images

      can be saved only in one those formats.}

    property SupportedFormats: TImageFormats read GetSupportedFormats;

  end;

  {$TYPEINFO OFF}

  { Class reference for TImageFileFormat class}

  TImageFileFormatClass = class of TImageFileFormat;

{ Returns symbolic name of given format.}

function GetFormatName(Format: TImageFormat): string;

{ Returns string with information about given Image.}

function ImageToStr(const Image: TImageData): string;

{ Returns Imaging version string in format 'Major.Minor.Patch'.}

function GetVersionStr: string;

{ If Condition is True then TruePart is retured, otherwise FalsePart is returned.}

function IffFormat(Condition: Boolean; const TruePart, FalsePart: TImageFormat): TImageFormat;

{ Registers new image loader/saver so it can be used by LoadFrom/SaveTo

  functions.}

procedure RegisterImageFileFormat(AClass: TImageFileFormatClass);

{ Registers new option so it can be used by SetOption and GetOption functions.

  Returns True if registration was succesful - that is Id is valid and is

  not already taken by another option.}

function RegisterOption(OptionId: LongInt; Variable: PLongInt): Boolean;

{ Returns image format loader/saver according to given extension

  or nil if not found.}

function FindImageFileFormatByExt(const Ext: string): TImageFileFormat;

{ Returns image format loader/saver according to given filename

  or nil if not found.}

function FindImageFileFormatByName(const FileName: string): TImageFileFormat;

{ Returns image format loader/saver based on its class

  or nil if not found or not registered.}

function FindImageFileFormatByClass(AClass: TImageFileFormatClass): TImageFileFormat;

{ Returns number of registered image file format loaders/saver.}

function GetFileFormatCount: LongInt;

{ Returns image file format loader/saver at given index. Index must be

  in range [0..GetFileFormatCount - 1] otherwise nil is returned.}

function GetFileFormatAtIndex(Index: LongInt): TImageFileFormat;

{ Returns filter string for usage with open and save picture dialogs

  which contains all registered image file formats.

  Set OpenFileFilter to True if you want filter for open dialog

  and to False if you want save dialog filter (formats that cannot save to files

  are not added then).

  For open dialog filter for all known graphic files

  (like All(*.jpg;*.png;....) is added too at the first index.}

function GetImageFileFormatsFilter(OpenFileFilter: Boolean): string;

{ Returns file extension (without dot) of image format selected

  by given filter index. Used filter string is defined by GetImageFileFormatsFilter

  function. This function can be used with save dialogs (with filters created

  by GetImageFileFormatsFilter) to get the extension of file format selected

  in dialog quickly. Index is in range 1..N (as FilterIndex property

  of TOpenDialog/TSaveDialog)}

function GetFilterIndexExtension(Index: LongInt; OpenFileFilter: Boolean): string;

{ Returns filter index of image file format of file specified by FileName. Used filter

  string is defined by GetImageFileFormatsFilter function.

  Returned index is in range 1..N (as FilterIndex property of TOpenDialog/TSaveDialog)}

function GetFileNameFilterIndex(const FileName: string; OpenFileFilter: Boolean): LongInt;

{ Returns current IO functions.}

function GetIO: TIOFunctions;

{ Raises EImagingError with given message.}

procedure RaiseImaging(const Msg: string; const Args: array of const);

implementation

uses

{$IFDEF LINK_BITMAP}

  ImagingBitmap,

{$ENDIF}

{$IFDEF LINK_JPEG}

  ImagingJpeg,

{$ENDIF}

{$IF Defined(LINK_PNG) or Defined(LINK_MNG) or Defined(LINK_JNG)}

  ImagingNetworkGraphics,

{$IFEND}

{$IFDEF LINK_GIF}

  ImagingGif,

{$ENDIF}

{$IFDEF LINK_DDS}

  ImagingDds,

{$ENDIF}

{$IFDEF LINK_TARGA}

  ImagingTarga,

{$ENDIF}

{$IFDEF LINK_PNM}

  ImagingPortableMaps,

{$ENDIF}

{$IFDEF LINK_EXTRAS}

  ImagingExtras,

{$ENDIF}

  ImagingFormats, ImagingUtility, ImagingIO;

resourcestring

  SImagingTitle = 'Vampyre Imaging Library';

  SExceptMsg = 'Exception Message';

  SAllFilter = 'All Images';

  SUnknownFormat = 'Unknown and unsupported format';

  SErrorFreeImage = 'Error while freeing image. %s';

  SErrorCloneImage = 'Error while cloning image. %s';

  SErrorFlipImage = 'Error while flipping image. %s';

  SErrorMirrorImage = 'Error while mirroring image. %s';

  SErrorResizeImage = 'Error while resizing image.  %s';

  SErrorSwapImage = 'Error while swapping channels of image. %s';

  SFileFormatCanNotLoad = 'Image Format "%s" does not support loading images.';

  SFileFormatCanNotSave = 'Image Format "%s" does not support saving images.';

  SErrorNewImage = 'Error while creating image data with params: Width=%d ' +

    'Height=%d Format=%s.';

  SErrorConvertImage = 'Error while converting image to format "%s". %s';

  SImageInfo = 'Image @%p info: Width = %dpx, Height = %dpx, ' +

    'Format = %s, Size = %.0n %s, Bits @%p, Palette @%p.';

  SImageInfoInvalid = 'Access violation encountered when getting info on ' +

    'image at address %p.';

  SFileNotValid = 'File "%s" is not valid image in "%s" format.';

  SStreamNotValid = 'Stream %p does not contain valid image in "%s" format.';

  SMemoryNotValid = 'Memory %p (%d Bytes) does not contain valid image ' +

    'in "%s" format.';

  SErrorLoadingFile = 'Error while loading images from file "%s" (file format: %s).';

  SErrorLoadingStream = 'Error while loading images from stream %p (file format: %s).';

  SErrorLoadingMemory = 'Error while loading images from memory %p (%d Bytes) (file format: %s).';

  SErrorSavingFile = 'Error while saving images to file "%s" (file format: %s).';

  SErrorSavingStream = 'Error while saving images to stream %p (file format: %s).';

  SErrorSavingMemory = 'Error while saving images to memory %p (%d Bytes) (file format: %s).';

  SErrorFindColor = 'Error while finding color in palette @%p with %d entries.';

  SErrorGrayscalePalette = 'Error while filling grayscale palette @%p with %d entries.';

  SErrorCustomPalette = 'Error while filling custom palette @%p with %d entries.';

  SErrorSwapPalette = 'Error while swapping channels of palette @%p with %d entries.';

  SErrorReduceColors = 'Error while reducing number of colors of image to %d. %s';

  SErrorGenerateMipMaps = 'Error while generating %d mipmap levels for image %s';

  SImagesNotValid = 'One or more images are not valid.';

  SErrorCopyRect = 'Error while copying rect from image %s to image %s.';

  SErrorMapImage = 'Error while mapping image %s to palette.';

  SErrorFillRect = 'Error while filling rectangle X:%d Y:%d W:%d H:%d in image %s';

  SErrorSplitImage = 'Error while splitting image %s to %dx%d sized chunks.';

  SErrorMakePaletteForImages = 'Error while making %d color palette for %d images.';

  SErrorNewPalette = 'Error while creating new palette with %d entries';

  SErrorFreePalette = 'Error while freeing palette @%p';

  SErrorCopyPalette = 'Error while copying %d entries from palette @%p to @%p';

  SErrorReplaceColor = 'Error while replacing colors in rectangle X:%d Y:%d W:%d H:%d of image %s';

  SErrorRotateImage = 'Error while rotating image %s by %d degrees';

  SErrorStretchRect = 'Error while stretching rect from image %s to image %s.';

const

  // initial size of array with options information

  InitialOptions = 256;

  // max depth of the option stack

  OptionStackDepth = 8;

  // do not change the default format now, its too late

  DefaultImageFormat: TImageFormat = ifA8R8G8B8;

type

  TOptionArray = array of PLongInt;

  TOptionValueArray = array of LongInt;

  TOptionStack = class(TObject)

  private

    FStack: array[0..OptionStackDepth - 1] of TOptionValueArray;

    FPosition: LongInt;

  public

    constructor Create;

    destructor Destroy; override;

    function Push: Boolean;

    function Pop: Boolean;

  end;

var

  // currently set IO functions

  IO: TIOFunctions;

  // list with all registered TImageFileFormat classes

  ImageFileFormats: TList = nil;

  // array with registered options (pointers to their values)

  Options: TOptionArray = nil;

  // array containing addional infomation about every image format

  ImageFormatInfos: TImageFormatInfoArray;

  // stack used by PushOptions/PopOtions functions

  OptionStack: TOptionStack = nil;

var

  // variable for ImagingColorReduction option

  ColorReductionMask: LongInt = $FF;

  // variable for ImagingLoadOverrideFormat option

  LoadOverrideFormat: TImageFormat = ifUnknown;

  // variable for ImagingSaveOverrideFormat option

  SaveOverrideFormat: TImageFormat = ifUnknown;

  // variable for ImagingSaveOverrideFormat option

  MipMapFilter: TSamplingFilter = sfLinear;

{ Internal unit functions }

{ Modifies option value to be in the allowed range. Works only

  for options registered in this unit.}

function CheckOptionValue(OptionId, Value: LongInt): LongInt; forward;

{ Sets IO functions to file IO.}

procedure SetFileIO; forward;

{ Sets IO functions to stream IO.}

procedure SetStreamIO; forward;

{ Sets IO functions to memory IO.}

procedure SetMemoryIO; forward;

{ Inits image format infos array.}

procedure InitImageFormats; forward;

{ Freew image format infos array.}

procedure FreeImageFileFormats; forward;

{ Creates options array and stack.}

procedure InitOptions; forward;

{ Frees options array and stack.}

procedure FreeOptions; forward;

{$IFDEF USE_INLINE}

{ Those inline functions are copied here from ImagingFormats

  because Delphi 9/10 cannot inline them if they are declared in

  circularly dependent units.}

procedure CopyPixel(Src, Dest: Pointer; BytesPerPixel: LongInt); inline;

begin

  case BytesPerPixel of

    1: PByte(Dest)^ := PByte(Src)^;

    2: PWord(Dest)^ := PWord(Src)^;

    3: PColor24Rec(Dest)^ := PColor24Rec(Src)^;

    4: PLongWord(Dest)^ := PLongWord(Src)^;

    6: PColor48Rec(Dest)^ := PColor48Rec(Src)^;

    8: PInt64(Dest)^ := PInt64(Src)^;

    16: PColorFPRec(Dest)^ := PColorFPRec(Src)^;

  end;

end;

function ComparePixels(PixelA, PixelB: Pointer; BytesPerPixel: LongInt): Boolean; inline;

begin

  case BytesPerPixel of

    1: Result := PByte(PixelA)^ = PByte(PixelB)^;

    2: Result := PWord(PixelA)^ = PWord(PixelB)^;

    3: Result := (PWord(PixelA)^ = PWord(PixelB)^) and

         (PColor24Rec(PixelA).R = PColor24Rec(PixelB).R);

    4: Result := PLongWord(PixelA)^ = PLongWord(PixelB)^;

    6: Result := (PLongWord(PixelA)^ = PLongWord(PixelB)^) and

         (PColor48Rec(PixelA).R = PColor48Rec(PixelB).R);

    8: Result := PInt64(PixelA)^ = PInt64(PixelB)^;

    16: Result := (PFloatHelper(PixelA).Data2 = PFloatHelper(PixelB).Data2) and

          (PFloatHelper(PixelA).Data1 = PFloatHelper(PixelB).Data1);

  else

    Result := False;

  end;

end;

{$ENDIF}

{ ------------------------------------------------------------------------

                       Low Level Interface Functions

  ------------------------------------------------------------------------}

{ General Functions }

procedure InitImage(var Image: TImageData);

begin

  FillChar(Image, SizeOf(Image), 0);

end;

function NewImage(Width, Height: LongInt; Format: TImageFormat; var Image:

  TImageData): Boolean;

var

  FInfo: PImageFormatInfo;

begin

  Assert((Width >= 0) and (Height >= 0));

  Assert(IsImageFormatValid(Format));

  Result := False;

  FreeImage(Image);

  try

    Image.Width := Width;

    Image.Height := Height;

    // Select default data format if selected

    if (Format = ifDefault)  then

      Image.Format := DefaultImageFormat

    else

      Image.Format := Format;

    // Get extended format info

    FInfo := ImageFormatInfos[Image.Format];

    if FInfo = nil then

    begin

      InitImage(Image);

      Exit;

    end;

    // Check image dimensions and calculate its size in bytes

    FInfo.CheckDimensions(FInfo.Format, Image.Width, Image.Height);

    Image.Size := FInfo.GetPixelsSize(FInfo.Format, Image.Width, Image.Height);

    if Image.Size = 0 then

    begin

      InitImage(Image);

      Exit;

    end;

    // Image bits are allocated and set to zeroes

    GetMem(Image.Bits, Image.Size);

    FillChar(Image.Bits^, Image.Size, 0);

    // Palette is allocated and set to zeroes

    if FInfo.PaletteEntries > 0 then

    begin

      GetMem(Image.Palette, FInfo.PaletteEntries * SizeOf(TColor32Rec));

      FillChar(Image.Palette^, FInfo.PaletteEntries * SizeOf(TColor32Rec), 0);

    end;

    Result := TestImage(Image);

  except

    RaiseImaging(SErrorNewImage, [Width, Height, GetFormatName(Format)]);

  end;

end;

function TestImage(const Image: TImageData): Boolean;

begin

  try

    Result := (LongInt(Image.Format) >= LongInt(Low(TImageFormat))) and

      (LongInt(Image.Format) <= LongInt(High(TImageFormat))) and

      (ImageFormatInfos[Image.Format] <> nil) and

      (Assigned(ImageFormatInfos[Image.Format].GetPixelsSize) and

      (ImageFormatInfos[Image.Format].GetPixelsSize(Image.Format,

      Image.Width, Image.Height) = Image.Size));

  except

    // Possible int overflows or other errors 

    Result := False;

  end;

end;

procedure FreeImage(var Image: TImageData);

begin

  try

    if TestImage(Image) then

    begin

      FreeMemNil(Image.Bits);

      FreeMemNil(Image.Palette);

    end;

    InitImage(Image);

  except

    RaiseImaging(SErrorFreeImage, [ImageToStr(Image)]);

  end;

end;

procedure FreeImagesInArray(var Images: TDynImageDataArray);

var

  I: LongInt;

begin

  if Length(Images) > 0 then

  begin

    for I := 0 to Length(Images) - 1 do

      FreeImage(Images[I]);

    SetLength(Images, 0);

  end;

end;

function TestImagesInArray(const Images: TDynImageDataArray): Boolean;

var

  I: LongInt;

begin

  if Length(Images) > 0 then

  begin

    Result := True;

    for I := 0 to Length(Images) - 1 do

    begin

      Result := Result and TestImage(Images[I]);

      if not Result then

        Break;

    end;

  end

  else

    Result := False;

end;

function DetermineFileFormat(const FileName: string): string;

var

  I: LongInt;

  Fmt: TImageFileFormat;

  Handle: TImagingHandle;

begin

  Assert(FileName <> '');

  Result := '';

  SetFileIO;

  try

    Handle := IO.OpenRead(PChar(FileName));

    try

      // First file format according to FileName and test if the data in

      // file is really in that format

      for I := 0 to ImageFileFormats.Count - 1 do

      begin

        Fmt := TImageFileFormat(ImageFileFormats[I]);

        if Fmt.TestFileName(FileName) and Fmt.TestFormat(Handle) then

        begin

          Result := Fmt.Extensions[0];

          Exit;

        end;

      end;

      // No file format was found with filename search so try data-based search

      for I := 0 to ImageFileFormats.Count - 1 do

      begin

        Fmt := TImageFileFormat(ImageFileFormats[I]);

        if Fmt.TestFormat(Handle) then

        begin

          Result := Fmt.Extensions[0];

          Exit;

        end;

      end;

    finally

      IO.Close(Handle);

    end;

  except

    Result := '';

  end;

end;

function DetermineStreamFormat(Stream: TStream): string;

var

  I: LongInt;

  Fmt: TImageFileFormat;

  Handle: TImagingHandle;

begin

  Assert(Stream <> nil);

  Result := '';

  SetStreamIO;

  try

    Handle := IO.OpenRead(Pointer(Stream));

    try

      for I := 0 to ImageFileFormats.Count - 1 do

      begin

        Fmt := TImageFileFormat(ImageFileFormats[I]);

        if Fmt.TestFormat(Handle) then

        begin

          Result := Fmt.Extensions[0];

          Exit;

        end;

      end;

    finally

      IO.Close(Handle);

    end;

  except

    Result := '';

  end;

end;

function DetermineMemoryFormat(Data: Pointer; Size: LongInt): string;

var

  I: LongInt;

  Fmt: TImageFileFormat;

  Handle: TImagingHandle;

  IORec: TMemoryIORec;

begin

  Assert((Data <> nil) and (Size > 0));

  Result := '';

  SetMemoryIO;

  IORec.Data := Data;

  IORec.Position := 0;

  IORec.Size := Size;

  try

    Handle := IO.OpenRead(@IORec);

    try

      for I := 0 to ImageFileFormats.Count - 1 do

      begin

        Fmt := TImageFileFormat(ImageFileFormats[I]);

        if Fmt.TestFormat(Handle) then

        begin

          Result := Fmt.Extensions[0];

          Exit;

        end;

      end;

    finally

      IO.Close(Handle);

    end;

  except

    Result := '';

  end;

end;

function IsFileFormatSupported(const FileName: string): Boolean;

begin

  Result := FindImageFileFormatByName(FileName) <> nil;

end;

function EnumFileFormats(var Index: LongInt; var Name, DefaultExt, Masks: string;

  var CanSaveImages, IsMultiImageFormat: Boolean): Boolean;

var

  FileFmt: TImageFileFormat;

begin

  FileFmt := GetFileFormatAtIndex(Index);

  Result := FileFmt <> nil;

  if Result then

  begin

    Name := FileFmt.Name;

    DefaultExt := FileFmt.Extensions[0];

    Masks := FileFmt.Masks.DelimitedText; 

    CanSaveImages := FileFmt.CanSave;

    IsMultiImageFormat := FileFmt.IsMultiImageFormat;

    Inc(Index);

  end

  else

  begin

    Name := '';

    DefaultExt := '';

    Masks := '';

    CanSaveImages := False;

    IsMultiImageFormat := False;

  end;

end;

{ Loading Functions }

function LoadImageFromFile(const FileName: string; var Image: TImageData):

  Boolean;

var

  Format: TImageFileFormat;

  IArray: TDynImageDataArray;

  I: LongInt;

begin

  Assert(FileName <> '');

  Result := False;

  Format := FindImageFileFormatByExt(DetermineFileFormat(FileName));

  if Format <> nil then

  begin

    FreeImage(Image);

    Result := Format.LoadFromFile(FileName, IArray, True);

    if Result and (Length(IArray) > 0) then

    begin

      Image := IArray[0];

      for I := 1 to Length(IArray) - 1 do

        FreeImage(IArray[I]);

    end

    else

      Result := False;

  end;

end;

function LoadImageFromStream(Stream: TStream; var Image: TImageData): Boolean;

var

  Format: TImageFileFormat;

  IArray: TDynImageDataArray;

  I: LongInt;

begin

  Assert(Stream <> nil);

  Result := False;

  Format := FindImageFileFormatByExt(DetermineStreamFormat(Stream));

  if Format <> nil then

  begin

    FreeImage(Image);

    Result := Format.LoadFromStream(Stream, IArray, True);

    if Result and (Length(IArray) > 0) then

    begin

      Image := IArray[0];

      for I := 1 to Length(IArray) - 1 do

        FreeImage(IArray[I]);

    end

    else

      Result := False;

  end;

end;

function LoadImageFromMemory(Data: Pointer; Size: LongInt; var Image: TImageData): Boolean;

var

  Format: TImageFileFormat;

  IArray: TDynImageDataArray;

  I: LongInt;

begin

  Assert((Data <> nil) and (Size > 0));

  Result := False;

  Format := FindImageFileFormatByExt(DetermineMemoryFormat(Data, Size));

  if Format <> nil then

  begin

    FreeImage(Image);

    Result := Format.LoadFromMemory(Data, Size, IArray, True);

    if Result and (Length(IArray) > 0) then

    begin

      Image := IArray[0];

      for I := 1 to Length(IArray) - 1 do

        FreeImage(IArray[I]);

    end

    else

      Result := False;

  end;

end;

function LoadMultiImageFromFile(const FileName: string; var Images:

  TDynImageDataArray): Boolean;

var

  Format: TImageFileFormat;

begin

  Assert(FileName <> '');

  Result := False;

  Format := FindImageFileFormatByExt(DetermineFileFormat(FileName));

  if Format <> nil then

  begin

    FreeImagesInArray(Images);

    Result := Format.LoadFromFile(FileName, Images);

  end;

end;

function LoadMultiImageFromStream(Stream: TStream; var Images: TDynImageDataArray): Boolean;

var

  Format: TImageFileFormat;

begin

  Assert(Stream <> nil);

  Result := False;

  Format := FindImageFileFormatByExt(DetermineStreamFormat(Stream));

  if Format <> nil then

  begin

    FreeImagesInArray(Images);

    Result := Format.LoadFromStream(Stream, Images);

  end;

end;

function LoadMultiImageFromMemory(Data: Pointer; Size: LongInt;

  var Images: TDynImageDataArray): Boolean;

var

  Format: TImageFileFormat;

begin

  Assert((Data <> nil) and (Size > 0));

  Result := False;

  Format := FindImageFileFormatByExt(DetermineMemoryFormat(Data, Size));

  if Format <> nil then

  begin

    FreeImagesInArray(Images);

    Result := Format.LoadFromMemory(Data, Size, Images);

  end;

end;

{ Saving Functions }

function SaveImageToFile(const FileName: string; const Image: TImageData): Boolean;

var

  Format: TImageFileFormat;

  IArray: TDynImageDataArray;

begin

  Assert(FileName <> '');

  Result := False;

  Format := FindImageFileFormatByName(FileName);

  if Format <> nil then

  begin

    SetLength(IArray, 1);

    IArray[0] := Image;

    Result := Format.SaveToFile(FileName, IArray, True);

  end;

end;

function SaveImageToStream(const Ext: string; Stream: TStream;

  const Image: TImageData): Boolean;

var

  Format: TImageFileFormat;

  IArray: TDynImageDataArray;

begin

  Assert((Ext <> '') and (Stream <> nil));

  Result := False;

  Format := FindImageFileFormatByExt(Ext);

  if Format <> nil then

  begin

    SetLength(IArray, 1);

    IArray[0] := Image;

    Result := Format.SaveToStream(Stream, IArray, True);

  end;

end;

function SaveImageToMemory(const Ext: string; Data: Pointer; var Size: LongInt;

  const Image: TImageData): Boolean;

var

  Format: TImageFileFormat;

  IArray: TDynImageDataArray;

begin

  Assert((Ext <> '') and (Data <> nil) and (Size > 0));

  Result := False;

  Format := FindImageFileFormatByExt(Ext);

  if Format <> nil then

  begin

    SetLength(IArray, 1);

    IArray[0] := Image;

    Result := Format.SaveToMemory(Data, Size, IArray, True);

  end;

end;

function SaveMultiImageToFile(const FileName: string;

  const Images: TDynImageDataArray): Boolean;

var

  Format: TImageFileFormat;

begin

  Assert(FileName <> '');

  Result := False;

  Format := FindImageFileFormatByName(FileName);

  if Format <> nil then

    Result := Format.SaveToFile(FileName, Images);

end;

function SaveMultiImageToStream(const Ext: string; Stream: TStream;

  const Images: TDynImageDataArray): Boolean;

var

  Format: TImageFileFormat;

begin

  Assert((Ext <> '') and (Stream <> nil));

  Result := False;

  Format := FindImageFileFormatByExt(Ext);

  if Format <> nil then

    Result := Format.SaveToStream(Stream, Images);

end;

function SaveMultiImageToMemory(const Ext: string; Data: Pointer;

  var Size: LongInt; const Images: TDynImageDataArray): Boolean;

var

  Format: TImageFileFormat;

begin

  Assert((Ext <> '') and (Data <> nil) and (Size > 0));

  Result := False;

  Format := FindImageFileFormatByExt(Ext);

  if Format <> nil then

    Result := Format.SaveToMemory(Data, Size, Images);

end;

{ Manipulation Functions }

function CloneImage(const Image: TImageData; var Clone: TImageData): Boolean;

var

  Info: PImageFormatInfo;

begin

  Result := False;

  if TestImage(Image) then

  try

    if TestImage(Clone) and (Image.Bits <> Clone.Bits) then

      FreeImage(Clone)

    else

      InitImage(Clone);

    Info := ImageFormatInfos[Image.Format];

    Clone.Width := Image.Width;

    Clone.Height := Image.Height;

    Clone.Format := Image.Format;

    Clone.Size := Image.Size;

    if Info.PaletteEntries > 0 then

    begin

      GetMem(Clone.Palette, Info.PaletteEntries * SizeOf(TColor32Rec));

      Move(Image.Palette^, Clone.Palette^, Info.PaletteEntries *

        SizeOf(TColor32Rec));

    end;

    GetMem(Clone.Bits, Clone.Size);

    Move(Image.Bits^, Clone.Bits^, Clone.Size);

    Result := True;

  except

    RaiseImaging(SErrorCloneImage, [ImageToStr(Image)]);

  end;

end;

function ConvertImage(var Image: TImageData; DestFormat: TImageFormat): Boolean;

var

  NewData: Pointer;

  NewPal: PPalette32;

  NewSize, NumPixels: LongInt;

  SrcInfo, DstInfo: PImageFormatInfo;

begin

  Assert(IsImageFormatValid(DestFormat));

  Result := False;

  if TestImage(Image) then

  with Image do

  try

    // If default format is set we use DefaultImageFormat

    if DestFormat = ifDefault then

      DestFormat := DefaultImageFormat;

    SrcInfo := ImageFormatInfos[Format];

    DstInfo := ImageFormatInfos[DestFormat];

    if SrcInfo = DstInfo then

    begin

      // There is nothing to convert - src is alredy in dest format

      Result := True;

      Exit;

    end;

    // Exit Src or Dest format is invalid 

    if (SrcInfo = nil) or (DstInfo = nil) then Exit;

    // If dest format is just src with swapped channels we call

    // SwapChannels instead

    if (SrcInfo.RBSwapFormat = DestFormat) and

      (DstInfo.RBSwapFormat = SrcInfo.Format) then

    begin

      Result := SwapChannels(Image, ChannelRed, ChannelBlue);

      Image.Format := SrcInfo.RBSwapFormat;

      Exit;

    end;

    if (not SrcInfo.IsSpecial) and (not DstInfo.IsSpecial) then

    begin

      NumPixels := Width * Height;

      NewSize := NumPixels * DstInfo.BytesPerPixel;

      GetMem(NewData, NewSize);

      FillChar(NewData^, NewSize, 0);

      GetMem(NewPal, DstInfo.PaletteEntries * SizeOf(TColor32Rec));

      FillChar(NewPal^, DstInfo.PaletteEntries * SizeOf(TColor32Rec), 0);

      if SrcInfo.IsIndexed then

      begin

        // Source: indexed format

        if DstInfo.IsIndexed then

          IndexToIndex(NumPixels, Bits, NewData, SrcInfo, DstInfo, Palette, NewPal)

        else if DstInfo.HasGrayChannel then

          IndexToGray(NumPixels, Bits, NewData, SrcInfo, DstInfo, Palette)

        else if DstInfo.IsFloatingPoint then

          IndexToFloat(NumPixels, Bits, NewData, SrcInfo, DstInfo, Palette)

        else

          IndexToChannel(NumPixels, Bits, NewData, SrcInfo, DstInfo, Palette);

      end

      else if SrcInfo.HasGrayChannel then

      begin

        // Source: grayscale format

        if DstInfo.IsIndexed then

          GrayToIndex(NumPixels, Bits, NewData, SrcInfo, DstInfo, NewPal)

        else if DstInfo.HasGrayChannel then

          GrayToGray(NumPixels, Bits, NewData, SrcInfo, DstInfo)

        else if DstInfo.IsFloatingPoint then

          GrayToFloat(NumPixels, Bits, NewData, SrcInfo, DstInfo)

        else

          GrayToChannel(NumPixels, Bits, NewData, SrcInfo, DstInfo);

      end

      else if SrcInfo.IsFloatingPoint then

      begin

        // Source: floating point format

        if DstInfo.IsIndexed then

          FloatToIndex(NumPixels, Bits, NewData, SrcInfo, DstInfo, NewPal)

        else if DstInfo.HasGrayChannel then

          FloatToGray(NumPixels, Bits, NewData, SrcInfo, DstInfo)

        else if DstInfo.IsFloatingPoint then

          FloatToFloat(NumPixels, Bits, NewData, SrcInfo, DstInfo)

        else

          FloatToChannel(NumPixels, Bits, NewData, SrcInfo, DstInfo);

      end

      else

      begin

        // Source: standard multi channel image

        if DstInfo.IsIndexed then

          ChannelToIndex(NumPixels, Bits, NewData, SrcInfo, DstInfo, NewPal)

        else if DstInfo.HasGrayChannel then

          ChannelToGray(NumPixels, Bits, NewData, SrcInfo, DstInfo)

        else if DstInfo.IsFloatingPoint then

          ChannelToFloat(NumPixels, Bits, NewData, SrcInfo, DstInfo)

        else

          ChannelToChannel(NumPixels, Bits, NewData, SrcInfo, DstInfo);

      end;

      FreeMemNil(Bits);

      FreeMemNil(Palette);

      Format := DestFormat;

      Bits := NewData;

      Size := NewSize;

      Palette := NewPal;

    end

    else

      ConvertSpecial(Image, SrcInfo, DstInfo);

    Assert(SrcInfo.Format <> Image.Format);

    Result := True;

  except

    RaiseImaging(SErrorConvertImage, [GetFormatName(DestFormat), ImageToStr(Image)]);

  end;

end;

function FlipImage(var Image: TImageData): Boolean;

var

  P1, P2, Buff: Pointer;

  WidthBytes, I: LongInt;

  OldFmt: TImageFormat;

begin

  Result := False;

  OldFmt := Image.Format;