You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
4464 lines
137 KiB
4464 lines
137 KiB
{
|
|
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;
|
|
const
|
|
{ Default resampling filter used for bicubic resizing.}
|
|
DefaultCubicFilter = sfCatmullRom;
|
|
var
|
|
{ Built-in filter functions.}
|
|
SamplingFilterFunctions: array[TSamplingFilter] of TFilterFunction;
|
|
{ Default radii of built-in filter functions.}
|
|
SamplingFilterRadii: array[TSamplingFilter] of 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 & 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}
|
|
{ Helper function that converts pixel in any format to 32bit ARGB pixel.
|
|
For common formats it's faster than calling GetPixel32 etc.}
|
|
procedure ConvertToPixel32(SrcPix: PByte; DestPix: PColor32Rec;
|
|
const SrcInfo: TImageFormatInfo; SrcPalette: PPalette32 = nil); {$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. Used mostly by file loaders for formats
|
|
supporting 1bit images. Scaling of pixel values to 8bits is optional
|
|
(indexed formats don't need this).}
|
|
procedure Convert1To8(DataIn, DataOut: PByte; Width, Height,
|
|
WidthBytes: LongInt; ScaleTo8Bits: Boolean);
|
|
{ Converts 2bit image data to 8bit. Used mostly by file loaders for formats
|
|
supporting 2bit images. Scaling of pixel values to 8bits is optional
|
|
(indexed formats don't need this).}
|
|
procedure Convert2To8(DataIn, DataOut: PByte; Width, Height,
|
|
WidthBytes: LongInt; ScaleTo8Bits: Boolean);
|
|
{ Converts 4bit image data to 8bit. Used mostly by file loaders for formats
|
|
supporting 4bit images. Scaling of pixel values to 8bits is optional
|
|
(indexed formats don't need this).}
|
|
procedure Convert4To8(DataIn, DataOut: PByte; Width, Height,
|
|
WidthBytes: LongInt; ScaleTo8Bits: Boolean);
|
|
|
|
{ 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/X8R8G8B8 format.}
|
|
function Has32BitImageAlpha(NumPixels: LongInt; Data: PLongWord): Boolean;
|
|
{ Checks if there is any relevant alpha data (any entry has alpha <> 255)
|
|
in the given palette.}
|
|
function PaletteHasAlpha(Palette: PPalette32; PaletteEntries: Integer): Boolean;
|
|
{ Checks if given palette has only grayscale entries.}
|
|
function PaletteIsGrayScale(Palette: PPalette32; PaletteEntries: Integer): 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}
|
|
|
|
{ Converts ARGB color to grayscale. }
|
|
function Color32ToGray(Color32: TColor32): Byte; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
|
|
{ Makes image PalEntries x 1 big where each pixel has color of one pal entry.}
|
|
procedure VisualizePalette(Pal: PPalette32; Entries: Integer; out PalImage: TImageData);
|
|
|
|
type
|
|
TPointRec = record
|
|
Pos: LongInt;
|
|
Weight: Single;
|
|
end;
|
|
TCluster = array of TPointRec;
|
|
TMappingTable = array of TCluster;
|
|
|
|
{ Helper function for resampling.}
|
|
function BuildMappingTable(DstLow, DstHigh, SrcLow, SrcHigh, SrcImageWidth: LongInt;
|
|
Filter: TFilterFunction; Radius: Single; WrapEdges: Boolean): TMappingTable;
|
|
{ Helper function for resampling.}
|
|
procedure FindExtremes(const Map: TMappingTable; var MinPos, MaxPos: LongInt);
|
|
|
|
|
|
{ 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);
|
|
|
|
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;
|
|
|
|
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;
|
|
{ Returns size in bytes of image in binary format (1bit image).}
|
|
function GetBinaryPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; forward;
|
|
|
|
function GetBCPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; forward;
|
|
procedure CheckBCDimensions(Format: TImageFormat; var Width, Height: 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;
|
|
|
|
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;
|
|
HasAlphaChannel: True;
|
|
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);
|
|
|
|
R32G32B32FInfo: TImageFormatInfo = (
|
|
Format: ifR32G32B32F;
|
|
Name: 'R32G32B32F';
|
|
BytesPerPixel: 12;
|
|
ChannelCount: 3;
|
|
IsFloatingPoint: True;
|
|
RBSwapFormat: ifB32G32R32F;
|
|
GetPixelsSize: GetStdPixelsSize;
|
|
CheckDimensions: CheckStdDimensions;
|
|
GetPixel32: GetPixel32Generic;
|
|
GetPixelFP: GetPixelFPFloat32;
|
|
SetPixel32: SetPixel32Generic;
|
|
SetPixelFP: SetPixelFPFloat32);
|
|
|
|
B32G32R32FInfo: TImageFormatInfo = (
|
|
Format: ifB32G32R32F;
|
|
Name: 'B32G32R32F';
|
|
BytesPerPixel: 12;
|
|
ChannelCount: 3;
|
|
IsFloatingPoint: True;
|
|
IsRBSwapped: True;
|
|
RBSwapFormat: ifR32G32B32F;
|
|
GetPixelsSize: GetStdPixelsSize;
|
|
CheckDimensions: CheckStdDimensions;
|
|
GetPixel32: GetPixel32Generic;
|
|
GetPixelFP: GetPixelFPFloat32;
|
|
SetPixel32: SetPixel32Generic;
|
|
SetPixelFP: SetPixelFPFloat32);
|
|
|
|
// 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);
|
|
|
|
ATI1NInfo: TImageFormatInfo = (
|
|
Format: ifATI1N;
|
|
Name: 'ATI1N';
|
|
ChannelCount: 1;
|
|
HasAlphaChannel: False;
|
|
IsSpecial: True;
|
|
GetPixelsSize: GetDXTPixelsSize;
|
|
CheckDimensions: CheckDXTDimensions;
|
|
SpecialNearestFormat: ifGray8);
|
|
|
|
ATI2NInfo: TImageFormatInfo = (
|
|
Format: ifATI2N;
|
|
Name: 'ATI2N';
|
|
ChannelCount: 2;
|
|
HasAlphaChannel: False;
|
|
IsSpecial: True;
|
|
GetPixelsSize: GetDXTPixelsSize;
|
|
CheckDimensions: CheckDXTDimensions;
|
|
SpecialNearestFormat: ifA8R8G8B8);
|
|
|
|
BinaryInfo: TImageFormatInfo = (
|
|
Format: ifBinary;
|
|
Name: 'Binary';
|
|
ChannelCount: 1;
|
|
HasAlphaChannel: False;
|
|
IsSpecial: True;
|
|
GetPixelsSize: GetBinaryPixelsSize;
|
|
CheckDimensions: CheckStdDimensions;
|
|
SpecialNearestFormat: ifGray8);
|
|
|
|
{ Passtrough formats }
|
|
|
|
{ETC1Info: TImageFormatInfo = (
|
|
Format: ifETC1;
|
|
Name: 'ETC1';
|
|
ChannelCount: 3;
|
|
HasAlphaChannel: False;
|
|
IsSpecial: True;
|
|
IsPasstrough: True;
|
|
GetPixelsSize: GetBCPixelsSize;
|
|
CheckDimensions: CheckBCDimensions;
|
|
SpecialNearestFormat: ifR8G8B8);
|
|
|
|
ETC2RGBInfo: TImageFormatInfo = (
|
|
Format: ifETC2RGB;
|
|
Name: 'ETC2RGB';
|
|
ChannelCount: 3;
|
|
HasAlphaChannel: False;
|
|
IsSpecial: True;
|
|
IsPasstrough: True;
|
|
GetPixelsSize: GetBCPixelsSize;
|
|
CheckDimensions: CheckBCDimensions;
|
|
SpecialNearestFormat: ifR8G8B8);
|
|
|
|
ETC2RGBAInfo: TImageFormatInfo = (
|
|
Format: ifETC2RGBA;
|
|
Name: 'ETC2RGBA';
|
|
ChannelCount: 4;
|
|
HasAlphaChannel: True;
|
|
IsSpecial: True;
|
|
IsPasstrough: True;
|
|
GetPixelsSize: GetBCPixelsSize;
|
|
CheckDimensions: CheckBCDimensions;
|
|
SpecialNearestFormat: ifA8R8G8B8);
|
|
|
|
ETC2PAInfo: TImageFormatInfo = (
|
|
Format: ifETC2PA;
|
|
Name: 'ETC2PA';
|
|
ChannelCount: 4;
|
|
HasAlphaChannel: True;
|
|
IsSpecial: True;
|
|
IsPasstrough: True;
|
|
GetPixelsSize: GetBCPixelsSize;
|
|
CheckDimensions: CheckBCDimensions;
|
|
SpecialNearestFormat: ifA8R8G8B8);
|
|
|
|
DXBC6Info: TImageFormatInfo = (
|
|
Format: ifDXBC6;
|
|
Name: 'DXBC6';
|
|
ChannelCount: 4;
|
|
HasAlphaChannel: True;
|
|
IsSpecial: True;
|
|
IsPasstrough: True;
|
|
GetPixelsSize: GetBCPixelsSize;
|
|
CheckDimensions: CheckBCDimensions;
|
|
SpecialNearestFormat: ifA8R8G8B8);
|
|
|
|
DXBC7Info: TImageFormatInfo = (
|
|
Format: ifDXBC6;
|
|
Name: 'DXBC7';
|
|
ChannelCount: 4;
|
|
HasAlphaChannel: True;
|
|
IsSpecial: True;
|
|
IsPasstrough: True;
|
|
GetPixelsSize: GetBCPixelsSize;
|
|
CheckDimensions: CheckBCDimensions;
|
|
SpecialNearestFormat: ifA8R8G8B8);
|
|
|
|
PVRTCInfo: TImageFormatInfo = (
|
|
Format: ifPVRTC;
|
|
Name: 'PVRTC';
|
|
ChannelCount: 4;
|
|
HasAlphaChannel: True;
|
|
IsSpecial: True;
|
|
IsPasstrough: True;
|
|
GetPixelsSize: GetBCPixelsSize;
|
|
CheckDimensions: CheckBCDimensions;
|
|
SpecialNearestFormat: ifA8R8G8B8);}
|
|
|
|
{$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;
|
|
Infos[ifR32G32B32F] := @R32G32B32FInfo;
|
|
Infos[ifB32G32R32F] := @B32G32R32FInfo;
|
|
// special formats
|
|
Infos[ifDXT1] := @DXT1Info;
|
|
Infos[ifDXT3] := @DXT3Info;
|
|
Infos[ifDXT5] := @DXT5Info;
|
|
Infos[ifBTC] := @BTCInfo;
|
|
Infos[ifATI1N] := @ATI1NInfo;
|
|
Infos[ifATI2N] := @ATI2NInfo;
|
|
Infos[ifBinary] := @BinaryInfo;
|
|
|
|
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;
|
|
|
|
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
|
|
begin
|
|
if I < Boxes then
|
|
with Box[I].Represented do
|
|
begin
|
|
DstPal[I].A := A;
|
|
DstPal[I].R := R;
|
|
DstPal[I].G := G;
|
|
DstPal[I].B := B;
|
|
end
|
|
else
|
|
DstPal[I].Color := $FF000000;
|
|
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;
|
|
end
|
|
else
|
|
if Value < 2.0 then
|
|
begin
|
|
Value := 2.0 - Value;
|
|
Result := Sqr(Value) * Value / 6.0;
|
|
end
|
|
else
|
|
Result := 0.0;
|
|
end;
|
|
|
|
{ Lanczos-windowed sinc filter.}
|
|
function FilterLanczos(Value: Single): Single;
|
|
|
|
function SinC(Value: Single): Single;
|
|
begin
|
|
if Value <> 0.0 then
|
|
begin
|
|
Value := Value * Pi;
|
|
Result := Sin(Value) / Value;
|
|
end
|
|
else
|
|
Result := 1.0;
|
|
end;
|
|
|
|
begin
|
|
if Value < 0.0 then
|
|
Value := -Value;
|
|
if Value < 3.0 then
|
|
Result := SinC(Value) * SinC(Value / 3.0)
|
|
else
|
|
Result := 0.0;
|
|
end;
|
|
|
|
{ Micthell cubic filter.}
|
|
function FilterMitchell(Value: Single): Single;
|
|
const
|
|
B = 1.0 / 3.0;
|
|
C = 1.0 / 3.0;
|
|
var
|
|
Temp: Single;
|
|
begin
|
|
if Value < 0.0 then
|
|
Value := -Value;
|
|
Temp := Sqr(Value);
|
|
if Value < 1.0 then
|
|
begin
|
|
Value := (((12.0 - 9.0 * B - 6.0 * C) * (Value * Temp)) +
|
|
((-18.0 + 12.0 * B + 6.0 * C) * Temp) +
|
|
(6.0 - 2.0 * B));
|
|
Result := Value / 6.0;
|
|
end
|
|
else
|
|
if Value < 2.0 then
|
|
begin
|
|
Value := (((-B - 6.0 * C) * (Value * Temp)) +
|
|
((6.0 * B + 30.0 * C) * Temp) +
|
|
((-12.0 * B - 48.0 * C) * Value) +
|
|
(8.0 * B + 24.0 * C));
|
|
Result := Value / 6.0;
|
|
end
|
|
else
|
|
Result := 0.0;
|
|
end;
|
|
|
|
{ CatmullRom spline filter.}
|
|
function FilterCatmullRom(Value: Single): Single;
|
|
begin
|
|
if Value < 0.0 then
|
|
Value := -Value;
|
|
if Value < 1.0 then
|
|
Result := 0.5 * (2.0 + Sqr(Value) * (-5.0 + 3.0 * Value))
|
|
else
|
|
if Value < 2.0 then
|
|
Result := 0.5 * (4.0 + Value * (-8.0 + Value * (5.0 - Value)))
|
|
else
|
|
Result := 0.0;
|
|
end;
|
|
|
|
procedure StretchResample(const SrcImage: TImageData; SrcX, SrcY, SrcWidth,
|
|
SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth,
|
|
DstHeight: LongInt; Filter: TSamplingFilter; WrapEdges: Boolean);
|
|
begin
|
|
// Calls the other function with filter function and radius defined by Filter
|
|
StretchResample(SrcImage, SrcX, SrcY, SrcWidth, SrcHeight, DstImage, DstX, DstY,
|
|
DstWidth, DstHeight, SamplingFilterFunctions[Filter], SamplingFilterRadii[Filter],
|
|
WrapEdges);
|
|
end;
|
|
|
|
var
|
|
FullEdge: Boolean = True;
|
|
|
|
{ The following resampling code is modified and extended code from Graphics32
|
|
library by Alex A. Denisov.}
|
|
function BuildMappingTable(DstLow, DstHigh, SrcLow, SrcHigh, SrcImageWidth: LongInt;
|
|
Filter: TFilterFunction; Radius: Single; WrapEdges: Boolean): TMappingTable;
|
|
var
|
|
I, J, K, N: LongInt;
|
|
Left, Right, SrcWidth, DstWidth: LongInt;
|
|
Weight, Scale, Center, Count: Single;
|
|
begin
|
|
Result := nil;
|
|
K := 0;
|
|
SrcWidth := SrcHigh - SrcLow;
|
|
DstWidth := DstHigh - DstLow;
|
|
|
|
// Check some special cases
|
|
if SrcWidth = 1 then
|
|
begin
|
|
SetLength(Result, DstWidth);
|
|
for I := 0 to DstWidth - 1 do
|
|
begin
|
|
SetLength(Result[I], 1);
|
|
Result[I][0].Pos := 0;
|
|
Result[I][0].Weight := 1.0;
|
|
end;
|
|
Exit;
|
|
end
|
|
else
|
|
if (SrcWidth = 0) or (DstWidth = 0) then
|
|
Exit;
|
|
|
|
if FullEdge then
|
|
Scale := DstWidth / SrcWidth
|
|
else
|
|
Scale := (DstWidth - 1) / (SrcWidth - 1);
|
|
|
|
SetLength(Result, DstWidth);
|
|
|
|
// Pre-calculate filter contributions for a row or column
|
|
if Scale = 0.0 then
|
|
begin
|
|
Assert(Length(Result) = 1);
|
|
SetLength(Result[0], 1);
|
|
Result[0][0].Pos := (SrcLow + SrcHigh) div 2;
|
|
Result[0][0].Weight := 1.0;
|
|
end
|
|
else if Scale < 1.0 then
|
|
begin
|
|
// Sub-sampling - scales from bigger to smaller
|
|
Radius := Radius / Scale;
|
|
for I := 0 to DstWidth - 1 do
|
|
begin
|
|
if FullEdge then
|
|
Center := SrcLow - 0.5 + (I + 0.5) / Scale
|
|
else
|
|
Center := SrcLow + I / Scale;
|
|
Left := Floor(Center - Radius);
|
|
Right := Ceil(Center + Radius);
|
|
Count := -1.0;
|
|
for J := Left to Right do
|
|
begin
|
|
Weight := Filter((Center - J) * Scale) * Scale;
|
|
if Weight <> 0.0 then
|
|
begin
|
|
Count := Count + Weight;
|
|
K := Length(Result[I]);
|
|
SetLength(Result[I], K + 1);
|
|
Result[I][K].Pos := ClampInt(J, SrcLow, SrcHigh - 1);
|
|
Result[I][K].Weight := Weight;
|
|
end;
|
|
end;
|
|
if Length(Result[I]) = 0 then
|
|
begin
|
|
SetLength(Result[I], 1);
|
|
Result[I][0].Pos := Floor(Center);
|
|
Result[I][0].Weight := 1.0;
|
|
end
|
|
else if Count <> 0.0 then
|
|
Result[I][K div 2].Weight := Result[I][K div 2].Weight - Count;
|
|
end;
|
|
end
|
|
else // if Scale > 1.0 then
|
|
begin
|
|
// Super-sampling - scales from smaller to bigger
|
|
Scale := 1.0 / Scale;
|
|
for I := 0 to DstWidth - 1 do
|
|
begin
|
|
if FullEdge then
|
|
Center := SrcLow - 0.5 + (I + 0.5) * Scale
|
|
else
|
|
Center := SrcLow + I * Scale;
|
|
Left := Floor(Center - Radius);
|
|
Right := Ceil(Center + Radius);
|
|
Count := -1.0;
|
|
for J := Left to Right do
|
|
begin
|
|
Weight := Filter(Center - J);
|
|
if Weight <> 0.0 then
|
|
begin
|
|
Count := Count + Weight;
|
|
K := Length(Result[I]);
|
|
SetLength(Result[I], K + 1);
|
|
|
|
if WrapEdges then
|
|
begin
|
|
if J < 0 then
|
|
N := SrcImageWidth + J
|
|
else if J >= SrcImageWidth then
|
|
N := J - SrcImageWidth
|
|
else
|
|
N := ClampInt(J, SrcLow, SrcHigh - 1);
|
|
end
|
|
else
|
|
N := ClampInt(J, SrcLow, SrcHigh - 1);
|
|
|
|
Result[I][K].Pos := N;
|
|
Result[I][K].Weight := Weight;
|
|
end;
|
|
end;
|
|
if Count <> 0.0 then
|
|
Result[I][K div 2].Weight := Result[I][K div 2].Weight - Count;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure FindExtremes(const Map: TMappingTable; var MinPos, MaxPos: LongInt);
|
|
var
|
|
I, J: LongInt;
|
|
begin
|
|
if Length(Map) > 0 then
|
|
begin
|
|
MinPos := Map[0][0].Pos;
|
|
MaxPos := MinPos;
|
|
for I := 0 to Length(Map) - 1 do
|
|
for J := 0 to Length(Map[I]) - 1 do
|
|
begin
|
|
if MinPos > Map[I][J].Pos then
|
|
MinPos := Map[I][J].Pos;
|
|
if MaxPos < Map[I][J].Pos then
|
|
MaxPos := Map[I][J].Pos;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure StretchResample(const SrcImage: TImageData; SrcX, SrcY, SrcWidth,
|
|
SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth,
|
|
DstHeight: LongInt; Filter: TFilterFunction; Radius: Single; WrapEdges: Boolean);
|
|
var
|
|
MapX, MapY: TMappingTable;
|
|
I, J, X, Y: LongInt;
|
|
XMinimum, XMaximum: LongInt;
|
|
LineBufferFP: array of TColorFPRec;
|
|
ClusterX, ClusterY: TCluster;
|
|
Weight, AccumA, AccumR, AccumG, AccumB: Single;
|
|
DstLine: PByte;
|
|
SrcFloat: TColorFPRec;
|
|
Info: TImageFormatInfo;
|
|
BytesPerChannel: Integer;
|
|
begin
|
|
GetImageFormatInfo(SrcImage.Format, Info);
|
|
Assert(SrcImage.Format = DstImage.Format);
|
|
Assert(not Info.IsSpecial and not Info.IsIndexed);
|
|
BytesPerChannel := Info.BytesPerPixel div Info.ChannelCount;
|
|
|
|
// Create horizontal and vertical mapping tables
|
|
MapX := BuildMappingTable(DstX, DstX + DstWidth, SrcX, SrcX + SrcWidth,
|
|
SrcImage.Width, Filter, Radius, WrapEdges);
|
|
MapY := BuildMappingTable(DstY, DstY + DstHeight, SrcY, SrcY + SrcHeight,
|
|
SrcImage.Height, Filter, Radius, WrapEdges);
|
|
|
|
if (MapX = nil) or (MapY = nil) then
|
|
Exit;
|
|
|
|
ClusterX := nil;
|
|
ClusterY := nil;
|
|
|
|
try
|
|
// Find min and max X coords of pixels that will contribute to target image
|
|
FindExtremes(MapX, XMinimum, XMaximum);
|
|
|
|
SetLength(LineBufferFP, XMaximum - XMinimum + 1);
|
|
// Following code works for the rest of data formats
|
|
for J := 0 to DstHeight - 1 do
|
|
begin
|
|
// First for each pixel in the current line sample vertically
|
|
// and store results in LineBuffer. Then sample horizontally
|
|
// using values in LineBuffer.
|
|
ClusterY := MapY[J];
|
|
for X := XMinimum to XMaximum do
|
|
begin
|
|
// Clear accumulators
|
|
AccumA := 0;
|
|
AccumR := 0;
|
|
AccumG := 0;
|
|
AccumB := 0;
|
|
// For each pixel in line compute weighted sum of pixels
|
|
// in source column that will contribute to this pixel
|
|
for Y := 0 to Length(ClusterY) - 1 do
|
|
begin
|
|
// Accumulate this pixel's weighted value
|
|
Weight := ClusterY[Y].Weight;
|
|
SrcFloat := Info.GetPixelFP(@PByteArray(SrcImage.Bits)[(ClusterY[Y].Pos * SrcImage.Width + X) * Info.BytesPerPixel], @Info, nil);
|
|
AccumB := AccumB + SrcFloat.B * Weight;
|
|
AccumG := AccumG + SrcFloat.G * Weight;
|
|
AccumR := AccumR + SrcFloat.R * Weight;
|
|
AccumA := AccumA + SrcFloat.A * Weight;
|
|
end;
|
|
// Store accumulated value for this pixel in buffer
|
|
with LineBufferFP[X - XMinimum] do
|
|
begin
|
|
A := AccumA;
|
|
R := AccumR;
|
|
G := AccumG;
|
|
B := AccumB;
|
|
end;
|
|
end;
|
|
|
|
DstLine := @PByteArray(DstImage.Bits)[((J + DstY) * DstImage.Width + DstX) * Info.BytesPerPixel];
|
|
// Now compute final colors for targte pixels in the current row
|
|
// by sampling horizontally
|
|
for I := 0 to DstWidth - 1 do
|
|
begin
|
|
ClusterX := MapX[I];
|
|
// Clear accumulator
|
|
AccumA := 0;
|
|
AccumR := 0;
|
|
AccumG := 0;
|
|
AccumB := 0;
|
|
// Compute weighted sum of values (which are already
|
|
// computed weighted sums of pixels in source columns stored in LineBuffer)
|
|
// that will contribute to the current target pixel
|
|
for X := 0 to Length(ClusterX) - 1 do
|
|
begin
|
|
Weight := ClusterX[X].Weight;
|
|
with LineBufferFP[ClusterX[X].Pos - XMinimum] do
|
|
begin
|
|
AccumB := AccumB + B * Weight;
|
|
AccumG := AccumG + G * Weight;
|
|
AccumR := AccumR + R * Weight;
|
|
AccumA := AccumA + A * Weight;
|
|
end;
|
|
end;
|
|
|
|
// Now compute final color to be written to dest image
|
|
SrcFloat.A := AccumA;
|
|
SrcFloat.R := AccumR;
|
|
SrcFloat.G := AccumG;
|
|
SrcFloat.B := AccumB;
|
|
|
|
Info.SetPixelFP(DstLine, @Info, nil, SrcFloat);
|
|
Inc(DstLine, Info.BytesPerPixel);
|
|
end;
|
|
end;
|
|
|
|
finally
|
|
MapX := nil;
|
|
MapY := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure FillMipMapLevel(const BiggerLevel: TImageData; Width, Height: LongInt;
|
|
var SmallerLevel: TImageData);
|
|
var
|
|
Filter: TSamplingFilter;
|
|
Info: TImageFormatInfo;
|
|
CompatibleCopy: TImageData;
|
|
begin
|
|
Assert(TestImage(BiggerLevel));
|
|
Filter := TSamplingFilter(GetOption(ImagingMipMapFilter));
|
|
|
|
// If we have special format image we must create copy to allow pixel access
|
|
GetImageFormatInfo(BiggerLevel.Format, Info);
|
|
if Info.IsSpecial then
|
|
begin
|
|
InitImage(CompatibleCopy);
|
|
CloneImage(BiggerLevel, CompatibleCopy);
|
|
ConvertImage(CompatibleCopy, ifDefault);
|
|
end
|
|
else
|
|
CompatibleCopy := BiggerLevel;
|
|
|
|
// Create new smaller image
|
|
NewImage(Width, Height, CompatibleCopy.Format, SmallerLevel);
|
|
GetImageFormatInfo(CompatibleCopy.Format, Info);
|
|
// If input is indexed we must copy its palette
|
|
if Info.IsIndexed then
|
|
CopyPalette(CompatibleCopy.Palette, SmallerLevel.Palette, 0, 0, Info.PaletteEntries);
|
|
|
|
if (Filter = sfNearest) or Info.IsIndexed then
|
|
begin
|
|
StretchNearest(CompatibleCopy, 0, 0, CompatibleCopy.Width, CompatibleCopy.Height,
|
|
SmallerLevel, 0, 0, Width, Height);
|
|
end
|
|
else
|
|
begin
|
|
StretchResample(CompatibleCopy, 0, 0, CompatibleCopy.Width, CompatibleCopy.Height,
|
|
SmallerLevel, 0, 0, Width, Height, Filter);
|
|
end;
|
|
|
|
// Free copy and convert result to special format if necessary
|
|
if CompatibleCopy.Format <> BiggerLevel.Format then
|
|
begin
|
|
ConvertImage(SmallerLevel, BiggerLevel.Format);
|
|
FreeImage(CompatibleCopy);
|
|
end;
|
|
end;
|
|
|
|
|
|
{ Various format support functions }
|
|
|
|
procedure CopyPixel(Src, Dest: Pointer; BytesPerPixel: LongInt);
|
|
begin
|
|
case BytesPerPixel of
|
|
1: PByte(Dest)^ := PByte(Src)^;
|
|
2: PWord(Dest)^ := PWord(Src)^;
|
|
3: PColor24Rec(Dest)^ := PColor24Rec(Src)^;
|
|
4: PLongWord(Dest)^ := PLongWord(Src)^;
|
|
6: PColor48Rec(Dest)^ := PColor48Rec(Src)^;
|
|
8: PInt64(Dest)^ := PInt64(Src)^;
|
|
12: PColor96FPRec(Dest)^ := PColor96FPRec(Src)^;
|
|
16: PColorFPRec(Dest)^ := PColorFPRec(Src)^;
|
|
end;
|
|
end;
|
|
|
|
function ComparePixels(PixelA, PixelB: Pointer; BytesPerPixel: LongInt): Boolean;
|
|
begin
|
|
case BytesPerPixel of
|
|
1: Result := PByte(PixelA)^ = PByte(PixelB)^;
|
|
2: Result := PWord(PixelA)^ = PWord(PixelB)^;
|
|
3: Result := (PWord(PixelA)^ = PWord(PixelB)^) and (PColor24Rec(PixelA).R = PColor24Rec(PixelB).R);
|
|
4: Result := PLongWord(PixelA)^ = PLongWord(PixelB)^;
|
|
6: Result := (PLongWord(PixelA)^ = PLongWord(PixelB)^) and (PColor48Rec(PixelA).R = PColor48Rec(PixelB).R);
|
|
8: Result := PInt64(PixelA)^ = PInt64(PixelB)^;
|
|
12: Result := (PFloatHelper(PixelA).Data = PFloatHelper(PixelB).Data) and
|
|
(PFloatHelper(PixelA).Data32 = PFloatHelper(PixelB).Data32);
|
|
16: Result := (PFloatHelper(PixelA).Data = PFloatHelper(PixelB).Data) and
|
|
(PFloatHelper(PixelA).Data64 = PFloatHelper(PixelB).Data64);
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TranslatePixel(SrcPixel, DstPixel: Pointer; SrcFormat,
|
|
DstFormat: TImageFormat; SrcPalette, DstPalette: PPalette32);
|
|
var
|
|
SrcInfo, DstInfo: PImageFormatInfo;
|
|
PixFP: TColorFPRec;
|
|
begin
|
|
SrcInfo := FInfos[SrcFormat];
|
|
DstInfo := FInfos[DstFormat];
|
|
|
|
PixFP := GetPixelFPGeneric(SrcPixel, SrcInfo, SrcPalette);
|
|
SetPixelFPGeneric(DstPixel, DstInfo, DstPalette, PixFP);
|
|
end;
|
|
|
|
procedure ClampFloatPixel(var PixF: TColorFPRec);
|
|
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;
|
|
|
|
procedure ConvertToPixel32(SrcPix: PByte; DestPix: PColor32Rec;
|
|
const SrcInfo: TImageFormatInfo; SrcPalette: PPalette32);
|
|
begin
|
|
case SrcInfo.Format of
|
|
ifIndex8:
|
|
begin
|
|
DestPix^ := SrcPalette[SrcPix^];
|
|
end;
|
|
ifGray8:
|
|
begin
|
|
DestPix.R := SrcPix^;
|
|
DestPix.G := SrcPix^;
|
|
DestPix.B := SrcPix^;
|
|
DestPix.A := 255;
|
|
end;
|
|
ifA8Gray8:
|
|
begin
|
|
DestPix.R := SrcPix^;
|
|
DestPix.G := SrcPix^;
|
|
DestPix.B := SrcPix^;
|
|
DestPix.A := PWordRec(SrcPix).High;
|
|
end;
|
|
ifGray16:
|
|
begin
|
|
DestPix.R := PWord(SrcPix)^ shr 8;
|
|
DestPix.G := DestPix.R;
|
|
DestPix.B := DestPix.R;
|
|
DestPix.A := 255;
|
|
end;
|
|
ifR8G8B8:
|
|
begin
|
|
DestPix.Color24Rec := PColor24Rec(SrcPix)^;
|
|
DestPix.A := 255;
|
|
end;
|
|
ifA8R8G8B8:
|
|
begin
|
|
DestPix^ := PColor32Rec(SrcPix)^;
|
|
end;
|
|
ifR16G16B16:
|
|
begin
|
|
DestPix.R := PColor48Rec(SrcPix).R shr 8;
|
|
DestPix.G := PColor48Rec(SrcPix).G shr 8;
|
|
DestPix.B := PColor48Rec(SrcPix).B shr 8;
|
|
DestPix.A := 255;
|
|
end;
|
|
ifA16R16G16B16:
|
|
begin
|
|
DestPix.R := PColor64Rec(SrcPix).R shr 8;
|
|
DestPix.G := PColor64Rec(SrcPix).G shr 8;
|
|
DestPix.B := PColor64Rec(SrcPix).B shr 8;
|
|
DestPix.A := PColor64Rec(SrcPix).A shr 8;
|
|
end;
|
|
else
|
|
DestPix^ := SrcInfo.GetPixel32(SrcPix, @SrcInfo, SrcPalette);
|
|
end;
|
|
end;
|
|
|
|
procedure AddPadBytes(DataIn: Pointer; 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; 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 Convert1To8(DataIn, DataOut: PByte; Width, Height,
|
|
WidthBytes: LongInt; ScaleTo8Bits: Boolean);
|
|
const
|
|
Mask1: array[0..7] of Byte = ($80, $40, $20, $10, $08, $04, $02, $01);
|
|
Shift1: array[0..7] of Byte = (7, 6, 5, 4, 3, 2, 1, 0);
|
|
Scaling: Byte = 255;
|
|
var
|
|
X, Y: LongInt;
|
|
InArray: PByteArray absolute DataIn;
|
|
begin
|
|
for Y := 0 to Height - 1 do
|
|
for X := 0 to Width - 1 do
|
|
begin
|
|
DataOut^ := (InArray[Y * WidthBytes + X shr 3] and Mask1[X and 7]) shr Shift1[X and 7];
|
|
if ScaleTo8Bits then
|
|
DataOut^ := DataOut^ * Scaling;
|
|
Inc(DataOut);
|
|
end;
|
|
end;
|
|
|
|
procedure Convert2To8(DataIn, DataOut: PByte; Width, Height,
|
|
WidthBytes: LongInt; ScaleTo8Bits: Boolean);
|
|
const
|
|
Mask2: array[0..3] of Byte = ($C0, $30, $0C, $03);
|
|
Shift2: array[0..3] of Byte = (6, 4, 2, 0);
|
|
Scaling: Byte = 85;
|
|
var
|
|
X, Y: LongInt;
|
|
InArray: PByteArray absolute DataIn;
|
|
begin
|
|
for Y := 0 to Height - 1 do
|
|
for X := 0 to Width - 1 do
|
|
begin
|
|
DataOut^ := (InArray[Y * WidthBytes + X shr 2] and Mask2[X and 3]) shr Shift2[X and 3];
|
|
if ScaleTo8Bits then
|
|
DataOut^ := DataOut^ * Scaling;
|
|
Inc(DataOut);
|
|
end;
|
|
end;
|
|
|
|
procedure Convert4To8(DataIn, DataOut: PByte; Width, Height,
|
|
WidthBytes: LongInt; ScaleTo8Bits: Boolean);
|
|
const
|
|
Mask4: array[0..1] of Byte = ($F0, $0F);
|
|
Shift4: array[0..1] of Byte = (4, 0);
|
|
Scaling: Byte = 17;
|
|
var
|
|
X, Y: LongInt;
|
|
InArray: PByteArray absolute DataIn;
|
|
begin
|
|
for Y := 0 to Height - 1 do
|
|
for X := 0 to Width - 1 do
|
|
begin
|
|
DataOut^ := (InArray[Y * WidthBytes + X shr 1] and Mask4[X and 1]) shr Shift4[X and 1];
|
|
if ScaleTo8Bits then
|
|
DataOut^ := DataOut^ * Scaling;
|
|
Inc(DataOut);
|
|
end;
|
|
end;
|
|
|
|
function Has16BitImageAlpha(NumPixels: LongInt; Data: PWord): Boolean;
|
|
var
|
|
I: LongInt;
|
|
begin
|
|
Result := False;
|
|
for I := 0 to NumPixels - 1 do
|
|
begin
|
|
if Data^ >= 1 shl 15 then
|
|
begin
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
Inc(Data);
|
|
end;
|
|
end;
|
|
|
|
function Has32BitImageAlpha(NumPixels: LongInt; Data: PLongWord): Boolean;
|
|
var
|
|
I: LongInt;
|
|
begin
|
|
Result := False;
|
|
for I := 0 to NumPixels - 1 do
|
|
begin
|
|
if Data^ >= 1 shl 24 then
|
|
begin
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
Inc(Data);
|
|
end;
|
|
end;
|
|
|
|
function PaletteHasAlpha(Palette: PPalette32; PaletteEntries: Integer): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to PaletteEntries - 1 do
|
|
begin
|
|
if Palette[I].A <> 255 then
|
|
begin
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := False;
|
|
end;
|
|
|
|
function PaletteIsGrayScale(Palette: PPalette32; PaletteEntries: Integer): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to PaletteEntries - 1 do
|
|
begin
|
|
if (Palette[I].R <> Palette[I].G) or (Palette[I].R <> Palette[I].B) then
|
|
begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
function GetScanLine(ImageBits: Pointer; const FormatInfo: TImageFormatInfo;
|
|
LineWidth, Index: LongInt): Pointer;
|
|
var
|
|
LineBytes: LongInt;
|
|
begin
|
|
Assert(not FormatInfo.IsSpecial);
|
|
LineBytes := FormatInfo.GetPixelsSize(FormatInfo.Format, LineWidth, 1);
|
|
Result := @PByteArray(ImageBits)[Index * LineBytes];
|
|
end;
|
|
|
|
function IsImageFormatValid(Format: TImageFormat): Boolean;
|
|
begin
|
|
Result := FInfos[Format] <> nil;
|
|
end;
|
|
|
|
const
|
|
HalfMin: Single = 5.96046448e-08; // Smallest positive half
|
|
HalfMinNorm: Single = 6.10351562e-05; // Smallest positive normalized half
|
|
HalfMax: Single = 65504.0; // Largest positive half
|
|
HalfEpsilon: Single = 0.00097656; // Smallest positive e for which half (1.0 + e) != half (1.0)
|
|
HalfNaN: THalfFloat = 65535;
|
|
HalfPosInf: THalfFloat = 31744;
|
|
HalfNegInf: THalfFloat = 64512;
|
|
|
|
|
|
{
|
|
Half/Float conversions inspired by half class from OpenEXR library.
|
|
|
|
Float (Pascal Single type) is an IEEE 754 single-precision
|
|
floating point number.
|
|
|
|
Bit layout of Single:
|
|
|
|
31 (msb)
|
|
|
|
|
| 30 23
|
|
| | |
|
|
| | | 22 0 (lsb)
|
|
| | | | |
|
|
X XXXXXXXX XXXXXXXXXXXXXXXXXXXXXXX
|
|
s e m
|
|
|
|
Bit layout of half:
|
|
|
|
15 (msb)
|
|
|
|
|
| 14 10
|
|
| | |
|
|
| | | 9 0 (lsb)
|
|
| | | | |
|
|
X XXXXX XXXXXXXXXX
|
|
s e m
|
|
|
|
S is the sign-bit, e is the exponent and m is the significand (mantissa).
|
|
}
|
|
|
|
function HalfToFloat(Half: THalfFloat): Single;
|
|
var
|
|
Dst, Sign, Mantissa: LongWord;
|
|
Exp: LongInt;
|
|
begin
|
|
// Extract sign, exponent, and mantissa from half number
|
|
Sign := Half shr 15;
|
|
Exp := (Half and $7C00) shr 10;
|
|
Mantissa := Half and 1023;
|
|
|
|
if (Exp > 0) and (Exp < 31) then
|
|
begin
|
|
// Common normalized number
|
|
Exp := Exp + (127 - 15);
|
|
Mantissa := Mantissa shl 13;
|
|
Dst := (Sign shl 31) or (LongWord(Exp) shl 23) or Mantissa;
|
|
// Result := Power(-1, Sign) * Power(2, Exp - 15) * (1 + Mantissa / 1024);
|
|
end
|
|
else if (Exp = 0) and (Mantissa = 0) then
|
|
begin
|
|
// Zero - preserve sign
|
|
Dst := Sign shl 31;
|
|
end
|
|
else if (Exp = 0) and (Mantissa <> 0) then
|
|
begin
|
|
// Denormalized number - renormalize it
|
|
while (Mantissa and $00000400) = 0 do
|
|
begin
|
|
Mantissa := Mantissa shl 1;
|
|
Dec(Exp);
|
|
end;
|
|
Inc(Exp);
|
|
Mantissa := Mantissa and not $00000400;
|
|
// Now assemble normalized number
|
|
Exp := Exp + (127 - 15);
|
|
Mantissa := Mantissa shl 13;
|
|
Dst := (Sign shl 31) or (LongWord(Exp) shl 23) or Mantissa;
|
|
// Result := Power(-1, Sign) * Power(2, -14) * (Mantissa / 1024);
|
|
end
|
|
else if (Exp = 31) and (Mantissa = 0) then
|
|
begin
|
|
// +/- infinity
|
|
Dst := (Sign shl 31) or $7F800000;
|
|
end
|
|
else //if (Exp = 31) and (Mantisa <> 0) then
|
|
begin
|
|
// Not a number - preserve sign and mantissa
|
|
Dst := (Sign shl 31) or $7F800000 or (Mantissa shl 13);
|
|
end;
|
|
|
|
// Reinterpret LongWord as Single
|
|
Result := PSingle(@Dst)^;
|
|
end;
|
|
|
|
function FloatToHalf(Float: Single): THalfFloat;
|
|
var
|
|
Src: LongWord;
|
|
Sign, Exp, Mantissa: LongInt;
|
|
begin
|
|
Src := PLongWord(@Float)^;
|
|
// Extract sign, exponent, and mantissa from Single number
|
|
Sign := Src shr 31;
|
|
Exp := LongInt((Src and $7F800000) shr 23) - 127 + 15;
|
|
Mantissa := Src and $007FFFFF;
|
|
|
|
if (Exp > 0) and (Exp < 30) then
|
|
begin
|
|
// Simple case - round the significand and combine it with the sign and exponent
|
|
Result := (Sign shl 15) or (Exp shl 10) or ((Mantissa + $00001000) shr 13);
|
|
end
|
|
else if Src = 0 then
|
|
begin
|
|
// Input float is zero - return zero
|
|
Result := 0;
|
|
end
|
|
else
|
|
begin
|
|
// Difficult case - lengthy conversion
|
|
if Exp <= 0 then
|
|
begin
|
|
if Exp < -10 then
|
|
begin
|
|
// Input float's value is less than HalfMin, return zero
|
|
Result := 0;
|
|
end
|
|
else
|
|
begin
|
|
// Float is a normalized Single whose magnitude is less than HalfNormMin.
|
|
// We convert it to denormalized half.
|
|
Mantissa := (Mantissa or $00800000) shr (1 - Exp);
|
|
// Round to nearest
|
|
if (Mantissa and $00001000) > 0 then
|
|
Mantissa := Mantissa + $00002000;
|
|
// Assemble Sign and Mantissa (Exp is zero to get denormalized number)
|
|
Result := (Sign shl 15) or (Mantissa shr 13);
|
|
end;
|
|
end
|
|
else if Exp = 255 - 127 + 15 then
|
|
begin
|
|
if Mantissa = 0 then
|
|
begin
|
|
// Input float is infinity, create infinity half with original sign
|
|
Result := (Sign shl 15) or $7C00;
|
|
end
|
|
else
|
|
begin
|
|
// Input float is NaN, create half NaN with original sign and mantissa
|
|
Result := (Sign shl 15) or $7C00 or (Mantissa shr 13);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// Exp is > 0 so input float is normalized Single
|
|
|
|
// Round to nearest
|
|
if (Mantissa and $00001000) > 0 then
|
|
begin
|
|
Mantissa := Mantissa + $00002000;
|
|
if (Mantissa and $00800000) > 0 then
|
|
begin
|
|
Mantissa := 0;
|
|
Exp := Exp + 1;
|
|
end;
|
|
end;
|
|
|
|
if Exp > 30 then
|
|
begin
|
|
// Exponent overflow - return infinity half
|
|
Result := (Sign shl 15) or $7C00;
|
|
end
|
|
else
|
|
// Assemble normalized half
|
|
Result := (Sign shl 15) or (Exp shl 10) or (Mantissa shr 13);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ColorHalfToFloat(ColorHF: TColorHFRec): TColorFPRec;
|
|
begin
|
|
Result.A := HalfToFloat(ColorHF.A);
|
|
Result.R := HalfToFloat(ColorHF.R);
|
|
Result.G := HalfToFloat(ColorHF.G);
|
|
Result.B := HalfToFloat(ColorHF.B);
|
|
end;
|
|
|
|
function ColorFloatToHalf(ColorFP: TColorFPRec): TColorHFRec;
|
|
begin
|
|
Result.A := FloatToHalf(ColorFP.A);
|
|
Result.R := FloatToHalf(ColorFP.R);
|
|
Result.G := FloatToHalf(ColorFP.G);
|
|
Result.B := FloatToHalf(ColorFP.B);
|
|
end;
|
|
|
|
function Color32ToGray(Color32: TColor32): Byte;
|
|
begin
|
|
Result := Round(GrayConv.R * TColor32Rec(Color32).R +
|
|
GrayConv.G * TColor32Rec(Color32).G +
|
|
GrayConv.B * TColor32Rec(Color32).B);
|
|
end;
|
|
|
|
procedure VisualizePalette(Pal: PPalette32; Entries: Integer; out PalImage: TImageData);
|
|
var
|
|
I: Integer;
|
|
Pix: PColor32;
|
|
begin
|
|
InitImage(PalImage);
|
|
NewImage(Entries, 1, ifA8R8G8B8, PalImage);
|
|
Pix := PalImage.Bits;
|
|
for I := 0 to Entries - 1 do
|
|
begin
|
|
Pix^ := Pal[I].Color;
|
|
Inc(Pix);
|
|
end;
|
|
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 := MulDiv(PColor24Rec(Src).R, 65535, 255);
|
|
G := MulDiv(PColor24Rec(Src).G, 65535, 255);
|
|
B := MulDiv(PColor24Rec(Src).B, 65535, 255);
|
|
end;
|
|
4:
|
|
with Pix do
|
|
begin
|
|
A := MulDiv(PColor32Rec(Src).A, 65535, 255);
|
|
R := MulDiv(PColor32Rec(Src).R, 65535, 255);
|
|
G := MulDiv(PColor32Rec(Src).G, 65535, 255);
|
|
B := MulDiv(PColor32Rec(Src).B, 65535, 255);
|
|
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
|
|
SwapValues(Pix.R, Pix.B);
|
|
end;
|
|
|
|
procedure ChannelSetDstPixel(Dst: PByte; DstInfo: PImageFormatInfo;
|
|
const Pix: TColor64Rec);
|
|
var
|
|
PixW: TColor64Rec;
|
|
begin
|
|
PixW := Pix;
|
|
if DstInfo.IsRBSwapped then
|
|
SwapValues(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 := MulDiv(PixW.R, 255, 65535);
|
|
G := MulDiv(PixW.G, 255, 65535);
|
|
B := MulDiv(PixW.B, 255, 65535);
|
|
end;
|
|
4:
|
|
with PColor32Rec(Dst)^ do
|
|
begin
|
|
A := MulDiv(PixW.A, 255, 65535);
|
|
R := MulDiv(PixW.R, 255, 65535);
|
|
G := MulDiv(PixW.G, 255, 65535);
|
|
B := MulDiv(PixW.B, 255, 65535);
|
|
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 := MulDiv(Src^, 65535, 255);
|
|
2:
|
|
if SrcInfo.HasAlphaChannel then
|
|
with PWordRec(Src)^ do
|
|
begin
|
|
Alpha := MulDiv(High, 65535, 255);
|
|
Gray.A := MulDiv(Low, 65535, 255);
|
|
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^ := MulDiv(Gray.A, 255, 65535);
|
|
2:
|
|
if DstInfo.HasAlphaChannel then
|
|
with PWordRec(Dst)^ do
|
|
begin
|
|
High := MulDiv(Alpha, 255, 65535);
|
|
Low := MulDiv(Gray.A, 255, 65535);
|
|
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: TColorFPRec);
|
|
var
|
|
PixHF: TColorHFRec;
|
|
begin
|
|
Assert(SrcInfo.BytesPerPixel in [2, 4, 8, 12, 16]);
|
|
|
|
if SrcInfo.BytesPerPixel in [4, 12, 16] then
|
|
begin
|
|
// IEEE 754 single-precision channels
|
|
FillChar(Pix, SizeOf(Pix), 0);
|
|
case SrcInfo.BytesPerPixel of
|
|
4: Pix.R := PSingle(Src)^;
|
|
12: Pix.Color96Rec := PColor96FPRec(Src)^;
|
|
16: Pix := PColorFPRec(Src)^;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// Half float channels
|
|
FillChar(PixHF, SizeOf(PixHF), 0);
|
|
case SrcInfo.BytesPerPixel of
|
|
2: PixHF.R := PHalfFloat(Src)^;
|
|
8: PixHF := PColorHFRec(Src)^;
|
|
end;
|
|
Pix := ColorHalfToFloat(PixHF);
|
|
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
|
|
SwapValues(Pix.R, Pix.B);
|
|
end;
|
|
|
|
procedure FloatSetDstPixel(Dst: PByte; DstInfo: PImageFormatInfo;
|
|
const Pix: TColorFPRec);
|
|
var
|
|
PixW: TColorFPRec;
|
|
PixHF: TColorHFRec;
|
|
begin
|
|
Assert(DstInfo.BytesPerPixel in [2, 4, 8, 12, 16]);
|
|
|
|
PixW := Pix;
|
|
if DstInfo.IsRBSwapped then
|
|
SwapValues(PixW.R, PixW.B);
|
|
|
|
if DstInfo.BytesPerPixel in [4, 12, 16] then
|
|
begin
|
|
case DstInfo.BytesPerPixel of
|
|
4: PSingle(Dst)^ := PixW.R;
|
|
12: PColor96FPRec(Dst)^:= PixW.Color96Rec;
|
|
16: PColorFPRec(Dst)^ := PixW;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
PixHF := ColorFloatToHalf(PixW);
|
|
case DstInfo.BytesPerPixel of
|
|
2: PHalfFloat(Dst)^ := PixHF.R;
|
|
8: PColorHFRec(Dst)^ := PixHF;
|
|
end;
|
|
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;
|
|
|
|
|
|
{ Pixel readers/writers for 32bit and FP colors}
|
|
|
|
function GetPixel32Generic(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColor32Rec;
|
|
var
|
|
Pix64: TColor64Rec;
|
|
PixF: TColorFPRec;
|
|
Alpha: Word;
|
|
Index: LongWord;
|
|
begin
|
|
if Info.Format = ifA8R8G8B8 then
|
|
begin
|
|
Result := PColor32Rec(Bits)^
|
|
end
|
|
else if Info.Format = ifR8G8B8 then
|
|
begin
|
|
PColor24Rec(@Result)^ := PColor24Rec(Bits)^;
|
|
Result.A := $FF;
|
|
end
|
|
else if Info.IsFloatingPoint then
|
|
begin
|
|
FloatGetSrcPixel(Bits, Info, PixF);
|
|
Result.A := ClampToByte(Round(PixF.A * 255.0));
|
|
Result.R := ClampToByte(Round(PixF.R * 255.0));
|
|
Result.G := ClampToByte(Round(PixF.G * 255.0));
|
|
Result.B := ClampToByte(Round(PixF.B * 255.0));
|
|
end
|
|
else if Info.HasGrayChannel then
|
|
begin
|
|
GrayGetSrcPixel(Bits, Info, Pix64, Alpha);
|
|
Result.A := MulDiv(Alpha, 255, 65535);
|
|
Result.R := MulDiv(Pix64.A, 255, 65535);
|
|
Result.G := MulDiv(Pix64.A, 255, 65535);
|
|
Result.B := MulDiv(Pix64.A, 255, 65535);
|
|
end
|
|
else if Info.IsIndexed then
|
|
begin
|
|
IndexGetSrcPixel(Bits, Info, Index);
|
|
Result := Palette[Index];
|
|
end
|
|
else
|
|
begin
|
|
ChannelGetSrcPixel(Bits, Info, Pix64);
|
|
Result.A := MulDiv(Pix64.A, 255, 65535);
|
|
Result.R := MulDiv(Pix64.R, 255, 65535);
|
|
Result.G := MulDiv(Pix64.G, 255, 65535);
|
|
Result.B := MulDiv(Pix64.B, 255, 65535);
|
|
end;
|
|
end;
|
|
|
|
procedure SetPixel32Generic(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColor32Rec);
|
|
var
|
|
Pix64: TColor64Rec;
|
|
PixF: TColorFPRec;
|
|
Alpha: Word;
|
|
Index: LongWord;
|
|
begin
|
|
if Info.Format = ifA8R8G8B8 then
|
|
begin
|
|
PColor32Rec(Bits)^ := Color
|
|
end
|
|
else if Info.Format = ifR8G8B8 then
|
|
begin
|
|
PColor24Rec(Bits)^ := Color.Color24Rec;
|
|
end
|
|
else if Info.IsFloatingPoint then
|
|
begin
|
|
PixF.A := Color.A * OneDiv8Bit;
|
|
PixF.R := Color.R * OneDiv8Bit;
|
|
PixF.G := Color.G * OneDiv8Bit;
|
|
PixF.B := Color.B * OneDiv8Bit;
|
|
FloatSetDstPixel(Bits, Info, PixF);
|
|
end
|
|
else if Info.HasGrayChannel then
|
|
begin
|
|
Alpha := MulDiv(Color.A, 65535, 255);
|
|
Pix64.Color := 0;
|
|
Pix64.A := MulDiv(Round(GrayConv.R * Color.R + GrayConv.G * Color.G +
|
|
GrayConv.B * Color.B), 65535, 255);
|
|
GraySetDstPixel(Bits, Info, Pix64, Alpha);
|
|
end
|
|
else if Info.IsIndexed then
|
|
begin
|
|
Index := FindColor(Palette, Info.PaletteEntries, Color.Color);
|
|
IndexSetDstPixel(Bits, Info, Index);
|
|
end
|
|
else
|
|
begin
|
|
Pix64.A := MulDiv(Color.A, 65535, 255);
|
|
Pix64.R := MulDiv(Color.R, 65535, 255);
|
|
Pix64.G := MulDiv(Color.G, 65535, 255);
|
|
Pix64.B := MulDiv(Color.B, 65535, 255);
|
|
ChannelSetDstPixel(Bits, Info, Pix64);
|
|
end;
|
|
end;
|
|
|
|
function GetPixelFPGeneric(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColorFPRec;
|
|
var
|
|
Pix32: TColor32Rec;
|
|
Pix64: TColor64Rec;
|
|
Alpha: Word;
|
|
Index: LongWord;
|
|
begin
|
|
if Info.IsFloatingPoint then
|
|
begin
|
|
FloatGetSrcPixel(Bits, Info, Result);
|
|
end
|
|
else if Info.HasGrayChannel then
|
|
begin
|
|
GrayGetSrcPixel(Bits, Info, Pix64, Alpha);
|
|
Result.A := Alpha * OneDiv16Bit;
|
|
Result.R := Pix64.A * OneDiv16Bit;
|
|
Result.G := Pix64.A * OneDiv16Bit;
|
|
Result.B := Pix64.A * OneDiv16Bit;
|
|
end
|
|
else if Info.IsIndexed then
|
|
begin
|
|
IndexGetSrcPixel(Bits, Info, Index);
|
|
Pix32 := Palette[Index];
|
|
Result.A := Pix32.A * OneDiv8Bit;
|
|
Result.R := Pix32.R * OneDiv8Bit;
|
|
Result.G := Pix32.G * OneDiv8Bit;
|
|
Result.B := Pix32.B * OneDiv8Bit;
|
|
end
|
|
else
|
|
begin
|
|
ChannelGetSrcPixel(Bits, Info, Pix64);
|
|
Result.A := Pix64.A * OneDiv16Bit;
|
|
Result.R := Pix64.R * OneDiv16Bit;
|
|
Result.G := Pix64.G * OneDiv16Bit;
|
|
Result.B := Pix64.B * OneDiv16Bit;
|
|
end;
|
|
end;
|
|
|
|
procedure SetPixelFPGeneric(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColorFPRec);
|
|
var
|
|
Pix32: TColor32Rec;
|
|
Pix64: TColor64Rec;
|
|
Alpha: Word;
|
|
Index: LongWord;
|
|
begin
|
|
if Info.IsFloatingPoint then
|
|
begin
|
|
FloatSetDstPixel(Bits, Info, Color);
|
|
end
|
|
else if Info.HasGrayChannel then
|
|
begin
|
|
Alpha := ClampToWord(Round(Color.A * 65535.0));
|
|
Pix64.Color := 0;
|
|
Pix64.A := ClampToWord(Round((GrayConv.R * Color.R + GrayConv.G * Color.G +
|
|
GrayConv.B * Color.B) * 65535.0));
|
|
GraySetDstPixel(Bits, Info, Pix64, Alpha);
|
|
end
|
|
else if Info.IsIndexed then
|
|
begin
|
|
Pix32.A := ClampToByte(Round(Color.A * 255.0));
|
|
Pix32.R := ClampToByte(Round(Color.R * 255.0));
|
|
Pix32.G := ClampToByte(Round(Color.G * 255.0));
|
|
Pix32.B := ClampToByte(Round(Color.B * 255.0));
|
|
Index := FindColor(Palette, Info.PaletteEntries, Pix32.Color);
|
|
IndexSetDstPixel(Bits, Info, Index);
|
|
end
|
|
else
|
|
begin
|
|
Pix64.A := ClampToWord(Round(Color.A * 65535.0));
|
|
Pix64.R := ClampToWord(Round(Color.R * 65535.0));
|
|
Pix64.G := ClampToWord(Round(Color.G * 65535.0));
|
|
Pix64.B := ClampToWord(Round(Color.B * 65535.0));
|
|
ChannelSetDstPixel(Bits, Info, Pix64);
|
|
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)^;
|
|
if DstInfo.HasAlphaChannel then
|
|
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
|
|
Dst^ := Round(GrayConv.R * PColor24Rec(Src).R + GrayConv.G * PColor24Rec(Src).G +
|
|
GrayConv.B * 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);
|
|
var
|
|
I: LongInt;
|
|
Pix64: TColor64Rec;
|
|
PixF: TColorFPRec;
|
|
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 * OneDiv16Bit;
|
|
PixF.R := Pix64.R * OneDiv16Bit;
|
|
PixF.G := Pix64.G * OneDiv16Bit;
|
|
PixF.B := Pix64.B * OneDiv16Bit;
|
|
|
|
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
|
|
begin
|
|
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;
|
|
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 := $FF;
|
|
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);
|
|
var
|
|
I: LongInt;
|
|
Gray: TColor64Rec;
|
|
PixF: TColorFPRec;
|
|
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 * OneDiv16Bit;
|
|
PixF.G := Gray.A * OneDiv16Bit;
|
|
PixF.B := Gray.A * OneDiv16Bit;
|
|
PixF.A := Alpha * OneDiv16Bit;
|
|
|
|
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: TColorFPRec;
|
|
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: TColorFPRec;
|
|
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 := ClampToWord(Round(PixF.A * 65535));
|
|
Pix64.R := ClampToWord(Round(PixF.R * 65535));
|
|
Pix64.G := ClampToWord(Round(PixF.G * 65535));
|
|
Pix64.B := ClampToWord(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: TColorFPRec;
|
|
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 := ClampToWord(Round(PixF.A * 65535.0));
|
|
Gray.A := ClampToWord(Round((GrayConv.R * PixF.R + GrayConv.G * PixF.G +
|
|
GrayConv.B * PixF.B) * 65535.0));
|
|
|
|
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
|
|
begin
|
|
for I := 0 to NumPixels - 1 do
|
|
begin
|
|
Dst^ := Round(GrayConv.R * SrcPal[Src^].R + GrayConv.G * SrcPal[Src^].G +
|
|
GrayConv.B * SrcPal[Src^].B);
|
|
Inc(Src, SrcInfo.BytesPerPixel);
|
|
Inc(Dst, DstInfo.BytesPerPixel);
|
|
end
|
|
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;
|
|
Gray.A := MulDiv(Round(GrayConv.R * SrcPal[Idx].R + GrayConv.G * SrcPal[Idx].G +
|
|
GrayConv.B * SrcPal[Idx].B), 65535, 255);
|
|
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);
|
|
var
|
|
I: LongInt;
|
|
Idx: LongWord;
|
|
PixF: TColorFPRec;
|
|
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 * OneDiv8Bit;
|
|
R := SrcPal[Idx].R * OneDiv8Bit;
|
|
G := SrcPal[Idx].G * OneDiv8Bit;
|
|
B := SrcPal[Idx].B * OneDiv8Bit;
|
|
end;
|
|
FloatSetDstPixel(Dst, DstInfo, PixF);
|
|
Inc(Src, SrcInfo.BytesPerPixel);
|
|
Inc(Dst, DstInfo.BytesPerPixel);
|
|
end;
|
|
end;
|
|
|
|
|
|
{ Special formats conversion functions }
|
|
|
|
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
|
|
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;
|
|
|
|
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
|
|
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;
|
|
|
|
procedure GetInterpolatedAlphas(var AlphaBlock: TDXTAlphaBlockInt);
|
|
begin
|
|
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;
|
|
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
|
|
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
|
|
GetInterpolatedAlphas(AlphaBlock);
|
|
|
|
// 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;
|
|
|
|
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: PByte; 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) or ((Pixels[I shl 1 + 1].Alpha shr 4) shl 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;
|
|
|
|
type
|
|
TBTCBlock = packed record
|
|
MLower, MUpper: Byte;
|
|
BitField: Word;
|
|
end;
|
|
PBTCBlock = ^TBTCBlock;
|
|
|
|
procedure EncodeBTC(SrcBits: Pointer; DestBits: PByte; Width, Height: Integer);
|
|
var
|
|
X, Y, I, J: Integer;
|
|
Block: TBTCBlock;
|
|
M, MLower, MUpper, K: Integer;
|
|
Pixels: array[0..15] of Byte;
|
|
begin
|
|
for Y := 0 to Height div 4 - 1 do
|
|
for X := 0 to Width div 4 - 1 do
|
|
begin
|
|
M := 0;
|
|
MLower := 0;
|
|
MUpper := 0;
|
|
FillChar(Block, SizeOf(Block), 0);
|
|
K := 0;
|
|
|
|
// Store 4x4 pixels and compute average, lower, and upper intensity levels
|
|
for I := 0 to 3 do
|
|
for J := 0 to 3 do
|
|
begin
|
|
Pixels[K] := PByteArray(SrcBits)[(Y shl 2 + I) * Width + X shl 2 + J];
|
|
Inc(M, Pixels[K]);
|
|
Inc(K);
|
|
end;
|
|
|
|
M := M div 16;
|
|
K := 0;
|
|
|
|
// Now compute upper and lower levels, number of upper pixels,
|
|
// and update bit field (1 when pixel is above avg. level M)
|
|
for I := 0 to 15 do
|
|
begin
|
|
if Pixels[I] > M then
|
|
begin
|
|
Inc(MUpper, Pixels[I]);
|
|
Inc(K);
|
|
Block.BitField := Block.BitField or (1 shl I);
|
|
end
|
|
else
|
|
Inc(MLower, Pixels[I]);
|
|
end;
|
|
|
|
// Scale levels and save them to block
|
|
if K > 0 then
|
|
Block.MUpper := ClampToByte(MUpper div K)
|
|
else
|
|
Block.MUpper := 0;
|
|
Block.MLower := ClampToByte(MLower div (16 - K));
|
|
|
|
// Finally save block to dest data
|
|
PBTCBlock(DestBits)^ := Block;
|
|
Inc(DestBits, SizeOf(Block));
|
|
end;
|
|
end;
|
|
|
|
procedure GetOneChannelBlock(var Block: TPixelBlock; SrcBits: Pointer; XPos, YPos,
|
|
Width, Height, BytesPP, ChannelIdx: Integer);
|
|
var
|
|
X, Y, I: Integer;
|
|
Src: PByte;
|
|
begin
|
|
I := 0;
|
|
// 4x4 pixel block is filled with information about every pixel in the block,
|
|
// but only one channel value is stored in Alpha field
|
|
for Y := 0 to 3 do
|
|
for X := 0 to 3 do
|
|
begin
|
|
Src := @PByteArray(SrcBits)[(YPos * 4 + Y) * Width * BytesPP +
|
|
(XPos * 4 + X) * BytesPP + ChannelIdx];
|
|
Block[I].Alpha := Src^;
|
|
Inc(I);
|
|
end;
|
|
end;
|
|
|
|
procedure EncodeATI1N(SrcBits: Pointer; DestBits: PByte; Width, Height: Integer);
|
|
var
|
|
X, Y: Integer;
|
|
AlphaBlock: TDXTAlphaBlockInt;
|
|
Pixels: TPixelBlock;
|
|
begin
|
|
for Y := 0 to Height div 4 - 1 do
|
|
for X := 0 to Width div 4 - 1 do
|
|
begin
|
|
// Encode one channel
|
|
GetOneChannelBlock(Pixels, SrcBits, X, Y, Width, Height, 1, 0);
|
|
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));
|
|
end;
|
|
end;
|
|
|
|
procedure EncodeATI2N(SrcBits: Pointer; DestBits: PByte; Width, Height: Integer);
|
|
var
|
|
X, Y: Integer;
|
|
AlphaBlock: TDXTAlphaBlockInt;
|
|
Pixels: TPixelBlock;
|
|
begin
|
|
for Y := 0 to Height div 4 - 1 do
|
|
for X := 0 to Width div 4 - 1 do
|
|
begin
|
|
// Encode Red/X channel
|
|
GetOneChannelBlock(Pixels, SrcBits, X, Y, Width, Height, 4, ChannelRed);
|
|
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));
|
|
// Encode Green/Y channel
|
|
GetOneChannelBlock(Pixels, SrcBits, X, Y, Width, Height, 4, ChannelGreen);
|
|
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));
|
|
end;
|
|
end;
|
|
|
|
procedure EncodeBinary(SrcBits: Pointer; DestBits: PByte; Width, Height: Integer);
|
|
var
|
|
Src: PByte absolute SrcBits;
|
|
Bitmap: PByteArray absolute DestBits;
|
|
X, Y, WidthBytes: Integer;
|
|
PixelTresholded, Treshold: Byte;
|
|
begin
|
|
Treshold := ClampToByte(GetOption(ImagingBinaryTreshold));
|
|
WidthBytes := (Width + 7) div 8;
|
|
|
|
for Y := 0 to Height - 1 do
|
|
for X := 0 to Width - 1 do
|
|
begin
|
|
if Src^ > Treshold then
|
|
PixelTresholded := 255
|
|
else
|
|
PixelTresholded := 0;
|
|
|
|
Bitmap[Y * WidthBytes + X div 8] := Bitmap[Y * WidthBytes + X div 8] or // OR current value of byte with following:
|
|
(PixelTresholded and 1) // To make 1 from 255, 0 remains 0
|
|
shl (7 - (X mod 8)); // Put current bit to proper place in byte
|
|
|
|
Inc(Src);
|
|
end;
|
|
end;
|
|
|
|
procedure DecodeBTC(SrcBits, DestBits: PByte; Width, Height: Integer);
|
|
var
|
|
X, Y, I, J, K: Integer;
|
|
Block: TBTCBlock;
|
|
Dest: PByte;
|
|
begin
|
|
for Y := 0 to Height div 4 - 1 do
|
|
for X := 0 to Width div 4 - 1 do
|
|
begin
|
|
Block := PBTCBlock(SrcBits)^;
|
|
Inc(SrcBits, SizeOf(Block));
|
|
K := 0;
|
|
|
|
// Just write MUpper when there is '1' in bit field and MLower
|
|
// when there is '0'
|
|
for I := 0 to 3 do
|
|
for J := 0 to 3 do
|
|
begin
|
|
Dest := @PByteArray(DestBits)[(Y shl 2 + I) * Width + X shl 2 + J];
|
|
if Block.BitField and (1 shl K) <> 0 then
|
|
Dest^ := Block.MUpper
|
|
else
|
|
Dest^ := Block.MLower;
|
|
Inc(K);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure DecodeATI1N(SrcBits, DestBits: PByte; Width, Height: Integer);
|
|
var
|
|
X, Y, I, J: Integer;
|
|
AlphaBlock: TDXTAlphaBlockInt;
|
|
AMask: array[0..1] of LongWord;
|
|
begin
|
|
for Y := 0 to Height div 4 - 1 do
|
|
for X := 0 to Width div 4 - 1 do
|
|
begin
|
|
AlphaBlock := PDXTAlphaBlockInt(SrcBits)^;
|
|
Inc(SrcBits, SizeOf(AlphaBlock));
|
|
// 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
|
|
GetInterpolatedAlphas(AlphaBlock);
|
|
|
|
// we distribute the dxt block alphas
|
|
// across the 4x4 block of the destination image
|
|
for J := 0 to 3 do
|
|
for I := 0 to 3 do
|
|
begin
|
|
PByteArray(DestBits)[(Y shl 2 + J) * Width + (X shl 2 + I)] :=
|
|
AlphaBlock.Alphas[AMask[J shr 1] and 7];
|
|
AMask[J shr 1] := AMask[J shr 1] shr 3;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure DecodeATI2N(SrcBits, DestBits: PByte; Width, Height: Integer);
|
|
var
|
|
X, Y, I, J: Integer;
|
|
Color: TColor32Rec;
|
|
AlphaBlock1, AlphaBlock2: TDXTAlphaBlockInt;
|
|
AMask1: array[0..1] of LongWord;
|
|
AMask2: array[0..1] of LongWord;
|
|
begin
|
|
for Y := 0 to Height div 4 - 1 do
|
|
for X := 0 to Width div 4 - 1 do
|
|
begin
|
|
// Read the first alpha block and get masks
|
|
AlphaBlock1 := PDXTAlphaBlockInt(SrcBits)^;
|
|
Inc(SrcBits, SizeOf(AlphaBlock1));
|
|
AMask1[0] := PLongWord(@AlphaBlock1.Alphas[2])^ and $00FFFFFF;
|
|
AMask1[1] := PLongWord(@AlphaBlock1.Alphas[5])^ and $00FFFFFF;
|
|
// Read the secind alpha block and get masks
|
|
AlphaBlock2 := PDXTAlphaBlockInt(SrcBits)^;
|
|
Inc(SrcBits, SizeOf(AlphaBlock2));
|
|
AMask2[0] := PLongWord(@AlphaBlock2.Alphas[2])^ and $00FFFFFF;
|
|
AMask2[1] := PLongWord(@AlphaBlock2.Alphas[5])^ and $00FFFFFF;
|
|
// alpha interpolation between two endpoint alphas
|
|
GetInterpolatedAlphas(AlphaBlock1);
|
|
GetInterpolatedAlphas(AlphaBlock2);
|
|
|
|
Color.A := $FF;
|
|
Color.B := 0;
|
|
|
|
// Distribute alpha block values across 4x4 pixel block,
|
|
// first alpha block represents Red channel, second is Green.
|
|
for J := 0 to 3 do
|
|
for I := 0 to 3 do
|
|
begin
|
|
Color.R := AlphaBlock1.Alphas[AMask1[J shr 1] and 7];
|
|
Color.G := AlphaBlock2.Alphas[AMask2[J shr 1] and 7];
|
|
PColor32RecArray(DestBits)[(Y shl 2 + J) * Width + (X shl 2 + I)] := Color;
|
|
AMask1[J shr 1] := AMask1[J shr 1] shr 3;
|
|
AMask2[J shr 1] := AMask2[J shr 1] shr 3;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure DecodeBinary(SrcBits, DestBits: PByte; Width, Height: Integer); {$IFDEF USE_INLINE}inline;{$ENDIF}
|
|
begin
|
|
Convert1To8(SrcBits, DestBits, Width, Height, (Width + 7) div 8, True);
|
|
end;
|
|
|
|
procedure SpecialToUnSpecial(const SrcImage: TImageData; DestBits: Pointer;
|
|
SpecialFormat: TImageFormat);
|
|
begin
|
|
case SpecialFormat 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);
|
|
ifBTC: DecodeBTC (SrcImage.Bits, DestBits, SrcImage.Width, SrcImage.Height);
|
|
ifATI1N: DecodeATI1N(SrcImage.Bits, DestBits, SrcImage.Width, SrcImage.Height);
|
|
ifATI2N: DecodeATI2N(SrcImage.Bits, DestBits, SrcImage.Width, SrcImage.Height);
|
|
ifBinary: DecodeBinary(SrcImage.Bits, DestBits, SrcImage.Width, SrcImage.Height);
|
|
end;
|
|
end;
|
|
|
|
procedure UnSpecialToSpecial(SrcBits: Pointer; const DestImage: TImageData;
|
|
SpecialFormat: TImageFormat);
|
|
begin
|
|
case SpecialFormat 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);
|
|
ifBTC: EncodeBTC (SrcBits, DestImage.Bits, DestImage.Width, DestImage.Height);
|
|
ifATI1N: EncodeATI1N(SrcBits, DestImage.Bits, DestImage.Width, DestImage.Height);
|
|
ifATI2N: EncodeATI2N(SrcBits, DestImage.Bits, DestImage.Width, DestImage.Height);
|
|
ifBinary: EncodeBinary(SrcBits, DestImage.Bits, DestImage.Width, DestImage.Height);
|
|
end;
|
|
end;
|
|
|
|
procedure ConvertSpecial(var Image: TImageData;
|
|
SrcInfo, DstInfo: PImageFormatInfo);
|
|
var
|
|
WorkImage: TImageData;
|
|
|
|
procedure CheckSize(var Img: TImageData; Info: PImageFormatInfo);
|
|
var
|
|
Width, Height: Integer;
|
|
begin
|
|
Width := Img.Width;
|
|
Height := Img.Height;
|
|
DstInfo.CheckDimensions(Info.Format, Width, Height);
|
|
ResizeImage(Img, Width, Height, rfNearest);
|
|
end;
|
|
|
|
begin
|
|
if SrcInfo.IsSpecial and DstInfo.IsSpecial then
|
|
begin
|
|
// Convert source to nearest 'normal' format
|
|
InitImage(WorkImage);
|
|
NewImage(Image.Width, Image.Height, SrcInfo.SpecialNearestFormat, WorkImage);
|
|
SpecialToUnSpecial(Image, WorkImage.Bits, SrcInfo.Format);
|
|
FreeImage(Image);
|
|
// Make sure output of SpecialToUnSpecial is the same as input of
|
|
// UnSpecialToSpecial
|
|
if SrcInfo.SpecialNearestFormat <> DstInfo.SpecialNearestFormat then
|
|
ConvertImage(WorkImage, DstInfo.SpecialNearestFormat);
|
|
// Convert work image to dest special format
|
|
CheckSize(WorkImage, DstInfo);
|
|
NewImage(WorkImage.Width, WorkImage.Height, DstInfo.Format, Image);
|
|
UnSpecialToSpecial(WorkImage.Bits, Image, DstInfo.Format);
|
|
FreeImage(WorkImage);
|
|
end
|
|
else if SrcInfo.IsSpecial and not DstInfo.IsSpecial then
|
|
begin
|
|
// Convert source to nearest 'normal' format
|
|
InitImage(WorkImage);
|
|
NewImage(Image.Width, Image.Height, SrcInfo.SpecialNearestFormat, WorkImage);
|
|
SpecialToUnSpecial(Image, WorkImage.Bits, SrcInfo.Format);
|
|
FreeImage(Image);
|
|
// Now convert to dest format
|
|
ConvertImage(WorkImage, DstInfo.Format);
|
|
Image := WorkImage;
|
|
end
|
|
else if not SrcInfo.IsSpecial and DstInfo.IsSpecial then
|
|
begin
|
|
// Convert source to nearest format
|
|
WorkImage := Image;
|
|
ConvertImage(WorkImage, DstInfo.SpecialNearestFormat);
|
|
// Now convert from nearest to dest
|
|
CheckSize(WorkImage, DstInfo);
|
|
InitImage(Image);
|
|
NewImage(WorkImage.Width, WorkImage.Height, DstInfo.Format, Image);
|
|
UnSpecialToSpecial(WorkImage.Bits, Image, DstInfo.Format);
|
|
FreeImage(WorkImage);
|
|
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
|
|
CheckDXTDimensions(Format, Width, Height);
|
|
Result := Width * Height;
|
|
if Format in [ifDXT1, ifATI1N] 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) and not 3; // div 4 * 4;
|
|
Height := (Height + 3) and not 3; // div 4 * 4;
|
|
end;
|
|
|
|
function GetBTCPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt;
|
|
begin
|
|
// BTC can be used only for images with dimensions that are
|
|
// multiples of four
|
|
CheckDXTDimensions(Format, Width, Height);
|
|
Result := Width * Height div 4; // 2bits/pixel
|
|
end;
|
|
|
|
function GetBCPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt;
|
|
begin
|
|
raise ENotImplemented.Create();
|
|
end;
|
|
|
|
procedure CheckBCDimensions(Format: TImageFormat; var Width, Height: LongInt);
|
|
begin
|
|
raise ENotImplemented.Create();
|
|
end;
|
|
|
|
function GetBinaryPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt;
|
|
begin
|
|
// Binary images are aligned on BYTE boundary
|
|
Result := ((Width + 7) div 8) * Height; // 1bit/pixel
|
|
end;
|
|
|
|
{ Optimized pixel readers/writers for 32bit and FP colors to be stored in TImageFormatInfo }
|
|
|
|
function GetPixel32ifA8R8G8B8(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColor32Rec;
|
|
begin
|
|
Result.Color := PLongWord(Bits)^;
|
|
end;
|
|
|
|
procedure SetPixel32ifA8R8G8B8(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColor32Rec);
|
|
begin
|
|
PLongWord(Bits)^ := Color.Color;
|
|
end;
|
|
|
|
function GetPixelFPifA8R8G8B8(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColorFPRec;
|
|
begin
|
|
Result.A := PColor32Rec(Bits).A * OneDiv8Bit;
|
|
Result.R := PColor32Rec(Bits).R * OneDiv8Bit;
|
|
Result.G := PColor32Rec(Bits).G * OneDiv8Bit;
|
|
Result.B := PColor32Rec(Bits).B * OneDiv8Bit;
|
|
end;
|
|
|
|
procedure SetPixelFPifA8R8G8B8(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColorFPRec);
|
|
begin
|
|
PColor32Rec(Bits).A := ClampToByte(Round(Color.A * 255.0));
|
|
PColor32Rec(Bits).R := ClampToByte(Round(Color.R * 255.0));
|
|
PColor32Rec(Bits).G := ClampToByte(Round(Color.G * 255.0));
|
|
PColor32Rec(Bits).B := ClampToByte(Round(Color.B * 255.0));
|
|
end;
|
|
|
|
function GetPixel32Channel8Bit(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColor32Rec;
|
|
begin
|
|
case Info.Format of
|
|
ifR8G8B8, ifX8R8G8B8:
|
|
begin
|
|
Result.A := $FF;
|
|
PColor24Rec(@Result)^ := PColor24Rec(Bits)^;
|
|
end;
|
|
ifGray8, ifA8Gray8:
|
|
begin
|
|
if Info.HasAlphaChannel then
|
|
Result.A := PWordRec(Bits).High
|
|
else
|
|
Result.A := $FF;
|
|
Result.R := PWordRec(Bits).Low;
|
|
Result.G := PWordRec(Bits).Low;
|
|
Result.B := PWordRec(Bits).Low;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SetPixel32Channel8Bit(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColor32Rec);
|
|
begin
|
|
case Info.Format of
|
|
ifR8G8B8, ifX8R8G8B8:
|
|
begin
|
|
PColor24Rec(Bits)^ := PColor24Rec(@Color)^;
|
|
end;
|
|
ifGray8, ifA8Gray8:
|
|
begin
|
|
if Info.HasAlphaChannel then
|
|
PWordRec(Bits).High := Color.A;
|
|
PWordRec(Bits).Low := Round(GrayConv.R * Color.R + GrayConv.G * Color.G +
|
|
GrayConv.B * Color.B);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetPixelFPChannel8Bit(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColorFPRec;
|
|
begin
|
|
case Info.Format of
|
|
ifR8G8B8, ifX8R8G8B8:
|
|
begin
|
|
Result.A := 1.0;
|
|
Result.R := PColor24Rec(Bits).R * OneDiv8Bit;
|
|
Result.G := PColor24Rec(Bits).G * OneDiv8Bit;
|
|
Result.B := PColor24Rec(Bits).B * OneDiv8Bit;
|
|
end;
|
|
ifGray8, ifA8Gray8:
|
|
begin
|
|
if Info.HasAlphaChannel then
|
|
Result.A := PWordRec(Bits).High * OneDiv8Bit
|
|
else
|
|
Result.A := 1.0;
|
|
Result.R := PWordRec(Bits).Low * OneDiv8Bit;
|
|
Result.G := PWordRec(Bits).Low * OneDiv8Bit;
|
|
Result.B := PWordRec(Bits).Low * OneDiv8Bit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SetPixelFPChannel8Bit(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColorFPRec);
|
|
begin
|
|
case Info.Format of
|
|
ifR8G8B8, ifX8R8G8B8:
|
|
begin
|
|
PColor24Rec(Bits).R := ClampToByte(Round(Color.R * 255.0));
|
|
PColor24Rec(Bits).G := ClampToByte(Round(Color.G * 255.0));
|
|
PColor24Rec(Bits).B := ClampToByte(Round(Color.B * 255.0));
|
|
end;
|
|
ifGray8, ifA8Gray8:
|
|
begin
|
|
if Info.HasAlphaChannel then
|
|
PWordRec(Bits).High := ClampToByte(Round(Color.A * 255.0));
|
|
PWordRec(Bits).Low := ClampToByte(Round((GrayConv.R * Color.R + GrayConv.G * Color.G +
|
|
GrayConv.B * Color.B) * 255.0));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetPixelFPFloat32(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColorFPRec;
|
|
begin
|
|
case Info.Format of
|
|
ifA32R32G32B32F, ifA32B32G32R32F:
|
|
begin
|
|
Result := PColorFPRec(Bits)^;
|
|
end;
|
|
ifR32G32B32F, ifB32G32R32F:
|
|
begin
|
|
Result.A := 1.0;
|
|
Result.Color96Rec := PColor96FPRec(Bits)^;
|
|
end;
|
|
ifR32F:
|
|
begin
|
|
Result.A := 1.0;
|
|
Result.R := PSingle(Bits)^;
|
|
Result.G := 0.0;
|
|
Result.B := 0.0;
|
|
end;
|
|
end;
|
|
if Info.IsRBSwapped then
|
|
SwapValues(Result.R, Result.B);
|
|
end;
|
|
|
|
procedure SetPixelFPFloat32(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColorFPRec);
|
|
begin
|
|
case Info.Format of
|
|
ifA32R32G32B32F, ifA32B32G32R32F:
|
|
begin
|
|
PColorFPRec(Bits)^ := Color;
|
|
end;
|
|
ifR32G32B32F, ifB32G32R32F:
|
|
begin
|
|
PColor96FPRec(Bits)^ := Color.Color96Rec;
|
|
end;
|
|
ifR32F:
|
|
begin
|
|
PSingle(Bits)^ := Color.R;
|
|
end;
|
|
end;
|
|
if Info.IsRBSwapped then
|
|
SwapValues(PColor96FPRec(Bits).R, PColor96FPRec(Bits).B);
|
|
end;
|
|
|
|
initialization
|
|
// Initialize default sampling filter function pointers and radii
|
|
SamplingFilterFunctions[sfNearest] := FilterNearest;
|
|
SamplingFilterFunctions[sfLinear] := FilterLinear;
|
|
SamplingFilterFunctions[sfCosine] := FilterCosine;
|
|
SamplingFilterFunctions[sfHermite] := FilterHermite;
|
|
SamplingFilterFunctions[sfQuadratic] := FilterQuadratic;
|
|
SamplingFilterFunctions[sfGaussian] := FilterGaussian;
|
|
SamplingFilterFunctions[sfSpline] := FilterSpline;
|
|
SamplingFilterFunctions[sfLanczos] := FilterLanczos;
|
|
SamplingFilterFunctions[sfMitchell] := FilterMitchell;
|
|
SamplingFilterFunctions[sfCatmullRom] := FilterCatmullRom;
|
|
SamplingFilterRadii[sfNearest] := 1.0;
|
|
SamplingFilterRadii[sfLinear] := 1.0;
|
|
SamplingFilterRadii[sfCosine] := 1.0;
|
|
SamplingFilterRadii[sfHermite] := 1.0;
|
|
SamplingFilterRadii[sfQuadratic] := 1.5;
|
|
SamplingFilterRadii[sfGaussian] := 1.25;
|
|
SamplingFilterRadii[sfSpline] := 2.0;
|
|
SamplingFilterRadii[sfLanczos] := 3.0;
|
|
SamplingFilterRadii[sfMitchell] := 2.0;
|
|
SamplingFilterRadii[sfCatmullRom] := 2.0;
|
|
|
|
{
|
|
File Notes:
|
|
|
|
-- TODOS ----------------------------------------------------
|
|
- nothing now
|
|
|
|
-- 0.80 -------------------------------------------------------
|
|
- Added PaletteIsGrayScale and Color32ToGray functions.
|
|
|
|
-- 0.77 Changes/Bug Fixes -------------------------------------
|
|
- NOT YET: Added support for Passtrough image data formats.
|
|
- Added ConvertToPixel32 helper function.
|
|
|
|
-- 0.26.5 Changes/Bug Fixes -----------------------------------
|
|
- Removed optimized codepatch for few data formats from StretchResample
|
|
function. It was quite buggy and not so much faster anyway.
|
|
- Added PaletteHasAlpha function.
|
|
- Added support functions for ifBinary data format.
|
|
- Added optional pixel scaling to Convert1To8, Convert2To8,
|
|
abd Convert4To8 functions.
|
|
|
|
-- 0.26.3 Changes/Bug Fixes -----------------------------------
|
|
- Filtered resampling ~10% faster now.
|
|
- Fixed DXT3 alpha encoding.
|
|
- ifIndex8 format now has HasAlphaChannel=True.
|
|
|
|
-- 0.25.0 Changes/Bug Fixes -----------------------------------
|
|
- Made some resampling stuff public so that it can be used in canvas class.
|
|
- Added some color constructors.
|
|
- Added VisualizePalette helper function.
|
|
- Fixed ConvertSpecial, not very readable before and error when
|
|
converting special->special.
|
|
|
|
-- 0.24.3 Changes/Bug Fixes -----------------------------------
|
|
- Some refactorings a changes to DXT based formats.
|
|
- Added ifATI1N and ifATI2N image data formats support structures and functions.
|
|
|
|
-- 0.23 Changes/Bug Fixes -----------------------------------
|
|
- Added ifBTC image format support structures and functions.
|
|
|
|
-- 0.21 Changes/Bug Fixes -----------------------------------
|
|
- FillMipMapLevel now works well with indexed and special formats too.
|
|
- Moved Convert1To8 and Convert4To8 functions from ImagingBitmaps here
|
|
and created new Convert2To8 function. They are now used by more than one
|
|
file format loader.
|
|
|
|
-- 0.19 Changes/Bug Fixes -----------------------------------
|
|
- StretchResample now uses pixel get/set functions stored in
|
|
TImageFormatInfo so it is much faster for formats that override
|
|
them with optimized ones
|
|
- added pixel set/get functions optimized for various image formats
|
|
(to be stored in TImageFormatInfo)
|
|
- bug in ConvertSpecial caused problems when converting DXTC images
|
|
to bitmaps in ImagingCoponents
|
|
- bug in StretchRect caused that it didn't work with ifR32F and
|
|
ifR16F formats
|
|
- removed leftover code in FillMipMapLevel which disabled
|
|
filtered resizing of images witch ChannelSize <> 8bits
|
|
- added half float converting functions and support for half based
|
|
image formats where needed
|
|
- added TranslatePixel and IsImageFormatValid functions
|
|
- fixed possible range overflows when converting from FP to integer images
|
|
- added pixel set/get functions: GetPixel32Generic, GetPixelFPGeneric,
|
|
SetPixel32Generic, SetPixelFPGeneric
|
|
- fixed occasional range overflows in StretchResample
|
|
|
|
-- 0.17 Changes/Bug Fixes -----------------------------------
|
|
- added StretchNearest, StretchResample and some sampling functions
|
|
- added ChannelCount values to TImageFormatInfo constants
|
|
- added resolution validity check to GetDXTPixelsSize
|
|
|
|
-- 0.15 Changes/Bug Fixes -----------------------------------
|
|
- added RBSwapFormat values to some TImageFromatInfo definitions
|
|
- fixed bug in ConvertSpecial (causing DXT images to convert only to 32bit)
|
|
- added CopyPixel, ComparePixels helper functions
|
|
|
|
-- 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.
|
|
|