{
  $Id: ImagingFormats.pas,v 1.8 2005/06/22 13:53:21 galfar Exp $
  Vampyre Imaging Library
  by Marek Mauder (pentar@seznam.cz)
  http://imaginglib.sourceforge.net

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

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

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

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


{ This unit contains information about all image data formats and there are
  also format conversion functions.}
unit ImagingFormats;

{$I ImagingOptions.inc}

interface

uses
  ImagingTypes, Imaging;

type
  TImageFormatInfoArray = array[TImageFormat] of PImageFormatInfo;
  PImageFormatInfoArray = ^TImageFormatInfoArray;
  pWord = ^Word;
  pSingle = ^Single;

{ Inits all image format information. Called internally on startup.}
procedure InitImageFormats(var Infos: TImageFormatInfoArray);


{ Various helper format support functions }

{ 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; var 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; var DataOut: Pointer; Width, Height,
  Bpp, WidthBytes: LongInt);

type
  TReduceColorsAction = (raCreateHistogram, raUpdateHistogram, raMakeColorMap,
    raMapImage);
  TReduceColorsActions = set of TReduceColorsAction;
  pByte = ^Byte;
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);


{ 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: TColorFRec);
{ 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: TColorFRec);

{ 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);


{ 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);


{ 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;
{ Checks if Width and Height are valid for given standard format.}
procedure CheckStdDimensions(Format: TImageFormat; var Width, Height: LongInt);
{ Returns size in bytes of image in given DXT format.}
function GetDXTPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt;
{ 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);

implementation

uses
  ImagingUtility;

var
  PFR3G3B2: TPixelFormat;
  PFX5R1G1B1: TPixelFormat;
  PFR5G6B5: TPixelFormat;
  PFA1R5G5B5: TPixelFormat;
  PFA4R4G4B4: TPixelFormat;
  PFX1R5G5B5: TPixelFormat;
  PFX4R4G4B4: TPixelFormat;
  FInfos: PImageFormatInfoArray;
  RCh, GCh, BCh: array[Byte] of Byte;

var 
  // grayscale conversion channel weights
  GrayConv: TColorFRec = (B: 0.114; G: 0.587; R: 0.299; A: 0.0);

  // Free Pascal generates hundreds of warnings here
{$WARNINGS OFF}

  // indexed formats
  Index8Info: TImageFormatInfo = (
    Format: ifIndex8;
    Name: 'Index8';
    BytesPerPixel: 1;
    PaletteEntries: 256;
    IsIndexed: True;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  // grayscale formats
  Gray8Info: TImageFormatInfo = (
    Format: ifGray8;
    Name: 'Gray8';
    BytesPerPixel: 1;
    HasGrayChannel: True;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  A8Gray8Info: TImageFormatInfo = (
    Format: ifA8Gray8;
    Name: 'A8Gray8';
    BytesPerPixel: 2;
    HasGrayChannel: True;
    HasAlphaChannel: True;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  Gray16Info: TImageFormatInfo = (
    Format: ifGray16;
    Name: 'Gray16';
    BytesPerPixel: 2;
    HasGrayChannel: True;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  Gray32Info: TImageFormatInfo = (
    Format: ifGray32;
    Name: 'Gray32';
    BytesPerPixel: 4;
    HasGrayChannel: True;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  Gray64Info: TImageFormatInfo = (
    Format: ifGray64;
    Name: 'Gray64';
    BytesPerPixel: 8;
    HasGrayChannel: True;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  A16Gray16Info: TImageFormatInfo = (
    Format: ifA16Gray16;
    Name: 'A16Gray16';
    BytesPerPixel: 4;
    HasGrayChannel: True;
    HasAlphaChannel: True;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  // ARGB formats
  X5R1G1B1Info: TImageFormatInfo = (
    Format: ifX5R1G1B1;
    Name: 'X5R1G1B1';
    BytesPerPixel: 1;
    UsePixelFormat: True;
    PixelFormat: @PFX5R1G1B1;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  R3G3B2Info: TImageFormatInfo = (
    Format: ifR3G3B2;
    Name: 'R3G3B2';
    BytesPerPixel: 1;
    UsePixelFormat: True;
    PixelFormat: @PFR3G3B2;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  R5G6B5Info: TImageFormatInfo = (
    Format: ifR5G6B5;
    Name: 'R5G6B5';
    BytesPerPixel: 2;
    UsePixelFormat: True;
    PixelFormat: @PFR5G6B5;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  A1R5G5B5Info: TImageFormatInfo = (
    Format: ifA1R5G5B5;
    Name: 'A1R5G5B5';
    BytesPerPixel: 2;
    HasAlphaChannel: True;
    UsePixelFormat: True;
    PixelFormat: @PFA1R5G5B5;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  A4R4G4B4Info: TImageFormatInfo = (
    Format: ifA4R4G4B4;
    Name: 'A4R4G4B4';
    BytesPerPixel: 2;
    HasAlphaChannel: True;
    UsePixelFormat: True;
    PixelFormat: @PFA4R4G4B4;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  X1R5G5B5Info: TImageFormatInfo = (
    Format: ifX1R5G5B5;
    Name: 'X1R5G5B5';
    BytesPerPixel: 2;
    UsePixelFormat: True;
    PixelFormat: @PFX1R5G5B5;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  X4R4G4B4Info: TImageFormatInfo = (
    Format: ifX4R4G4B4;
    Name: 'X4R4G4B4';
    BytesPerPixel: 2;
    UsePixelFormat: True;
    PixelFormat: @PFX4R4G4B4;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  R8G8B8Info: TImageFormatInfo = (
    Format: ifR8G8B8;
    Name: 'R8G8B8';
    BytesPerPixel: 3;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  A8R8G8B8Info: TImageFormatInfo = (
    Format: ifA8R8G8B8;
    Name: 'A8R8G8B8';
    BytesPerPixel: 4;
    HasAlphaChannel: True;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  X8R8G8B8Info: TImageFormatInfo = (
    Format: ifX8R8G8B8;
    Name: 'X8R8G8B8';
    BytesPerPixel: 4;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  R16G16B16Info: TImageFormatInfo = (
    Format: ifR16G16B16;
    Name: 'R16G16B16';
    BytesPerPixel: 6;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  A16R16G16B16Info: TImageFormatInfo = (
    Format: ifA16R16G16B16;
    Name: 'A16R16G16B16';
    BytesPerPixel: 8;
    HasAlphaChannel: True;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  B16G16R16Info: TImageFormatInfo = (
    Format: ifB16G16R16;
    Name: 'B16G16R16';
    BytesPerPixel: 6;
    IsRBSwapped: True;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  A16B16G16R16Info: TImageFormatInfo = (
    Format: ifA16B16G16R16;
    Name: 'A16B16G16R16';
    BytesPerPixel: 8;
    HasAlphaChannel: True;
    IsRBSwapped: True;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  // floating point formats
  R32FInfo: TImageFormatInfo = (
    Format: ifR32F;
    Name: 'R32F';
    BytesPerPixel: 4;
    IsFloatingPoint: True;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

 A32R32G32B32FInfo: TImageFormatInfo = (
    Format: ifA32R32G32B32F;
    Name: 'A32R32G32B32F';
    BytesPerPixel: 16;
    HasAlphaChannel: True;
    IsFloatingPoint: True;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  A32B32G32R32FInfo: TImageFormatInfo = (
    Format: ifA32B32G32R32F;
    Name: 'A32B32G32R32F';
    BytesPerPixel: 16;
    HasAlphaChannel: True;
    IsFloatingPoint: True;
    IsRBSwapped: True;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions);

  // special formats
  DXT1Info: TImageFormatInfo = (
    Format: ifDXT1;
    Name: 'DXT1';
    IsSpecial: True;
    GetPixelsSize: GetDXTPixelsSize;
    CheckDimensions: CheckDXTDimensions);

  DXT3Info: TImageFormatInfo = (
    Format: ifDXT3;
    Name: 'DXT3';
    IsSpecial: True;
    GetPixelsSize: GetDXTPixelsSize;
    CheckDimensions: CheckDXTDimensions);

  DXT5Info: TImageFormatInfo = (
    Format: ifDXT5;
    Name: 'DXT5';
    IsSpecial: True;
    GetPixelsSize: GetDXTPixelsSize;
    CheckDimensions: CheckDXTDimensions);

{$WARNINGS ON}

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

procedure InitImageFormats(var Infos: TImageFormatInfoArray);
var
  I: LongInt;
begin
  FInfos := @Infos;
  // 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;
  // special formats
  Infos[ifDXT1] := @DXT1Info;
  Infos[ifDXT3] := @DXT3Info;
  Infos[ifDXT5] := @DXT5Info;

  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);

  for I := 0 to 255 do
  begin
    RCh[I] := Trunc(GrayConv.R * I);
    GCh[I] := Trunc(GrayConv.G * I);
    BCh[I] := Trunc(GrayConv.B * I);
  end;
end;


{ Internal unit helper functions }

function PixelFormat(ABitCount, RBitCount, GBitCount, BBitCount: Byte):
  TPixelFormat;
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):
  TPixelFormat;

  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: TPixelFormat; 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: TPixelFormat; 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: TPixelFormat; 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: TPixelFormat; 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;

procedure ClampFloatPixel(var PixF: TColorFRec);
{$IFDEF USE_INLINE}inline;{$ENDIF}
begin
  if PixF.A > 1.0 then
    PixF.A := 1.0;
  if PixF.R > 1.0 then
    PixF.R := 1.0;
  if PixF.G > 1.0 then
    PixF.G := 1.0;
  if PixF.B > 1.0 then
    PixF.B := 1.0;

  if PixF.A < 0.0 then
    PixF.A := 0.0;
  if PixF.R < 0.0 then
    PixF.R := 0.0;
  if PixF.G < 0.0 then
    PixF.G := 0.0;
  if PixF.B < 0.0 then
    PixF.B := 0.0;
end;


{ Various format support functions }

procedure AddPadBytes(DataIn: Pointer; var DataOut: Pointer; Width, Height,
  Bpp, WidthBytes: LongInt);
var
  I, W: LongInt;
begin
  W := Width * Bpp;
  for I := 0 to Height - 1 do
    Move(PByteArray(DataIn)[I * W], PByteArray(DataOut)[I * WidthBytes], W);
end;

procedure RemovePadBytes(DataIn: Pointer; var DataOut: Pointer; Width, Height,
  Bpp, WidthBytes: LongInt);
var
  I, W: LongInt;
begin
  W := Width * Bpp;
  for I := 0 to Height - 1 do
    Move(PByteArray(DataIn)[I * WidthBytes], PByteArray(DataOut)[I * W], W);
end;

procedure IndexConvReader(Src: PByte; SrcInfo: PImageFormatInfo;
  var Col: TColor32Rec);
var
  Pix64: TColor64Rec;
  PixF: TColorFRec;
begin
  if SrcInfo.IsFloatingPoint then
  begin
    FloatGetSrcPixel(Src, SrcInfo, PixF);
    Col.A := Round(PixF.A * 255);
    Col.R := Round(PixF.R * 255);
    Col.G := Round(PixF.G * 255);
    Col.B := Round(PixF.B * 255);
  end
  else
    if SrcInfo.Format = ifA8R8G8B8 then
      Col := PColor32Rec(Src)^
    else
      if SrcInfo.Format = ifR8G8B8 then
      begin
        PColor24Rec(@Col)^ := PColor24Rec(Src)^;
        Col.A := $FF;
      end
      else
      begin
        ChannelGetSrcPixel(Src, SrcInfo, Pix64);
        Col.A := Pix64.A shr 8;
        Col.R := Pix64.R shr 8;
        Col.G := Pix64.G shr 8;
        Col.B := Pix64.B shr 8;
      end;
end;

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
      IndexConvReader(Src, SrcInfo, Col);
      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
      IndexConvReader(Src, SrcInfo, Col);
      IndexSetDstPixel(Dst, DstInfo, MapColor(Col));
      Inc(Src, SrcInfo.BytesPerPixel);
      Inc(Dst, DstInfo.BytesPerPixel);
    end;
  end;

begin
  if MaxColors > MaxPossibleColors then
    MaxColors := MaxPossibleColors;
  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;


{ Pixel readers/writers for different image formats }

procedure ChannelGetSrcPixel(Src: PByte; SrcInfo: PImageFormatInfo; var Pix:
  TColor64Rec); 
var
  A, R, G, B: Byte;
begin
  FillChar(Pix, SizeOf(Pix), 0);
  // returns 64 bit color value with 16 bits for each channel
  case SrcInfo.BytesPerPixel of
    1:
      begin
        PFGetARGB(SrcInfo.PixelFormat^, Src^, A, R, G, B);
        Pix.A := A shl 8;
        Pix.R := R shl 8;
        Pix.G := G shl 8;
        Pix.B := B shl 8;
      end;
    2:
      begin
        PFGetARGB(SrcInfo.PixelFormat^, PWord(Src)^, A, R, G, B);
        Pix.A := A shl 8;
        Pix.R := R shl 8;
        Pix.G := G shl 8;
        Pix.B := B shl 8;
      end;
    3:
      with Pix do
      begin
        R := PColor24Rec(Src).R shl 8;
        G := PColor24Rec(Src).G shl 8;
        B := PColor24Rec(Src).B shl 8;
      end;
    4:
      with Pix do
      begin
        A := PColor32Rec(Src).A shl 8;
        R := PColor32Rec(Src).R shl 8;
        G := PColor32Rec(Src).G shl 8;
        B := PColor32Rec(Src).B shl 8;
      end;
    6:
      with Pix do
      begin
        R := PColor48Rec(Src).R;
        G := PColor48Rec(Src).G;
        B := PColor48Rec(Src).B;
      end;
    8: Pix.Color := PColor64(Src)^;
  end;
  // if src has no alpha, we set it to max (otherwise we would have to
  // test if dest has alpha or not in each ChannelToXXX function)
  if not SrcInfo.HasAlphaChannel then
    Pix.A := 65535;

  if SrcInfo.IsRBSwapped then
    Swap(Pix.R, Pix.B);
end;

procedure ChannelSetDstPixel(Dst: PByte; DstInfo: PImageFormatInfo;
  const Pix: TColor64Rec);
var
  PixW: TColor64Rec;
begin
  PixW := Pix;
  if DstInfo.IsRBSwapped then
    Swap(PixW.R, PixW.B);
  // Pix contains 64 bit color value with 16 bit for each channel
  case DstInfo.BytesPerPixel of
    1: Dst^ := PFSetARGB(DstInfo.PixelFormat^, PixW.A shr 8,
        PixW.R shr 8, PixW.G shr 8, PixW.B shr 8);
    2: PWord(Dst)^ := PFSetARGB(DstInfo.PixelFormat^, PixW.A shr 8,
        PixW.R shr 8, PixW.G shr 8, PixW.B shr 8);
    3:
      with PColor24Rec(Dst)^ do
      begin
        R := PixW.R shr 8;
        G := PixW.G shr 8;
        B := PixW.B shr 8;
      end;
    4:
      with PColor32Rec(Dst)^ do
      begin
        A := PixW.A shr 8;
        R := PixW.R shr 8;
        G := PixW.G shr 8;
        B := PixW.B shr 8;
      end;
    6:
      with PColor48Rec(Dst)^ do
      begin
        R := PixW.R;
        G := PixW.G;
        B := PixW.B;
      end;
    8: PColor64(Dst)^ := PixW.Color;
  end;
end;

procedure GrayGetSrcPixel(Src: PByte; SrcInfo: PImageFormatInfo;
  var Gray: TColor64Rec; var Alpha: Word);
begin
  FillChar(Gray, SizeOf(Gray), 0);
  // Source alpha is scaled to 16 bits and stored in Alpha,
  // grayscale value is scaled to 64 bits and stored in Gray
  case SrcInfo.BytesPerPixel of
    1: Gray.A := Src^ shl 8;
    2:
      if SrcInfo.HasAlphaChannel then
        with PWordRec(Src)^ do
        begin
          Alpha := High shl 8;
          Gray.A := Low shl 8;
        end
      else
        Gray.A := PWord(Src)^;
    4:
      if SrcInfo.HasAlphaChannel then
        with PLongWordRec(Src)^ do
        begin
          Alpha := High;
          Gray.A := Low;
        end
      else
        with PLongWordRec(Src)^ do
        begin
          Gray.A := High;
          Gray.R := Low;
        end;
    8: Gray.Color := PColor64(Src)^;
  end;
  // if src has no alpha, we set it to max (otherwise we would have to
  // test if dest has alpha or not in each GrayToXXX function)
  if not SrcInfo.HasAlphaChannel then
    Alpha := 65535;
end;

procedure GraySetDstPixel(Dst: PByte; DstInfo: PImageFormatInfo;
  const Gray: TColor64Rec; Alpha: Word);
begin
  // Gray contains grayscale value scaled to 64 bits, Alpha contains
  // alpha value scaled to 16 bits
  case DstInfo.BytesPerPixel of
    1: Dst^ := Gray.A shr 8;
    2:
      if DstInfo.HasAlphaChannel then
        with PWordRec(Dst)^ do
        begin
          High := Alpha shr 8;
          Low := Gray.A shr 8;
        end
      else
        PWord(Dst)^ := Gray.A;
    4:
      if DstInfo.HasAlphaChannel then
        with PLongWordRec(Dst)^ do
        begin
          High := Alpha;
          Low := Gray.A;
        end
      else
        with PLongWordRec(Dst)^ do
        begin
          High := Gray.A;
          Low := Gray.R;
        end;
    8: PColor64(Dst)^ := Gray.Color;
  end;
end;

procedure FloatGetSrcPixel(Src: PByte; SrcInfo: PImageFormatInfo;
  var Pix: TColorFRec);
begin
  FillChar(Pix, SizeOf(Pix), 0);
  case SrcInfo.BytesPerPixel of
    4: Pix.R := PSingle(Src)^;
    16: Pix := PColorFRec(Src)^;
  end;
  // if src has no alpha, we set it to max (otherwise we would have to
  // test if dest has alpha or not in each FloatToXXX function)
  if not SrcInfo.HasAlphaChannel then
    Pix.A := 1.0;
  if SrcInfo.IsRBSwapped then
    Swap(Pix.R, Pix.B);
end;

procedure FloatSetDstPixel(Dst: PByte; DstInfo: PImageFormatInfo;
  const Pix: TColorFRec);
var
  PixW: TColorFRec;
begin
  PixW := Pix;
  if DstInfo.IsRBSwapped then
    Swap(PixW.R, PixW.B);
  case DstInfo.BytesPerPixel of
    4: PSingle(Dst)^ := PixW.R;
    16: PColorFRec(Dst)^ := PixW;
  end;
end;

procedure IndexGetSrcPixel(Src: PByte; SrcInfo: PImageFormatInfo;
  var Index: LongWord);
begin
  case SrcInfo.BytesPerPixel of
    1: Index := Src^;
  end;
end;

procedure IndexSetDstPixel(Dst: PByte; DstInfo: PImageFormatInfo;
  Index: LongWord);
begin
  case DstInfo.BytesPerPixel of
    1: Dst^ := Byte(Index);
    2: PWord(Dst)^ := Word(Index);
    4: PLongWord(Dst)^ := Index;
  end;
end;


{ Image format conversion functions }

procedure ChannelToChannel(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,
  DstInfo: PImageFormatInfo);
var
  I: LongInt;
  Pix64: TColor64Rec;
begin
  // two most common conversions (RGB->ARGB and ARGB->RGB for 24/32 bit
  // images) are made separately from general ARGB conversion to
  // make them faster
  if (SrcInfo.BytesPerPixel = 3) and (DstInfo.BytesPerPixel = 4) then
  for I := 0 to NumPixels - 1 do
    begin
      PColor24Rec(Dst)^ := PColor24Rec(Src)^;
      PColor32Rec(Dst).A := 255;
      Inc(Src, SrcInfo.BytesPerPixel);
      Inc(Dst, DstInfo.BytesPerPixel);
    end
  else
  if (SrcInfo.BytesPerPixel = 4) and (DstInfo.BytesPerPixel = 3) then
    for I := 0 to NumPixels - 1 do
    begin
      PColor24Rec(Dst)^ := PColor24Rec(Src)^;
      Inc(Src, SrcInfo.BytesPerPixel);
      Inc(Dst, DstInfo.BytesPerPixel);
    end
  else
    for I := 0 to NumPixels - 1 do
    begin
      // general ARGB conversion
      ChannelGetSrcPixel(Src, SrcInfo, Pix64);
      ChannelSetDstPixel(Dst, DstInfo, Pix64);
      Inc(Src, SrcInfo.BytesPerPixel);
      Inc(Dst, DstInfo.BytesPerPixel);
    end;
end;

procedure ChannelToGray(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,
  DstInfo: PImageFormatInfo);
var
  I: LongInt;
  Pix64: TColor64Rec;
  Alpha: Word;
begin
  // two most common conversions (R8G8B8->Gray8 nad A8R8G8B8->Gray8)
  // are made separately from general conversions to make them faster
  if (SrcInfo.BytesPerPixel in [3, 4]) and (DstInfo.Format = ifGray8) then
    for I := 0 to NumPixels - 1 do
    begin
      with GrayConv do
        Dst^ := RCh[PColor24Rec(Src).R] + GCh[PColor24Rec(Src).G] +
          BCh[PColor24Rec(Src).B];
      Inc(Src, SrcInfo.BytesPerPixel);
      Inc(Dst, DstInfo.BytesPerPixel);
    end
  else
    for I := 0 to NumPixels - 1 do
    begin
      ChannelGetSrcPixel(Src, SrcInfo, Pix64);

      // alpha is saved from source pixel to Alpha,
      // Gray value is computed and set to highest word of Pix64 so
      // Pix64.Color contains grayscale value scaled to 64 bits
      Alpha := Pix64.A;
      with GrayConv do
        Pix64.A := Round(R * Pix64.R + G * Pix64.G + B * Pix64.B);

      GraySetDstPixel(Dst, DstInfo, Pix64, Alpha);
      Inc(Src, SrcInfo.BytesPerPixel);
      Inc(Dst, DstInfo.BytesPerPixel);
    end;
end;

procedure ChannelToFloat(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,
  DstInfo: PImageFormatInfo);
const
  OneDivided = 1.0 / 65535;
var
  I: LongInt;
  Pix64: TColor64Rec;
  PixF: TColorFRec;
begin
  for I := 0 to NumPixels - 1 do
  begin
    ChannelGetSrcPixel(Src, SrcInfo, Pix64);

    // floating point channel values are scaled to 1.0
    PixF.A := Pix64.A * OneDivided;
    PixF.R := Pix64.R * OneDivided;
    PixF.G := Pix64.G * OneDivided;
    PixF.B := Pix64.B * OneDivided;

    FloatSetDstPixel(Dst, DstInfo, PixF);
    Inc(Src, SrcInfo.BytesPerPixel);
    Inc(Dst, DstInfo.BytesPerPixel);
  end;
end;

procedure ChannelToIndex(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,
  DstInfo: PImageFormatInfo; DstPal: PPalette32);
begin
  ReduceColorsMedianCut(NumPixels, Src, Dst, SrcInfo, DstInfo, DstInfo.PaletteEntries,
    GetOption(ImagingColorReductionMask), DstPal);
end;

procedure GrayToGray(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,
  DstInfo: PImageFormatInfo);
var
  I: LongInt;
  Gray: TColor64Rec;
  Alpha: Word;
begin
  // two most common conversions (Gray8->Gray16 nad Gray16->Gray8)
  // are made separately from general conversions to make them faster
  if (SrcInfo.Format = ifGray8) and (DstInfo.Format = ifGray16) then
  begin
    for I := 0 to NumPixels - 1 do
      PWordArray(Dst)[I] := PByteArray(Src)[I] shl 8;
  end
  else
    if (DstInfo.Format = ifGray8) and (SrcInfo.Format = ifGray16) then
    begin
      for I := 0 to NumPixels - 1 do
        PByteArray(Dst)[I] := PWordArray(Src)[I] shr 8;
    end
    else
      for I := 0 to NumPixels - 1 do
      begin
        // general grayscale conversion
        GrayGetSrcPixel(Src, SrcInfo, Gray, Alpha);
        GraySetDstPixel(Dst, DstInfo, Gray, Alpha);
        Inc(Src, SrcInfo.BytesPerPixel);
        Inc(Dst, DstInfo.BytesPerPixel);
      end;
end;

procedure GrayToChannel(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,
  DstInfo: PImageFormatInfo);
var
  I: LongInt;
  Pix64: TColor64Rec;
  Alpha: Word;
begin
  // two most common conversions (Gray8->R8G8B8 nad Gray8->A8R8G8B8)
  // are made separately from general conversions to make them faster
  if (DstInfo.BytesPerPixel in [3, 4]) and (SrcInfo.Format = ifGray8) then
    for I := 0 to NumPixels - 1 do
    begin
      PColor24Rec(Dst).R := Src^;
      PColor24Rec(Dst).G := Src^;
      PColor24Rec(Dst).B := Src^;
      if DstInfo.HasAlphaChannel then
        PColor32Rec(Dst).A := 32;
      Inc(Src, SrcInfo.BytesPerPixel);
      Inc(Dst, DstInfo.BytesPerPixel);
    end
  else
    for I := 0 to NumPixels - 1 do
    begin
      GrayGetSrcPixel(Src, SrcInfo, Pix64, Alpha);

      // most significant word of grayscale value is used for
      // each channel and alpha channel is set to Alpha
      Pix64.R := Pix64.A;
      Pix64.G := Pix64.A;
      Pix64.B := Pix64.A;
      Pix64.A := Alpha;

      ChannelSetDstPixel(Dst, DstInfo, Pix64);
      Inc(Src, SrcInfo.BytesPerPixel);
      Inc(Dst, DstInfo.BytesPerPixel);
    end;
end;

procedure GrayToFloat(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,
  DstInfo: PImageFormatInfo);
const
  OneDivided = 1.0 / 65535;
var
  I: LongInt;
  Gray: TColor64Rec;
  PixF: TColorFRec;
  Alpha: Word;
begin
  for I := 0 to NumPixels - 1 do
  begin
    GrayGetSrcPixel(Src, SrcInfo, Gray, Alpha);
    // most significant word of grayscale value is used for
    // each channel and alpha channel is set to Alpha
    // then all is scaled to 0..1
    PixF.R := Gray.A * OneDivided;
    PixF.G := Gray.A * OneDivided;
    PixF.B := Gray.A * OneDivided;
    PixF.A := Alpha * OneDivided;

    FloatSetDstPixel(Dst, DstInfo, PixF);
    Inc(Src, SrcInfo.BytesPerPixel);
    Inc(Dst, DstInfo.BytesPerPixel);
  end;
end;

procedure GrayToIndex(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,
  DstInfo: PImageFormatInfo; DstPal: PPalette32);
var
  I: LongInt;
  Idx: LongWord;
  Gray: TColor64Rec;
  Alpha, Shift: Word;
begin
  FillGrayscalePalette(DstPal, DstInfo.PaletteEntries);
  Shift := Log2Int(DstInfo.PaletteEntries);
  // most common conversion (Gray8->Index8)
  // is made separately from general conversions to make it faster
  if (SrcInfo.Format = ifGray8) and (DstInfo.Format = ifIndex8) then
    for I := 0 to NumPixels - 1 do
    begin
      Dst^ := Src^;
      Inc(Src, SrcInfo.BytesPerPixel);
      Inc(Dst, DstInfo.BytesPerPixel);
    end
  else
    for I := 0 to NumPixels - 1 do
    begin
      // gray value is read from src and index to precomputed
      // grayscale palette is computed and written to dst
      // (we assume here that there will be no more than 65536 palette
      // entries in dst format, gray value is shifted so the highest
      // gray value match the highest possible index in palette)
      GrayGetSrcPixel(Src, SrcInfo, Gray, Alpha);
      Idx := Gray.A shr (16 - Shift);
      IndexSetDstPixel(Dst, DstInfo, Idx);
      Inc(Src, SrcInfo.BytesPerPixel);
      Inc(Dst, DstInfo.BytesPerPixel);
    end;
end;

procedure FloatToFloat(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,
  DstInfo: PImageFormatInfo);
var
  I: LongInt;
  PixF: TColorFRec;
begin
  for I := 0 to NumPixels - 1 do
  begin
    // general floating point conversion
    FloatGetSrcPixel(Src, SrcInfo, PixF);
    FloatSetDstPixel(Dst, DstInfo, PixF);
    Inc(Src, SrcInfo.BytesPerPixel);
    Inc(Dst, DstInfo.BytesPerPixel);
  end;
end;

procedure FloatToChannel(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,
  DstInfo: PImageFormatInfo);
var
  I: LongInt;
  Pix64: TColor64Rec;
  PixF: TColorFRec;
begin
  for I := 0 to NumPixels - 1 do
  begin
    FloatGetSrcPixel(Src, SrcInfo, PixF);
    ClampFloatPixel(PixF);

    // floating point channel values are scaled to 1.0
    Pix64.A := Round(PixF.A * 65535);
    Pix64.R := Round(PixF.R * 65535);
    Pix64.G := Round(PixF.G * 65535);
    Pix64.B := Round(PixF.B * 65535);

    ChannelSetDstPixel(Dst, DstInfo, Pix64);
    Inc(Src, SrcInfo.BytesPerPixel);
    Inc(Dst, DstInfo.BytesPerPixel);
  end;
end;

procedure FloatToGray(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,
  DstInfo: PImageFormatInfo);
var
  I: LongInt;
  PixF: TColorFRec;
  Gray: TColor64Rec;
  Alpha: Word;
begin
  for I := 0 to NumPixels - 1 do
  begin
    FloatGetSrcPixel(Src, SrcInfo, PixF);
    ClampFloatPixel(PixF);

    // alpha is saved from source pixel to Alpha,
    // Gray value is computed and set to highest word of Pix64 so
    // Pix64.Color contains grayscale value scaled to 64 bits
    Alpha := Round(PixF.A * 65535);
    with GrayConv do
      Gray.A := Round((R * PixF.R + G * PixF.G + B * PixF.B) * 65535);

    GraySetDstPixel(Dst, DstInfo, Gray, Alpha);
    Inc(Src, SrcInfo.BytesPerPixel);
    Inc(Dst, DstInfo.BytesPerPixel);
  end;
end;

procedure FloatToIndex(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,
  DstInfo: PImageFormatInfo; DstPal: PPalette32);
begin
  ReduceColorsMedianCut(NumPixels, Src, Dst, SrcInfo, DstInfo, DstInfo.PaletteEntries,
    GetOption(ImagingColorReductionMask), DstPal);
end;

procedure IndexToIndex(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,
  DstInfo: PImageFormatInfo; SrcPal, DstPal: PPalette32);
var
  I: LongInt;
begin
  // there is only one indexed format now, so it is just a copy
  for I := 0 to NumPixels - 1 do
  begin
    Dst^ := Src^;
    Inc(Src, SrcInfo.BytesPerPixel);
    Inc(Dst, DstInfo.BytesPerPixel);
  end;
  for I := 0 to SrcInfo.PaletteEntries - 1 do
    DstPal[I] := SrcPal[I];
end;

procedure IndexToChannel(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,
  DstInfo: PImageFormatInfo; SrcPal: PPalette32);
var
  I: LongInt;
  Pix64: TColor64Rec;
  Idx: LongWord;
begin
  // two most common conversions (Index8->R8G8B8 nad Index8->A8R8G8B8)
  // are made separately from general conversions to make them faster
  if (SrcInfo.Format = ifIndex8) and (DstInfo.Format in
    [ifR8G8B8, ifA8R8G8B8]) then
    for I := 0 to NumPixels - 1 do
    begin
      with PColor24Rec(Dst)^ do
      begin
        R := SrcPal[Src^].R;
        G := SrcPal[Src^].G;
        B := SrcPal[Src^].B;
      end;
      if DstInfo.Format = ifA8R8G8B8 then
        PColor32Rec(Dst).A := SrcPal[Src^].A;
      Inc(Src, SrcInfo.BytesPerPixel);
      Inc(Dst, DstInfo.BytesPerPixel);
    end
  else
    for I := 0 to NumPixels - 1 do
    begin
      // index to palette is read from source and color
      // is retrieved from palette entry. Color is then
      // scaled to 16bits and written to dest
      IndexGetSrcPixel(Src, SrcInfo, Idx);
      with Pix64 do
      begin
        A := SrcPal[Idx].A shl 8;
        R := SrcPal[Idx].R shl 8;
        G := SrcPal[Idx].G shl 8;
        B := SrcPal[Idx].B shl 8;
      end;
      ChannelSetDstPixel(Dst, DstInfo, Pix64);
      Inc(Src, SrcInfo.BytesPerPixel);
      Inc(Dst, DstInfo.BytesPerPixel);
    end;
end;

procedure IndexToGray(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,
  DstInfo: PImageFormatInfo; SrcPal: PPalette32);
var
  I: LongInt;
  Gray: TColor64Rec;
  Alpha: Word;
  Idx: LongWord;
begin
  // most common conversion (Index8->Gray8)
  // is made separately from general conversions to make it faster
  if (SrcInfo.Format = ifIndex8) and (DstInfo.Format = ifGray8) then
    for I := 0 to NumPixels - 1 do
    begin
      with GrayConv do
        Dst^ := Round(R * SrcPal[Src^].R + G * SrcPal[Src^].G +
          B * SrcPal[Src^].B);
      Inc(Src, SrcInfo.BytesPerPixel);
      Inc(Dst, DstInfo.BytesPerPixel);
    end
  else
    for I := 0 to NumPixels - 1 do
    begin
      // index to palette is read from source and color
      // is retrieved from palette entry. Color is then
      // transformed to grayscale and assigned to the highest
      // byte of Gray value
      IndexGetSrcPixel(Src, SrcInfo, Idx);
      Alpha := SrcPal[Idx].A shl 8;
      with GrayConv do
        Gray.A := Round(R * SrcPal[Idx].R + G * SrcPal[Idx].G +
          B * SrcPal[Idx].B) shl 8;
      GraySetDstPixel(Dst, DstInfo, Gray, Alpha);
      Inc(Src, SrcInfo.BytesPerPixel);
      Inc(Dst, DstInfo.BytesPerPixel);
    end;
end;

procedure IndexToFloat(NumPixels: LongInt; Src, Dst: PByte; SrcInfo,
  DstInfo: PImageFormatInfo; SrcPal: PPalette32);
const
  OneDivided = 1.0 / 255;
var
  I: LongInt;
  Idx: LongWord;
  PixF: TColorFRec;
begin
  for I := 0 to NumPixels - 1 do
  begin
    // index to palette is read from source and color
    // is retrieved from palette entry. Color is then
    // scaled to 0..1 and written to dest
    IndexGetSrcPixel(Src, SrcInfo, Idx);
    with PixF do
    begin
      A := SrcPal[Idx].A * OneDivided;
      R := SrcPal[Idx].R * OneDivided;
      G := SrcPal[Idx].G * OneDivided;
      B := SrcPal[Idx].B * OneDivided;
    end;
    FloatSetDstPixel(Dst, DstInfo, PixF);
    Inc(Src, SrcInfo.BytesPerPixel);
    Inc(Dst, DstInfo.BytesPerPixel);
  end;
end;


{ Special formats conversion functions }

var
  UnSpecialFormat: TImageFormat = ifDefault;

type
  // DXT RGB color block
  TDXTColorBlock = packed record
    Color0, Color1: Word;
    Mask: LongWord;
  end;
  PDXTColorBlock = ^TDXTColorBlock;

  // DXT explicit alpha for a block
  TDXTAlphaBlockExp = packed record
    Alphas: array[0..3] of Word;
  end;
  PDXTAlphaBlockExp = ^TDXTAlphaBlockExp;

  // DXT interpolated alpha for a block
  TDXTAlphaBlockInt = packed record
    Alphas: array[0..7] of Byte;
  end;
  PDXTAlphaBlockInt = ^TDXTAlphaBlockInt;

  TPixelInfo = record
    Color: Word;
    Alpha: Byte;
    Orig: TColor32Rec;
  end;

  TPixelBlock = array[0..15] of TPixelInfo;

function DecodeCol(Color : Word): TColor32Rec;
{$IFDEF USE_INLINE} inline; {$ENDIF}
begin
  Result.A := $FF;
  {Result.R := ((Color and $F800) shr 11) shl 3;
  Result.G := ((Color and $07E0) shr 5) shl 2;
  Result.B := (Color and $001F) shl 3;}
  // this color expansion is slower but gives better results
  Result.R := (Color shr 11) * 255 div 31;
  Result.G := ((Color shr 5) and $3F) * 255 div 63;
  Result.B := (Color and $1F) * 255 div 31;
end;

procedure DecodeDXT1(SrcBits, DestBits: PByte; Width, Height: LongInt);
var
  Sel, X, Y, I, J, K: LongInt;
  Block: TDXTColorBlock;
  Colors: array[0..3] of TColor32Rec;
begin
  for Y := 0 to (Height div 4) - 1 do
  begin
    for X := 0 to (Width div 4) - 1 do
    begin
      Block := PDXTColorBlock(SrcBits)^;
      Inc(SrcBits, SizeOf(Block));
      // we read and decode endpoint colors
      Colors[0] := DecodeCol(Block.Color0);
      Colors[1] := DecodeCol(Block.Color1);
      // and interpolate between them
      if Block.Color0 > Block.Color1 then
      begin
        // interpolation for block without alpha
        Colors[2].A := $FF;
        Colors[2].R := (Colors[0].R shl 1 + Colors[1].R + 1) div 3;
        Colors[2].G := (Colors[0].G shl 1 + Colors[1].G + 1) div 3;
        Colors[2].B := (Colors[0].B shl 1 + Colors[1].B + 1) div 3;
        Colors[3].A := $FF;
        Colors[3].R := (Colors[0].R + Colors[1].R shl 1 + 1) div 3;
        Colors[3].G := (Colors[0].G + Colors[1].G shl 1 + 1) div 3;
        Colors[3].B := (Colors[0].B + Colors[1].B shl 1 + 1) div 3;
      end
      else
      begin
        // interpolation for block with alpha
        Colors[2].A := $FF;
        Colors[2].R := (Colors[0].R + Colors[1].R) shr 1;
        Colors[2].G := (Colors[0].G + Colors[1].G) shr 1;
        Colors[2].B := (Colors[0].B + Colors[1].B) shr 1;
        Colors[3].A := 0;
        Colors[3].R := (Colors[0].R + Colors[1].R shl 1 + 1) div 3;
        Colors[3].G := (Colors[0].G + Colors[1].G shl 1 + 1) div 3;
        Colors[3].B := (Colors[0].B + Colors[1].B shl 1 + 1) div 3;
      end;

      // we distribute the dxt block colors across the 4x4 block of the
      // destination image accroding to the dxt block mask
      K := 0;
      for J := 0 to 3 do
        for I := 0 to 3 do
        begin
          Sel := (Block.Mask and (3 shl (K shl 1))) shr (K shl 1);
          if ((X shl 2 + I) < Width) and ((Y shl 2 + J) < Height) then
            PPalette32(DestBits)[(Y shl 2 + J) * Width + X shl 2 + I] :=
              Colors[Sel];
          Inc(K);
        end;
    end;
  end;
end;

procedure DecodeDXT3(SrcBits, DestBits: PByte; Width, Height: LongInt);
var
  Sel, X, Y, I, J, K: LongInt;
  Block: TDXTColorBlock;
  AlphaBlock: TDXTAlphaBlockExp;
  Colors: array[0..3] of TColor32Rec;
  AWord: Word;
begin
  for Y := 0 to (Height div 4) - 1 do
  begin
    for X := 0 to (Width div 4) - 1 do
    begin
      AlphaBlock := PDXTAlphaBlockExp(SrcBits)^;
      Inc(SrcBits, SizeOf(AlphaBlock));
      Block := PDXTColorBlock(SrcBits)^;
      Inc(SrcBits, SizeOf(Block));
      // we read and decode endpoint colors
      Colors[0] := DecodeCol(Block.Color0);
      Colors[1] := DecodeCol(Block.Color1);
      // and interpolate between them
      Colors[2].R := (Colors[0].R shl 1 + Colors[1].R + 1) div 3;
      Colors[2].G := (Colors[0].G shl 1 + Colors[1].G + 1) div 3;
      Colors[2].B := (Colors[0].B shl 1 + Colors[1].B + 1) div 3;
      Colors[3].R := (Colors[0].R + Colors[1].R shl 1 + 1) div 3;
      Colors[3].G := (Colors[0].G + Colors[1].G shl 1 + 1) div 3;
      Colors[3].B := (Colors[0].B + Colors[1].B shl 1 + 1) div 3;

      // we distribute the dxt block colors and alphas
      // across the 4x4 block of the destination image
      // accroding to the dxt block mask and alpha block
      K := 0;
      for J := 0 to 3 do
      begin
        AWord := AlphaBlock.Alphas[J];
        for I := 0 to 3 do
        begin
          Sel := (Block.Mask and (3 shl (K shl 1))) shr (K shl 1);
          if (X shl 2 + I < Width) and (Y shl 2 + J < Height) then
          begin
            Colors[Sel].A := AWord and $0F;
            Colors[Sel].A := Colors[Sel].A or (Colors[Sel].A shl 4);
            PPalette32(DestBits)[(Y shl 2 + J) * Width + X shl 2 + I] :=
              Colors[Sel];
          end;
          Inc(K);
          AWord := AWord shr 4;
        end;
      end;
    end;
  end;
end;

procedure DecodeDXT5(SrcBits, DestBits: PByte; Width, Height: LongInt);
var
  Sel, X, Y, I, J, K: LongInt;
  Block: TDXTColorBlock;
  AlphaBlock: TDXTAlphaBlockInt;
  Colors: array[0..3] of TColor32Rec;
  AMask: array[0..1] of LongWord;
begin
  for Y := 0 to (Height div 4) - 1 do
  begin
    for X := 0 to (Width div 4) - 1 do
    begin
      AlphaBlock := PDXTAlphaBlockInt(SrcBits)^;
      Inc(SrcBits, SizeOf(AlphaBlock));
      Block := PDXTColorBlock(SrcBits)^;
      Inc(SrcBits, SizeOf(Block));
      // we read and decode endpoint colors
      Colors[0] := DecodeCol(Block.Color0);
      Colors[1] := DecodeCol(Block.Color1);
      // and interpolate between them
      Colors[2].R := (Colors[0].R shl 1 + Colors[1].R + 1) div 3;
      Colors[2].G := (Colors[0].G shl 1 + Colors[1].G + 1) div 3;
      Colors[2].B := (Colors[0].B shl 1 + Colors[1].B + 1) div 3;
      Colors[3].R := (Colors[0].R + Colors[1].R shl 1 + 1) div 3;
      Colors[3].G := (Colors[0].G + Colors[1].G shl 1 + 1) div 3;
      Colors[3].B := (Colors[0].B + Colors[1].B shl 1 + 1) div 3;
      // 6 bit alpha mask is copied into two long words for
      // easier usage 
      AMask[0] := PLongWord(@AlphaBlock.Alphas[2])^ and $00FFFFFF;
      AMask[1] := PLongWord(@AlphaBlock.Alphas[5])^ and $00FFFFFF;
      // alpha interpolation between two endpoint alphas
      with AlphaBlock do
        if Alphas[0] > Alphas[1] then
        begin
          // interpolation of six alphas
          Alphas[2] := (6 * Alphas[0] + 1 * Alphas[1] + 3) div 7;
          Alphas[3] := (5 * Alphas[0] + 2 * Alphas[1] + 3) div 7;
          Alphas[4] := (4 * Alphas[0] + 3 * Alphas[1] + 3) div 7;
          Alphas[5] := (3 * Alphas[0] + 4 * Alphas[1] + 3) div 7;
          Alphas[6] := (2 * Alphas[0] + 5 * Alphas[1] + 3) div 7;
          Alphas[7] := (1 * Alphas[0] + 6 * Alphas[1] + 3) div 7;
        end
        else
        begin
          // interpolation of four alphas, two alphas are set directly
          Alphas[2] := (4 * Alphas[0] + 1 * Alphas[1] + 2) div 5;
          Alphas[3] := (3 * Alphas[0] + 2 * Alphas[1] + 2) div 5;
          Alphas[4] := (2 * Alphas[0] + 3 * Alphas[1] + 2) div 5;
          Alphas[5] := (1 * Alphas[0] + 4 * Alphas[1] + 2) div 5;
          Alphas[6] := 0;
          Alphas[7] := $FF;
        end;

      // we distribute the dxt block colors and alphas
      // across the 4x4 block of the destination image
      // accroding to the dxt block mask and alpha block mask
      K := 0;
      for J := 0 to 3 do
        for I := 0 to 3 do
        begin
          Sel := (Block.Mask and (3 shl (K shl 1))) shr (K shl 1);
          if ((X shl 2 + I) < Width) and ((Y shl 2 + J) < Height) then
          begin
            Colors[Sel].A := AlphaBlock.Alphas[AMask[J shr 1] and 7];
            PPalette32(DestBits)[(Y shl 2 + J) * Width + (X shl 2 + I)] :=
              Colors[Sel];
          end;
          Inc(K);
          AMask[J shr 1] := AMask[J shr 1] shr 3;
        end;
    end;
  end;
end;

procedure SpecialToUnSpecial(const SrcImage: TImageData; DestBits: Pointer;
  SrcInfo, DstInfo: PImageFormatInfo);
begin
  case SrcInfo.Format of
    ifDXT1: DecodeDXT1(SrcImage.Bits, DestBits, SrcImage.Width, SrcImage.Height);
    ifDXT3: DecodeDXT3(SrcImage.Bits, DestBits, SrcImage.Width, SrcImage.Height);
    ifDXT5: DecodeDXT5(SrcImage.Bits, DestBits, SrcImage.Width, SrcImage.Height);
  end;
end;

procedure GetBlock(var Block: TPixelBlock; SrcBits: Pointer; XPos, YPos,
  Width, Height: LongInt);
var
  X, Y, I: LongInt;
  Src: PColor32Rec;
begin
  I := 0;
  // 4x4 pixel block is filled with information about every
  // pixel in the block: alpha, original color, 565 color
  for Y := 0 to 3 do
    for X := 0 to 3 do
    begin
      Src := @PPalette32(SrcBits)[(YPos shl 2 + Y) * Width + XPos shl 2 + X];
      Block[I].Color := ((Src.R shr 3) shl 11) or ((Src.G shr 2) shl 5) or
        (Src.B shr 3);
      Block[I].Alpha := Src.A;
      Block[I].Orig := Src^;
      Inc(I);
    end;
end;

function ColorDistance(const C1, C2: TColor32Rec): LongInt;
{$IFDEF USE_INLINE} inline;{$ENDIF}
begin
  Result := (C1.R - C2.R) * (C1.R - C2.R) +
    (C1.G - C2.G) * (C1.G - C2.G) + (C1.B - C2.B) * (C1.B - C2.B);
end;

procedure GetEndpoints(const Block: TPixelBlock; var Ep0, Ep1: Word);
var
  I, J, Farthest, Dist: LongInt;
  Colors: array[0..15] of TColor32Rec;
begin
  // we choose two colors from the pixel block which has the
  // largest distance between them
  for I := 0 to 15 do
    Colors[I] := Block[I].Orig;
  Farthest := -1;
  for I := 0 to 15 do
    for J := I + 1 to 15 do
    begin
      Dist := ColorDistance(Colors[I], Colors[J]);
      if Dist > Farthest then
      begin
        Farthest := Dist;
        Ep0 := Block[I].Color;
        Ep1 := Block[J].Color;
      end;
    end;
end;

procedure GetAlphaEndpoints(const Block: TPixelBlock; var Min, Max: Byte);
var
  I: LongInt;
begin
  Min := 255;
  Max := 0;
  // we choose the lowest and the highest alpha values
  for I := 0 to 15 do
  begin
    if Block[I].Alpha < Min then
      Min := Block[I].Alpha;
    if Block[I].Alpha > Max then
      Max := Block[I].Alpha;
  end;
end;

procedure FixEndpoints(var Ep0, Ep1: Word; HasAlpha: Boolean);
var
  Temp: Word;
begin
  // if dxt block has alpha information, Ep0 must be smaller
  // than Ep1, if the  block has no alpha Ep1 must be smaller
  if HasAlpha then
  begin
    if Ep0 > Ep1 then
    begin
      Temp := Ep0;
      Ep0 := Ep1;
      Ep1 := Temp;
    end;
  end
  else
    if Ep0 < Ep1 then
    begin
      Temp := Ep0;
      Ep0 := Ep1;
      Ep1 := Temp;
    end;
end;

function GetColorMask(Ep0, Ep1: Word; NumCols: LongInt;
  const Block: TPixelBlock): LongWord;
var
  I, J, Closest, Dist: LongInt;
  Colors: array[0..3] of TColor32Rec;
  Mask: array[0..15] of Byte;
begin
  // we decode endpoint colors
  Colors[0] := DecodeCol(Ep0);
  Colors[1] := DecodeCol(Ep1);
  // and interpolate colors between (3 for DXT1 with alpha, 4 for the others)
  if NumCols = 3 then
  begin
    Colors[2].R := (Colors[0].R + Colors[1].R) shr 1;
    Colors[2].G := (Colors[0].G + Colors[1].G) shr 1;
    Colors[2].B := (Colors[0].B + Colors[1].B) shr 1;
    Colors[3].R := (Colors[0].R + Colors[1].R) shr 1;
    Colors[3].G := (Colors[0].G + Colors[1].G) shr 1;
    Colors[3].B := (Colors[0].B + Colors[1].B) shr 1;
  end
  else
  begin
    Colors[2].R := (Colors[0].R shl 1 + Colors[1].R + 1) div 3;
    Colors[2].G := (Colors[0].G shl 1 + Colors[1].G + 1) div 3;
    Colors[2].B := (Colors[0].B shl 1 + Colors[1].B + 1) div 3;
    Colors[3].R := (Colors[0].R + Colors[1].R shl 1 + 1) div 3;
    Colors[3].G := (Colors[0].G + Colors[1].G shl 1 + 1) div 3;
    Colors[3].B := (Colors[0].B + Colors[1].B shl 1 + 1) div 3;
  end;

  for I := 0 to 15 do
  begin
    // this is only for DXT1 with alpha
    if (Block[I].Alpha < 128) and (NumCols = 3) then
    begin
      Mask[I] := 3;
      Continue;
    end;
    // for each of the 16 input pixels the nearest color in the
    // 4 dxt colors is found
    Closest := MaxInt;
    for J := 0 to NumCols - 1 do
    begin
      Dist := ColorDistance(Block[I].Orig, Colors[J]);
      if Dist < Closest then
      begin
        Closest := Dist;
        Mask[I] := J;
      end;
    end;
  end;

  Result := 0;
  for I := 0 to 15 do
    Result := Result or (Mask[I] shl (I shl 1));
end;

procedure GetAlphaMask(Ep0, Ep1: Byte; var Block: TPixelBlock; Mask: PByteArray);
var
  Alphas: array[0..7] of Byte;
  M: array[0..15] of Byte;
  I, J, Closest, Dist: LongInt;
begin
  Alphas[0] := Ep0;
  Alphas[1] := Ep1;
  // interpolation between two given alpha endpoints
  // (I use 6 interpolated values mode)
  Alphas[2] := (6 * Alphas[0] + 1 * Alphas[1] + 3) div 7;
  Alphas[3] := (5 * Alphas[0] + 2 * Alphas[1] + 3) div 7;
  Alphas[4] := (4 * Alphas[0] + 3 * Alphas[1] + 3) div 7;
  Alphas[5] := (3 * Alphas[0] + 4 * Alphas[1] + 3) div 7;
  Alphas[6] := (2 * Alphas[0] + 5 * Alphas[1] + 3) div 7;
  Alphas[7] := (1 * Alphas[0] + 6 * Alphas[1] + 3) div 7;

  // the closest interpolated values for each of the input alpha
  // is found
  for I := 0 to 15 do
  begin
    Closest := MaxInt;
    for J := 0 to 7 do
    begin
      Dist := Abs(Alphas[J] - Block[I].Alpha);
      if Dist < Closest then
      begin
        Closest := Dist;
        M[I] := J;
      end;
    end;
  end;

  Mask[0] := M[0] or (M[1] shl 3) or ((M[2] and 3) shl 6);
  Mask[1] := ((M[2] and 4) shr 2) or (M[3] shl 1) or (M[4] shl 4) or
    ((M[5] and 1) shl 7);
  Mask[2] := ((M[5] and 6) shr 1) or (M[6] shl 2) or (M[7] shl 5);
  Mask[3] := M[8] or (M[9] shl 3) or ((M[10] and 3) shl 6);
  Mask[4] := ((M[10] and 4) shr 2) or (M[11] shl 1) or (M[12] shl 4) or
   ((M[13] and 1) shl 7);
  Mask[5] := ((M[13] and 6) shr 1) or (M[14] shl 2) or (M[15] shl 5);
end;


procedure EncodeDXT1(SrcBits: Pointer; DestBits: PByte; Width, Height: LongInt);
var
  X, Y, I: LongInt;
  HasAlpha: Boolean;
  Block: TDXTColorBlock;
  Pixels: TPixelBlock;
begin
  for Y := 0 to (Height div 4) - 1 do
    for X := 0 to (Width div 4) - 1 do
    begin
      GetBlock(Pixels, SrcBits, X, Y, Width, Height);
      HasAlpha := False;
      for I := 0 to 15 do
        if Pixels[I].Alpha < 128 then
        begin
          HasAlpha := True;
          Break;
        end;
      GetEndpoints(Pixels, Block.Color0, Block.Color1);
      FixEndpoints(Block.Color0, Block.Color1, HasAlpha);
      if HasAlpha then
        Block.Mask := GetColorMask(Block.Color0, Block.Color1, 3, Pixels)
      else
        Block.Mask := GetColorMask(Block.Color0, Block.Color1, 4, Pixels);
      PDXTColorBlock(DestBits)^ := Block;
      Inc(DestBits, SizeOf(Block));
    end;
end;

procedure EncodeDXT3(SrcBits: Pointer; DestBits: PByte; Width, Height: LongInt);
var
  X, Y, I: LongInt;
  Block: TDXTColorBlock;
  AlphaBlock: TDXTAlphaBlockExp;
  Pixels: TPixelBlock;
begin
  for Y := 0 to (Height div 4) - 1 do
    for X := 0 to (Width div 4) - 1 do
    begin
      GetBlock(Pixels, SrcBits, X, Y, Width, Height);
      for I := 0 to 7 do
        PByteArray(@AlphaBlock.Alphas)[I] :=
          ((Pixels[I shl 1].Alpha shr 4) shl 4) or (Pixels[I shl 1 + 1].Alpha shr 4);
      GetEndpoints(Pixels, Block.Color0, Block.Color1);
      FixEndpoints(Block.Color0, Block.Color1, False);
      Block.Mask := GetColorMask(Block.Color0, Block.Color1, 4, Pixels);
      PDXTAlphaBlockExp(DestBits)^ := AlphaBlock;
      Inc(DestBits, SizeOf(AlphaBlock));
      PDXTColorBlock(DestBits)^ := Block;
      Inc(DestBits, SizeOf(Block));
    end;
end;

procedure EncodeDXT5(SrcBits: Pointer; DestBits: PByte; Width, Height: LongInt);
var
  X, Y: LongInt;
  Block: TDXTColorBlock;
  AlphaBlock: TDXTAlphaBlockInt;
  Pixels: TPixelBlock;
begin
  for Y := 0 to (Height div 4) - 1 do
    for X := 0 to (Width div 4) - 1 do
    begin
      GetBlock(Pixels, SrcBits, X, Y, Width, Height);
      GetEndpoints(Pixels, Block.Color0, Block.Color1);
      FixEndpoints(Block.Color0, Block.Color1, False);
      Block.Mask := GetColorMask(Block.Color0, Block.Color1, 4, Pixels);
      GetAlphaEndPoints(Pixels, AlphaBlock.Alphas[1], AlphaBlock.Alphas[0]);
      GetAlphaMask(AlphaBlock.Alphas[0], AlphaBlock.Alphas[1], Pixels,
        PByteArray(@AlphaBlock.Alphas[2]));
      PDXTAlphaBlockInt(DestBits)^ := AlphaBlock;
      Inc(DestBits, SizeOf(AlphaBlock));
      PDXTColorBlock(DestBits)^ := Block;
      Inc(DestBits, SizeOf(Block));
    end;
end;

procedure UnSpecialToSpecial(const DestImage: TImageData; SrcBits: Pointer;
  SrcInfo, DstInfo: PImageFormatInfo);
begin
  case DstInfo.Format of
    ifDXT1: EncodeDXT1(SrcBits, DestImage.Bits, DestImage.Width,
      DestImage.Height);
    ifDXT3: EncodeDXT3(SrcBits, DestImage.Bits, DestImage.Width,
      DestImage.Height);
    ifDXT5: EncodeDXT5(SrcBits, DestImage.Bits, DestImage.Width,
      DestImage.Height);
  end;
end;

procedure ConvertSpecial(var Image: TImageData; SrcInfo,
  DstInfo: PImageFormatInfo);
var
  TmpImage: TImageData;
  Width, Height: LongInt;
begin
  // first convert image to default non-special format
  if SrcInfo.IsSpecial then
  begin
    InitImage(TmpImage);
    NewImage(Image.Width, Image.Height, UnSpecialFormat, TmpImage);
    SpecialToUnSpecial(Image, TmpImage.Bits, SrcInfo, DstInfo);
    FreeImage(Image);
    Image := TmpImage;
  end
  else
    ConvertImage(Image, UnSpecialFormat);
  // we have now image in default non-special format and
  // if dest format is special we will convert to this special format
  if DstInfo.IsSpecial then
  begin
    Width := Image.Width;
    Height := Image.Height;
    DstInfo.CheckDimensions(DstInfo.Format, Width, Height);
    InitImage(TmpImage);
    NewImage(Width, Height, DstInfo.Format, TmpImage);
    ResizeImage(Image, Width, Height);
    UnSpecialToSpecial(TmpImage, Image.Bits, SrcInfo, DstInfo);
    FreeImage(Image);
    Image := TmpImage;
  end;
end;

function GetStdPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt;
begin
  if FInfos[Format] <> nil then
    Result := Width * Height * FInfos[Format].BytesPerPixel
  else
    Result := 0;
end;

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

function GetDXTPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt;
begin
  // DXT can be used only for images with dimensions that are
  // multiples of four
  Result := Width * Height;
  if Format = ifDXT1 then
    Result := Result div 2;
end;

procedure CheckDXTDimensions(Format: TImageFormat; var Width, Height: LongInt);
begin
  // DXT image dimensions must be multiples of four
  Width := ((Width + 3) div 4) * 4;
  Height := ((Height + 3) div 4) * 4;
end;

{
  File Notes:
  
  -- TODOS ----------------------------------------------------
    - nothing now

  -- 0.13 Changes/Bug Fixes -----------------------------------
    - replaced pixel format conversions for colors not to be
      darkened when converting from low bit counts
    - ReduceColorsMedianCut was updated to support creating one
      optimal palette for more images and it is somewhat faster
      now too
    - there was ugly bug in DXTC dimensions checking
}

end.

