unit Img32;

(*******************************************************************************
* Author    :  Angus Johnson                                                   *
* Version   :  4.3                                                             *
* Date      :  27 September 2022                                               *
* Website   :  http://www.angusj.com                                           *
* Copyright :  Angus Johnson 2019-2022                                         *
*                                                                              *
* Purpose   :  The core module of the Image32 library                          *
*                                                                              *
* License   :  Use, modification & distribution is subject to                  *
*              Boost Software License Ver 1                                    *
*              http://www.boost.org/LICENSE_1_0.txt                            *
*******************************************************************************)

interface

{$I Img32.inc}

uses
  Types, SysUtils, Classes,
  {$IFDEF MSWINDOWS} Windows,{$ENDIF}
  {$IFDEF USING_VCL_LCL}
    {$IFDEF USES_NAMESPACES} Vcl.Graphics, Vcl.Forms,
    {$ELSE}Graphics, Forms,
    {$ENDIF}
  {$ENDIF}
  {$IFDEF XPLAT_GENERICS}
    Generics.Collections, Generics.Defaults, Character,
  {$ENDIF}
  Math;

type
  TRect = Types.TRect;
  TColor32 = type Cardinal;

  TPointD = record
    X, Y: double;
  end;

const
  clNone32     = TColor32($00000000);
  clAqua32     = TColor32($FF00FFFF);
  clBlack32    = TColor32($FF000000);
  clBlue32     = TColor32($FF0000FF);
  clFuchsia32  = TColor32($FFFF00FF);
  clGray32     = TColor32($FF808080);
  clGreen32    = TColor32($FF008000);
  clGrey32     = TColor32($FF808080);
  clLime32     = TColor32($FF00FF00);
  clMaroon32   = TColor32($FF800000);
  clNavy32     = TColor32($FF000080);
  clOlive32    = TColor32($FF7F7F00);
  clOrange32   = TColor32($FFFF7F00);
  clPurple32   = TColor32($FF7F00FF);
  clRed32      = TColor32($FFFF0000);
  clSilver32   = TColor32($FFC0C0C0);
  clTeal32     = TColor32($FF007F7F);
  clWhite32    = TColor32($FFFFFFFF);
  clYellow32   = TColor32($FFFFFF00);

  //custom gray colors
  clDarkGray32 = TColor32($FF505050);
  clDarkGrey32 = TColor32($FF505050);
  //clGray32   = TColor32($FF808080);
  //clSilver32 = TColor32($FFC0C0C0);
  clLiteGray32 = TColor32($FFD3D3D3);
  clLiteGrey32 = TColor32($FFD3D3D3);
  clPaleGray32 = TColor32($FFE0E0E0);
  clPaleGrey32 = TColor32($FFE0E0E0);
  clDarkBtn32  = TColor32($FFE8E8E8);
  clBtnFace32  = TColor32($FFF0F0F0);
  clLiteBtn32  = TColor32($FFF8F8F8);

{$IFDEF ZEROBASEDSTR}
  {$ZEROBASEDSTRINGS OFF}
{$ENDIF}

{$IFNDEF MSWINDOWS}
  RT_BITMAP = PChar(2);
{$ENDIF}

type
  TClipboardPriority = (cpLow, cpMedium, cpHigh);

  PColor32 = ^TColor32;
  TArrayOfColor32 = array of TColor32;
  TArrayOfArrayOfColor32 = array of TArrayOfColor32;
  TArrayOfInteger = array of Integer;
  TArrayOfWord = array of WORD;
  TArrayOfByte = array of Byte;

  TImg32Notification = (inStateChange, inDestroy);

  //A INotifyRecipient receives change notifications though a property
  //interface from a single NotifySender (eg a Font property).
  //A NotifySender can send change notificatons to multiple NotifyRecipients
  //(eg where multiple object use the same font property). NotifyRecipients can
  //still receive change notificatons from mulitple NotifySenders, but it
  //must use a separate property for each NotifySender. (Also there's little
  //benefit in using INotifySender and INotifyRecipient interfaces where there
  //will only be one receiver - eg scroll - scrolling window.)

  INotifyRecipient = interface
    ['{95F50C62-D321-46A4-A42C-8E9D0E3149B5}']
   procedure ReceiveNotification(Sender: TObject; notify: TImg32Notification);
  end;
  TRecipients = array of INotifyRecipient;

  INotifySender = interface
    ['{52072382-8B2F-481D-BE0A-E1C0A216B03E}']
    procedure AddRecipient(recipient: INotifyRecipient);
    procedure DeleteRecipient(recipient: INotifyRecipient);
  end;

  TInterfacedObj = class(TObject, IInterface)
  public
  {$IFDEF FPC}
    function  _AddRef: Integer;
      {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    function  _Release: Integer;
      {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    function QueryInterface(
      {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;
      out obj) : longint;
      {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
  {$ELSE}
    function  _AddRef: Integer; stdcall;
    function  _Release: Integer; stdcall;
    function  QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  {$ENDIF}
  end;

  TImage32 = class;
  TImageFormatClass = class of TImageFormat;

  //TImageFormat: Abstract base class for loading and saving images in TImage32.<br>
  //This class is overridden to provide support for separate
  //file storage formats (eg BMP, PNG, GIF & JPG).<br>
  //Derived classes register with TImage32 using TImage32.RegisterImageFormatClass.
  TImageFormat = class
    class function IsValidImageStream(stream: TStream): Boolean; virtual; abstract;
    procedure SaveToStream(stream: TStream; img32: TImage32); virtual; abstract;
    function SaveToFile(const filename: string; img32: TImage32): Boolean; virtual;
    function LoadFromStream(stream: TStream; img32: TImage32): Boolean; virtual; abstract;
    function LoadFromFile(const filename: string; img32: TImage32): Boolean; virtual;
    class function CanCopyToClipboard: Boolean; virtual;
    class function CopyToClipboard(img32: TImage32): Boolean; virtual; abstract;
    class function CanPasteFromClipboard: Boolean; virtual; abstract;
    class function PasteFromClipboard(img32: TImage32): Boolean; virtual; abstract;
  end;

  TBlendFunction = function(bgColor, fgColor: TColor32): TColor32;

  TCompareFunction = function(master, current: TColor32; data: integer): Boolean;
  TCompareFunctionEx = function(master, current: TColor32): Byte;

  TTileFillStyle = (tfsRepeat, tfsMirrorHorz, tfsMirrorVert, tfsRotate180);

  TResamplerFunction = function(img: TImage32; x256, y256: integer): TColor32;

  TImage32 = class(TObject)
  private
    fWidth: integer;
    fHeight: Integer;
    fResampler: integer;
    fIsPremultiplied: Boolean;
    fColorCount: integer;
    fPixels: TArrayOfColor32;
    fOnChange: TNotifyEvent;
    fOnResize: TNotifyEvent;
    fUpdateCnt: integer;
    fAntiAliased: Boolean;
    fNotifyBlocked: Boolean;
    function GetPixel(x,y: Integer): TColor32;
    procedure SetPixel(x,y: Integer; color: TColor32);
    function GetIsBlank: Boolean;
    function GetIsEmpty: Boolean;
    function GetPixelBase: PColor32;
    function GetPixelRow(row: Integer): PColor32;
    procedure NearestNeighborResize(newWidth, newHeight: Integer);
    procedure ResamplerResize(newWidth, newHeight: Integer);
    procedure RotateLeft90;
    procedure RotateRight90;
    procedure Rotate180;
    function GetColorCount: Integer;
    function GetHasTransparency: Boolean;
    function GetBounds: TRect;
    function GetMidPoint: TPointD;
  protected
    function  RectHasTransparency(rec: TRect): Boolean;
    function  CopyPixels(rec: TRect): TArrayOfColor32;
    //CopyInternal: Internal routine (has no scaling or bounds checking)
    procedure CopyInternal(src: TImage32;
      const srcRec, dstRec: TRect; blendFunc: TBlendFunction);
    procedure  Changed; virtual;
    procedure  Resized; virtual;
    property   UpdateCount: integer read fUpdateCnt;
  public
    constructor Create(width: Integer = 0; height: Integer = 0); overload;
    constructor Create(src: TImage32); overload;
    constructor Create(src: TImage32; const srcRec: TRect); overload;
    destructor Destroy; override;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure BlockNotify;
    procedure UnblockNotify;

    procedure Assign(src: TImage32);
    procedure AssignTo(dst: TImage32);
    //SetSize: Erases any current image, and fills with the specified color.
    procedure SetSize(newWidth, newHeight: Integer; color: TColor32 = 0);
    //Resize: is similar to Scale() in that it won't eraze the existing
    //image. Depending on the stretchImage parameter it will either stretch
    //or crop the image. Don't confuse Resize() with SetSize(), as the latter
    //does erase the image.
    procedure Resize(newWidth, newHeight: Integer; stretchImage: Boolean = true);
    //ScaleToFit: The new image will be scaled to fit within 'rec'
    procedure ScaleToFit(width, height: integer);
    //ScaleToFitCentered: The new image will be scaled and also centred
    procedure ScaleToFitCentered(width, height: integer); overload;
    procedure ScaleToFitCentered(const rect: TRect); overload;
    procedure Scale(s: double); overload;
    procedure Scale(sx, sy: double); overload;

    function Copy(src: TImage32; srcRec, dstRec: TRect): Boolean;
    //CopyBlend: Copies part or all of another image (src) on top of the
    //existing image. If no blend function is provided, then the function
    //will behave exactly as the Copy function above. However, when a blend
    //function is specified, that function will determine how the images will
    //be blended. If srcRec and dstRec have different widths or heights,
    //then the image in srcRec will also be stretched to fit dstRec.
    function CopyBlend(src: TImage32; srcRec, dstRec: TRect;
      blendFunc: TBlendFunction = nil): Boolean;

{$IFDEF MSWINDOWS}
    //CopyFromDC: Copies an image from a Windows device context, erasing
    //any current image in TImage32. (eg copying from TBitmap.canvas.handle)
    procedure CopyFromDC(srcDc: HDC; const srcRect: TRect);
    //CopyToDc: Copies the image into a Windows device context
    procedure CopyToDc(dstDc: HDC; x: Integer = 0; y: Integer = 0;
      transparent: Boolean = true); overload;
    procedure CopyToDc(const srcRect: TRect; dstDc: HDC;
      x: Integer = 0; y: Integer = 0; transparent: Boolean = true); overload;
    procedure CopyToDc(const srcRect, dstRect: TRect; dstDc: HDC;
      transparent: Boolean = true); overload;
{$ENDIF}
{$IFDEF USING_VCL_LCL}
    procedure CopyFromBitmap(bmp: TBitmap);
    procedure CopyToBitmap(bmp: TBitmap);
{$ENDIF}
    function CopyToClipBoard: Boolean;
    class function CanPasteFromClipBoard: Boolean;
    function PasteFromClipBoard: Boolean;
    procedure Crop(const rec: TRect);
    //SetBackgroundColor: Assumes the current image is semi-transparent.
    procedure SetBackgroundColor(bgColor: TColor32);
    procedure Clear(color: TColor32 = 0); overload;
    procedure Clear(const rec: TRect; color: TColor32 = 0); overload;
    procedure FillRect(rec: TRect; color: TColor32);

    procedure ConvertToBoolMask(reference: TColor32;
      tolerance: integer; colorFunc: TCompareFunction;
      maskBg: TColor32 = clWhite32; maskFg: TColor32 = clBlack32);
    procedure ConvertToAlphaMask(reference: TColor32;
      colorFunc: TCompareFunctionEx);

    procedure FlipVertical;
    procedure FlipHorizontal;
    procedure PreMultiply;
    //SetAlpha: Sets 'alpha' to the alpha byte of every pixel in the image
    procedure SetAlpha(alpha: Byte);
    procedure ReduceOpacity(opacity: Byte); overload;
    procedure ReduceOpacity(opacity: Byte; rec: TRect); overload;
    //SetRGB: Sets the RGB channels leaving the alpha channel unchanged
    procedure SetRGB(rgbColor: TColor32); overload;
    procedure SetRGB(rgbColor: TColor32; rec: TRect); overload;
    //Grayscale: Only changes color channels. The alpha channel is untouched.
    procedure Grayscale;
    procedure InvertColors;
    procedure InvertAlphas;
    procedure AdjustHue(percent: Integer);         //ie +/- 100%
    procedure AdjustLuminance(percent: Integer);   //ie +/- 100%
    procedure AdjustSaturation(percent: Integer);  //ie +/- 100%

    //CropTransparentPixels: Trims transparent edges until each edge contains
    //at least one opaque or semi-opaque pixel.
    function CropTransparentPixels: TRect;
    procedure Rotate(angleRads: double);
    //RotateRect: Rotates part of an image, but also clips those parts of the
    //rotated image that fall outside rec. The eraseColor parameter indicates
    //the color to fill those uncovered pixels in rec following rotation.
    procedure RotateRect(const rec: TRect;
      angleRads: double; eraseColor: TColor32 = 0);
    procedure Skew(dx,dy: double);

    //ScaleAlpha: Scales the alpha byte of every pixel by the specified amount.
    procedure ScaleAlpha(scale: double);
    class procedure RegisterImageFormatClass(ext: string;
      bm32ExClass: TImageFormatClass; clipPriority: TClipboardPriority);
    class function GetImageFormatClass(const ext: string): TImageFormatClass; overload;
    class function GetImageFormatClass(stream: TStream): TImageFormatClass; overload;
    class function IsRegisteredFormat(const ext: string): Boolean;
    function SaveToFile(filename: string): Boolean;
    function SaveToStream(stream: TStream; const FmtExt: string): Boolean;
    function LoadFromFile(const filename: string): Boolean;
    function LoadFromStream(stream: TStream): Boolean;
    function LoadFromResource(const resName: string; resType: PChar): Boolean;

    //properties ...

    property AntiAliased: Boolean read fAntiAliased write fAntiAliased;
    property Width: Integer read fWidth;
    property Height: Integer read fHeight;
    property Bounds: TRect read GetBounds;
    property IsBlank: Boolean read GetIsBlank;
    property IsEmpty: Boolean read GetIsEmpty;
    property IsPreMultiplied: Boolean read fIsPremultiplied;
    property MidPoint: TPointD read GetMidPoint;
    property Pixel[x,y: Integer]: TColor32 read GetPixel write SetPixel;
    property Pixels: TArrayOfColor32 read fPixels;
    property PixelBase: PColor32 read GetPixelBase;
    property PixelRow[row: Integer]: PColor32 read GetPixelRow;
    property ColorCount: Integer read GetColorCount;
    //HasTransparency: Returns true if any pixel's alpha byte < 255.
    property HasTransparency: Boolean read GetHasTransparency;
    //Resampler: is used in scaling and rotation transforms
    property Resampler: integer read fResampler write fResampler;
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
    property OnResize: TNotifyEvent read fOnResize write fOnResize;
  end;

  TImageList32 = class
  private
{$IFDEF XPLAT_GENERICS}
    fList: TList<TImage32>;
{$ELSE}
    fList: TList;
{$ENDIF}
    fIsImageOwner: Boolean;
    function GetImage(index: integer): TImage32;
    procedure SetImage(index: integer; img: TIMage32);
    function GetLast: TImage32;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    function Count: integer;
    procedure Add(image: TImage32); overload;
    function Add(width, height: integer): TImage32; overload;
    procedure Insert(index: integer; image: TImage32);
    procedure Move(currentIndex, newIndex: integer);
    procedure Delete(index: integer);
    property Image[index: integer]: TImage32 read GetImage write SetImage; default;
    property IsImageOwner: Boolean read fIsImageOwner write fIsImageOwner;
    property Last: TImage32 read GetLast;
  end;

  PARGB = ^TARGB;
  TARGB = packed record
    case boolean of
      false: (B: Byte; G: Byte; R: Byte; A: Byte);
      true : (Color: TColor32);
  end;
  TArrayOfARGB = array of TARGB;
  PArgbArray = ^TArrayOfARGB;

  THsl = packed record
    hue  : byte;
    sat  : byte;
    lum  : byte;
    alpha: byte;
  end;
  PHsl = ^THsl;
  TArrayofHSL = array of THsl;

  TTriState = (tsUnknown = 0, tsYes = 1, tsChecked = 1, tsNo = 2, tsUnchecked = 2);

  PPointD = ^TPointD;
  TPathD = array of TPointD;       //nb: watch for ambiguity with Clipper.pas
  TPathsD = array of TPathD;       //nb: watch for ambiguity with Clipper.pas
  TArrayOfPathsD = array of TPathsD;

  TArrayOfDouble = array of double;
  TArrayOfString = array of string;

  TRectD = {$IFDEF RECORD_METHODS} record {$ELSE} object {$ENDIF}
    {$IFNDEF RECORD_METHODS}
    Left, Top, Right, Bottom: Double;
    function TopLeft: TPointD;
    function BottomRight: TPointD;
    {$ENDIF}
    function IsEmpty: Boolean;
    function Width: double;
    function Height: double;
    //Normalize: Returns True if swapping top & bottom or left & right
    function Normalize: Boolean;
    function Contains(const Pt: TPoint): Boolean; overload;
    function Contains(const Pt: TPointD): Boolean; overload;
    function MidPoint: TPointD;
    {$IFDEF RECORD_METHODS}
    case Integer of
      0: (Left, Top, Right, Bottom: Double);
      1: (TopLeft, BottomRight: TPointD);
    {$ENDIF}
  end;

  {$IFNDEF PBYTE}
  PByte = type PChar;
  {$ENDIF}

  //BLEND FUNCTIONS ( see TImage32.CopyBlend() )

  //BlendToOpaque: Blends a semi-transparent image onto an opaque background
  function BlendToOpaque(bgColor, fgColor: TColor32): TColor32;
  //BlendToAlpha: Blends two semi-transparent images (slower than BlendToOpaque)
  function BlendToAlpha(bgColor, fgColor: TColor32): TColor32;
  //BlendMask: Whereever the mask is, preserves the background
  function BlendMask(bgColor, alphaMask: TColor32): TColor32;
  function BlendAltMask(bgColor, alphaMask: TColor32): TColor32;
  function BlendDifference(color1, color2: TColor32): TColor32;
  function BlendSubtract(bgColor, fgColor: TColor32): TColor32;
  function BlendLighten(bgColor, fgColor: TColor32): TColor32;
  function BlendDarken(bgColor, fgColor: TColor32): TColor32;
  function BlendInvertedMask(bgColor, alphaMask: TColor32): TColor32;
  //BlendBlueChannel: typically useful for white color masks
  function BlendBlueChannel(bgColor, blueMask: TColor32): TColor32;

  //COMPARE COLOR FUNCTIONS (ConvertToBoolMask, FloodFill, Vectorize etc.)

  function CompareRGB(master, current: TColor32; tolerance: Integer): Boolean;
  function CompareHue(master, current: TColor32; tolerance: Integer): Boolean;
  function CompareAlpha(master, current: TColor32; tolerance: Integer): Boolean;

  //CompareEx COLOR FUNCTIONS (see ConvertToAlphaMask)
  function CompareRgbEx(master, current: TColor32): Byte;
  function CompareAlphaEx(master, current: TColor32): Byte;

  //MISCELLANEOUS FUNCTIONS ...

  function GetBoolMask(img: TImage32; reference: TColor32;
    compareFunc: TCompareFunction; tolerance: Integer): TArrayOfByte;

  function GetByteMask(img: TImage32; reference: TColor32;
    compareFunc: TCompareFunctionEx): TArrayOfByte;

  {$IFDEF MSWINDOWS}
  //Color32: Converts a Graphics.TColor value into a TColor32 value.
  function Color32(rgbColor: Integer): TColor32; overload;
  {$ENDIF}
  function Color32(a, r, g, b: Byte): TColor32; overload;

  //RGBColor: Converts a TColor32 value into a COLORREF value
  function RGBColor(color: TColor32): Cardinal;
  function InvertColor(color: TColor32): TColor32;

  //RgbToHsl: See https://en.wikipedia.org/wiki/HSL_and_HSV
  function RgbToHsl(color: TColor32): THsl;
  //HslToRgb: See https://en.wikipedia.org/wiki/HSL_and_HSV
  function HslToRgb(hslColor: THsl): TColor32;
  function AdjustHue(color: TColor32; percent: Integer): TColor32;
  function ArrayOfColor32ToArrayHSL(const clr32Arr: TArrayOfColor32): TArrayofHSL;
  function ArrayOfHSLToArrayColor32(const hslArr: TArrayofHSL): TArrayOfColor32;

  function GetAlpha(color: TColor32): Byte;  {$IFDEF INLINE} inline; {$ENDIF}

  function PointD(const X, Y: Double): TPointD; overload;
  function PointD(const pt: TPoint): TPointD; overload;

  function RectD(left, top, right, bottom: double): TRectD; overload;
  function RectD(const rec: TRect): TRectD; overload;

  function ClampByte(val: Integer): byte; overload; {$IFDEF INLINE} inline; {$ENDIF}
  function ClampByte(val: double): byte; overload; {$IFDEF INLINE} inline; {$ENDIF}
  function ClampRange(val, min, max: Integer): Integer; overload;
  function ClampRange(val, min, max: double): double; overload;
  function IncPColor32(pc: Pointer; cnt: Integer): PColor32;

  procedure NormalizeAngle(var angle: double; tolerance: double = Pi/360);
  function GrayScale(color: TColor32): TColor32;

  //DPIAware: Useful for DPIAware sizing of images and their container controls.
  //It scales values relative to the display's resolution (PixelsPerInch).
  //See https://docs.microsoft.com/en-us/windows/desktop/hidpi/high-DPIAware-desktop-application-development-on-windows
  function DPIAware(val: Integer): Integer; overload; {$IFDEF INLINE} inline; {$ENDIF}
  function DPIAware(val: double): double; overload; {$IFDEF INLINE} inline; {$ENDIF}
  function DPIAware(const pt: TPoint): TPoint; overload;
  function DPIAware(const pt: TPointD): TPointD; overload;
  function DPIAware(const rec: TRect): TRect; overload;
  function DPIAware(const rec: TRectD): TRectD; overload;

{$IFDEF MSWINDOWS}
  {$IFDEF FPC}
  function AlphaBlend(DC: HDC; p2, p3, p4, p5: Integer;
    DC6: HDC; p7, p8, p9, p10: Integer; p11: Windows.TBlendFunction): BOOL;
    stdcall; external 'msimg32.dll' name 'AlphaBlend';
  {$ENDIF}
{$ENDIF}

  //CreateResourceStream: handles both numeric and string names and types
  function CreateResourceStream(const resName: string;
    resType: PChar): TResourceStream;

  function GetResampler(id: integer): TResamplerFunction;
  function RegisterResampler(func: TResamplerFunction; const name: string): integer;
  procedure GetResamplerList(stringList: TStringList);

const
  TwoPi = Pi *2;
  angle0   = 0;
  angle1   = Pi/180;
  angle15  = Pi /12;
  angle30  = angle15 *2;
  angle45  = angle15 *3;
  angle60  = angle15 *4;
  angle75  = angle15 *5;
  angle90  = Pi /2;
  angle105 = Pi - angle75;
  angle120 = Pi - angle60;
  angle135 = Pi - angle45;
  angle150 = Pi - angle30;
  angle165 = Pi - angle15;
  angle180 = Pi;
  angle195 = Pi + angle15;
  angle210 = Pi + angle30;
  angle225 = Pi + angle45;
  angle240 = Pi + angle60;
  angle255 = Pi + angle75;
  angle270 = TwoPi - angle90;
  angle285 = TwoPi - angle75;
  angle300 = TwoPi - angle60;
  angle315 = TwoPi - angle45;
  angle330 = TwoPi - angle30;
  angle345 = TwoPi - angle15;
  angle360 = TwoPi;

var
  ClockwiseRotationIsAnglePositive: Boolean = true;

  //Resampling function identifiers (initialized in Img32.Resamplers)
  rNearestResampler : integer;
  rBilinearResampler: integer;
  rBicubicResampler : integer;

  DefaultResampler: Integer = 0;

  //Both MulTable and DivTable are used in blend functions
  //MulTable[a,b] = a * b / 255
  MulTable: array [Byte,Byte] of Byte;
  //DivTable[a,b] = a * 255/b (for a &lt;= b)
  DivTable: array [Byte,Byte] of Byte;

  dpiAware1   : integer = 1;
  DpiAwareOne : double  = 1.0;

  //AND BECAUSE OLDER DELPHI COMPILERS (OLDER THAN D2006)
  //DON'T SUPPORT RECORD METHODS
  procedure RectWidthHeight(const rec: TRect; out width, height: Integer);
  {$IFDEF INLINE} inline; {$ENDIF}
  function RectWidth(const rec: TRect): Integer;
  {$IFDEF INLINE} inline; {$ENDIF}
  function RectHeight(const rec: TRect): Integer;
  {$IFDEF INLINE} inline; {$ENDIF}

  function IsEmptyRect(const rec: TRect): Boolean; overload;
  {$IFDEF INLINE} inline; {$ENDIF}
  function IsEmptyRect(const rec: TRectD): Boolean; overload;
  {$IFDEF INLINE} inline; {$ENDIF}

  function SwapRedBlue(color: TColor32): TColor32; overload;
  procedure SwapRedBlue(color: PColor32; count: integer); overload;

  function MulBytes(b1, b2: Byte) : Byte;

implementation

uses
  Img32.Vector, Img32.Resamplers, Img32.Transform;

resourcestring
  rsImageTooLarge = 'Image32 error: the image is too large.';
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------

const
  div255 : Double = 1 / 255;
type
  TByteArray = array[0..MaxInt -1] of Byte;
  PByteArray = ^TByteArray;

  TImgFmtRec = record
    Fmt: string;
    SortOrder: TClipboardPriority;
    Obj: TImageFormatClass;
  end;
  PImgFmtRec = ^TImgFmtRec;

  TResamplerObj = class
    id: integer;
    name: string;
    func: TResamplerFunction;
  end;

var
{$IFDEF XPLAT_GENERICS}
  ImageFormatClassList: TList<PImgFmtRec>; //list of supported file extensions
  ResamplerList: TList<TResamplerObj>;     //list of resampler functions
{$ELSE}
  ImageFormatClassList: TList;
  ResamplerList: TList;
{$ENDIF}

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------

procedure CreateImageFormatList;
begin
  if Assigned(ImageFormatClassList) then Exit;

{$IFDEF XPLAT_GENERICS}
  ImageFormatClassList := TList<PImgFmtRec>.Create;
{$ELSE}
  ImageFormatClassList := TList.Create;
{$ENDIF}
end;
//------------------------------------------------------------------------------

function FMod(const ANumerator, ADenominator: Double): Double;
begin
  Result := ANumerator - Trunc(ANumerator / ADenominator) * ADenominator;
end;
//------------------------------------------------------------------------------

procedure NormalizeAngle(var angle: double; tolerance: double = Pi/360);
var
  aa: double;
begin
  angle := FMod(angle, angle360);
  if angle < -Angle180 then angle := angle + angle360
  else if angle > angle180 then angle := angle - angle360;

  aa := Abs(angle);
  if aa < tolerance then angle := 0
  else if aa > angle180 - tolerance then angle := angle180
  else if (aa < angle90 - tolerance) or (aa > angle90 + tolerance) then Exit
  else if angle < 0 then angle := -angle90
  else angle := angle90;
end;
//------------------------------------------------------------------------------

function SwapRedBlue(color: TColor32): TColor32;
var
  c: array[0..3] of byte absolute color;
  r: array[0..3] of byte absolute Result;
begin
  result := color;
  r[0] := c[2];
  r[2] := c[0];
end;
//------------------------------------------------------------------------------

procedure SwapRedBlue(color: PColor32; count: integer);
var
  i: integer;
begin
  for i := 1 to count do
  begin
    color^ := SwapRedBlue(color^);
    inc(color);
  end;
end;
//------------------------------------------------------------------------------

function MulBytes(b1, b2: Byte) : Byte; {$IFDEF INLINE} inline; {$ENDIF}
begin
  Result := MulTable[b1, b2];
end;
//------------------------------------------------------------------------------

function ImageFormatClassListSort(item1, item2: Pointer): integer;
var
  imgFmtRec1: PImgFmtRec absolute item1;
  imgFmtRec2: PImgFmtRec absolute item2;
begin
  Result := Integer(imgFmtRec1.SortOrder) - Integer(imgFmtRec2.SortOrder);
end;
//------------------------------------------------------------------------------

function ClampByte(val: Integer): byte;
begin
  if val < 0 then result := 0
  else if val > 255 then result := 255
  else result := val;
end;
//------------------------------------------------------------------------------

function ClampByte(val: double): byte;
begin
  if val <= 0 then result := 0
  else if val >= 255 then result := 255
  else result := Round(val);
end;
//------------------------------------------------------------------------------

//------------------------------------------------------------------------------
// Blend functions - used by TImage32.CopyBlend()
//------------------------------------------------------------------------------

function BlendToOpaque(bgColor, fgColor: TColor32): TColor32;
var
  res: TARGB absolute Result;
  bg: TARGB absolute bgColor;
  fg: TARGB absolute fgColor;
  fw,bw: PByteArray;
begin
  if fg.A = 0 then Result := bgColor
  else if fg.A = 255 then Result := fgColor
  else
  begin
    //assuming bg.A = 255, use just fg.A for color weighting
    res.A := 255;
    fw := PByteArray(@MulTable[fg.A]);     //ie weight of foreground
    bw := PByteArray(@MulTable[not fg.A]); //ie weight of foreground
    res.R := fw[fg.R] + bw[bg.R];
    res.G := fw[fg.G] + bw[bg.G];
    res.B := fw[fg.B] + bw[bg.B];
  end;
end;
//------------------------------------------------------------------------------

function BlendToAlpha(bgColor, fgColor: TColor32): TColor32;
var
  res: TARGB absolute Result;
  bg: TARGB absolute bgColor;
  fg: TARGB absolute fgColor;
  fgWeight: byte;
  R, InvR: PByteArray;
begin
  //(see https://en.wikipedia.org/wiki/Alpha_compositing)
  if (bg.A = 0) or (fg.A = 255) then Result := fgColor
  else if fg.A = 0 then Result := bgColor
  else
  begin
    //combine alphas ...
    res.A := not MulTable[not fg.A, not bg.A];
    fgWeight := DivTable[fg.A, res.A]; //fgWeight = amount foreground color
                                       //contibutes to total (result) color

    R     := PByteArray(@MulTable[fgWeight]);      //ie weight of foreground
    InvR  := PByteArray(@MulTable[not fgWeight]);  //ie weight of foreground
    res.R := R[fg.R] + InvR[bg.R];
    res.G := R[fg.G] + InvR[bg.G];
    res.B := R[fg.B] + InvR[bg.B];
  end;
end;
//------------------------------------------------------------------------------

function BlendMask(bgColor, alphaMask: TColor32): TColor32;
var
  res: TARGB absolute Result;
  bg: TARGB absolute bgColor;
  fg: TARGB absolute alphaMask;
begin
  Result := bgColor;
  res.A := MulTable[bg.A, fg.A];
  if res.A = 0 then Result := 0;
end;
//------------------------------------------------------------------------------

function BlendAltMask(bgColor, alphaMask: TColor32): TColor32;
var
  res: TARGB absolute Result;
  bg: TARGB absolute bgColor;
  fg: TARGB absolute alphaMask;
begin
  Result := bgColor;
  res.A := MulTable[bg.A, 255-fg.A];
  if res.A = 0 then Result := 0;
end;
//------------------------------------------------------------------------------

function BlendDifference(color1, color2: TColor32): TColor32;
var
  res: TARGB absolute Result;
  bg: TARGB absolute color1;
  fg: TARGB absolute color2;
begin
  if fg.A = 0 then Result := color1
  else if bg.A = 0 then Result := color2
  else
  begin
    res.A := (((fg.A xor 255) * (bg.A xor 255)) shr 8) xor 255;
    res.R := Abs(fg.R - bg.R);
    res.G := Abs(fg.G - bg.G);
    res.B := Abs(fg.B - bg.B);
  end;
end;
//------------------------------------------------------------------------------

function BlendSubtract(bgColor, fgColor: TColor32): TColor32;
var
  res: TARGB absolute Result;
  bg: TARGB absolute bgColor;
  fg: TARGB absolute fgColor;
begin
  if fg.A = 0 then Result := bgColor
  else if bg.A = 0 then Result := fgColor
  else
  begin
    res.A := (((fg.A xor 255) * (bg.A xor 255)) shr 8) xor 255;
    res.R := ClampByte(fg.R - bg.R);
    res.G := ClampByte(fg.G - bg.G);
    res.B := ClampByte(fg.B - bg.B);
  end;
end;
//------------------------------------------------------------------------------

function BlendLighten(bgColor, fgColor: TColor32): TColor32;
var
  res: TARGB absolute Result;
  bg: TARGB absolute bgColor;
  fg: TARGB absolute fgColor;
begin
  if fg.A = 0 then Result := bgColor
  else if bg.A = 0 then Result := fgColor
  else
  begin
    res.A := (((fg.A xor 255) * (bg.A xor 255)) shr 8) xor 255;
    res.R := Max(fg.R, bg.R);
    res.G := Max(fg.G, bg.G);
    res.B := Max(fg.B, bg.B);
  end;
end;
//------------------------------------------------------------------------------

function BlendDarken(bgColor, fgColor: TColor32): TColor32;
var
  res: TARGB absolute Result;
  bg: TARGB absolute bgColor;
  fg: TARGB absolute fgColor;
begin
  if fg.A = 0 then Result := bgColor
  else if bg.A = 0 then Result := fgColor
  else
  begin
    res.A := (((fg.A xor 255) * (bg.A xor 255)) shr 8) xor 255;
    res.R := Min(fg.R, bg.R);
    res.G := Min(fg.G, bg.G);
    res.B := Min(fg.B, bg.B);
  end;
end;
//------------------------------------------------------------------------------

function BlendBlueChannel(bgColor, blueMask: TColor32): TColor32;
var
  res: TARGB absolute Result;
  bg: TARGB absolute bgColor;
  fg: TARGB absolute blueMask;
begin
  Result := bgColor;
  res.A := MulTable[bg.A, fg.B];
end;
//------------------------------------------------------------------------------

function BlendInvertedMask(bgColor, alphaMask: TColor32): TColor32;
var
  res: TARGB absolute Result;
  bg: TARGB absolute bgColor;
  fg: TARGB absolute alphaMask;
begin
  Result := bgColor;
  res.A := MulTable[bg.A, 255 - fg.A];
  if res.A < 2 then Result := 0;
end;

//------------------------------------------------------------------------------
// Compare functions (see ConvertToBoolMask, FloodFill & Vectorize)
//------------------------------------------------------------------------------

function CompareRGB(master, current: TColor32; tolerance: Integer): Boolean;
var
  mast: TARGB absolute master;
  curr: TARGB absolute current;
begin
  if curr.A < $80 then
    Result := false
  else if (master and $FFFFFF) = (current and $FFFFFF) then
    Result := true
  else if tolerance = 0 then
    Result := false
  else result :=
    (Abs(curr.R - mast.R) <= tolerance) and
    (Abs(curr.G - mast.G) <= tolerance) and
    (Abs(curr.B - mast.B) <= tolerance);
end;
//------------------------------------------------------------------------------

function CompareAlpha(master, current: TColor32; tolerance: Integer): Boolean;
var
  mast: TARGB absolute master;
  curr: TARGB absolute current;
begin
  if mast.A = curr.A then Result := true
  else if tolerance = 0 then Result := false
  else result := Abs(curr.A - mast.A) <= tolerance;
end;
//------------------------------------------------------------------------------

function CompareHue(master, current: TColor32; tolerance: Integer): Boolean;
var
  curr, mast: THsl;
  val: Integer;
begin
  if TARGB(current).A < $80 then
  begin
    Result := false;
    Exit;
  end;
  curr := RgbToHsl(current);
  mast := RgbToHsl(master);
  if curr.hue > mast.hue then
  begin
    val := curr.hue - mast.hue;
    if val > 127 then val := mast.hue - curr.hue + 255;
  end else
  begin
    val := mast.hue - curr.hue;
    if val > 127 then val := curr.hue - mast.hue + 255;
  end;
  result := val <= tolerance;
end;

//------------------------------------------------------------------------------
// CompareEx functions (see ConvertToAlphaMask)
//------------------------------------------------------------------------------

function CompareRgbEx(master, current: TColor32): Byte;
var
  mast: TARGB absolute master;
  curr: TARGB absolute current;
  res: Cardinal;
begin
  res := Sqr(mast.R - curr.R) + Sqr(mast.G - curr.G) + Sqr(mast.B - curr.B);
  if res >= 65025 then result := 255
  else result := Round(Sqrt(res));
end;
//------------------------------------------------------------------------------

function CompareAlphaEx(master, current: TColor32): Byte;
var
  mast: TARGB absolute master;
  curr: TARGB absolute current;
begin
  Result := abs(mast.A - curr.A);
end;

//------------------------------------------------------------------------------
// Miscellaneous functions ...
//------------------------------------------------------------------------------

function IsAlphaChar(c: Char): Boolean;
begin
  Result := ((c >= 'A') and (c <= 'Z')) or ((c >= 'a') and (c <= 'z'));
end;
//------------------------------------------------------------------------------

procedure RectWidthHeight(const rec: TRect; out width, height: Integer);
begin
  width := rec.Right - rec.Left;
  height := rec.Bottom - rec.Top;
end;
//------------------------------------------------------------------------------

function RectWidth(const rec: TRect): Integer;
begin
  Result := rec.Right - rec.Left;
end;
//------------------------------------------------------------------------------

function RectHeight(const rec: TRect): Integer;
begin
  Result := rec.Bottom - rec.Top;
end;
//------------------------------------------------------------------------------

function IsEmptyRect(const rec: TRect): Boolean;
begin
  Result := (rec.Right <= rec.Left) or (rec.Bottom <= rec.Top);
end;
//------------------------------------------------------------------------------

function IsEmptyRect(const rec: TRectD): Boolean;
begin
  Result := (rec.Right <= rec.Left) or (rec.Bottom <= rec.Top);
end;
//------------------------------------------------------------------------------

function InvertColor(color: TColor32): TColor32;
var
  c: TARGB absolute color;
  r: TARGB absolute Result;
begin
  r.A := c.A;
  r.R := 255 - c.R;
  r.G := 255 - c.G;
  r.B := 255 - c.B;
end;
//------------------------------------------------------------------------------

function GetAlpha(color: TColor32): Byte;
begin
  Result := Byte(color shr 24);
end;
//------------------------------------------------------------------------------

function RGBColor(color: TColor32): Cardinal;
var
  c  : TARGB absolute color;
  res: TARGB absolute Result;
begin
  res.R := c.B; res.G := c.G; res.B := c.R; res.A := 0;
end;
//------------------------------------------------------------------------------

function Color32(a, r, g, b: Byte): TColor32;
var
  res: TARGB absolute Result;
begin
  res.A := a; res.R := r; res.G := g; res.B := b;
end;
//------------------------------------------------------------------------------

{$IFDEF MSWINDOWS}
function Color32(rgbColor: Integer): TColor32;
var
  res: TARGB absolute Result;
begin
  if rgbColor < 0 then
    result := GetSysColor(rgbColor and $FFFFFF) else
    result := rgbColor;
  res.A := res.B; res.B := res.R; res.R := res.A; //byte swap
  res.A := 255;
end;
//------------------------------------------------------------------------------

function Get32bitBitmapInfoHeader(width, height: Integer): TBitmapInfoHeader;
begin
  FillChar(Result, sizeof(Result), #0);
  Result.biSize := sizeof(TBitmapInfoHeader);
  Result.biWidth := width;
  Result.biHeight := height;
  Result.biPlanes := 1;
  Result.biBitCount := 32;
  Result.biSizeImage := width * height * SizeOf(TColor32);
  Result.biCompression := BI_RGB;
end;
//------------------------------------------------------------------------------
{$ENDIF}

function DPIAware(val: Integer): Integer;
begin
  result := Round(val * DpiAwareOne);
end;
//------------------------------------------------------------------------------

function DPIAware(val: double): double;
begin
  result := val * DpiAwareOne;
end;
//------------------------------------------------------------------------------

function DPIAware(const pt: TPoint): TPoint;
begin
  result.X := Round(pt.X * DpiAwareOne);
  result.Y := Round(pt.Y * DpiAwareOne);
end;
//------------------------------------------------------------------------------

function DPIAware(const pt: TPointD): TPointD;
begin
  result.X := pt.X * DpiAwareOne;
  result.Y := pt.Y * DpiAwareOne;
end;
//------------------------------------------------------------------------------

function DPIAware(const rec: TRect): TRect;
begin
  result.Left := Round(rec.Left * DpiAwareOne);
  result.Top := Round(rec.Top * DpiAwareOne);
  result.Right := Round(rec.Right * DpiAwareOne);
  result.Bottom := Round(rec.Bottom * DpiAwareOne);
end;
//------------------------------------------------------------------------------

function DPIAware(const rec: TRectD): TRectD;
begin
  result.Left := rec.Left * DpiAwareOne;
  result.Top := rec.Top * DpiAwareOne;
  result.Right := rec.Right * DpiAwareOne;
  result.Bottom := rec.Bottom * DpiAwareOne;
end;
//------------------------------------------------------------------------------

function GrayScale(color: TColor32): TColor32;
var
  c: TARGB absolute color;
  r: TARGB absolute result;
  g: Byte;
begin
  //https://www.w3.org/TR/AERT/#color-contrast
  g := ClampByte(0.299 * c.R + 0.587 * c.G + 0.114 * c.B);
  r.A := c.A;
  r.R := g; r.G := g; r.B := g;
end;
//------------------------------------------------------------------------------

function ClampRange(val, min, max: Integer): Integer;
begin
  if val < min then result := min
  else if val > max then result := max
  else result := val;
end;
//------------------------------------------------------------------------------

function ClampRange(val, min, max: double): double;
begin
  if val < min then result := min
  else if val > max then result := max
  else result := val;
end;
//------------------------------------------------------------------------------

procedure ScaleRect(var rec: TRect; x,y: double);
begin
  rec.Right := rec.Left + Round((rec.Right - rec.Left) * x);
  rec.Bottom := rec.Top + Round((rec.Bottom - rec.Top) * y);
end;
//------------------------------------------------------------------------------

function IncPColor32(pc: Pointer; cnt: Integer): PColor32;
begin
  result := PColor32(PByte(pc) + cnt * SizeOf(TColor32));
end;
//------------------------------------------------------------------------------

function PointD(const X, Y: Double): TPointD;
begin
  Result.X := X;
  Result.Y := Y;
end;
//------------------------------------------------------------------------------

function PointD(const pt: TPoint): TPointD;
begin
  Result.X := pt.X;
  Result.Y := pt.Y;
end;
//------------------------------------------------------------------------------

function GetBoolMask(img: TImage32; reference: TColor32;
  compareFunc: TCompareFunction; tolerance: Integer): TArrayOfByte;
var
  i: integer;
  pa: PByte;
  pc: PColor32;
begin
  result := nil;
  if not assigned(img) or img.IsEmpty then Exit;
  if not Assigned(compareFunc) then compareFunc := CompareRGB;
  SetLength(Result, img.Width * img.Height);
  pa := @Result[0];
  pc := img.PixelBase;
  for i := 0 to img.Width * img.Height -1 do
  begin
    if compareFunc(reference, pc^, tolerance) then
  {$IFDEF PBYTE}
      pa^ := 1 else
      pa^ := 0;
  {$ELSE}
      pa^ := #1 else
      pa^ := #0;
  {$ENDIF}
    inc(pc); inc(pa);
  end;
end;
//------------------------------------------------------------------------------

function GetAlphaEx(master, current: TColor32): Byte;
{$IFDEF INLINE} inline; {$ENDIF}
var
  curr: TARGB absolute current;
begin
  result := curr.A; //nb: 'master' is ignored
end;
//------------------------------------------------------------------------------

function GetByteMask(img: TImage32; reference: TColor32;
  compareFunc: TCompareFunctionEx): TArrayOfByte;
var
  i: integer;
  pa: PByte;
  pc: PColor32;
begin
  result := nil;
  if not assigned(img) or img.IsEmpty then Exit;
  if not Assigned(compareFunc) then compareFunc := GetAlphaEx;
  SetLength(Result, img.Width * img.Height);
  pa := @Result[0];
  pc := img.PixelBase;
  for i := 0 to img.Width * img.Height -1 do
  begin
    {$IFDEF PBYTE}
    pa^ := compareFunc(reference, pc^);
    {$ELSE}
    pa^ := Char(compareFunc(reference, pc^));
    {$ENDIF}
    inc(pc); inc(pa);
  end;
end;
//------------------------------------------------------------------------------

function RgbToHsl(color: TColor32): THsl;
var
  rgba: TARGB absolute color;
  hsl: THsl absolute result;
  r,g,b: byte;
  maxRGB, minRGB, mAdd, mSub: Integer;
begin
  //https://en.wikipedia.org/wiki/HSL_and_HSV and
  //http://en.wikipedia.org/wiki/HSL_color_space
{$IF DEFINED(ANDROID)}
  color := SwapRedBlue(color);
{$IFEND}

  r := rgba.R; g := rgba.G; b := rgba.B;
  maxRGB := Max(r, Max(g, b));
  minRGB := Min(r, Min(g, b));
  mAdd := maxRGB + minRGB;
  hsl.lum := mAdd shr 1;
  hsl.alpha := rgba.A;

  if maxRGB = minRGB then
  begin
    hsl.hue := 0; //hsl.hue is undefined when gray
    hsl.sat := 0;
    Exit;
  end;

  mSub := maxRGB - minRGB;
  if mAdd <= 255 then
    hsl.sat := DivTable[mSub, mAdd] else
    hsl.sat := DivTable[mSub, 511 - mAdd];

  mSub := mSub * 6;
  if r = maxRGB then
  begin
    if g >= b then
      hsl.hue := (g - b) * 255 div mSub else
      hsl.hue := 255 - ((b - g) * 255 div mSub);
  end
  else if G = maxRGB then
  begin
    if b > r then
      hsl.hue := 85 + (b - r) * 255 div mSub else
      hsl.hue := 85 - (r - b)  * 255 div mSub;
  end else
  begin
    if r > g then
      hsl.hue := 170 + (r - g)  * 255 div mSub else
      hsl.hue := 170 - (g - r)  * 255 div mSub;
  end;
end;
//------------------------------------------------------------------------------

function HslToRgb(hslColor: THsl): TColor32;
var
  rgba: TARGB absolute result;
  hsl: THsl absolute hslColor;
  c, x, m, a: Integer;
begin
  //formula from https://www.rapidtables.com/convert/color/hsl-to-rgb.html
  c := (255 - abs(2 * hsl.lum - 255)) * hsl.sat div 255;
  a := (hsl.hue mod 85) * 6 - 255;
  x := c * (255 - abs(a)) div 255;
  m := hsl.lum - c div 2;
  rgba.A := hsl.alpha;
  case (hsl.hue * 6) shr 8 of
    0: begin rgba.R := c + m; rgba.G := x + m; rgba.B := 0 + m; end;
    1: begin rgba.R := x + m; rgba.G := c + m; rgba.B := 0 + m; end;
    2: begin rgba.R := 0 + m; rgba.G := c + m; rgba.B := x + m; end;
    3: begin rgba.R := 0 + m; rgba.G := x + m; rgba.B := c + m; end;
    4: begin rgba.R := x + m; rgba.G := 0 + m; rgba.B := c + m; end;
    5: begin rgba.R := c + m; rgba.G := 0 + m; rgba.B := x + m; end;
  end;
{$IF DEFINED(ANDROID)}
  Result := SwapRedBlue(Result);
{$IFEND}
end;
//------------------------------------------------------------------------------

function AdjustHue(color: TColor32; percent: Integer): TColor32;
var
  hsl: THsl;
begin
  percent := percent mod 100;
  if percent < 0 then inc(percent, 100);
  hsl := RgbToHsl(color);
  hsl.hue := (hsl.hue + Round(percent*255/100)) mod 256;
  result := HslToRgb(hsl);
end;
//------------------------------------------------------------------------------

function ArrayOfColor32ToArrayHSL(const clr32Arr: TArrayOfColor32): TArrayofHSL;
var
  i, len: Integer;
begin
  len := length(clr32Arr);
  setLength(result, len);
  for i := 0 to len -1 do
    result[i] := RgbToHsl(clr32Arr[i]);
end;
//------------------------------------------------------------------------------

function ArrayOfHSLToArrayColor32(const hslArr: TArrayofHSL): TArrayOfColor32;
var
  i, len: Integer;
begin
  len := length(hslArr);
  setLength(result, len);
  for i := 0 to len -1 do
    result[i] := HslToRgb(hslArr[i]);
end;
//------------------------------------------------------------------------------

function NameToId(Name: PChar): Longint;
begin
  if Cardinal(PWord(Name)) < 30 then
  begin
    Result := Cardinal(PWord(Name))
  end else
  begin
    if Name^ = '#' then inc(Name);
    Result := StrToIntDef(Name, 0);
    if Result > 65535 then Result := 0;
  end;
end;
//------------------------------------------------------------------------------

function CreateResourceStream(const resName: string;
  resType: PChar): TResourceStream;
var
  nameId, typeId: Cardinal;
begin
  Result := nil;
  typeId := NameToId(resType);
  if (typeId > 0) then resType := PChar(typeId)
  else if (resType = 'BMP') then resType := RT_BITMAP;

  nameId := NameToId(PChar(resName));
  if nameId > 0 then
  begin
    if FindResource(hInstance, PChar(nameId), resType) <> 0 then
      Result := TResourceStream.CreateFromID(hInstance, nameId, resType);
  end else
  begin
    if FindResource(hInstance, PChar(resName), resType) <> 0 then
      Result := TResourceStream.Create(hInstance, PChar(resName), resType);
  end;
end;

//------------------------------------------------------------------------------
// TRectD methods (and helpers)
//------------------------------------------------------------------------------

function TRectD.IsEmpty: Boolean;
begin
  result := (right <= left) or (bottom <= top);
end;
//------------------------------------------------------------------------------

function TRectD.Width: double;
begin
  result := Max(0, right - left);
end;
//------------------------------------------------------------------------------

function TRectD.Height: double;
begin
  result := Max(0, bottom - top);
end;
//------------------------------------------------------------------------------

function TRectD.MidPoint: TPointD;
begin
  Result.X := (Right + Left)/2;
  Result.Y := (Bottom + Top)/2;
end;
//------------------------------------------------------------------------------

{$IFNDEF RECORD_METHODS}
function TRectD.TopLeft: TPointD;
begin
  Result.X := Left;
  Result.Y := Top;
end;
//------------------------------------------------------------------------------

function TRectD.BottomRight: TPointD;
begin
  Result.X := Right;
  Result.Y := Bottom;
end;
//------------------------------------------------------------------------------
{$ENDIF}

function TRectD.Normalize: Boolean;
var
  d: double;
begin
  Result := false;
  if Left > Right then
  begin
    d := Left;
    Left := Right;
    Right := d;
    Result := True;
  end;
  if Top > Bottom then
  begin
    d := Top;
    Top := Bottom;
    Bottom := d;
    Result := True;
  end;
end;
//------------------------------------------------------------------------------

function TRectD.Contains(const Pt: TPoint): Boolean;
begin
  Result := (pt.X >= Left) and (pt.X < Right) and
    (pt.Y >= Top) and (pt.Y < Bottom);
end;
//------------------------------------------------------------------------------

function TRectD.Contains(const Pt: TPointD): Boolean;
begin
  Result := (pt.X >= Left) and (pt.X < Right) and
    (pt.Y >= Top) and (pt.Y < Bottom);
end;
//------------------------------------------------------------------------------

function RectD(left, top, right, bottom: double): TRectD;
begin
  result.Left := left;
  result.Top := top;
  result.Right := right;
  result.Bottom := bottom;
end;
//------------------------------------------------------------------------------

function RectD(const rec: TRect): TRectD;
begin
  with rec do
  begin
    result.Left := left;
    result.Top := top;
    result.Right := right;
    result.Bottom := bottom;
  end;
end;

//------------------------------------------------------------------------------
// TImage32 methods
//------------------------------------------------------------------------------

constructor TImage32.Create(width: Integer; height: Integer);
begin
  fAntiAliased := true;
  fResampler := DefaultResampler;
  fwidth := Max(0, width);
  fheight := Max(0, height);
  SetLength(fPixels, fwidth * fheight);
end;
//------------------------------------------------------------------------------

constructor TImage32.Create(src: TImage32);
begin
  Assign(src);
end;
//------------------------------------------------------------------------------

constructor TImage32.Create(src: TImage32; const srcRec: TRect);
var
  rec: TRect;
begin
  fAntiAliased := src.AntiAliased;
  fResampler := src.fResampler;
  types.IntersectRect(rec, src.Bounds, srcRec);
  RectWidthHeight(rec, fWidth, fHeight);
  SetLength(fPixels, fWidth * fHeight);
  if (fWidth = 0) or (fheight = 0) then Exit;
  fPixels := src.CopyPixels(srcRec);
end;
//------------------------------------------------------------------------------

destructor TImage32.Destroy;
begin
  fPixels := nil;
  inherited;
end;
//------------------------------------------------------------------------------

class function TImage32.IsRegisteredFormat(const ext: string): Boolean;
begin
  result := Assigned(TImage32.GetImageFormatClass(ext));
end;
//------------------------------------------------------------------------------

class procedure TImage32.RegisterImageFormatClass(ext: string;
  bm32ExClass: TImageFormatClass; clipPriority: TClipboardPriority);
var
  i: Integer;
  imgFmtRec: PImgFmtRec;
  isNewFormat: Boolean;
begin
  if not Assigned(ImageFormatClassList) then CreateImageFormatList;

  if (ext = '') or (ext = '.') then Exit;
  if (ext[1] = '.') then Delete(ext, 1,1);
  if not IsAlphaChar(ext[1]) then Exit;
  isNewFormat := true;

  // avoid duplicates but still allow overriding
  for i := 0 to imageFormatClassList.count -1 do
  begin
    imgFmtRec := PImgFmtRec(imageFormatClassList[i]);
    if SameText(imgFmtRec.Fmt, ext) then
    begin
      imgFmtRec.Obj := bm32ExClass; // replace prior class
      if imgFmtRec.SortOrder = clipPriority then
        Exit; // re-sorting isn't required
      imgFmtRec.SortOrder := clipPriority;
      isNewFormat := false;
      Break;
    end;
  end;

  if isNewFormat then
  begin
    new(imgFmtRec);
    imgFmtRec.Fmt := ext;
    imgFmtRec.SortOrder := clipPriority;
    imgFmtRec.Obj := bm32ExClass;
    ImageFormatClassList.Add(imgFmtRec);
  end;

  // Sort with lower priority before higher.
  // Sorting here is arguably inefficient but, with so few
  // entries, this inefficiency will be inconsequential.

{$IFDEF XPLAT_GENERICS}
  ImageFormatClassList.Sort(TComparer<PImgFmtRec>.Construct(
      function(const imgFmtRec1, imgFmtRec2: PImgFmtRec): Integer
      begin
        Result := Integer(imgFmtRec1.SortOrder) - Integer(imgFmtRec2.SortOrder);
      end));
{$ELSE}
  ImageFormatClassList.Sort(ImageFormatClassListSort);
{$ENDIF}
end;
//------------------------------------------------------------------------------

class function TImage32.GetImageFormatClass(const ext: string): TImageFormatClass;
var
  i: Integer;
  pattern: string;
  imgFmtRec: PImgFmtRec;
begin
  Result := nil;
  pattern := ext;
  if (pattern = '')  or (pattern = '.') then Exit;
  if pattern[1] = '.' then Delete(pattern, 1,1);

  //try for highest priority first
  for i := imageFormatClassList.count -1 downto 0 do
  begin
    imgFmtRec := PImgFmtRec(imageFormatClassList[i]);
    if not SameText(imgFmtRec.Fmt, pattern) then Continue;
    Result := imgFmtRec.Obj;
    break;
  end;
end;
//------------------------------------------------------------------------------

class function TImage32.GetImageFormatClass(stream: TStream): TImageFormatClass;
var
  i: integer;
begin
  Result := nil;
  for i := 0 to imageFormatClassList.count -1 do
    with PImgFmtRec(imageFormatClassList[i])^ do
      if Obj.IsValidImageStream(stream) then
      begin
        Result := Obj;
        break;
      end;
end;
//------------------------------------------------------------------------------


procedure TImage32.Assign(src: TImage32);
begin
  if assigned(src) then
    src.AssignTo(self);
end;
//------------------------------------------------------------------------------

procedure TImage32.AssignTo(dst: TImage32);
begin
  if dst = self then Exit;
  dst.BeginUpdate;
  try
    dst.fResampler := fResampler;
    dst.fIsPremultiplied := fIsPremultiplied;
    dst.fAntiAliased := fAntiAliased;
    dst.fColorCount := 0;
    try
      dst.SetSize(Width, Height);
      if (Width > 0) and (Height > 0) then
        move(fPixels[0], dst.fPixels[0], Width * Height * SizeOf(TColor32));
    except
      dst.SetSize(0,0);
    end;
  finally
    dst.EndUpdate;
  end;
end;
//------------------------------------------------------------------------------

procedure TImage32.Changed;
begin
  if fUpdateCnt <> 0 then Exit;
  fColorCount := 0;
  if Assigned(fOnChange) then fOnChange(Self);
end;
//------------------------------------------------------------------------------

procedure TImage32.Resized;
begin
  if fUpdateCnt <> 0 then Exit
  else if Assigned(fOnResize) then fOnResize(Self)
  else Changed;
end;
//------------------------------------------------------------------------------

procedure TImage32.BeginUpdate;
begin
  if fNotifyBlocked then Exit;
  inc(fUpdateCnt);
end;
//------------------------------------------------------------------------------

procedure TImage32.EndUpdate;
begin
  if fNotifyBlocked then Exit;
  dec(fUpdateCnt);
  if fUpdateCnt = 0 then Changed;
end;
//------------------------------------------------------------------------------

procedure TImage32.BlockNotify;
begin
  if fUpdateCnt <> 0 then Exit;
  inc(fUpdateCnt);
  fNotifyBlocked := true;
end;
//------------------------------------------------------------------------------

procedure TImage32.UnblockNotify;
begin
  if not fNotifyBlocked then Exit;
  dec(fUpdateCnt);
  fNotifyBlocked := false;
end;
//------------------------------------------------------------------------------

procedure TImage32.SetBackgroundColor(bgColor: TColor32);
var
  i: Integer;
  pc: PColor32;
begin
  pc := Pixelbase;
  for i := 0 to high(fPixels) do
  begin
    pc^ := BlendToOpaque(bgColor, pc^);
     inc(pc);
  end;
  Changed;
end;
//------------------------------------------------------------------------------

procedure TImage32.Clear(color: TColor32);
var
  i: Integer;
  pc: PColor32;
begin
  fIsPremultiplied := false;
  if IsEmpty then Exit;
  if color = clNone32 then
    FillChar(fPixels[0], Width * Height * SizeOf(TColor32), 0)
  else
  begin
    pc := PixelBase;
    for i := 0 to Width * Height -1 do
    begin
      pc^ := color;
      inc(pc);
    end;
  end;
  Changed;
end;
//------------------------------------------------------------------------------

procedure TImage32.Clear(const rec: TRect; color: TColor32 = 0);
begin
  FillRect(rec, color);
end;
//------------------------------------------------------------------------------

procedure TImage32.FillRect(rec: TRect; color: TColor32);
var
  i,j, rw: Integer;
  c: PColor32;
begin
  Types.IntersectRect(rec, rec, bounds);
  if IsEmptyRect(rec) then Exit;
  rw := RectWidth(rec);
  c := @Pixels[rec.Top * Width + rec.Left];
  for i := rec.Top to rec.Bottom -1 do
  begin
    for j := 1 to rw do
    begin
      c^ := color;
      inc(c);
    end;
    inc(c, Width - rw);
  end;
  Changed;
end;
//------------------------------------------------------------------------------

function TImage32.RectHasTransparency(rec: TRect): Boolean;
var
  i,j, rw: Integer;
  c: PARGB;
begin
  Result := True;
  Types.IntersectRect(rec, rec, bounds);
  if IsEmptyRect(rec) then Exit;
  rw := RectWidth(rec);
  c := @Pixels[rec.Top * Width + rec.Left];
  for i := rec.Top to rec.Bottom -1 do
  begin
    for j := 1 to rw do
    begin
      if c.A < 254 then Exit;
      inc(c);
    end;
    inc(c, Width - rw);
  end;
  Result := False;
end;
//------------------------------------------------------------------------------

procedure CheckBlendFill(pc: PColor32; color: TColor32);
{$IFDEF INLINE} inline; {$ENDIF}
begin
  if not assigned(pc) then Exit;
  pc^ := BlendToAlpha(pc^, color);
end;
//------------------------------------------------------------------------------

function TImage32.CopyPixels(rec: TRect): TArrayOfColor32;
var
  i, clipW, w,h: Integer;
  pSrc, pDst, pDst2: PColor32;
  recClipped: TRect;
begin
  RectWidthHeight(rec, w,h);
  setLength(result, w * h);

  if w * h = 0 then Exit;
  Types.IntersectRect(recClipped, rec, Bounds);
  //if recClipped is wholely outside the bounds of the image ...
  if IsEmptyRect(recClipped) then
  begin
    //rec is considered valid even when completely outside the image bounds,
    //and so when that happens we simply return a fully transparent image ...
    FillChar(Result[0], w * h * SizeOf(TColor32), 0);
    Exit;
  end;

  //if recClipped is wholely within the bounds of the image ...
  if RectsEqual(recClipped, rec) then
  begin
    pDst := @Result[0];
    pSrc := @fPixels[recClipped.Top * Width + rec.Left];
    for i := recClipped.Top to recClipped.Bottom -1 do
    begin
      Move(pSrc^, pDst^, w * SizeOf(TColor32));
      inc(pSrc, Width); inc(pDst, w);
    end;
    Exit;
  end;

  //a part of 'rec' must be outside the bounds of the image ...

  pDst := @Result[0];
  for i := rec.Top to -1 do
  begin
    FillChar(pDst^, w * SizeOf(TColor32), 0);
    inc(pDst, w);
  end;
  pSrc := @fPixels[recClipped.Top * Width + Max(0,rec.Left)];
  if (rec.Left < 0) or (rec.Right > Width) then
  begin
    clipW := RectWidth(recClipped);
    pDst2 := IncPColor32(pDst, -Min(0, rec.Left));
    for i := recClipped.Top to recClipped.Bottom -1 do
    begin
      //when rec.left < 0 or rec.right > width it's simplest to
      //start with a prefilled row of transparent pixels
      FillChar(pDst^, w * SizeOf(TColor32), 0);
      Move(pSrc^, pDst2^, clipW * SizeOf(TColor32));
      inc(pDst, w); inc(pDst2, w); inc(pSrc, Width);
    end;
  end else
  begin
    //things are simpler when there's no part of 'rec' is
    //outside the image, at least not on the left or right sides ...
    for i := recClipped.Top to recClipped.Bottom -1 do
    begin
      Move(pSrc^, pDst^, w * SizeOf(TColor32));
      inc(pSrc, Width); inc(pDst, w);
    end;
  end;
  for i := Height to rec.Bottom -1 do
  begin
    FillChar(pDst^, w * SizeOf(TColor32), 0);
    inc(pDst, w);
  end;
end;
//------------------------------------------------------------------------------

procedure TImage32.Crop(const rec: TRect);
var
  newPixels: TArrayOfColor32;
  w,h: integer;
begin
  RectWidthHeight(rec, w, h);
  if (w = Width) and (h = Height) then Exit;
  newPixels := CopyPixels(rec);
  BlockNotify;
  try
    SetSize(w, h);
    if not IsEmptyRect(rec) then
      fPixels := newPixels;
  finally
    UnblockNotify;
  end;
  Resized;
end;
//------------------------------------------------------------------------------

function TImage32.GetBounds: TRect;
begin
  result := Types.Rect(0, 0, Width, Height);
end;
//------------------------------------------------------------------------------

function TImage32.GetMidPoint: TPointD;
begin
  Result := PointD(fWidth * 0.5, fHeight * 0.5);
end;
//------------------------------------------------------------------------------

procedure TImage32.SetSize(newWidth, newHeight: Integer; color: TColor32);
begin
  //very large images are usually due to a bug
  if (newWidth > 20000) or (newHeight > 20000) then
    raise Exception.Create(rsImageTooLarge);
  fwidth := Max(0, newWidth);
  fheight := Max(0, newHeight);
  fPixels := nil; //forces a blank image
  SetLength(fPixels, fwidth * fheight);
  fIsPremultiplied := false;
  if color > 0 then
  begin
    BlockNotify;
    Clear(color);
    UnblockNotify;
  end;
  Resized;
end;
//------------------------------------------------------------------------------

procedure TImage32.Resize(newWidth, newHeight: Integer; stretchImage: Boolean);
var
  tmp: TImage32;
  rec: TRect;
begin

  if (newWidth <= 0) or (newHeight <= 0) then
  begin
    SetSize(0, 0);
    Exit;
  end
  else if (newWidth = fwidth) and (newHeight = fheight) then
  begin
    Exit
  end
  else if IsEmpty then
  begin
    SetSize(newWidth, newHeight);
    Exit;
  end;

  BlockNotify;
  try
    if stretchImage then
    begin
      if fResampler = 0 then
        NearestNeighborResize(newWidth, newHeight)
      else
        ResamplerResize(newWidth, newHeight);
    end else
    begin
      tmp := TImage32.create(self);
      try
        rec := Bounds;
        SetSize(newWidth, newHeight, clNone32);
        Copy(tmp, rec, rec); //this will clip as required.
      finally
        tmp.Free;
      end;
    end;
  finally
    UnblockNotify;
  end;
  Resized;
end;
//------------------------------------------------------------------------------

procedure TImage32.NearestNeighborResize(newWidth, newHeight: Integer);
var
  x, y, srcY: Integer;
  scaledXi, scaledYi: TArrayOfInteger;
  tmp: TArrayOfColor32;
  pc: PColor32;
begin
  //this NearestNeighbor code is slightly more efficient than
  //the more general purpose one in Img32.Resamplers

  if (newWidth = fWidth) and (newHeight = fHeight) then Exit;
  SetLength(tmp, newWidth * newHeight * SizeOf(TColor32));

  //get scaled X & Y values once only (storing them in lookup arrays) ...
  SetLength(scaledXi, newWidth);
  for x := 0 to newWidth -1 do
    scaledXi[x] := Floor(x * fWidth / newWidth);
  SetLength(scaledYi, newHeight);
  for y := 0 to newHeight -1 do
    scaledYi[y] := Floor(y * fHeight / newHeight);

  pc := @tmp[0];
  for y := 0 to newHeight - 1 do
  begin
    srcY := scaledYi[y];
    if (srcY < 0) or (srcY >= fHeight) then Continue;
    for x := 0 to newWidth - 1 do
    begin
      pc^ := fPixels[scaledXi[x] + srcY * fWidth];
      inc(pc);
    end;
  end;

  fPixels := tmp;
  fwidth := newWidth;
  fheight := newHeight;
end;
//------------------------------------------------------------------------------

procedure TImage32.ResamplerResize(newWidth, newHeight: Integer);
var
  mat: TMatrixD;
begin
  mat := IdentityMatrix;
  MatrixScale(mat, newWidth/fWidth, newHeight/fHeight);
  AffineTransformImage(self, mat);
end;
//------------------------------------------------------------------------------

procedure TImage32.Scale(s: double);
begin
  Scale(s, s);
end;
//------------------------------------------------------------------------------

procedure TImage32.Scale(sx, sy: double);
begin
  //sx := Min(sx, 100); sy := Min(sy, 100);
  if (sx > 0) and (sy > 0) then
    ReSize(Round(width * sx), Round(height * sy));
end;
//------------------------------------------------------------------------------

procedure TImage32.ScaleToFit(width, height: integer);
var
  sx, sy: double;
begin
  if IsEmpty or (width <= 0) or (height <= 0) then Exit;
  sx := width / self.Width;
  sy := height / self.Height;
  if sx <= sy then
    Scale(sx) else
    Scale(sy);
end;
//------------------------------------------------------------------------------

procedure TImage32.ScaleToFitCentered(const rect: TRect);
begin
  ScaleToFitCentered(RectWidth(rect), RectHeight(rect));
end;
//------------------------------------------------------------------------------

procedure TImage32.ScaleToFitCentered(width, height: integer);
var
  sx, sy: double;
  tmp: TImage32;
  rec2: TRect;
begin
  if IsEmpty or (width <= 0) or (height <= 0) or
    ((width = self.Width) and (height = self.Height)) then Exit;

  sx := width / self.Width;
  sy := height / self.Height;
  BlockNotify;
  try
    if sx <= sy then
    begin
      Scale(sx);
      if height = self.Height then Exit;
      rec2 := Bounds;
      Types.OffsetRect(rec2, 0, (height - self.Height) div 2);
      tmp := TImage32.Create(self);
      try
        SetSize(width, height);
        CopyInternal(tmp, tmp.Bounds, rec2, nil);
      finally
        tmp.Free;
      end;
    end else
    begin
      Scale(sy);
      if width = self.Width then Exit;
      rec2 := Bounds;
      Types.OffsetRect(rec2, (width - self.Width) div 2, 0);
      tmp := TImage32.Create(self);
      try
        SetSize(width, height);
        CopyInternal(tmp, tmp.Bounds, rec2, nil);
      finally
        tmp.Free;
      end;
    end;
  finally
    UnblockNotify;
  end;
  Resized;
end;
//------------------------------------------------------------------------------

procedure TImage32.RotateLeft90;
var
  x,y, xx: Integer;
  src, dst: PColor32;
  tmp: TImage32;
begin
  if IsEmpty then Exit;

  BeginUpdate;
  tmp := TImage32.create(Self);
  try
    SetSize(Height, Width);
    xx := (width - 1) * Height;
    dst := PixelBase;
    for y := 0 to Height -1 do
    begin
      src := @tmp.Pixels[xx + y];
      for x := 0 to Width -1 do
      begin
        dst^ := src^;
        inc(dst); dec(src, Height);
      end;
    end;
  finally
    tmp.Free;
    EndUpdate;
  end;
end;
//------------------------------------------------------------------------------

procedure TImage32.RotateRight90;
var
  x,y: Integer;
  src, dst: PColor32;
  tmp: TImage32;
begin
  if IsEmpty then Exit;

  BeginUpdate;
  tmp := TImage32.create(Self);
  try
    SetSize(Height, Width);
    dst := PixelBase;
    for y := 0 to Height -1 do
    begin
      src := @tmp.Pixels[Height -1 - y];
      for x := 0 to Width -1 do
      begin
        dst^ := src^;
        inc(dst); inc(src, Height);
      end;
    end;
  finally
    tmp.Free;
    EndUpdate;
  end;
end;
//------------------------------------------------------------------------------

procedure TImage32.Rotate180;
var
  x,y: Integer;
  src, dst: PColor32;
  tmp: TImage32;
begin
  if IsEmpty then Exit;
  tmp := TImage32.create(Self);
  try
    dst := PixelBase;
    src := @tmp.Pixels[Width * Height -1];
    for y := 0 to Height -1 do
    begin
      for x := 0 to Width -1 do
      begin
        dst^ := src^;
        inc(dst); dec(src);
      end;
    end;
  finally
    tmp.Free;
  end;
  Changed;
end;
//------------------------------------------------------------------------------

function TImage32.GetColorCount: Integer;
var
  allColors: PByteArray;
  i: Integer;
  c: PColor32;
const
  cube256 = 256 * 256 * 256;
begin
  result := 0;
  if IsEmpty then Exit;
  if fColorCount > 0 then
  begin
    result := fColorCount;
    Exit;
  end;
  //because 'allColors' uses quite a chunk of memory, it's
  //allocated on the heap rather than the stack
  allColors := AllocMem(cube256); //nb: zero initialized
  try
    c := PixelBase;
    for i := 0 to Width * Height -1 do
    begin
      //ignore colors with signifcant transparency
      if GetAlpha(c^)  > $80 then
        allColors[c^ and $FFFFFF] := 1;
      inc(c);
    end;
    for i := 0 to cube256 -1 do
      if allColors[i] = 1 then inc(Result);
  finally
    FreeMem(allColors);
  end;
  fColorCount := Result; //avoids repeating the above unnecessarily
end;
//------------------------------------------------------------------------------

function TImage32.GetHasTransparency: Boolean;
var
  i: Integer;
  pc: PARGB;
begin
  result := true;
  If IsEmpty then Exit;
  pc := PARGB(PixelBase);
  for i := 0 to Width * Height -1 do
  begin
    if pc.A < 255 then Exit;
    inc(pc);
  end;
  result := false;
end;
//------------------------------------------------------------------------------

function TImage32.SaveToFile(filename: string): Boolean;
var
  fileFormatClass: TImageFormatClass;
begin
  result := false;
  if IsEmpty or (length(filename) < 5) then Exit;
  //use the process's current working directory if no path supplied ...
  if ExtractFilePath(filename) = '' then
    filename := GetCurrentDir + '\'+ filename;
  fileFormatClass := GetImageFormatClass(ExtractFileExt(filename));
  if assigned(fileFormatClass) then
    with fileFormatClass.Create do
    try
      result := SaveToFile(filename, self);
    finally
      free;
    end;
end;
//------------------------------------------------------------------------------

function TImage32.SaveToStream(stream: TStream; const FmtExt: string): Boolean;
var
  fileFormatClass: TImageFormatClass;
begin
  result := false;
  fileFormatClass := GetImageFormatClass(FmtExt);
  if assigned(fileFormatClass) then
    with fileFormatClass.Create do
    try
      SaveToStream(stream, self);
      result := true;
    finally
      free;
    end;
end;
//------------------------------------------------------------------------------

function TImage32.LoadFromFile(const filename: string): Boolean;
var
  stream: TFileStream;
begin
  Result := false;
  if not FileExists(filename) then Exit;

  stream := TFileStream.Create(filename, fmOpenRead or fmShareDenyNone);
  try
    result := LoadFromStream(stream);
  finally
    stream.Free;
  end;
end;
//------------------------------------------------------------------------------

function TImage32.LoadFromStream(stream: TStream): Boolean;
var
  ifc: TImageFormatClass;
begin
  ifc := GetImageFormatClass(stream);
  Result := Assigned(ifc);
  if not Result then Exit;

  with ifc.Create do
  try
    result := LoadFromStream(stream, self);
  finally
    free;
  end;
end;
//------------------------------------------------------------------------------

function TImage32.GetPixel(x, y: Integer): TColor32;
begin
  if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then
    result := clNone32 else
    result := fPixels[y * width + x];
end;
//------------------------------------------------------------------------------

procedure TImage32.SetPixel(x,y: Integer; color: TColor32);
begin
  if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then Exit;
  fPixels[y * width + x] := color;
  //nb: no notify event here
end;
//------------------------------------------------------------------------------

function TImage32.GetIsBlank: Boolean;
var
  i: integer;
  pc: PARGB;
begin
  result := IsEmpty;
  if result then Exit;
  pc := PARGB(PixelBase);
  for i := 0 to width * height -1 do
  begin
    if pc.A > 0 then Exit;
    inc(pc);
  end;
  result := true;
end;
//------------------------------------------------------------------------------

function TImage32.GetIsEmpty: Boolean;
begin
  result := fPixels = nil;
end;
//------------------------------------------------------------------------------

function TImage32.GetPixelBase: PColor32;
begin
  if IsEmpty then result := nil
  else result := @fPixels[0];
end;
//------------------------------------------------------------------------------

function TImage32.GetPixelRow(row: Integer): PColor32;
begin
  if IsEmpty then result := nil
  else result := @fPixels[row * Width];
end;
//------------------------------------------------------------------------------

procedure TImage32.CopyInternal(src: TImage32;
  const srcRec, dstRec: TRect; blendFunc: TBlendFunction);
var
  i, j, srcRecWidth, srcRecHeight: Integer;
  s, d: PColor32;
begin
  // occasionally, due to rounding, srcRec and dstRec
  // don't have exactly the same widths and heights, so ...
  srcRecWidth :=
    Min(srcRec.Right - srcRec.Left, dstRec.Right - dstRec.Left);
  srcRecHeight :=
    Min(srcRec.Bottom - srcRec.Top, dstRec.Bottom - dstRec.Top);

  s := @src.Pixels[srcRec.Top * src.Width + srcRec.Left];
  d := @Pixels[dstRec.top * Width + dstRec.Left];

  if assigned(blendFunc) then
    for i := srcRec.Top to srcRec.Top + srcRecHeight -1 do
    begin
      for j := 1 to srcRecWidth do
      begin
        d^ := blendFunc(d^, s^);
        inc(s); inc(d);
      end;
      inc(s, src.Width - srcRecWidth);
      inc(d, Width - srcRecWidth);
    end
  else
    //simply overwrite src with dst (ie without blending)
    for i := srcRec.Top to srcRec.Top + srcRecHeight -1 do
    begin
      move(s^, d^, srcRecWidth * SizeOf(TColor32));
      inc(s, src.Width);
      inc(d, Width);
    end;
end;
//------------------------------------------------------------------------------

function TImage32.Copy(src: TImage32; srcRec, dstRec: TRect): Boolean;
begin
  Result := CopyBlend(src, srcRec, dstRec, nil);
end;
//------------------------------------------------------------------------------

function TImage32.CopyBlend(src: TImage32; srcRec, dstRec: TRect;
  blendFunc: TBlendFunction): Boolean;
var
  tmp: TImage32;
  srcRecClipped, dstRecClipped, r: TRect;
  scaleX, scaleY: double;
  w,h, dstW,dstH, srcW,srcH: integer;
begin
  result := false;
  if IsEmptyRect(srcRec) or IsEmptyRect(dstRec) then Exit;
  Types.IntersectRect(srcRecClipped, srcRec, src.Bounds);

  //get the scaling amount (if any) before
  //dstRec might be adjusted due to clipping ...
  RectWidthHeight(dstRec, dstW, dstH);
  RectWidthHeight(srcRec, srcW, srcH);

  //watching out for insignificant scaling
  if Abs(dstW - srcW) < 2 then
     scaleX := 1 else
     scaleX := dstW / srcW;
  if Abs(dstH - srcH) < 2 then
     scaleY := 1 else
     scaleY := dstH / srcH;

  //check if the source rec has been clipped ...
  if not RectsEqual(srcRecClipped, srcRec) then
  begin
    if IsEmptyRect(srcRecClipped) then Exit;
    //the source has been clipped so clip the destination too ...
    RectWidthHeight(srcRecClipped, w, h);
    RectWidthHeight(srcRec, srcW, srcH);
    ScaleRect(dstRec, w / srcW, h / srcH);
    Types.OffsetRect(dstRec,
      srcRecClipped.Left - srcRec.Left,
      srcRecClipped.Top - srcRec.Top);
  end;

  if (scaleX <> 1.0) or (scaleY <> 1.0) then
  begin
    //scale source (tmp) to the destination then call CopyBlend() again ...
    tmp := TImage32.Create(src, srcRecClipped);
    try
      tmp.Scale(scaleX, scaleY);
      result := CopyBlend(tmp, tmp.Bounds, dstRec, blendFunc);
    finally
      tmp.Free;
    end;
    Exit;
  end;

  Types.IntersectRect(dstRecClipped, dstRec, Bounds);
  if IsEmptyRect(dstRecClipped) then Exit;

  //there's no scaling if we get here, but further clipping may be needed if
  //the destination rec is partially outside the destination image's bounds

  if not RectsEqual(dstRecClipped, dstRec) then
  begin
    //the destination rec has been clipped so clip the source too ...
    RectWidthHeight(dstRecClipped, w, h);
    RectWidthHeight(dstRec, dstW, dstH);
    ScaleRect(srcRecClipped, w / dstW, h / dstH);
    Types.OffsetRect(srcRecClipped,
      dstRecClipped.Left - dstRec.Left,
      dstRecClipped.Top - dstRec.Top);
  end;

  //when copying to self and srcRec & dstRec overlap then
  //copy srcRec to a temporary image and use it as the source ...
  if (src = self) and Types.IntersectRect(r, srcRecClipped, dstRecClipped) then
  begin
    tmp := TImage32.Create(self, srcRecClipped);
    try
      result := src.CopyBlend(tmp, tmp.Bounds, dstRecClipped, blendFunc);
    finally
      tmp.Free;
    end;
    Exit;
  end;

  CopyInternal(src, srcRecClipped, dstRecClipped, blendFunc);
  result := true;
  Changed;
end;
//------------------------------------------------------------------------------

function TImage32.LoadFromResource(const resName: string; resType: PChar): Boolean;
var
  resStream: TResourceStream;
begin
  resStream := CreateResourceStream(resName, resType);
  try
    Result := assigned(resStream) and
      LoadFromStream(resStream);
  finally
    resStream.Free;
  end;
end;
//------------------------------------------------------------------------------

{$IFDEF MSWINDOWS}
procedure TImage32.CopyFromDC(srcDc: HDC; const srcRect: TRect);
var
  bi: TBitmapInfoHeader;
  bm, oldBm: HBitmap;
  dc, memDc: HDC;
  pixels: Pointer;
  w,h: integer;
begin
  BeginUpdate;
  try
    RectWidthHeight(srcRect, w,h);
    SetSize(w, h);
    bi := Get32bitBitmapInfoHeader(w, h);
    dc := GetDC(0);
    memDc := CreateCompatibleDC(dc);
    try
      bm := CreateDIBSection(dc,
        PBITMAPINFO(@bi)^, DIB_RGB_COLORS, pixels, 0, 0);
      if bm = 0 then Exit;
      try
        oldBm := SelectObject(memDc, bm);
        BitBlt(memDc, 0, 0, w, h, srcDc, srcRect.Left,srcRect.Top, SRCCOPY);
        Move(pixels^, fPixels[0], w * h * sizeOf(TColor32));
        SelectObject(memDc, oldBm);
      finally
        DeleteObject(bm);
      end;
    finally
      DeleteDc(memDc);
      ReleaseDc(0, dc);
    end;
    if IsBlank then SetAlpha(255);
    FlipVertical;
  finally
    EndUpdate;
  end;
end;
//------------------------------------------------------------------------------

procedure TImage32.CopyToDc(dstDc: HDC; x,y: Integer; transparent: Boolean);
begin
  CopyToDc(Bounds, Types.Rect(x,y, x+Width, y+Height),
    dstDc, transparent);
end;
//------------------------------------------------------------------------------

procedure TImage32.CopyToDc(const srcRect: TRect; dstDc: HDC;
  x: Integer = 0; y: Integer = 0; transparent: Boolean = true);
var
  recW, recH: integer;
begin
  RectWidthHeight(srcRect, recW, recH);
  CopyToDc(srcRect, Types.Rect(x,y, x+recW, y+recH), dstDc, transparent);
end;
//------------------------------------------------------------------------------

procedure TImage32.CopyToDc(const srcRect, dstRect: TRect;
  dstDc: HDC; transparent: Boolean = true);
var
  i, x,y, wSrc ,hSrc, wDest, hDest: integer;
  rec: TRect;
  bi: TBitmapInfoHeader;
  bm, oldBm: HBitmap;
  dibBits: Pointer;
  pc: PARGB;
  memDc: HDC;
  isTransparent: Boolean;
  bf: BLENDFUNCTION;
begin
  Types.IntersectRect(rec, srcRect, Bounds);
  if IsEmpty or IsEmptyRect(rec) or IsEmptyRect(dstRect) then Exit;
  RectWidthHeight(rec, wSrc, hSrc);
  RectWidthHeight(dstRect, wDest, hDest);
  x := dstRect.Left;
  y := dstRect.Top;
  inc(x, rec.Left - srcRect.Left);
  inc(y, rec.Top - srcRect.Top);

  bi := Get32bitBitmapInfoHeader(wSrc, hSrc);

  isTransparent := transparent and RectHasTransparency(srcRect);
  memDc := CreateCompatibleDC(0);
  try
    bm := CreateDIBSection(memDc, PBITMAPINFO(@bi)^,
      DIB_RGB_COLORS, dibBits, 0, 0);
    if bm = 0 then Exit;

    try
      //copy Image to dibBits (with vertical flip)
      pc := dibBits;
      for i := rec.Bottom -1 downto rec.Top do
      begin
        Move(Pixels[i * Width + rec.Left], pc^, wSrc * SizeOf(TColor32));
        inc(pc, wSrc);
      end;

      oldBm := SelectObject(memDC, bm);
      if isTransparent then
      begin

        //premultiplied alphas are required when alpha blending
        pc := dibBits;
        for i := 0 to wSrc * hSrc -1 do
        begin
          if pc.A > 0 then
          begin
            pc.R  := MulTable[pc.R, pc.A];
            pc.G  := MulTable[pc.G, pc.A];
            pc.B  := MulTable[pc.B, pc.A];
          end else
            pc.Color := 0;
          inc(pc);
        end;

        bf.BlendOp := AC_SRC_OVER;
        bf.BlendFlags := 0;
        bf.SourceConstantAlpha := 255;
        bf.AlphaFormat := AC_SRC_ALPHA;
        AlphaBlend(dstDc, x,y, wDest,hDest, memDC, 0,0, wSrc,hSrc, bf);
      end
      else if (wDest = wSrc) and (hDest = hSrc) then
        BitBlt(dstDc, x,y, wSrc, hSrc, memDc, 0,0, SRCCOPY)
      else
        StretchBlt(dstDc, x,y, wDest, hDest, memDc, 0,0, wSrc,hSrc, SRCCOPY);

      SelectObject(memDC, oldBm);
    finally
      DeleteObject(bm);
    end;
  finally
    DeleteDc(memDc);
  end;
end;
//------------------------------------------------------------------------------
{$ENDIF}

function TImage32.CopyToClipBoard: Boolean;
var
  i: Integer;
  formatClass: TImageFormatClass;
begin
  //Sadly with CF_DIB (and even CF_DIBV5) clipboard formats, transparency is
  //usually lost, so we'll copy all available formats including CF_PNG, that
  //is if it's registered.
  result := not IsEmpty;
  if not result then Exit;
  result := false;

  for i := ImageFormatClassList.Count -1 downto 0 do
  begin
    formatClass := PImgFmtRec(ImageFormatClassList[i]).Obj;
    if not formatClass.CanCopyToClipboard then Continue;
    with formatClass.Create do
    try
      result := CopyToClipboard(self);
    finally
      free;
    end;
  end;
end;
//------------------------------------------------------------------------------

class function TImage32.CanPasteFromClipBoard: Boolean;
var
  i: Integer;
  formatClass: TImageFormatClass;
begin
  result := false;
  for i := ImageFormatClassList.Count -1 downto 0 do
  begin
    formatClass := PImgFmtRec(ImageFormatClassList[i]).Obj;
    if formatClass.CanPasteFromClipboard then
    begin
      result := true;
      Exit;
    end;
  end;
end;
//------------------------------------------------------------------------------

function TImage32.PasteFromClipBoard: Boolean;
var
  i: Integer;
  formatClass: TImageFormatClass;
begin
  result := false;
  for i := ImageFormatClassList.Count -1 downto 0 do
  begin
    formatClass := PImgFmtRec(ImageFormatClassList[i]).Obj;
    if not formatClass.CanPasteFromClipboard then Continue;

    with formatClass.Create do
    try
      result := PasteFromClipboard(self);
      if not Result then Continue;
    finally
      free;
    end;
    Changed;
    Break;
  end;
end;
//------------------------------------------------------------------------------

{$IFDEF USING_VCL_LCL}
procedure TImage32.CopyFromBitmap(bmp: TBitmap);
var
  savedPF: TPixelFormat;
{$IFNDEF MSWINDOWS}
  i: integer;
  pxDst, pxSrc: PColor32;
{$ENDIF}
begin
  if not Assigned(bmp) then Exit;
  savedPF := bmp.PixelFormat;
  bmp.PixelFormat := pf32bit;
  SetSize(bmp.Width, bmp.Height);
{$IFDEF MSWINDOWS}
  GetBitmapBits(bmp.Handle, Width * Height * 4, PixelBase);
{$ELSE}
  for i := 0 to bmp.Height -1 do
  begin
    pxSrc := bmp.ScanLine[i];
    pxDst := PixelRow[i];
    Move(pxSrc^, pxDst^, bmp.Width * SizeOf(TColor32));
  end;
{$ENDIF}
  bmp.PixelFormat := savedPF;
end;
//------------------------------------------------------------------------------

procedure TImage32.CopyToBitmap(bmp: TBitmap);
{$IFNDEF MSWINDOWS}
var
  i: integer;
  pxDst, pxSrc: PColor32;
{$ENDIF}
begin
  if not Assigned(bmp) then Exit;
  bmp.PixelFormat := pf32bit;
  bmp.Width := Width;
  bmp.Height := Height;
{$IFDEF MSWINDOWS}
  {$IFNDEF FPC}
  {$IFDEF ALPHAFORMAT}
  bmp.AlphaFormat := afDefined;
  {$ENDIF}
  {$ENDIF}
  SetBitmapBits(bmp.Handle, Width * Height * 4, PixelBase);
{$ELSE}
  for i := 0 to bmp.Height -1 do
  begin
    pxDst := bmp.ScanLine[i];
    pxSrc := PixelRow[i];
    Move(pxSrc^, pxDst^, bmp.Width * SizeOf(TColor32));
  end;
{$ENDIF}
end;
//------------------------------------------------------------------------------
{$ENDIF}

procedure TImage32.ConvertToBoolMask(reference: TColor32; tolerance: integer;
  colorFunc: TCompareFunction; maskBg: TColor32; maskFg: TColor32);
var
  i: Integer;
  mask: TArrayOfByte;
  c: PColor32;
  b: PByte;
begin
  if IsEmpty then Exit;
  mask := GetBoolMask(self, reference, colorFunc, tolerance);
  c := PixelBase;
  b := @mask[0];
  for i := 0 to Width * Height -1 do
  begin
  {$IFDEF PBYTE}
    if b^ = 0 then c^ := maskBg else c^ := maskFg;
  {$ELSE}
    if b^ = #0 then c^ := maskBg else c^ := maskFg;
  {$ENDIF}
    inc(c); inc(b);
  end;
  Changed;
end;
//------------------------------------------------------------------------------

procedure TImage32.ConvertToAlphaMask(reference: TColor32;
  colorFunc: TCompareFunctionEx);
var
  i: Integer;
  mask: TArrayOfByte;
  c: PColor32;
  b: PByte;
begin
  if IsEmpty then Exit;
  mask := GetByteMask(self, reference, colorFunc);
  c := PixelBase;
  b := @mask[0];
  for i := 0 to Width * Height -1 do
  begin
  {$IFDEF PBYTE}
    c^ := b^ shl 24;
  {$ELSE}
    c^ := Ord(b^) shl 24;
  {$ENDIF}
    inc(c); inc(b);
  end;
  Changed;
end;
//------------------------------------------------------------------------------

procedure TImage32.FlipVertical;
var
  i: Integer;
  a: TArrayOfColor32;
  src, dst: PColor32;
begin
  if IsEmpty then Exit;
  SetLength(a, fWidth * fHeight);
  src := @fPixels[(height-1) * width];
  dst := @a[0];
  for i := 0 to fHeight -1 do
  begin
    move(src^, dst^, fWidth * SizeOf(TColor32));
    dec(src, fWidth); inc(dst, fWidth);
  end;
  fPixels := a;
  Changed;
end;
//------------------------------------------------------------------------------

procedure TImage32.FlipHorizontal;
var
  i,j, widthLess1: Integer;
  a: TArrayOfColor32;
  row: PColor32;
begin
  if IsEmpty then Exit;
  SetLength(a, fWidth);
  widthLess1 := fWidth -1;
  row := @fPixels[(height-1) * width]; //top row
  for i := 0 to fHeight -1 do
  begin
    move(row^, a[0], fWidth * SizeOf(TColor32));
    for j := 0 to widthLess1 do
    begin
      row^ := a[widthLess1 - j];
      inc(row);
    end;
    dec(row, fWidth *2);
  end;
  Changed;
end;
//------------------------------------------------------------------------------

procedure TImage32.PreMultiply;
var
  i: Integer;
  c: PARGB;
begin
  if IsEmpty or fIsPremultiplied then Exit;
  fIsPremultiplied := true;
  c := PARGB(PixelBase);
  for i := 0 to Width * Height -1 do
  begin
    if (c.A = 0) then c.Color := 0
    else if (c.A < 255) then
    begin
      c.R  := MulTable[c.R, c.A];
      c.G  := MulTable[c.G, c.A];
      c.B  := MulTable[c.B, c.A];
    end;
    inc(c);
  end;
  //nb: no OnChange notify event here
end;
//------------------------------------------------------------------------------

procedure TImage32.SetRGB(rgbColor: TColor32);
var
  rgb: TARGB absolute rgbColor;
  r,g,b: Byte;
  i: Integer;
  pc: PARGB;
begin
  //this method leaves the alpha channel untouched
  if IsEmpty then Exit;
  r := rgb.R; g := rgb.G; b := rgb.B;
  pc := PARGB(PixelBase);
  for i := 0 to Width * Height -1 do
    if pc.A = 0 then
    begin
      pc.Color := 0;
      inc(pc);
    end else
    begin
      pc.R := r;
      pc.G := g;
      pc.B := b;
      inc(pc);
    end;
  Changed;
end;
//------------------------------------------------------------------------------

procedure TImage32.SetRGB(rgbColor: TColor32; rec: TRect);
var
  rgb: TARGB absolute rgbColor;
  r,g,b: Byte;
  i,j, dx: Integer;
  pc: PARGB;
begin
  Types.IntersectRect(rec, rec, bounds);
  if IsEmptyRect(rec) then Exit;
  r := rgb.R; g := rgb.G; b := rgb.B;
  pc := PARGB(PixelBase);
  inc(pc, rec.Left);
  dx := Width - RectWidth(rec);
  for i := rec.Top to rec.Bottom -1 do
  begin
    for j := rec.Left to rec.Right -1 do
    begin
      pc.R := r;
      pc.G := g;
      pc.B := b;
      inc(pc);
    end;
    inc(pc, dx);
  end;
  Changed;
end;
//------------------------------------------------------------------------------

procedure TImage32.SetAlpha(alpha: Byte);
var
  i: Integer;
  c: PARGB;
begin
  //this method only changes the alpha channel
  if IsEmpty then Exit;
  c := PARGB(PixelBase);
  for i := 0 to Width * Height -1 do
  begin
    c.A := alpha;
    inc(c);
  end;
  Changed;
end;
//------------------------------------------------------------------------------

procedure TImage32.ReduceOpacity(opacity: Byte);
var
  i: Integer;
  c: PARGB;
begin
  if opacity = 255 then Exit;
  c := PARGB(PixelBase);
  for i := 0 to Width * Height -1 do
  begin
    c.A := MulTable[c.A, opacity];
    inc(c);
  end;
  Changed;
end;
//------------------------------------------------------------------------------

procedure TImage32.ReduceOpacity(opacity: Byte; rec: TRect);
var
  i,j, rw: Integer;
  c: PARGB;
begin
  Types.IntersectRect(rec, rec, bounds);
  if IsEmptyRect(rec) then Exit;
  rw := RectWidth(rec);
  c := @Pixels[rec.Top * Width + rec.Left];
  for i := rec.Top to rec.Bottom -1 do
  begin
    for j := 1 to rw do
    begin
      c.A := MulTable[c.A, opacity];
      inc(c);
    end;
    inc(c, Width - rw);
  end;
  Changed;
end;
//------------------------------------------------------------------------------

procedure TImage32.Grayscale;
begin
  AdjustSaturation(-100);
end;
//------------------------------------------------------------------------------

procedure TImage32.InvertColors;
var
  pc: PARGB;
  i: Integer;
begin
  pc := PARGB(PixelBase);
  for i := 0 to Width * Height -1 do
  begin
    pc.R := 255 - pc.R;
    pc.G := 255 - pc.G;
    pc.B := 255 - pc.B;
    inc(pc);
  end;
  Changed;
end;
//------------------------------------------------------------------------------

procedure TImage32.InvertAlphas;
var
  pc: PARGB;
  i: Integer;
begin
  pc := PARGB(PixelBase);
  for i := 0 to Width * Height -1 do
  begin
    pc.A := 255 - pc.A;
    inc(pc);
  end;
  Changed;
end;
//------------------------------------------------------------------------------

procedure TImage32.AdjustHue(percent: Integer);
var
  i: Integer;
  tmpImage: TArrayofHSL;
  lut: array [byte] of byte;
begin
  percent := percent mod 100;
  if percent < 0 then inc(percent, 100);
  percent := Round(percent * 255 / 100);
  if (percent = 0) or IsEmpty then Exit;
  for i := 0 to 255 do lut[i] := (i + percent) mod 255;
  tmpImage := ArrayOfColor32ToArrayHSL(fPixels);
  for i := 0 to high(tmpImage) do
    tmpImage[i].hue := lut[ tmpImage[i].hue ];
  fPixels := ArrayOfHSLToArrayColor32(tmpImage);
  Changed;
end;
//------------------------------------------------------------------------------

procedure TImage32.AdjustLuminance(percent: Integer);
var
  i: Integer;
  tmpImage: TArrayofHSL;
  pc: double;
  lut: array [byte] of byte;
begin
  if (percent = 0) or IsEmpty then Exit;
  percent := percent mod 101;
  pc := percent / 100;
  if pc > 0 then
    for i := 0 to 255 do lut[i] := Round(i + (255 - i) * pc)
  else
    for i := 0 to 255 do lut[i] := Round(i + (i * pc));

  tmpImage := ArrayOfColor32ToArrayHSL(fPixels);
  for i := 0 to high(tmpImage) do
    tmpImage[i].lum := lut[ tmpImage[i].lum ];
  fPixels := ArrayOfHSLToArrayColor32(tmpImage);
  Changed;
end;
//------------------------------------------------------------------------------

procedure TImage32.AdjustSaturation(percent: Integer);
var
  i: Integer;
  tmpImage: TArrayofHSL;
  lut: array [byte] of byte;
  pc: double;
begin
  if (percent = 0) or IsEmpty then Exit;
  percent := percent mod 101;
  pc := percent / 100;
  if pc > 0 then
    for i := 0 to 255 do lut[i] := Round(i + (255 - i) * pc)
  else
    for i := 0 to 255 do lut[i] := Round(i + (i * pc));

  tmpImage := ArrayOfColor32ToArrayHSL(fPixels);
  for i := 0 to high(tmpImage) do
    tmpImage[i].sat := lut[ tmpImage[i].sat ];
  fPixels := ArrayOfHSLToArrayColor32(tmpImage);
  Changed;
end;
//------------------------------------------------------------------------------

function TImage32.CropTransparentPixels: TRect;
var
  x,y, x1,x2,y1,y2: Integer;
  found: Boolean;
begin
  y1 := 0; y2 := 0;
  found := false;
  for y := 0 to Height -1 do
  begin
    for x := 0 to Width -1 do
      if TARGB(fPixels[y * Width + x]).A > 0 then
      begin
        y1 := y;
        found := true;
        break;
      end;
    if found then break;
  end;

  if not found then
  begin
    SetSize(0, 0);
    Exit;
  end;

  found := false;
  for y := Height -1 downto 0 do
  begin
    for x := 0 to Width -1 do
      if TARGB(fPixels[y * Width + x]).A > 0 then
      begin
        y2 := y;
        found := true;
        break;
      end;
    if found then break;
  end;

  x1 := Width; x2 := 0;
  for y := y1 to y2 do
    for x := 0 to Width -1 do
      if TARGB(fPixels[y * Width + x]).A > 0 then
      begin
        if x < x1 then x1 := x;
        if x > x2 then x2 := x;
      end;

  Result := Types.Rect(x1, y1, x2+1, y2+1);
  Crop(Result);
end;
//------------------------------------------------------------------------------

procedure TImage32.Rotate(angleRads: double);
var
  rec: TRectD;
  mat: TMatrixD;
begin
  if not ClockwiseRotationIsAnglePositive then
    angleRads := -angleRads;

  //nb: There's no point rotating about a specific point
  //since the rotated image will be recentered.

  NormalizeAngle(angleRads);
  if IsEmpty or (angleRads = 0) then Exit;

  if angleRads = angle180 then
  begin
    Rotate180; //because we've excluded 0 & 360 deg angles
  end
  else if angleRads = angle90 then
  begin
    RotateRight90;
  end
  else if angleRads = -angle90 then
  begin
    RotateLeft90;
  end else
  begin
    mat := IdentityMatrix;
    MatrixTranslate(mat, Width/2, Height/2);
    rec := RectD(Bounds);
    rec := GetRotatedRectBounds(rec, angleRads);
    MatrixRotate(mat, NullPointD, angleRads);
    MatrixTranslate(mat, rec.Width/2, rec.Height/2);
    AffineTransformImage(self, mat);
  end;
end;
//------------------------------------------------------------------------------

procedure TImage32.RotateRect(const rec: TRect;
  angleRads: double; eraseColor: TColor32 = 0);
var
  tmp: TImage32;
  rec2: TRect;
  recWidth, recHeight: integer;
begin
  recWidth := rec.Right - rec.Left;
  recHeight := rec.Bottom - rec.Top;
  //create a tmp image with a copy of the pixels inside rec ...
  tmp := TImage32.Create(self, rec);
  try
    tmp.Rotate(angleRads);
    //since rotating also resizes, get a centered
    //(clipped) rect of the rotated pixels ...
    rec2.Left := (tmp.Width - recWidth) div 2;
    rec2.Top := (tmp.Height - recHeight) div 2;
    rec2.Right := rec2.Left + recWidth;
    rec2.Bottom := rec2.Top + recHeight;
    //finally move the rotated rec back to the image ...
    FillRect(rec, eraseColor);
    CopyBlend(tmp, rec2, rec);
  finally
    tmp.Free;
  end;
end;
//------------------------------------------------------------------------------

procedure TImage32.Skew(dx,dy: double);
var
  mat: TMatrixD;
begin
  if IsEmpty or ((dx = 0) and (dy = 0)) then Exit;
  //limit skewing to twice the image's width and/or height
  dx := ClampRange(dx, -2.0, 2.0);
  dy := ClampRange(dy, -2.0, 2.0);
  mat := IdentityMatrix;
  MatrixSkew(mat, dx, dy);
  AffineTransformImage(self, mat);
end;
//------------------------------------------------------------------------------

procedure TImage32.ScaleAlpha(scale: double);
var
  i: Integer;
  pb: PARGB;
begin
  pb := PARGB(PixelBase);
  for i := 0 to Width * Height - 1 do
  begin
    pb.A := ClampByte(Round(pb.A * scale));
    inc(pb);
  end;
  Changed;
end;

//------------------------------------------------------------------------------
// TImageList32
//------------------------------------------------------------------------------

constructor TImageList32.Create;
begin
{$IFDEF XPLAT_GENERICS}
  fList := TList<TImage32>.Create;
{$ELSE}
  fList := TList.Create;
{$ENDIF}
  fIsImageOwner := true;
end;
//------------------------------------------------------------------------------

destructor TImageList32.Destroy;
begin
  Clear;
  fList.Free;
  inherited;
end;
//------------------------------------------------------------------------------

function TImageList32.Count: integer;
begin
  result := fList.Count;
end;
//------------------------------------------------------------------------------

procedure TImageList32.Clear;
var
  i: integer;
begin
  if IsImageOwner then
    for i := 0 to fList.Count -1 do
      TImage32(fList[i]).Free;
  fList.Clear;
end;
//------------------------------------------------------------------------------

function TImageList32.GetImage(index: integer): TImage32;
begin
  result := TImage32(fList[index]);
end;
//------------------------------------------------------------------------------

procedure TImageList32.SetImage(index: integer; img: TIMage32);
begin
  if fIsImageOwner then TImage32(fList[index]).Free;
  fList[index] := img;
end;
//------------------------------------------------------------------------------

function TImageList32.GetLast: TImage32;
begin
  if Count = 0 then Result := nil
  else Result := TImage32(fList[Count -1]);
end;
//------------------------------------------------------------------------------

procedure TImageList32.Add(image: TImage32);
begin
  fList.Add(image);
end;
//------------------------------------------------------------------------------

function TImageList32.Add(width, height: integer): TImage32;
begin
  Result := TImage32.create(width, height);
  fList.Add(Result);
end;
//------------------------------------------------------------------------------

procedure TImageList32.Insert(index: integer; image: TImage32);
begin
  fList.Insert(index, image);
end;
//------------------------------------------------------------------------------

procedure TImageList32.Move(currentIndex, newIndex: integer);
begin
  fList.Move(currentIndex, newIndex);
end;
//------------------------------------------------------------------------------

procedure TImageList32.Delete(index: integer);
begin
  if fIsImageOwner then TImage32(fList[index]).Free;
  fList.Delete(index);
end;

//------------------------------------------------------------------------------
// TImageFormat methods
//------------------------------------------------------------------------------

function TImageFormat.LoadFromFile(const filename: string;
  img32: TImage32): Boolean;
var
  fs: TFileStream;
begin
  result := FileExists(filename);
  if not result then Exit;
  fs := TFileStream.Create(filename, fmOpenRead or fmShareDenyWrite);
  try
    Result := LoadFromStream(fs, img32);
  finally
    fs.Free;
  end;
end;
//------------------------------------------------------------------------------

function TImageFormat.SaveToFile(const filename: string;
  img32: TImage32): Boolean;
var
  fs: TFileStream;
begin
  result := (pos('.', filename) = 1) or
    DirectoryExists(ExtractFilePath(filename));
  if not result then Exit;

  fs := TFileStream.Create(filename, fmCreate);
  try
    SaveToStream(fs, img32);
  finally
    fs.Free;
  end;
end;
//------------------------------------------------------------------------------

class function TImageFormat.CanCopyToClipboard: Boolean;
begin
  Result := false;
end;

//------------------------------------------------------------------------------
// TInterfacedObj
//------------------------------------------------------------------------------

{$IFDEF FPC}
function TInterfacedObj._AddRef: Integer;
  {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
  Result := -1;
end;
//------------------------------------------------------------------------------

function TInterfacedObj._Release: Integer;
  {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
  Result := -1;
end;
//------------------------------------------------------------------------------

function TInterfacedObj.QueryInterface(
  {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;
  out obj) : longint;
begin
  if GetInterface(IID, Obj) then Result := 0
  else Result := E_NOINTERFACE;
end;

{$ELSE}

function TInterfacedObj._AddRef: Integer; stdcall;
begin
  Result := -1;
end;
//------------------------------------------------------------------------------

function TInterfacedObj._Release: Integer; stdcall;
begin
  Result := -1;
end;
//------------------------------------------------------------------------------

function TInterfacedObj.QueryInterface(const IID: TGUID;
  out Obj): HResult;
begin
  if GetInterface(IID, Obj) then Result := 0
  else Result := E_NOINTERFACE;
end;
{$ENDIF}

//------------------------------------------------------------------------------
// Initialization and Finalization functions
//------------------------------------------------------------------------------

procedure MakeBlendTables;
var
  i,j: Integer;
begin
  for j := 0 to 255 do MulTable[0, j] := 0;
  for i := 0 to 255 do MulTable[i, 0] := 0;
  for j := 0 to 255 do DivTable[0, j] := 0;
  for i := 0 to 255 do DivTable[i, 0] := 0;
  for i := 1 to 255 do
    for j := 1 to 255 do
    begin
      MulTable[i, j] := Round(i * j * div255);
      if i >= j then
        DivTable[i, j] := 255 else
        DivTable[i, j] := Round(i * $FF / j);
    end;
end;
//------------------------------------------------------------------------------

{$IFDEF MSWINDOWS}
procedure GetScreenScale;
var
  dc: HDC;
  ScreenPixelsY: integer;
begin
  dc := GetDC(0);
  try
    ScreenPixelsY := GetDeviceCaps(dc, LOGPIXELSY);
    DpiAwareOne := ScreenPixelsY / 96;
  finally
    ReleaseDC(0, dc);
  end;
  dpiAware1   := Round(DpiAwareOne);
end;
{$ENDIF}
//------------------------------------------------------------------------------

{$IFDEF USING_VCL_LCL}
procedure GetScreenScale2;
begin
  DpiAwareOne := Screen.PixelsPerInch / 96;
  dpiAware1   := Round(DpiAwareOne);
end;
{$ENDIF}
//------------------------------------------------------------------------------

procedure CleanUpImageFormatClassList;
var
  i: integer;
begin
  for i := ImageFormatClassList.Count -1 downto 0 do
    Dispose(PImgFmtRec(ImageFormatClassList[i]));
  ImageFormatClassList.Free;
end;

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------

procedure CreateResamplerList;
begin
{$IFDEF XPLAT_GENERICS}
  ResamplerList := TList<TResamplerObj>.Create;
{$ELSE}
  ResamplerList := TList.Create;
{$ENDIF}
end;
//------------------------------------------------------------------------------

function GetResampler(id: integer): TResamplerFunction;
var
  i: integer;
begin
  result := nil;
  if not Assigned(ResamplerList) then Exit;

  for i := ResamplerList.Count -1 downto 0 do
    if TResamplerObj(ResamplerList[i]).id = id then
  begin
    Result := TResamplerObj(ResamplerList[i]).func;
    Break;
  end;
end;
//------------------------------------------------------------------------------

function RegisterResampler(func: TResamplerFunction; const name: string): integer;
var
  resampleObj: TResamplerObj;
begin
  if not Assigned(ResamplerList) then
    CreateResamplerList;

  resampleObj := TResamplerObj.Create;
  Result := ResamplerList.Add(resampleObj) +1;
  resampleObj.id := Result;
  resampleObj.name := name;
  resampleObj.func := func;
end;
//------------------------------------------------------------------------------

procedure GetResamplerList(stringList: TStringList);
var
  i: integer;
  resampleObj: TResamplerObj;
begin
  stringList.Clear;
  stringList.Capacity := ResamplerList.Count;
  for i := 0 to ResamplerList.Count -1 do
  begin
    resampleObj := ResamplerList[i];
    stringList.AddObject(resampleObj.name, resampleObj);
  end;
end;
//------------------------------------------------------------------------------

procedure CleanUpResamplerClassList;
var
  i: integer;
begin
  if not Assigned(ResamplerList) then Exit;
  for i := ResamplerList.Count -1 downto 0 do
    TResamplerObj(ResamplerList[i]).Free;
  ResamplerList.Free;
end;
//------------------------------------------------------------------------------

initialization
  CreateImageFormatList;
  MakeBlendTables;

{$IFDEF MSWINDOWS}
  GetScreenScale;
{$ELSE}
  {$IFDEF USING_VCL_LCL}
  GetScreenScale2;
  {$ENDIF}
{$ENDIF}

finalization
  CleanUpImageFormatClassList;
  CleanUpResamplerClassList;

end.
