CentrED

{

  $Id: ImagingFormats.pas 94 2007-06-21 19:29:49Z 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 manages information about all image data formats and contains

  low level format conversion, manipulation, and other related functions.}

unit ImagingFormats;

{$I ImagingOptions.inc}

interface

uses

  ImagingTypes, Imaging, ImagingUtility;

type

  TImageFormatInfoArray = array[TImageFormat] of PImageFormatInfo;

  PImageFormatInfoArray = ^TImageFormatInfoArray;

{ Additional image manipulation functions (usually used internally by Imaging unit) }

type

  { Color reduction operations.}

  TReduceColorsAction = (raCreateHistogram, raUpdateHistogram, raMakeColorMap,

    raMapImage);

  TReduceColorsActions = set of TReduceColorsAction;

const

  AllReduceColorsActions = [raCreateHistogram, raUpdateHistogram,

    raMakeColorMap, raMapImage];

{ Reduces the number of colors of source. Src is bits of source image

  (ARGB or floating point) and Dst is in some indexed format. MaxColors

  is the number of colors to which reduce and DstPal is palette to which

  the resulting colors are written and it must be allocated to at least

  MaxColors entries. ChannelMask is 'anded' with every pixel's channel value

  when creating color histogram. If $FF is used all 8bits of color channels

  are used which can be slow for large images with many colors so you can

  use  lower masks to speed it up.}

procedure ReduceColorsMedianCut(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,

  DstInfo: PImageFormatInfo; MaxColors: LongInt; ChannelMask: Byte;

  DstPal: PPalette32; Actions: TReduceColorsActions = AllReduceColorsActions);

{ Stretches rectangle in source image to rectangle in destination image

  using nearest neighbor filtering. It is fast but results look blocky

  because there is no interpolation used. SrcImage and DstImage must be

  in the same data format. Works for all data formats except special formats.}

procedure StretchNearest(const SrcImage: TImageData; SrcX, SrcY, SrcWidth,

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

  DstHeight: LongInt);

type

  { Built-in sampling filters.}

  TSamplingFilter = (sfNearest, sfLinear, sfCosine, sfHermite, sfQuadratic,

    sfGaussian, sfSpline, sfLanczos, sfMitchell, sfCatmullRom);

  { Type of custom sampling function}

  TFilterFunction = function(Value: Single): Single;

{ Stretches rectangle in source image to rectangle in destination image

  with resampling. One of built-in resampling filters defined by

  Filter is used. Set WrapEdges to True for seamlessly tileable images.

  SrcImage and DstImage must be in the same data format.

  Works for all data formats except special and indexed formats.}

procedure StretchResample(const SrcImage: TImageData; SrcX, SrcY, SrcWidth,

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

  DstHeight: LongInt; Filter: TSamplingFilter; WrapEdges: Boolean = False); overload;

{ Stretches rectangle in source image to rectangle in destination image

  with resampling. You can use custom sampling function and filter radius.

  Set WrapEdges to True for seamlessly tileable images. SrcImage and DstImage

  must be in the same data format.

  Works for all data formats except special and indexed formats.}

procedure StretchResample(const SrcImage: TImageData; SrcX, SrcY, SrcWidth,

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

  DstHeight: LongInt; Filter: TFilterFunction; Radius: Single;

  WrapEdges: Boolean = False); overload;

{ Helper for functions that create mipmap levels. BiggerLevel is

  valid image and SmallerLevel is empty zeroed image. SmallerLevel is created

  with Width and Height dimensions and it is filled with pixels of BiggerLevel

  using resampling filter specified by ImagingMipMapFilter option.

  Uses StretchNearest and StretchResample internally so the same image data format

  limitations apply.}

procedure FillMipMapLevel(const BiggerLevel: TImageData; Width, Height: LongInt;

  var SmallerLevel: TImageData);

{ Various helper format support functions }

{ Copies Src pixel to Dest pixel. It is faster than System.Move procedure.}

procedure CopyPixel(Src, Dest: Pointer; BytesPerPixel: LongInt); {$IFDEF USE_INLINE}inline;{$ENDIF}

{ Compares Src pixel and Dest pixel. It is faster than SysUtils.CompareMem function.}

function ComparePixels(PixelA, PixelB: Pointer; BytesPerPixel: LongInt): Boolean; {$IFDEF USE_INLINE}inline;{$ENDIF}

{ Translates pixel color in SrcFormat to DstFormat.}

procedure TranslatePixel(SrcPixel, DstPixel: Pointer; SrcFormat,

  DstFormat: TImageFormat; SrcPalette, DstPalette: PPalette32);

{ Clamps floating point pixel channel values to [0.0, 1.0] range.}

procedure ClampFloatPixel(var PixF: TColorFPRec); {$IFDEF USE_INLINE}inline;{$ENDIF}

{ Adds padding bytes at the ends of scanlines. Bpp is the number of bytes per

  pixel of source and WidthBytes is the number of bytes per scanlines of dest.}

procedure AddPadBytes(DataIn: Pointer; DataOut: Pointer; Width, Height,

  Bpp, WidthBytes: LongInt);

{ Removes padding from image with scanlines that have aligned sizes. Bpp is

  the number of bytes per pixel of dest and WidthBytes is the number of bytes

  per scanlines of source.}

procedure RemovePadBytes(DataIn: Pointer; DataOut: Pointer; Width, Height,

  Bpp, WidthBytes: LongInt);

{ Converts 1bit image data to 8bit (without scaling). Used by file

  loaders for formats supporting 1bit images.}

procedure Convert1To8(DataIn, DataOut: Pointer; Width, Height,

  WidthBytes: LongInt);

{ Converts 2bit image data to 8bit (without scaling). Used by file

  loaders for formats supporting 2bit images.}

procedure Convert2To8(DataIn, DataOut: Pointer; Width, Height,

  WidthBytes: LongInt);

{ Converts 4bit image data to 8bit (without scaling). Used by file

  loaders for formats supporting 4bit images.}

procedure Convert4To8(DataIn, DataOut: Pointer; Width, Height,

  WidthBytes: LongInt);

{ Helper function for image file loaders. Some 15 bit images (targas, bitmaps)

  may contain 1 bit alpha but there is no indication of it. This function checks

  all 16 bit(should be X1R5G5B5 or A1R5G5B5 format) pixels and some of them have

  alpha bit set it returns True, otherwise False.}

function Has16BitImageAlpha(NumPixels: LongInt; Data: PWord): Boolean;

{ Helper function for image file loaders. This function checks is similar

  to Has16BitImageAlpha but works with A8R8G8B8 format.}

function Has32BitImageAlpha(NumPixels: LongInt; Data: PLongWord): Boolean;

{ Provides indexed access to each line of pixels. Does not work with special

  format images.}

function GetScanLine(ImageBits: Pointer; const FormatInfo: TImageFormatInfo;

  LineWidth, Index: LongInt): Pointer; {$IFDEF USE_INLINE}inline;{$ENDIF}

{ Returns True if Format is valid image data format identifier.}

function IsImageFormatValid(Format: TImageFormat): Boolean;

{ Converts 16bit half floating point value to 32bit Single.}

function HalfToFloat(Half: THalfFloat): Single;

{ Converts 32bit Single to 16bit half floating point.}

function FloatToHalf(Float: Single): THalfFloat;

{ Converts half float color value to single-precision floating point color.}

function ColorHalfToFloat(ColorHF: TColorHFRec): TColorFPRec; {$IFDEF USE_INLINE}inline;{$ENDIF}

{ Converts single-precision floating point color to half float color.}

function ColorFloatToHalf(ColorFP: TColorFPRec): TColorHFRec; {$IFDEF USE_INLINE}inline;{$ENDIF}

{ Pixel readers/writers for different image formats }

{ Returns pixel of image in any ARGB format. Channel values are scaled to 16 bits.}

procedure ChannelGetSrcPixel(Src: PByte; SrcInfo: PImageFormatInfo;

  var Pix: TColor64Rec);

{ Sets pixel of image in any ARGB format. Channel values must be scaled to 16 bits.}

procedure ChannelSetDstPixel(Dst: PByte; DstInfo: PImageFormatInfo;

  const Pix: TColor64Rec); 

{ Returns pixel of image in any grayscale format. Gray value is scaled to 64 bits

  and alpha to 16 bits.}

procedure GrayGetSrcPixel(Src: PByte; SrcInfo: PImageFormatInfo;

  var Gray: TColor64Rec; var Alpha: Word);

{ Sets pixel of image in any grayscale format. Gray value must be scaled to 64 bits

  and alpha to 16 bits.}

procedure GraySetDstPixel(Dst: PByte; DstInfo: PImageFormatInfo;

  const Gray: TColor64Rec; Alpha: Word);

{ Returns pixel of image in any floating point format. Channel values are

  in range <0.0, 1.0>.}

procedure FloatGetSrcPixel(Src: PByte; SrcInfo: PImageFormatInfo;

  var Pix: TColorFPRec);

{ Sets pixel of image in any floating point format. Channel values must be

  in range <0.0, 1.0>.}

procedure FloatSetDstPixel(Dst: PByte; DstInfo: PImageFormatInfo;

  const Pix: TColorFPRec);

{ Returns pixel of image in any indexed format. Returned value is index to

  the palette.}

procedure IndexGetSrcPixel(Src: PByte; SrcInfo: PImageFormatInfo;

  var Index: LongWord);

{ Sets pixel of image in any indexed format. Index is index to the palette.}

procedure IndexSetDstPixel(Dst: PByte; DstInfo: PImageFormatInfo;

  Index: LongWord);

{ Pixel readers/writers for 32bit and FP colors}

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

  then translated to 32 bit ARGB.}

function GetPixel32Generic(Bits: Pointer; Info: PImageFormatInfo;

  Palette: PPalette32): TColor32Rec;

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

    native format and then written to Image.}

procedure SetPixel32Generic(Bits: Pointer; Info: PImageFormatInfo;

  Palette: PPalette32; const Color: TColor32Rec);

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

  then translated to FP ARGB.}

function GetPixelFPGeneric(Bits: Pointer; Info: PImageFormatInfo;

  Palette: PPalette32): TColorFPRec;

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

    native format and then written to Image.}

procedure SetPixelFPGeneric(Bits: Pointer; Info: PImageFormatInfo;

  Palette: PPalette32; const Color: TColorFPRec);

{ Image format conversion functions }

{ Converts any ARGB format to any ARGB format.}

procedure ChannelToChannel(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,

  DstInfo: PImageFormatInfo);

{ Converts any ARGB format to any grayscale format.}

procedure ChannelToGray(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,

  DstInfo: PImageFormatInfo);

{ Converts any ARGB format to any floating point format.}

procedure ChannelToFloat(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,

  DstInfo: PImageFormatInfo);

{ Converts any ARGB format to any indexed format.}

procedure ChannelToIndex(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,

  DstInfo: PImageFormatInfo; DstPal: PPalette32);

{ Converts any grayscale format to any grayscale format.}

procedure GrayToGray(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,

  DstInfo: PImageFormatInfo);

{ Converts any grayscale format to any ARGB format.}

procedure GrayToChannel(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,

  DstInfo: PImageFormatInfo);

{ Converts any grayscale format to any floating point format.}

procedure GrayToFloat(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,

  DstInfo: PImageFormatInfo);

{ Converts any grayscale format to any indexed format.}

procedure GrayToIndex(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,

  DstInfo: PImageFormatInfo; DstPal: PPalette32);

{ Converts any floating point format to any floating point format.}

procedure FloatToFloat(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,

  DstInfo: PImageFormatInfo);

{ Converts any floating point format to any ARGB format.}

procedure FloatToChannel(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,

  DstInfo: PImageFormatInfo);

{ Converts any floating point format to any grayscale format.}

procedure FloatToGray(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,

  DstInfo: PImageFormatInfo);

{ Converts any floating point format to any indexed format.}

procedure FloatToIndex(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,

  DstInfo: PImageFormatInfo; DstPal: PPalette32);

{ Converts any indexed format to any indexed format.}

procedure IndexToIndex(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,

  DstInfo: PImageFormatInfo; SrcPal, DstPal: PPalette32);

{ Converts any indexed format to any ARGB format.}

procedure IndexToChannel(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,

  DstInfo: PImageFormatInfo; SrcPal: PPalette32);

{ Converts any indexed format to any grayscale format.}

procedure IndexToGray(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,

  DstInfo: PImageFormatInfo; SrcPal: PPalette32);

{ Converts any indexed format to any floating point  format.}

procedure IndexToFloat(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,

  DstInfo: PImageFormatInfo; SrcPal: PPalette32);

{ Special formats conversion functions }

{ Converts image to/from/between special image formats (dxtc, ...).}

procedure ConvertSpecial(var Image: TImageData; SrcInfo,

  DstInfo: PImageFormatInfo);

{ Inits all image format information. Called internally on startup.}

procedure InitImageFormats(var Infos: TImageFormatInfoArray);

implementation

{ TImageFormatInfo member functions }

{ Returns size in bytes of image in given standard format where

  Size = Width * Height * Bpp.}

function GetStdPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; forward;

{ Checks if Width and Height are valid for given standard format.}

procedure CheckStdDimensions(Format: TImageFormat; var Width, Height: LongInt); forward;

{ Returns size in bytes of image in given DXT format.}

function GetDXTPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; forward;

{ Checks if Width and Height are valid for given DXT format. If they are

  not valid, they are changed to pass the check.}

procedure CheckDXTDimensions(Format: TImageFormat; var Width, Height: LongInt); forward;

{ Returns size in bytes of image in BTC format.}

function GetBTCPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; forward;

{ Optimized pixel readers/writers for 32bit and FP colors to be stored in TImageFormatInfo }

function GetPixel32ifA8R8G8B8(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColor32Rec; forward;

procedure SetPixel32ifA8R8G8B8(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColor32Rec); forward;

function GetPixelFPifA8R8G8B8(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColorFPRec; forward;

procedure SetPixelFPifA8R8G8B8(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColorFPRec); forward;

function GetPixel32Channel8Bit(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColor32Rec; forward;

procedure SetPixel32Channel8Bit(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColor32Rec); forward;

function GetPixelFPChannel8Bit(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColorFPRec; forward;

procedure SetPixelFPChannel8Bit(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColorFPRec); forward;

function GetPixelFPFloat32(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColorFPRec; forward;

procedure SetPixelFPFloat32(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColorFPRec); forward;

const

  // grayscale conversion channel weights

  GrayConv: TColorFPRec = (B: 0.114; G: 0.587; R: 0.299; A: 0.0);

  // contants for converting integer colors to floating point

  OneDiv8Bit: Single = 1.0 / 255.0;

  OneDiv16Bit: Single = 1.0 / 65535.0;

var

  PFR3G3B2: TPixelFormatInfo;

  PFX5R1G1B1: TPixelFormatInfo;

  PFR5G6B5: TPixelFormatInfo;

  PFA1R5G5B5: TPixelFormatInfo;

  PFA4R4G4B4: TPixelFormatInfo;

  PFX1R5G5B5: TPixelFormatInfo;

  PFX4R4G4B4: TPixelFormatInfo;

  FInfos: PImageFormatInfoArray;

var

  // Free Pascal generates hundreds of warnings here

{$WARNINGS OFF}

  // indexed formats

  Index8Info: TImageFormatInfo = (

    Format: ifIndex8;

    Name: 'Index8';

    BytesPerPixel: 1;

    ChannelCount: 1;

    PaletteEntries: 256;

    IsIndexed: True;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPGeneric;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPGeneric);

  // grayscale formats

  Gray8Info: TImageFormatInfo = (

    Format: ifGray8;

    Name: 'Gray8';

    BytesPerPixel: 1;

    ChannelCount: 1;

    HasGrayChannel: True;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Channel8Bit;

    GetPixelFP: GetPixelFPChannel8Bit;

    SetPixel32: SetPixel32Channel8Bit;

    SetPixelFP: SetPixelFPChannel8Bit);

  A8Gray8Info: TImageFormatInfo = (

    Format: ifA8Gray8;

    Name: 'A8Gray8';

    BytesPerPixel: 2;

    ChannelCount: 2;

    HasGrayChannel: True;

    HasAlphaChannel: True;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Channel8Bit;

    GetPixelFP: GetPixelFPChannel8Bit;

    SetPixel32: SetPixel32Channel8Bit;

    SetPixelFP: SetPixelFPChannel8Bit);

  Gray16Info: TImageFormatInfo = (

    Format: ifGray16;

    Name: 'Gray16';

    BytesPerPixel: 2;

    ChannelCount: 1;

    HasGrayChannel: True;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPGeneric;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPGeneric);

  Gray32Info: TImageFormatInfo = (

    Format: ifGray32;

    Name: 'Gray32';

    BytesPerPixel: 4;

    ChannelCount: 1;

    HasGrayChannel: True;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPGeneric;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPGeneric);

  Gray64Info: TImageFormatInfo = (

    Format: ifGray64;

    Name: 'Gray64';

    BytesPerPixel: 8;

    ChannelCount: 1;

    HasGrayChannel: True;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPGeneric;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPGeneric);

  A16Gray16Info: TImageFormatInfo = (

    Format: ifA16Gray16;

    Name: 'A16Gray16';

    BytesPerPixel: 4;

    ChannelCount: 2;

    HasGrayChannel: True;

    HasAlphaChannel: True;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPGeneric;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPGeneric);

  // ARGB formats

  X5R1G1B1Info: TImageFormatInfo = (

    Format: ifX5R1G1B1;

    Name: 'X5R1G1B1';

    BytesPerPixel: 1;

    ChannelCount: 3;

    UsePixelFormat: True;

    PixelFormat: @PFX5R1G1B1;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPGeneric;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPGeneric);

  R3G3B2Info: TImageFormatInfo = (

    Format: ifR3G3B2;

    Name: 'R3G3B2';

    BytesPerPixel: 1;

    ChannelCount: 3;

    UsePixelFormat: True;

    PixelFormat: @PFR3G3B2;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPGeneric;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPGeneric);

  R5G6B5Info: TImageFormatInfo = (

    Format: ifR5G6B5;

    Name: 'R5G6B5';

    BytesPerPixel: 2;

    ChannelCount: 3;

    UsePixelFormat: True;

    PixelFormat: @PFR5G6B5;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPGeneric;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPGeneric);

  A1R5G5B5Info: TImageFormatInfo = (

    Format: ifA1R5G5B5;

    Name: 'A1R5G5B5';

    BytesPerPixel: 2;

    ChannelCount: 4;

    HasAlphaChannel: True;

    UsePixelFormat: True;

    PixelFormat: @PFA1R5G5B5;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPGeneric;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPGeneric);

  A4R4G4B4Info: TImageFormatInfo = (

    Format: ifA4R4G4B4;

    Name: 'A4R4G4B4';

    BytesPerPixel: 2;

    ChannelCount: 4;

    HasAlphaChannel: True;

    UsePixelFormat: True;

    PixelFormat: @PFA4R4G4B4;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPGeneric;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPGeneric);

  X1R5G5B5Info: TImageFormatInfo = (

    Format: ifX1R5G5B5;

    Name: 'X1R5G5B5';

    BytesPerPixel: 2;

    ChannelCount: 3;

    UsePixelFormat: True;

    PixelFormat: @PFX1R5G5B5;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPGeneric;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPGeneric);

  X4R4G4B4Info: TImageFormatInfo = (

    Format: ifX4R4G4B4;

    Name: 'X4R4G4B4';

    BytesPerPixel: 2;

    ChannelCount: 3;

    UsePixelFormat: True;

    PixelFormat: @PFX4R4G4B4;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPGeneric;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPGeneric);

  R8G8B8Info: TImageFormatInfo = (

    Format: ifR8G8B8;

    Name: 'R8G8B8';

    BytesPerPixel: 3;

    ChannelCount: 3;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Channel8Bit;

    GetPixelFP: GetPixelFPChannel8Bit;

    SetPixel32: SetPixel32Channel8Bit;

    SetPixelFP: SetPixelFPChannel8Bit);

  A8R8G8B8Info: TImageFormatInfo = (

    Format: ifA8R8G8B8;

    Name: 'A8R8G8B8';

    BytesPerPixel: 4;

    ChannelCount: 4;

    HasAlphaChannel: True;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32ifA8R8G8B8;

    GetPixelFP: GetPixelFPifA8R8G8B8;

    SetPixel32: SetPixel32ifA8R8G8B8;

    SetPixelFP: SetPixelFPifA8R8G8B8);

  X8R8G8B8Info: TImageFormatInfo = (

    Format: ifX8R8G8B8;

    Name: 'X8R8G8B8';

    BytesPerPixel: 4;

    ChannelCount: 3;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Channel8Bit;

    GetPixelFP: GetPixelFPChannel8Bit;

    SetPixel32: SetPixel32Channel8Bit;

    SetPixelFP: SetPixelFPChannel8Bit);

  R16G16B16Info: TImageFormatInfo = (

    Format: ifR16G16B16;

    Name: 'R16G16B16';

    BytesPerPixel: 6;

    ChannelCount: 3;

    RBSwapFormat: ifB16G16R16;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPGeneric;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPGeneric);

  A16R16G16B16Info: TImageFormatInfo = (

    Format: ifA16R16G16B16;

    Name: 'A16R16G16B16';

    BytesPerPixel: 8;

    ChannelCount: 4;

    HasAlphaChannel: True;

    RBSwapFormat: ifA16B16G16R16;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPGeneric;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPGeneric);

  B16G16R16Info: TImageFormatInfo = (

    Format: ifB16G16R16;

    Name: 'B16G16R16';

    BytesPerPixel: 6;

    ChannelCount: 3;

    IsRBSwapped: True;

    RBSwapFormat: ifR16G16B16;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPGeneric;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPGeneric);

  A16B16G16R16Info: TImageFormatInfo = (

    Format: ifA16B16G16R16;

    Name: 'A16B16G16R16';

    BytesPerPixel: 8;

    ChannelCount: 4;

    HasAlphaChannel: True;

    IsRBSwapped: True;

    RBSwapFormat: ifA16R16G16B16;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPGeneric;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPGeneric);

  // floating point formats

  R32FInfo: TImageFormatInfo = (

    Format: ifR32F;

    Name: 'R32F';

    BytesPerPixel: 4;

    ChannelCount: 1;

    IsFloatingPoint: True;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPFloat32;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPFloat32);

 A32R32G32B32FInfo: TImageFormatInfo = (

    Format: ifA32R32G32B32F;

    Name: 'A32R32G32B32F';

    BytesPerPixel: 16;

    ChannelCount: 4;

    HasAlphaChannel: True;

    IsFloatingPoint: True;

    RBSwapFormat: ifA32B32G32R32F;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPFloat32;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPFloat32);

  A32B32G32R32FInfo: TImageFormatInfo = (

    Format: ifA32B32G32R32F;

    Name: 'A32B32G32R32F';

    BytesPerPixel: 16;

    ChannelCount: 4;

    HasAlphaChannel: True;

    IsFloatingPoint: True;

    IsRBSwapped: True;

    RBSwapFormat: ifA32R32G32B32F;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPFloat32;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPFloat32);

  R16FInfo: TImageFormatInfo = (

    Format: ifR16F;

    Name: 'R16F';

    BytesPerPixel: 2;

    ChannelCount: 1;

    IsFloatingPoint: True;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPGeneric;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPGeneric);

 A16R16G16B16FInfo: TImageFormatInfo = (

    Format: ifA16R16G16B16F;

    Name: 'A16R16G16B16F';

    BytesPerPixel: 8;

    ChannelCount: 4;

    HasAlphaChannel: True;

    IsFloatingPoint: True;

    RBSwapFormat: ifA16B16G16R16F;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPGeneric;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPGeneric);

  A16B16G16R16FInfo: TImageFormatInfo = (

    Format: ifA16B16G16R16F;

    Name: 'A16B16G16R16F';

    BytesPerPixel: 8;

    ChannelCount: 4;

    HasAlphaChannel: True;

    IsFloatingPoint: True;

    IsRBSwapped: True;

    RBSwapFormat: ifA16R16G16B16F;

    GetPixelsSize: GetStdPixelsSize;

    CheckDimensions: CheckStdDimensions;

    GetPixel32: GetPixel32Generic;

    GetPixelFP: GetPixelFPGeneric;

    SetPixel32: SetPixel32Generic;

    SetPixelFP: SetPixelFPGeneric);

  // special formats

  DXT1Info: TImageFormatInfo = (

    Format: ifDXT1;

    Name: 'DXT1';

    ChannelCount: 4;

    HasAlphaChannel: True;

    IsSpecial: True;

    GetPixelsSize: GetDXTPixelsSize;

    CheckDimensions: CheckDXTDimensions;

    SpecialNearestFormat: ifA8R8G8B8);

  DXT3Info: TImageFormatInfo = (

    Format: ifDXT3;

    Name: 'DXT3';

    ChannelCount: 4;

    HasAlphaChannel: True;

    IsSpecial: True;

    GetPixelsSize: GetDXTPixelsSize;

    CheckDimensions: CheckDXTDimensions;

    SpecialNearestFormat: ifA8R8G8B8);

  DXT5Info: TImageFormatInfo = (

    Format: ifDXT5;

    Name: 'DXT5';

    ChannelCount: 4;

    HasAlphaChannel: True;

    IsSpecial: True;

    GetPixelsSize: GetDXTPixelsSize;

    CheckDimensions: CheckDXTDimensions;

    SpecialNearestFormat: ifA8R8G8B8);

  BTCInfo: TImageFormatInfo = (

    Format: ifBTC;

    Name: 'BTC';

    ChannelCount: 1;

    HasAlphaChannel: False;

    IsSpecial: True;

    GetPixelsSize: GetBTCPixelsSize;

    CheckDimensions: CheckDXTDimensions;

    SpecialNearestFormat: ifGray8);

{$WARNINGS ON}

function PixelFormat(ABitCount, RBitCount, GBitCount, BBitCount: Byte): TPixelFormatInfo; forward;

procedure InitImageFormats(var Infos: TImageFormatInfoArray);

begin

  FInfos := @Infos;

  Infos[ifDefault] := @A8R8G8B8Info;

  // indexed formats

  Infos[ifIndex8] := @Index8Info;

  // grayscale formats

  Infos[ifGray8] := @Gray8Info;

  Infos[ifA8Gray8] := @A8Gray8Info;

  Infos[ifGray16] := @Gray16Info;

  Infos[ifGray32] := @Gray32Info;

  Infos[ifGray64] := @Gray64Info;

  Infos[ifA16Gray16] := @A16Gray16Info;

  // ARGB formats

  Infos[ifX5R1G1B1] := @X5R1G1B1Info;

  Infos[ifR3G3B2] := @R3G3B2Info;

  Infos[ifR5G6B5] := @R5G6B5Info;

  Infos[ifA1R5G5B5] := @A1R5G5B5Info;

  Infos[ifA4R4G4B4] := @A4R4G4B4Info;

  Infos[ifX1R5G5B5] := @X1R5G5B5Info;

  Infos[ifX4R4G4B4] := @X4R4G4B4Info;

  Infos[ifR8G8B8] := @R8G8B8Info;

  Infos[ifA8R8G8B8] := @A8R8G8B8Info;

  Infos[ifX8R8G8B8] := @X8R8G8B8Info;

  Infos[ifR16G16B16] := @R16G16B16Info;

  Infos[ifA16R16G16B16] := @A16R16G16B16Info;

  Infos[ifB16G16R16] := @B16G16R16Info;

  Infos[ifA16B16G16R16] := @A16B16G16R16Info;

  // floating point formats

  Infos[ifR32F] := @R32FInfo;

  Infos[ifA32R32G32B32F] := @A32R32G32B32FInfo;

  Infos[ifA32B32G32R32F] := @A32B32G32R32FInfo;

  Infos[ifR16F] := @R16FInfo;

  Infos[ifA16R16G16B16F] := @A16R16G16B16FInfo;

  Infos[ifA16B16G16R16F] := @A16B16G16R16FInfo;

  // special formats

  Infos[ifDXT1] := @DXT1Info;

  Infos[ifDXT3] := @DXT3Info;

  Infos[ifDXT5] := @DXT5Info;

  Infos[ifBTC] :=  @BTCInfo;

  PFR3G3B2 := PixelFormat(0, 3, 3, 2);

  PFX5R1G1B1 := PixelFormat(0, 1, 1, 1);

  PFR5G6B5 := PixelFormat(0, 5, 6, 5);

  PFA1R5G5B5 := PixelFormat(1, 5, 5, 5);

  PFA4R4G4B4 := PixelFormat(4, 4, 4, 4);

  PFX1R5G5B5 := PixelFormat(0, 5, 5, 5);

  PFX4R4G4B4 := PixelFormat(0, 4, 4, 4);

end;

{ Internal unit helper functions }

function PixelFormat(ABitCount, RBitCount, GBitCount, BBitCount: Byte): TPixelFormatInfo;

begin

  Result.ABitMask := ((1 shl ABitCount) - 1) shl (RBitCount + GBitCount +

    BBitCount);

  Result.RBitMask := ((1 shl RBitCount) - 1) shl (GBitCount + BBitCount);

  Result.GBitMask := ((1 shl GBitCount) - 1) shl (BBitCount);

  Result.BBitMask := (1 shl BBitCount) - 1;

  Result.ABitCount := ABitCount;

  Result.RBitCount := RBitCount;

  Result.GBitCount := GBitCount;

  Result.BBitCount := BBitCount;

  Result.AShift := RBitCount + GBitCount + BBitCount;

  Result.RShift := GBitCount + BBitCount;

  Result.GShift := BBitCount;

  Result.BShift := 0;

  Result.ARecDiv := Max(1, Pow2Int(Result.ABitCount) - 1);

  Result.RRecDiv := Max(1, Pow2Int(Result.RBitCount) - 1);

  Result.GRecDiv := Max(1, Pow2Int(Result.GBitCount) - 1);

  Result.BRecDiv := Max(1, Pow2Int(Result.BBitCount) - 1);

end;

function PixelFormatMask(ABitMask, RBitMask, GBitMask, BBitMask: LongWord): TPixelFormatInfo;

  function GetBitCount(B: LongWord): LongWord;

  var

    I: LongWord;

  begin

    I := 0;

    while (I < 31) and (((1 shl I) and B) = 0) do

      Inc(I);

    Result := 0;

    while ((1 shl I) and B) <> 0 do

    begin

      Inc(I);

      Inc(Result);

    end;

  end;

begin

  Result := PixelFormat(GetBitCount(ABitMask), GetBitCount(RBitMask),

    GetBitCount(GBitMask), GetBitCount(BBitMask));

end;

function PFSetARGB(const PF: TPixelFormatInfo; A, R, G, B: Byte): TColor32;

{$IFDEF USE_INLINE}inline;{$ENDIF}

begin

  with PF do

    Result :=

      (A shl ABitCount shr 8 shl AShift) or

      (R shl RBitCount shr 8 shl RShift) or

      (G shl GBitCount shr 8 shl GShift) or

      (B shl BBitCount shr 8 shl BShift);

end;

procedure PFGetARGB(const PF: TPixelFormatInfo; Color: LongWord;

  var A, R, G, B: Byte); {$IFDEF USE_INLINE}inline;{$ENDIF}

begin

  with PF do

   begin

     A := (Color and ABitMask shr AShift) * 255 div ARecDiv;

     R := (Color and RBitMask shr RShift) * 255 div RRecDiv;

     G := (Color and GBitMask shr GShift) * 255 div GRecDiv;

     B := (Color and BBitMask shl BShift) * 255 div BRecDiv;

    end;

end;

function PFSetColor(const PF: TPixelFormatInfo; ARGB: TColor32): LongWord;

{$IFDEF USE_INLINE}inline;{$ENDIF}

begin

  with PF do

    Result :=

      (Byte(ARGB shr 24) shl ABitCount shr 8 shl AShift) or

      (Byte(ARGB shr 16) shl RBitCount shr 8 shl RShift) or

      (Byte(ARGB shr 8) shl GBitCount shr 8 shl GShift) or

      (Byte(ARGB) shl BBitCount shr 8 shl BShift);

end;

function PFGetColor(const PF: TPixelFormatInfo; Color: LongWord): TColor32;

{$IFDEF USE_INLINE}inline;{$ENDIF}

begin

  with PF, TColor32Rec(Result) do

   begin

     A := (Color and ABitMask shr AShift) * 255 div ARecDiv;

     R := (Color and RBitMask shr RShift) * 255 div RRecDiv;

     G := (Color and GBitMask shr GShift) * 255 div GRecDiv;

     B := (Color and BBitMask shl BShift) * 255 div BRecDiv;

    end;

end;

{ Additional image manipulation functions (usually used internally by Imaging unit) }

const

  MaxPossibleColors = 4096;

  HashSize = 32768;

  AlphaWeight = 1024;

  RedWeight = 612;

  GreenWeight = 1202;

  BlueWeight = 234;

type

  PColorBin = ^TColorBin;

  TColorBin = record

    Color: TColor32Rec;

    Number: LongInt;

    Next: PColorBin;

  end;

  THashTable = array[0..HashSize - 1] of PColorBin;

  TColorBox = record

    AMin, AMax,

    RMin, RMax,

    GMin, GMax,

    BMin, BMax: LongInt;

    Total: LongInt;

    Represented: TColor32Rec;

    List: PColorBin;

  end;

var

  Table: THashTable;

  Box: array[0..MaxPossibleColors - 1] of TColorBox;

  Boxes: LongInt;

  BoxesCreated: Boolean = False;

procedure ReduceColorsMedianCut(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,

  DstInfo: PImageFormatInfo; MaxColors: LongInt; ChannelMask: Byte;

  DstPal: PPalette32; Actions: TReduceColorsActions);

  procedure CreateHistogram (Src: PByte; SrcInfo: PImageFormatInfo;

    ChannelMask: Byte);

  var

    A, R, G, B: Byte;

    I, Addr: LongInt;

    PC: PColorBin;

    Col: TColor32Rec;

  begin

    for I := 0 to NumPixels - 1 do

    begin

      Col := GetPixel32Generic(Src, SrcInfo, nil);

      A := Col.A and ChannelMask;

      R := Col.R and ChannelMask;

      G := Col.G and ChannelMask;

      B := Col.B and ChannelMask;

      Addr := (A + 11 * B + 59 * R + 119 * G) mod HashSize;

      PC := Table[Addr];

      while (PC <> nil) and ((PC.Color.R <> R) or (PC.Color.G <> G) or

        (PC.Color.B <> B) or (PC.Color.A <> A)) do

        PC := PC.Next;

      if PC = nil then

      begin

        New(PC);

        PC.Color.R := R;

        PC.Color.G := G;

        PC.Color.B := B;

        PC.Color.A := A;

        PC.Number := 1;

        PC.Next := Table[Addr];

        Table[Addr] := PC;

      end

      else

        Inc(PC^.Number);

      Inc(Src, SrcInfo.BytesPerPixel);

    end;

  end;

  procedure InitBox (var Box : TColorBox);

  begin

    Box.AMin := 256;

    Box.RMin := 256;

    Box.GMin := 256;

    Box.BMin := 256;

    Box.AMax := -1;

    Box.RMax := -1;

    Box.GMax := -1;

    Box.BMax := -1;

    Box.Total := 0;

    Box.List := nil;

  end;

  procedure ChangeBox (var Box: TColorBox; const C: TColorBin);

  begin

    with C.Color do

    begin

      if A < Box.AMin then Box.AMin := A;

      if A > Box.AMax then Box.AMax := A;

      if B < Box.BMin then Box.BMin := B;

      if B > Box.BMax then Box.BMax := B;

      if G < Box.GMin then Box.GMin := G;

      if G > Box.GMax then Box.GMax := G;

      if R < Box.RMin then Box.RMin := R;

      if R > Box.RMax then Box.RMax := R;

    end;

    Inc(Box.Total, C.Number);

  end;

  procedure MakeColormap;

  var

    I, J: LongInt;

    CP, Pom: PColorBin;

    Cut, LargestIdx, Largest, Size, S: LongInt;

    CutA, CutR, CutG, CutB: Boolean;

    SumA, SumR, SumG, SumB: LongInt;

    Temp: TColorBox;

  begin

    I := 0;

    Boxes := 1;

    LargestIdx := 0;

    while (I < HashSize) and (Table[I] = nil) do

      Inc(i);

    if I < HashSize then

    begin

      // put all colors into Box[0]

      InitBox(Box[0]);

      repeat

        CP := Table[I];

        while CP.Next <> nil do

        begin

          ChangeBox(Box[0], CP^);

          CP := CP.Next;

        end;

        ChangeBox(Box[0], CP^);

        CP.Next := Box[0].List;

        Box[0].List := Table[I];

        Table[I] := nil;

        repeat

          Inc(I)

        until (I = HashSize) or (Table[I] <> nil);

      until I = HashSize;

      // now all colors are in Box[0]

      repeat

        // cut one color box

        Largest := 0;

        for I := 0 to Boxes - 1 do

          with Box[I] do

          begin

            Size := (AMax - AMin) * AlphaWeight;

            S := (RMax - RMin) * RedWeight;

            if S > Size then

              Size := S;

            S := (GMax - GMin) * GreenWeight;

            if S > Size then

              Size := S;

            S := (BMax - BMin) * BlueWeight;

            if S > Size then

              Size := S;

            if Size > Largest then

            begin

              Largest := Size;

              LargestIdx := I;

            end;

          end;

        if Largest > 0 then

        begin

          // cutting Box[LargestIdx] into Box[LargestIdx] and Box[Boxes]

          CutR := False;

          CutG := False;

          CutB := False;

          CutA := False;

          with Box[LargestIdx] do

          begin

            if (AMax - AMin) * AlphaWeight = Largest then

            begin

              Cut := (AMax + AMin) shr 1;

              CutA := True;

            end

            else

              if (RMax - RMin) * RedWeight = Largest then

              begin

                Cut := (RMax + RMin) shr 1;

                CutR := True;

              end

              else

                if (GMax - GMin) * GreenWeight = Largest then

                begin

                  Cut := (GMax + GMin) shr 1;

                  CutG := True;

                end

                else

                begin

                  Cut := (BMax + BMin) shr 1;

                  CutB := True;

                end;

            CP := List;

          end;

          InitBox(Box[LargestIdx]);

          InitBox(Box[Boxes]);

          repeat

            // distribute one color

            Pom := CP.Next;

            with CP.Color do

            begin

              if (CutA and (A <= Cut)) or (CutR and (R <= Cut)) or

                (CutG and (G <= Cut)) or (CutB and (B <= Cut)) then

                I := LargestIdx

              else

                I := Boxes;

            end;

            CP.Next := Box[i].List;

            Box[i].List := CP;

            ChangeBox(Box[i], CP^);

            CP := Pom;

          until CP = nil;

          Inc(Boxes);

        end;

      until (Boxes = MaxColors) or (Largest = 0);

      // compute box representation

      for I := 0 to Boxes - 1 do

      begin

        SumR := 0;

        SumG := 0;

        SumB := 0;

        SumA := 0;

        repeat

          CP := Box[I].List;

          Inc(SumR, CP.Color.R * CP.Number);

          Inc(SumG, CP.Color.G * CP.Number);

          Inc(SumB, CP.Color.B * CP.Number);

          Inc(SumA, CP.Color.A * CP.Number);

          Box[I].List := CP.Next;

          Dispose(CP);

        until Box[I].List = nil;

        with Box[I] do

        begin

          Represented.A := SumA div Total;

          Represented.R := SumR div Total;

          Represented.G := SumG div Total;

          Represented.B := SumB div Total;

          AMin := AMin and ChannelMask;

          RMin := RMin and ChannelMask;

          GMin := GMin and ChannelMask;

          BMin := BMin and ChannelMask;

          AMax := (AMax and ChannelMask) + (not ChannelMask);

          RMax := (RMax and ChannelMask) + (not ChannelMask);

          GMax := (GMax and ChannelMask) + (not ChannelMask);

          BMax := (BMax and ChannelMask) + (not ChannelMask);

        end;

      end;

      // sort color boxes

      for I := 0 to Boxes - 2 do

      begin

        Largest := 0;

        for J := I to Boxes - 1 do

          if Box[J].Total > Largest then

          begin

            Largest := Box[J].Total;

            LargestIdx := J;

          end;

        if LargestIdx <> I then

        begin

          Temp := Box[I];

          Box[I] := Box[LargestIdx];

          Box[LargestIdx] := Temp;

        end;

      end;

    end;

  end;

  procedure FillOutputPalette;

  var

    I: LongInt;

  begin

    FillChar(DstPal^, SizeOf(TColor32Rec) * MaxColors, $FF);

    for I := 0 to MaxColors - 1 do

      with Box[I].Represented do

        begin

          DstPal[I].A := A;

          DstPal[I].R := R;

          DstPal[I].G := G;

          DstPal[I].B := B;

        end;

  end;

  function MapColor(const Col: TColor32Rec) : LongInt;

  var

    I: LongInt;

  begin

    I := 0;

    with Col do

      while (I < Boxes) and ((Box[I].AMin > A) or (Box[I].AMax < A) or

        (Box[I].RMin > R) or (Box[I].RMax < R) or (Box[I].GMin > G) or

        (Box[I].GMax < G) or (Box[I].BMin > B) or (Box[I].BMax < B)) do

        Inc(I);

    if I = Boxes then

      MapColor := 0

    else

      MapColor := I;

  end;

  procedure MapImage(Src, Dst: PByte; SrcInfo, DstInfo: PImageFormatInfo);

  var

    I: LongInt;

    Col: TColor32Rec;

  begin

    for I := 0 to NumPixels - 1 do

    begin

      Col := GetPixel32Generic(Src, SrcInfo, nil);

      IndexSetDstPixel(Dst, DstInfo, MapColor(Col));

      Inc(Src, SrcInfo.BytesPerPixel);

      Inc(Dst, DstInfo.BytesPerPixel);

    end;

  end;

begin

  MaxColors := ClampInt(MaxColors, 2, MaxPossibleColors);

  if (raUpdateHistogram in Actions) or (raMapImage in Actions) then

  begin

    Assert(not SrcInfo.IsSpecial);

    Assert(not SrcInfo.IsIndexed);

  end;

  if raCreateHistogram in Actions then

    FillChar(Table, SizeOf(Table), 0);

  if raUpdateHistogram in Actions then

    CreateHistogram(Src, SrcInfo, ChannelMask);

  if raMakeColorMap in Actions then

  begin

    MakeColorMap;

    FillOutputPalette;

  end;

  if raMapImage in Actions then

    MapImage(Src, Dst, SrcInfo, DstInfo);

end;

procedure StretchNearest(const SrcImage: TImageData; SrcX, SrcY, SrcWidth,

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

  DstHeight: LongInt);

var

  Info: TImageFormatInfo;

  ScaleX, ScaleY, X, Y, Xp, Yp: LongInt;

  DstPixel, SrcLine: PByte;

begin

  GetImageFormatInfo(SrcImage.Format, Info);

  Assert(SrcImage.Format = DstImage.Format);

  Assert(not Info.IsSpecial);

  // Use integers instead of floats for source image pixel coords

  // Xp and Yp coords must be shifted right to get read source image coords

  ScaleX := (SrcWidth shl 16) div DstWidth;

  ScaleY := (SrcHeight shl 16) div DstHeight;

  Yp := 0;

  for Y := 0 to DstHeight - 1 do

  begin

    Xp := 0;

    SrcLine := @PByteArray(SrcImage.Bits)[((SrcY + Yp shr 16) * SrcImage.Width + SrcX) * Info.BytesPerPixel];

    DstPixel := @PByteArray(DstImage.Bits)[((DstY + Y) * DstImage.Width + DstX) * Info.BytesPerPixel];

    for X := 0 to DstWidth - 1 do

    begin

      case Info.BytesPerPixel of

        1: PByte(DstPixel)^ := PByteArray(SrcLine)[Xp shr 16];

        2: PWord(DstPixel)^ := PWordArray(SrcLine)[Xp shr 16];

        3: PColor24Rec(DstPixel)^ := PPalette24(SrcLine)[Xp shr 16];

        4: PColor32(DstPixel)^ := PLongWordArray(SrcLine)[Xp shr 16];

        6: PColor48Rec(DstPixel)^ := PColor48RecArray(SrcLine)[Xp shr 16];

        8: PColor64(DstPixel)^ := PInt64Array(SrcLine)[Xp shr 16];

        16: PColorFPRec(DstPixel)^ := PColorFPRecArray(SrcLine)[Xp shr 16];

      end;

      Inc(DstPixel, Info.BytesPerPixel);

      Inc(Xp, ScaleX);

    end;

    Inc(Yp, ScaleY);

  end;

end;

{ Filter function for nearest filtering. Also known as box filter.}

function FilterNearest(Value: Single): Single;

begin

  if (Value > -0.5) and (Value <= 0.5) then

    Result := 1

  else

    Result := 0;

end;

{ Filter function for linear filtering. Also known as triangle or Bartlett filter.}

function FilterLinear(Value: Single): Single;

begin

  if Value < 0.0 then

    Value := -Value;

  if Value < 1.0 then

    Result := 1.0 - Value

  else

    Result := 0.0;

end;

{ Cosine filter.}

function FilterCosine(Value: Single): Single;

begin

  Result := 0;

  if Abs(Value) < 1 then

    Result := (Cos(Value * Pi) + 1) / 2;

end;

{ f(t) = 2|t|^3 - 3|t|^2 + 1, -1 <= t <= 1 }

function FilterHermite(Value: Single): Single;

begin

  if Value < 0.0 then

    Value := -Value;

  if Value < 1 then

    Result := (2 * Value - 3) * Sqr(Value) + 1

  else

    Result := 0;

end;

{ Quadratic filter. Also known as Bell.}

function FilterQuadratic(Value: Single): Single;

begin

  if Value < 0.0 then

    Value := -Value;

  if Value < 0.5 then

    Result := 0.75 - Sqr(Value)

  else

  if Value < 1.5 then

  begin

    Value := Value - 1.5;

    Result := 0.5 * Sqr(Value);

  end

  else

    Result := 0.0;

end;

{ Gaussian filter.}

function FilterGaussian(Value: Single): Single;

begin

  Result := Exp(-2.0 * Sqr(Value)) * Sqrt(2.0 / Pi);

end;

{ 4th order (cubic) b-spline filter.}

function FilterSpline(Value: Single): Single;

var

  Temp: Single;

begin

  if Value < 0.0 then

    Value := -Value;

  if Value < 1.0 then

  begin

    Temp := Sqr(Value);

    Result := 0.5 * Temp * Value - Temp + 2.0 / 3.0;