(* ImageEn Build 7.0.0.06.2637 @ 7-4-17 14:58:42.679 *)
(*
Copyright (c) 1998-2017 by Carlotta Calandra. All rights reserved.
Copyright (c) 2011-2017 by Xequte Software.

This software comes without express or implied warranty.
In no case shall the author be liable for any damage or unwanted behavior of any
computer hardware and/or software.

Author grants you the right to include the component
in your application, whether COMMERCIAL, SHAREWARE, or FREEWARE.

ImageEn, IEvolution and ImageEn ActiveX may not be included in any
commercial, shareware or freeware libraries or components.

www.ImageEn.com
*)

(*
File version 1200
*)


unit hyieutils;

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}


{$R-}
{$Q-}

{$I ie.inc}

interface

uses
  Windows, Messages, Forms, Classes, StdCtrls, Graphics, hyiedefs, SysUtils, Controls, ievision, 
  Contnrs;


type

{!!
<FS>TIOFileType

<FM>Declaration<FC>
TIOFileType = integer;

<FM>Description<FN>
Specifies a file format supported by ImageEn (may be read-write, read-only or write-only).

<TABLE>
<R> <H>Constant</H> <H>Description</H> </R>
<R> <C>ioUnknown</C> <C>Unknown file format</C> </R>
<R> <C>ioTIFF</C> <C>TIFF Bitmap</C> </R>
<R> <C>ioGIF</C> <C>GIF</C> </R>
<R> <C>ioJPEG</C> <C>Jpeg bitmap</C> </R>
<R> <C>ioPCX</C> <C>PaintBrush PCX</C> </R>
<R> <C>ioBMP</C> <C>Windows Bitmap</C> </R>
<R> <C>ioICO</C> <C>Windows Icon</C> </R>
<R> <C>ioCUR</C> <C>Windows Cursor</C> </R>
<R> <C>ioPNG</C> <C>Portable Network Graphics</C> </R>
<R> <C>ioWMF</C> <C>Windows Metafile</C> </R>
<R> <C>ioEMF</C> <C>Enhanced Windows Metafile</C> </R>
<R> <C>ioTGA</C> <C>Targa Bitmap</C> </R>
<R> <C>ioPXM</C> <C>Portable Pixmap, GreyMap, BitMap</C> </R>
<R> <C>ioJP2</C> <C>Jpeg2000</C> </R>
<R> <C>ioJ2K</C> <C>Jpeg2000</C> </R>
<R> <C>ioAVI</C> <C>AVI video</C> </R>
<R> <C>ioWBMP</C> <C>Wireless bitmap</C> </R>
<R> <C>ioPS</C> <C>Postscript</C> </R>
<R> <C>ioPDF</C> <C>Adobe PDF</C> </R>
<R> <C>ioSVG</C> <C>Scalable Vector Graphics</C> </R>
<R> <C>ioDCX</C> <C>Multipage PCX</C> </R>
<R> <C>ioRAW</C> <C>Digital Camera RAW (requires <L ImageEn DLLs and 64bit Support>ielib or ievision</L>)</C> </R>
<R> <C>ioBMPRAW</C> <C>Bitmap RAW</C> </R>
<R> <C>ioWMV</C> <C>Windows Media</C> </R>
<R> <C>ioMPEG</C> <C>Video MPEG</C> </R>
<R> <C>ioPSD</C> <C>Adobe Photoshop PSD</C> </R>
<R> <C>ioIEV</C> <C>Vectorial objects (<A TImageEnVect.SaveToFileIEV>)</C> </R>
<R> <C>ioIEN</C> <C>ImageEn native image format with layers (formerly ioLYR)</C> </R>
<R> <C>ioALL</C> <C>Combined layers and vectorial objects (<A TImageEnVect.SaveToFileAll>)</C> </R>
<R> <C>ioDICOM</C> <C>DICOM medical imaging</C> </R>
<R> <C>ioHDP</C> <C>Microsoft HD Photo. Requires Windows XP (SP2) with .Net 3.0, Windows Vista or newer</C> </R>
<R> <C>ioOtherDLLPlugIns + offset</C> <C>External plugins (e.g. JBIG)</C> </R>
<R> <C>ioMiscDLLPlugIns + offset</C> <C>Misc External plugins (e.g. PCL)</C> </R>
<R> <C>ioUSER + offset</C> <C>User registered file formats</C> </R>
</TABLE>
!!}
  TIOFileType = integer;

const
  // types for TIOFileType
  ioUnknown    = 0;
  ioTIFF       = 1;
  ioGIF        = 2;
  ioJPEG       = 3;
  ioPCX        = 4;
  ioBMP        = 5;
  ioICO        = 6;
  ioCUR        = 7;
  ioPNG        = 8;
  ioWMF        = 9;
  ioEMF        = 10;
  ioTGA        = 11;
  ioPXM        = 12;
  ioJP2        = 13;
  ioJ2K        = 14;
  ioAVI        = 15;
  ioWBMP       = 16;
  ioPS         = 17;
  ioPDF        = 18;
  ioDCX        = 19;
  ioRAW        = 20;
  ioBMPRAW     = 21;
  ioWMV        = 22;
  ioMPEG       = 23;
  ioPSD        = 24;
  ioIEV        = 25;
  ioIEN        = 26;           {$ifdef IEIncludeDeprecatedInV6} ioLYR = ioIEN; {$endif}
  ioALL        = 27;
  ioDICOM      = 28;
  ioHDP        = 29;
  ioRAS        = 30; // sun RAS (supported by ievision)
  ioSVG        = 31;
  ioOtherDLLPlugIns = 4097;
  ioMiscDLLPlugIns  = 8192;
  ioUSER            = 10000;


  // Support PDF loading by WP PDF Plug-In
  const iomscWPPDF = ioMiscDLLPlugIns + 30;

  // Used only by TImageEnView.LayersImport
  const ioDXF      = 9001;

type
{!!
<FS>TIEMTruncSide

<FM>Declaration<FC>
}
  TIEMTruncSide = (iemtsLeft, iemtsRight);
{!!}
   

{!!
<FS>TIEDataAccess

<FM>Declaration<FC>
}
  TIEDataAccess = set of (iedRead, iedWrite);
{!!}


{!!
<FS>TIEDitherMethod

<FM>Declaration<FC>
}
  TIEDitherMethod = (ieOrdered, ieThreshold, ieDithering);
{!!}

{!!
<FS>TIEHAlign

<FM>Declaration<FC>
}
  TIEHAlign = (iehLeft, iehCenter, iehRight);
{!!}

{!!
<FS>TIEVAlign

<FM>Declaration<FC>
}
  TIEVAlign = (ievTop, ievCenter, ievBottom);
{!!}

{!!
<FS>TIEPixelFormat

<FM>Declaration<FC>
TIEPixelFormat = (ienull,
                  ie1g,
                  ie8p,
                  ie8g,
                  ie16g,
                  ie24RGB,
                  ie32f,
                  ieCMYK,
                  ie48RGB,
                  ieCIELab,
                  ie32RGB);


<FM>Description<FN>
<TABLE>
<R> <H>Value</H> <H>Description</H> </R>
<R> <C><FC>ienull<FN></C> <C>Invalid pixel format.</C> </R>
<R> <C><FC>ie1g<FN></C> <C>Black/White (1 bit per pixel).</C> </R>
<R> <C><FC>ie8p<FN></C> <C>RGB color with colormap (256 colors, 8 bit per pixel).</C> </R>
<R> <C><FC>ie8g<FN></C> <C>Gray scale (256 shades of gray, 8 bit per pixel).</C> </R>
<R> <C><FC>ie16g<FN></C> <C>Gray scale (65536 shades of gray, 16 bit per pixel).</C> </R>
<R> <C><FC>ie24RGB<FN></C> <C>RGB true color (16M colors, 24 bit per pixel, 8 bit per channel).</C> </R>
<R> <C><FC>ie32f<FN></C> <C>Gray scale (0..1 floating point shades of gray, 32 bit per pixel).</C> </R>
<R> <C><FC>ieCMYK<FN></C> <C>CMYK color (32 bit per pixel, reversed 8 bit per channel).</C> </R>
<R> <C><FC>ie48RGB<FN></C> <C>RGB color (48 bit per pixel, 16 bit per channel).</C> </R>
<R> <C><FC>ieCIELab<FN></C> <C>CIELab color (24 bit per pixel, 8 bit per channel).</C> </R>
<R> <C><FC>ie32RGB<FN></C> <C>RGBA color (32 bit per pixel, 8 bit per channel, for compatibility with Windows DIB pixel format, last 8 bit unused with some exceptions).</C> </R>
</TABLE>
!!}
  TIEPixelFormat = (ienull,
                    ie1g,     // gray scale (black/white)
                    ie8p,     // color (palette)
                    ie8g,     // gray scale (256 levels)
                    ie16g,    // gray scale (65536 levels)
                    ie24RGB,  // RGB 24 bit (8 bit per channel)
                    ie32f,    // floating point values, 32 bit - Single in Pascal - gray scale
                    ieCMYK,   // CMYK (reversed 8 bit values)
                    ie48RGB,  // RGB 48 bit (16 bit per channel)
                    ieCIELab, // CIELab (8 bit per channel)
                    ie32RGB   // RGB 32 bit (8 bit per channel), last 8 bit are unused with some exceptions
  );



{!!
<FS>TIEPixelFormatSet

<FM>Declaration<FC>
}
  TIEPixelFormatSet = set of TIEPixelFormat;
{!!}

{!!
<FS>TIECompareFunction

<FM>Declaration<FC>
}
  TIECompareFunction = function(Index1, Index2: integer): integer of object;
{!!}

{!!
<FS>TIESwapFunction

<FM>Declaration<FC>
}
  TIESwapFunction = procedure(Index1, Index2: integer) of object;
{!!}


{!!
<FS>TIEDialogCenter

<FM>Declaration<FC>
}
  TIEDialogCenter = procedure(Wnd: HWnd);
{!!}



{!!
<FS>TFitMethod

<FM>Declaration<FC>
}
  TFitMethod = (_fmFitWithinRect,          // Normal Usage: All the image is made to fit within the available area (with border area)
                _fmFillRect_WithOverlap);  // Return an image that may be bigger than the available area but that does not have any border area showing
{!!}



{!!
<FS>TIERenderOperation

<FM>Declaration<FC>
}
  TIERenderOperation = (
    ielNormal,
    ielAdd, // Additive
    ielSub, // Difference
    ielDiv,
    ielMul,
    ielOR,
    ielAND,
    ielXOR,
    ielMAX, // Lighten
    ielMIN, // Darken
    ielAverage,
    ielScreen,
    ielNegation,
    ielExclusion,
    ielOverlay,
    ielHardLight,
    ielSoftLight,
    ielXFader,
    ielColorEdge,
    ielColorBurn,
    ielInverseColorDodge,
    ielInverseColorBurn,
    ielSoftDodge,
    ielSoftBurn,
    ielReflect,
    ielGlow,
    ielFreeze,
    ielEat,
    ielSubtractive,
    ielInterpolation,
    ielStamp,
    ielRed,
    ielGreen,
    ielBlue,
    ielHue,
    ielSaturation,
    ielColor,
    ielLuminosity,
    ielStereoBW,
    ielStereoColor,
    ielStereoColorDubois,
    ielStereoEven,
    ielStereoOdd,
    ielLuminosity2
    );
{!!}


{!!
<FS>TIEOpSys

<FM>Declaration<FC>
}
  TIEOpSys = (ieosWin95, ieosWin98, ieosWinME, ieosWinNT4, ieosWin2000, ieosWinXP, ieosWin2003, ieosWinVista, ieosWin7, ieosWin8, ieosWin10, ieosUnknown);
{!!}


  TIEShadowType = (iestNone, iestSolid, iestSmooth1, iestSmooth2);




{!!
<FS>TPreviewParams

<FM>Declaration<FC>
type TPreviewParams = set of (ppALL, ppAUTO, ppJPEG, ppTIFF, ppGIF, ppBMP, ppPCX, ppPNG, ppTGA, ppJ2000);

<FM>Description<FN>
Specify which pages are included in the IO Parameters dialog:
<TABLE>
<R> <H>Value</H> <H>Description</H> </R>
<R> <C>ppALL</C> <C>Show all pages</C> </R>
<R> <C>ppAUTO</C> <C>Show the relevant page for the current file type (i.e. as specified in <L TIOParams.FileType>Params.FileType</L>)</C> </R>
<R> <C>ppJPEG</C> <C>Show JPEG parameters</C> </R>
<R> <C>ppTIFF</C> <C>Show TIFF paramaters</C> </R>
<R> <C>ppGIF</C> <C>Show GIF (non-animated) parameters</C> </R>
<R> <C>ppBMP</C> <C>Show BMP parameters</C> </R>
<R> <C>ppPCX</C> <C>Show PCX parameters</C> </R>
<R> <C>ppPNG</C> <C>Show PNG parameters</C> </R>
<R> <C>ppTGA</C> <C>Show TGA parameters</C> </R>
<R> <C>ppJ2000</C> <C>Show JPEG2000 parameters</C> </R>
</TABLE>
!!}
  TPreviewParams = set of (
    ppALL,
    ppAUTO,
    ppJPEG,
    ppTIFF,
    ppGIF,
    ppBMP,
    ppPCX,
    ppPNG,
    ppTGA
{$IFDEF IEINCLUDEJPEG2000}
    , ppJ2000
{$ENDIF}
    );

  // previews properties

{!!
<FS>TIOPreviewsParamsItems

<FM>Declaration<FC>
TIOPreviewsParamsItems = (ioppDefaultLockPreview, ioppApplyButton);

<FM>Description<FN>
<TABLE>
<R> <H>Value</H> <H>Description</H> </R>
<R> <C>ioppDefaultLockPreview</C> <C>Enable "Lock preview" by default</C> </R>
<R> <C>ioppApplyButton</C> <C>Display an "Apply" button</C> </R>
</TABLE>

<FM>Example<FC>
// Show preview by default
ImageEnView1.IO.PreviewsParams := ImageEnView1.IO.PreviewsParams + [ ioppDefaultLockPreview ];
!!}
  TIOPreviewsParamsItems = (ioppDefaultLockPreview, ioppApplyButton);

{!!
<FS>TIOPreviewsParams

<FM>Declaration<FC>
TIOPreviewsParams = set of <A TIOPreviewsParamsItems>;

<FM>Description<FN>
<TABLE>
<R> <H>Value</H> <H>Description</H> </R>
<R> <C>ioppDefaultLockPreview</C> <C>Enable "Lock preview" by default</C> </R>
<R> <C>ioppApplyButton</C> <C>Display an "Apply" button</C> </R>
</TABLE>

<FM>Example<FC>
// Show preview by default
ImageEnView1.IO.PreviewsParams := ImageEnView1.IO.PreviewsParams + [ ioppDefaultLockPreview ];

!!}
  TIOPreviewsParams = set of TIOPreviewsParamsItems;  
  

{!!
<FS>TImageEnPaletteDialog

<FM>Description<FN>
TImageEnPaletteDialog is a dialog that shows a color palette and allows a color to be selected from it.

See also: <A TImageEnProc.CalcImagePalette>

<FM>Methods<FN>
  <A TImageEnPaletteDialog.Execute>
  <A TImageEnPaletteDialog.SetPalette>
!!}
  TImageEnPaletteDialog = class(TForm)
  private
    MouseCol: integer;
    fPalette: PRGBROW;
    fNumCol: integer;
    procedure FormPaint(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; x, y: integer);
    procedure FormClick(Sender: TObject);
  public
    ButtonCancel: TButton;
    SelCol: TColor;
    property NumCol: integer read MouseCol;
    constructor Create(AOwner: TComponent); override;
    procedure SetPalette(var Palette: array of TRGB; NumCol: integer);
    function Execute: boolean;
  end;




TIEWideStrings = class
  private
    fStrings: TList;
    function CreateCopyBuffer(const S: WideString): PWideChar;
    function GetCount: integer;
    function GetString(idx: integer): WideString;
    procedure SetString(idx: integer; const S: WideString);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    property Count: integer read GetCount;
    function Add(const S: WideString): integer;
    property Strings[idx: integer]: WideString read GetString write SetString; default;
end;



{
Example:
var
  dir: TIEDirContent;
  sFilename : WideString;
begin
  dir := TIEDirContent.Create('C:\images\*.jpg');
  while dir.GetItem(sFilename) do
  begin
    Memo.Lines.Add(sFileName);
  end;
  dir.free;
end;
}
TIEDirContent = class
  private
    fFirstGot : boolean;
    fHandle : THandle;
    fFindData : WIN32_FIND_DATAW;
    fIsDir : boolean;
    fIsHidden : boolean;
    fFileSizeBytes : Int64;
    fCreateDate : TDateTime;
    fEditDate : TDateTime;
  public
    constructor Create(const dir: WideString);
    destructor Destroy; override;
    function GetItem(out sFilename : WideString; bGetFiles: boolean = True; bGetDirs: boolean = False; bGetHidden : Boolean = True): boolean;
    property IsFolder : boolean read fIsDir;
    property IsHiddenFile : boolean read fIsHidden;
    property FileSizeBytes : Int64 read fFileSizeBytes;
    property CreateDate : TDateTime read fCreateDate;
    property EditDate : TDateTime read fEditDate;
    class procedure PopulateStrings(const path: WideString; strings: TStrings; bGetFiles: boolean = True; bGetDirs: boolean = False; bGetHidden : Boolean = True);
  end;



//////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////
// TIEExecutor
//
// A thread that can be or not be a thread!

TIEExecutorFunc = procedure() of object;


                       
    {$HINTS OFF}
TIEExecutorThread = class(TThread)
  private
    fExecFunc: TIEExecutorFunc;
    constructor Create(execFunc: TIEExecutorFunc);
    procedure Execute(); override;
end;         
    {$HINTS ON}


TIEExecutor = class
  private
    fThread: TIEExecutorThread;
  public
    constructor Create(execInThread: Boolean);
    destructor Destroy(); override;
    procedure Execute(); virtual; abstract;
    function GetThread(): TThread;
end;


//////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////
// TIEThreadPool

TIEThreadPool = class
  private
    fThreads: TList;
    function GetThreads(idx: integer): TIEExecutor;
  public
    constructor Create();
    destructor Destroy; override;
    procedure Add(Thread: TIEExecutor);
    procedure Join();
    procedure WaitFor();
    property Threads[idx: integer]: TIEExecutor read GetThreads; default;
end;

// TIEThreadPool
//////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////
  

///////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////
// TIEDictionary


TIEStrHashFunction = function (const str: WideString; bucketCount: cardinal): cardinal;


TIEDictionaryValueWideString = class
  value: WideString;
  constructor Create(value: WideString);
  destructor Destroy(); override;
end;


TIEDictionaryValueInteger = class
  value: integer;
  constructor Create(value: integer);
  destructor Destroy(); override;
end;


TIEDictionaryValueDouble = class
  value: double;
  constructor Create(value: double);
  destructor Destroy(); override;
end;


TIEDictionaryValueBoolean = class
  value: boolean;
  constructor Create(value: boolean);
  destructor Destroy(); override;
end;


TIEDictionaryBucket = class
  key:   WideString;
  value: TObject;
  next:  TIEDictionaryBucket;

  constructor Create(const key_: WideString; const value_: TObject; next_: TIEDictionaryBucket = nil); overload;
  destructor Destroy(); override;
end;


TIEStrStrEnumerator = class
  bucket: cardinal;
  item:   TIEDictionaryBucket;

  constructor Create();
  destructor Destroy(); override;
end;


{!!
<FS>TIEDictionaryParserLang

<FM>Declaration<FC>
}
TIEDictionaryParserLang = (ieplJSON, ieplXML);
{!!}


{!!
<FS>TIEDictionary

<FM>Declaration<FC>
TIEDictionary = class;


<FM>Description<FN>
TIEDictionary is a String->Object dictionary (hashmap).
It can import/export key-values in a JSON-like (not fully compatible yet) style.

<FM>Methods and Properties<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TIEDictionary.Create></C> </R>
<R> <C_IMG_METHOD> <C><A TIEDictionary.Clear></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEDictionary.Count></C> </R>
<R> <C_IMG_METHOD> <C><A TIEDictionary.Dump></C> </R>
<R> <C_IMG_METHOD> <C><A TIEDictionary.Erase></C> </R>
<R> <C_IMG_METHOD> <C><A TIEDictionary.HasKey></C> </R>
<R> <C_IMG_METHOD> <C><A TIEDictionary.Get></C> </R>
<R> <C_IMG_METHOD> <C><A TIEDictionary.GetBoolean></C> </R>
<R> <C_IMG_METHOD> <C><A TIEDictionary.GetDictionary></C> </R>
<R> <C_IMG_METHOD> <C><A TIEDictionary.GetDouble></C> </R>
<R> <C_IMG_METHOD> <C><A TIEDictionary.GetInteger></C> </R>
<R> <C_IMG_METHOD> <C><A TIEDictionary.GetList></C> </R>
<R> <C_IMG_METHOD> <C><A TIEDictionary.GetNext></C> </R>
<R> <C_IMG_METHOD> <C><A TIEDictionary.GetString></C> </R>
<R> <C_IMG_METHOD> <C><A TIEDictionary.Insert></C> </R>
<R> <C_IMG_METHOD> <C><A TIEDictionary.IsEmpty></C> </R>
<R> <C_IMG_METHOD> <C><A TIEDictionary.Parse></C> </R>
</TABLE>

<FM>Example<FC>
var
  dict: TIEDictionary;
begin
  dict := TIEDictionary.Create();
  dict.Insert('doublekey', 10.1);
  dict.Insert('integerkey', 100);
  dict.Insert('stringkey', 'hello');
  dict.Insert('bool_true', true);
  dict.Insert('bool_false', false);
  dict.Insert('dict', TIEDictionary.Create());
    dict.GetDictionary('dict').Insert('one', 1);
    dict.GetDictionary('dict').Insert('two', 'two');
  dict.Insert('list', TObjectList.Create());
    dict.GetList('list').Add( TIEDictionaryValueWideString.Create('mike') );
    dict.GetList('list').Add( TIEDictionaryValueWideString.Create('robert') );
    dict.GetList('list').Add( TIEDictionaryValueWideString.Create('john') );
    dict.GetList('list').Add( TIEDictionaryValueInteger.Create(2013) );

  memo1.lines.add(dict.dump());

  dict.free;
end;
!!}
TIEDictionary = class
  private
    m_initDone: boolean;
    m_bucketCount: cardinal;
    m_buckets: array of TIEDictionaryBucket;
    m_hashFunction: TIEStrHashFunction;
    m_caseSensitive: boolean;
    m_count: integer;

    procedure CheckInit();
    function GetInBucket(bucket: cardinal; key: WideString; out lastItem: TIEDictionaryBucket): TIEDictionaryBucket;

    function DumpJSON(obj: TObject): WideString; overload;
    function DumpJSON(obj: TObjectList): WideString; overload;
    function DumpJSON(): WideString; overload;

    function DumpXML(obj: TObject): WideString; overload;
    function DumpXML(obj: TObjectList): WideString; overload;
    function DumpXML(): WideString; overload;

    function EncodeString(Text: WideString): WideString;
    function FindInDictionaries(key: WideString): TObject;

    function execHash(const str: WideString; bucketCount: cardinal): cardinal;
    function keysMatch(const key1: WideString; const key2: WideString): boolean;

  public
    constructor Create(buckets: cardinal; hashFunction: TIEStrHashFunction; caseSensitive: boolean = false); overload;
    constructor Create(buckets: cardinal = 103; caseSensitive: boolean = false); overload;
    destructor Destroy(); override;

    procedure Clear();
    function IsEmpty(): boolean;
    function HasKey(key: WideString; recursive: boolean = true): boolean;
    function Get(key: WideString; silent: boolean = false; recursive: boolean = true): TObject;
    function GetString(key: WideString; recursive: boolean = true): WideString;
    function GetInteger(key: WideString; recursive: boolean = true): integer;
    function GetDouble(key: WideString; recursive: boolean = true): double;
    function GetBoolean(key: WideString; recursive: boolean = true): boolean;
    function GetDictionary(key: WideString; recursive: boolean = true): TIEDictionary;
    function GetList(key: WideString; recursive: boolean = true): TObjectList;
    procedure Insert(key: WideString; value: TObject); overload;
    procedure Insert(key: WideString; value: WideString); overload;
    procedure Insert(key: WideString; value: integer); overload;
    procedure Insert(key: WideString; value: double); overload;
    procedure Insert(key: WideString; value: boolean); overload;
    procedure Insert(key: WideString; value: TIEDictionary); overload;
    procedure Insert(key: WideString; value: TObjectList); overload;
    function Erase(key: WideString; freeValue: boolean = true): boolean;

{!!
<FS>TIEDictionary.Count

<FM>Declaration<FC>
property Count: integer;

<FM>Description<FN>
Returns the number of entries in the dictionary.
!!}
    property Count: integer read m_Count;

    function GetNext(current: TIEStrStrEnumerator): boolean;

    function Dump(dumpType: TIEDictionaryParserLang): WideString;
    function Parse(text: WideString): boolean;

    procedure Assign(Source: TIEDictionary);
end;



TIEDictionaryParser = class
  private
    m_text:    WideString;
    m_textLen: integer;
    m_textPos: integer;
    m_abort:   boolean;
    m_lang:    TIEDictionaryParserLang;

    procedure AbortParse();
    function IsToken(c: WideChar): boolean;
    function IsSpace(c: WideChar): boolean;
    procedure ByPassSpaces();
    function HasChar(): boolean;
    function GetChar(): WideChar;
    function PeekChar(): WideChar;
    function GetToken(): WideChar;
    function PeekToken(): WideChar;
    function GetString(): WideString;
    function ParseString(): TIEDictionaryValueWideString;
    function ParseIdentifier(): TObject;
    function SavePos(): integer;
    procedure RestorePos(pos: integer);
    function DecodeString(Text: WideString): WideString;

    function JSON_ParseDictionary(mergeWith: TIEDictionary = nil): TIEDictionary;
    function JSON_ParseValue(): TObject;
    function JSON_ParseArray(): TObjectList;

    function XML_ParseContent(mergeWith: TIEDictionary = nil): TIEDictionary;
    function XML_GetName(): WideString;
    function XML_ParseAttributes(): TIEDictionary;

  public
    constructor Create(Text: WideString);
    function Parse(mergeWith: TIEDictionary = nil): TIEDictionary;

    property Aborted: boolean read m_abort;
end;



/////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////
// TIEHashStream

{!!
<FS>TIEHashAlgorithm

<FM>Declaration<FC>
TIEHashAlgorithm = (
  iehaMD2, // MD2 hashing algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.
  iehaMD4, // MD4 hashing algorithm.
  iehaMD5, // MD5 hashing algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.
  iehaSHA  // SHA hashing algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.
);
!!}
{$ifdef IEHASCONSTENUM}
TIEHashAlgorithm = (
  iehaMD2 = $00008001, // MD2 hashing algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.
  iehaMD4 = $00008002, // MD4 hashing algorithm.
  iehaMD5 = $00008003, // MD5 hashing algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.
  iehaSHA = $00008004  // SHA hashing algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.
);
{$else}
type TIEHashAlgorithm = integer;
const iehaMD2 = $00008001; // MD2 hashing algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.
const iehaMD4 = $00008002; // MD4 hashing algorithm.
const iehaMD5 = $00008003; // MD5 hashing algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.
const iehaSHA = $00008004; // SHA hashing algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.
{$endif}

type

{!!
<FS>TIEHashStream

<FM>Description<FN>
Builds a hash string from a stream.
Hash algorithm can be MD2, MD4, MD5 and SHA.

<FM>Examples<FC>
// saves the file with an unique name (create hash from the jpeg content and use it as file name)
var
  hashStream: TIEHashStream;
begin
  hashStream := TIEHashStream.Create(iehaMD5);
  try
    ImageEnView1.IO.SaveToStreamJpeg(hashStream);
    hashStream.SaveToFile(hashStream.GetHash()+'.jpg');
  finally
    hashStream.Free;
  end;
end;

<FM>Methods and Properties<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TIEHashStream.Create></C> </R>
<R> <C_IMG_METHOD> <C><A TIEHashStream.GetHash></C> </R>
<R> <C_IMG_METHOD> <C><A TIEHashStream.LoadFromFile></C> </R>
<R> <C_IMG_METHOD> <C><A TIEHashStream.LoadFromStream></C> </R>
<R> <C_IMG_METHOD> <C><A TIEHashStream.Write></C> </R>
<R> <C_IMG_METHOD> <C><A TIEHashStream.Read></C> </R>
<R> <C_IMG_METHOD> <C><A TIEHashStream.Seek></C> </R>
<R> <C_IMG_METHOD> <C><A TIEHashStream.SaveToFile></C> </R>
<R> <C_IMG_METHOD> <C><A TIEHashStream.SaveToStream></C> </R>
</TABLE>
!!}
  TIEHashStream = class(TStream)
    private
      m_MemStream: TMemoryStream;
      m_CryptProvider: pointer;
      m_CryptHash: pointer;
    public
      constructor Create(Algorithm: TIEHashAlgorithm=iehaMD5; Buffered: boolean=true);
      destructor Destroy; override;
      function GetHash: AnsiString;
      function Write(const Buffer; Count: longint): longint; override;
      function Read(var Buffer; Count: longint): longint; override;
      {$ifdef IEOLDSEEKDEF}
      function Seek(Offset: longint; Origin: word): longint; override;
      {$else}
      function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
      {$endif}
      procedure SaveToFile(const filename: WideString);
      procedure SaveToStream(Stream: TStream);
      procedure LoadFromFile(const filename: WideString);
      procedure LoadFromStream(Stream: TStream);
  end;


// TIEHashStream
/////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////



  // a memorystream that doesn't create the memory space (and doesn't free it)
  TIEMemStream = class(TCustomMemoryStream)
  public
    constructor Create(Ptr: pointer; Size: integer);
    procedure SetSize(NewSize: Longint); override;
    function Write(const Buffer; Count: Longint): Longint; override;
  end;





///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// TIEScrollBarParams

{!!
<FS>TIEScrollBarParams

<FM>Description<FN>
Allows an application to customize the scrollbar behavior, including tracking (display refresh on mouse dragging), up/down buttons pixel scroll, pagedown/up pixel scroll.

<FM>Properties<FN>
- <A TIEScrollBarParams.LineStep>
- <A TIEScrollBarParams.PageStep>
- <A TIEScrollBarParams.Tracking>
!!}
  TIEScrollBarParams = class
  private
    fLineStep: integer; // click on up/down/left/right (-1=default size)
    fPageStep: integer; // page step (-1=default size)
    fTracking: boolean; // scroll-bar updates display in real-time (true=default)
  public
    constructor Create;
    destructor Destroy; override;

{!!
<FS>TIEScrollBarParams.LineStep

<FM>Declaration<FC>
property LineStep: integer;

<FM>Description<FN>
Specifies the number of pixels to scroll when the user clicks the Up or Down button on the scroll bar.
Setting the property to -1 will make the control scroll one thumbnail per click.

Default: -1
!!}
    property LineStep: integer read fLineStep write fLineStep;

{!!
<FS>TIEScrollBarParams.PageStep

<FM>Declaration<FC>
property PageStep: integer;

<FM>Description<FN>
Specifies is the number of pixels to scroll when the user clicks near the cursor (PAGEUP or PAGEDOWN).
Setting the property to -1 will make the control scroll by one page (i.e. client height) per click.

Default: -1
!!}
    property PageStep: integer read fPageStep write fPageStep;

{!!
<FS>TIEScrollBarParams.Tracking

<FM>Declaration<FC>
property Tracking: boolean

<FM>Description<FN>
Set False to disable display refreshing during mouse dragging.

Default: True
!!}
    property Tracking: boolean read fTracking write fTracking;

  end;

// TIEScrollBarParams
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////


///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// TIEMouseWheelParams

{!!
<FS>TIEMouseWheelParamsAction

<FM>Declaration<FC>
TIEMouseWheelParamsAction = (iemwNone, iemwVScroll, iemwZoom, iemwNavigate, iemwZoomView);

<FM>Description<FN>
The effect that rolling the mouse wheel has upon a control.

<TABLE>
<R> <H>Value</H> <H>Description</H> </R>
<R> <C><FC>iemwNone<FN></C> <C>Mouse wheel has no effect</C> </R>
<R> <C><FC>iemwVScroll<FN></C> <C>Scroll the control up/down</C> </R>
<R> <C><FC>iemwZoom<FN></C> <C>Enlarge/Reduce the image (TImageEnView) or thumbnails (TImageEnMView)</C> </R>
<R> <C><FC>iemwZoomView<FN></C> <C>In TImageEnMView this cycles through the <L TImageEnMView.SetStyleEx>common display styles and sizes</L>. With TImageEnView it works the same way as <FC>iemwZoom<FN></C> </R>
<R> <C><FC>iemwNavigate<FN></C> <C>Navigate to the next/previous image. Note: In <A TImageEnView> this is only relevant for images with multiple frames such as TIFFs and GIFs</C> </R>
</TABLE>
!!}
  TIEMouseWheelParamsAction = (iemwNone, iemwVScroll, iemwZoom, iemwNavigate, iemwZoomView);

{!!
<FS>TIEMouseWheelParamsVariation

<FM>Declaration<FC>
}
  TIEMouseWheelParamsVariation = (iemwAbsolute, iemwPercentage);
{!!}

{!!
<FS>TIEMouseWheelParamsZoomPosition

<FM>Declaration<FC>
}
  TIEMouseWheelParamsZoomPosition = (iemwCenter, iemwMouse);
{!!}

{!!
<FS>TIEMouseWheelParams

<FM>Description<FN>
Properties to customize the mouse wheel behavior.

<FM>Properties<FN>
- <A TIEMouseWheelParams.InvertDirection>
- <A TIEMouseWheelParams.Action>
- <A TIEMouseWheelParams.Variation>
- <A TIEMouseWheelParams.Value>
- <A TIEMouseWheelParams.ZoomPosition>
!!}
  TIEMouseWheelParams = class( TPersistent )
  private
    fInvertDirection: boolean;
    fAction: TIEMouseWheelParamsAction;
    fVariation: TIEMouseWheelParamsVariation;
    fValue: integer;
    fZoomPosition: TIEMouseWheelParamsZoomPosition;
  public

    procedure Assign(Source: TPersistent); override;
    constructor Create(DefaultAction : TIEMouseWheelParamsAction);
    destructor Destroy; override;

  published

{!!
<FS>TIEMouseWheelParams.InvertDirection

<FM>Declaration<FC>
property InvertDirection: boolean;

<FM>Description<FN>
Set to True to invert the wheel direction.

Default: False
!!}
    property InvertDirection: boolean read fInvertDirection write fInvertDirection default False;

{!!
<FS>TIEMouseWheelParams.Action

<FM>Declaration<FC>
property Action: <A TIEMouseWheelParamsAction>;

<FM>Description<FN>
Action specifies the task to perform on mouse wheel events.

<TABLE>
<R> <H>Value</H> <H>Description</H> </R>
<R> <C><FC>iemwNone<FN></C> <C>Mouse wheel has no effect</C> </R>
<R> <C><FC>iemwVScroll<FN></C> <C>Scroll the control up/down</C> </R>
<R> <C><FC>iemwZoom<FN></C> <C>Enlarge/Reduce the image (TImageEnView) or thumbnails (TImageEnMView)</C> </R>
<R> <C><FC>iemwZoomView<FN></C> <C>In TImageEnMView this cycles through the <L TImageEnMView.SetStyleEx>common display styles and sizes</L>. With TImageEnView it works the same way as <FC>iemwZoom<FN></C> </R>
<R> <C><FC>iemwNavigate<FN></C> <C>Navigate to the next/previous image. Note: In <A TImageEnView> this is only relevant for images with multiple frames such as TIFFs and GIFs</C> </R>
</TABLE>

TImageEnView default: iemwZoom
TImageEnMView default: iemwVScroll
TImageEnMView default (Alt): iemwZoom

!!}
    property Action: TIEMouseWheelParamsAction read fAction write fAction; // No default

{!!
<FS>TIEMouseWheelParams.Variation

<FM>Declaration<FC>
property Variation: <A TIEMouseWheelParamsVariation>;

<FM>Description<FN>
Specifies how much scrolling or zooming occurs in response to mouse wheel rotation

<TABLE>
<R> <H>Value</H> <H>Description</H> </R>
<R> <C><FC>iemwAbsolute<FN></C> <C><A TIEMouseWheelParams.Value> contains the absolute value to add or subtract from the current value</C> </R>
<R> <C><FC>iemwPercentage<FN></C> <C><A TIEMouseWheelParams.Value> contains the percentage of variation from the current value</C> </R>
</TABLE>

Default: iemwPercentage

Notes:
- In the case of <A TImageEnMView>, the height is actually based on a theoretical grid of 12.5 thumbnails high. So if <FC>iemwPercentage<FN> is used 8% equates to scrolling one thumbnail per wheel click, whereas 4% would scroll 1/2 a thumbnail
- Has no effect if <A TIEMouseWheelParams.Action> is <FC>iemwNavigate<FN>
!!}
    property Variation: TIEMouseWheelParamsVariation read fVariation write fVariation default iemwPercentage;

{!!
<FS>TIEMouseWheelParams.Value

<FM>Declaration<FC>
property Value: integer;

<FM>Description<FN>
Specifies the Value or percentage of variation.

<TABLE>
<R> <H>Setting for <A TIEMouseWheelParams.Variation></H> <H>Description</H> </R>
<R> <C><FC>iemwAbsolute<FN></C> <C><FC>value<FN> is a specific value to zoom (percentage points) or scroll (pixels) the image</C> </R>
<R> <C><FC>iemwPercentage<FN></C> <C><FC>value<FN> refers to the percentage to increase or decrease the zoom, or the percentage of the window to scroll (e.g. the default of 8 will scroll the window 8% with each mouse wheel click)</C> </R>
</TABLE>

Default: 8

Notes:
- In the case of <A TImageEnMView>, the height is actually based on a theoretical grid of 12.5 thumbnails high. So if <FC>iemwPercentage<FN> is used 8% equates to scrolling one thumbnail per wheel click, whereas 4% would scroll 1/2 a thumbnail
- Has no effect if <A TIEMouseWheelParams.Action> is <FC>iemwNavigate<FN>

!!}
    property Value: integer read fValue write fValue default 8; // value or percentage of variation

{!!
<FS>TIEMouseWheelParams.ZoomPosition

<FM>Declaration<FC>
property ZoomPosition: <A TIEMouseWheelParamsZoomPosition>;

<FM>Description<FN>
If Action is iemwZoom, ZoomPosition specifies where the zoom acts. The default is the center of the control, otherwise (iemwMouse) zooms from the mouse’s position.

Default: iemwCenter

Note: Has no effect with <A TImageEnMView>
!!}
    property ZoomPosition: TIEMouseWheelParamsZoomPosition read fZoomPosition write fZoomPosition default iemwCenter;
  end;

// TIEMouseWheelParams
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  

TIEClientSocket = class
  private
    m_socket: pointer;
    m_littleEndian: boolean;
    function GetConnected: boolean;
  public
    constructor Create;
    destructor Destroy; override;
    // options
    property LittleEndian: boolean read m_littleEndian write m_littleEndian;
    // receive
    procedure ReceiveBuffer(buf: pointer; len: integer);
    function ReceiveBufferSilent(buf: pointer; len: integer): Boolean;
    procedure ReceivePad(len: integer);
    function ReceiveByte(): byte;
    function ReceiveByteSilent(var b: Byte): Boolean;
    function ReceiveWord(): word;
    function ReceiveDWord(): dword;
    // send
    procedure SendBuffer(buf: pointer; len: integer);
    procedure SendPad(len: integer);
    procedure SendByte(value: byte);
    procedure SendWord(value: word);
    procedure SendDWord(value: dword);
    // connect/disconnect
    procedure Connect(const Address: string; Port: word);
    procedure Disconnect();
    property Connected: boolean read GetConnected;
end;



  TIEByteArray = class
  private
    fSize: integer;       // size of datas
    fRSize: integer;      // size of allocated buffer
    fBlockSize: integer;  // allocation block size
    procedure SetSize(v: integer);
  public
    Data: pbytearray;
    constructor Create(InitBlockSize: integer=8192);
    destructor Destroy; override;
    procedure AddByte(v: byte);
    property Size: integer read fSize write SetSize;
    property BlockSize: integer read fBlockSize write fBlockSize;
    procedure Clear;
    function AppendFromStream(Stream: TStream; Count: integer): integer;
  end;




/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
/// TIEIntegerMap (uses integer as keys, integer as values)

  // handles hash code for numeric values
  TIEIntegerMapItem = class
    key:      integer;
    value:    integer;
    nextitem: TIEIntegerMapItem; // nil=end of list
  end;

  TIEIntegerMap = class
  private
    fItems: array of TIEIntegerMapItem;
    fIterateIndex: integer;
    fIterateItem: TIEIntegerMapItem;
    fKeysCount: integer;
    function HashFunc(key: integer): integer;
  public
    constructor Create(bucketsCount: integer = 262144);
    destructor Destroy(); override;
    function Insert(key: integer): boolean; overload;
    function Insert(key: integer; var item: TIEIntegerMapItem): boolean; overload;
    function KeyExists(key: integer): boolean; overload;
    property KeysCount: integer read fKeysCount;
    procedure Clear();

    function IterateBegin(): boolean;
    function IterateNext(): boolean;
    function IterateGetKey(): integer; overload;
    function IterateGetValue(): integer; overload;

    function DumpStats(): string;
  end;

/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
// TIERGBMap (uses TRGB as keys, integer as values)

  TIERGBMap = class(TIEIntegerMap)
  public
    function Insert(const key: TRGB): boolean; overload;
    function Insert(const key: TRGB; value: integer): boolean; overload;
    function KeyExists(const key: TRGB): boolean; overload;
    function IterateGetKey(): TRGB; overload;
  end;

/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////




  TNulStream = class(TStream)
  private
    fposition: integer;
    fsize: integer;
  public
    constructor Create;
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
  end;



/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
/// TIELIST and associated classes

  TIEListChanges = set of (ielItems, ielRange, ielCurrentValue);

  TIEListCurrentValueEvent = procedure(Sender: TObject; Value: pointer) of object;

{!!
<FS>TIEListSortCompareFunc

<FM>Declaration<FC>
}
  TIEListSortCompareFunc = function(Item1, Item2: Pointer): Integer of object;
{!!}

{!!
<FS>TIEList

<FM>Description<FN>
This is the abstract class for <A TIEDoubleList> and <A TIEIntegerList>.

<FM>Implemented Methods<FN>
  <A TIEList.Clear>
  <A TIEList.Delete>
  <A TIEList.Sort>
  <A TIEList.ExchangeItems>

<FM>Implemented Properties<FN>
  <A TIEList.Changed>
  <A TIEList.Count>
!!}
  // abstract class for IE lists
  TIEList = class
  private
    fCapacity: integer;
    fCount: integer;
    fOnGetCurrentValue: TIEListCurrentValueEvent;
    fOnSetCurrentValue: TIEListCurrentValueEvent;

    procedure ListQuickSort(L, R: Integer; SCompare: TIEListSortCompareFunc);
  protected
    fItemSize: integer; // sizeof(...)
    fData: pointer;
    fChanged: TIEListChanges;
    procedure SetCount(v: integer); virtual;
    function AddItem(v: pointer): integer;
    procedure InsertItem(idx: integer; v: pointer);
    function IndexOfItem(v: pointer): integer;
    function BaseGetItem(idx: integer): pointer;
    procedure BaseSetItem(idx: integer; v: pointer);
    procedure DoGetCurrentValue(value: pointer);
    procedure DoSetCurrentValue(value: pointer);
    constructor Create(OnGetCurrentValue: TIEListCurrentValueEvent = nil; OnSetCurrentValue: TIEListCurrentValueEvent = nil);
  public
    destructor Destroy; override;
    procedure Delete(idx: integer); virtual;
    procedure ExchangeItems(idx1, idx2: integer);
    property Count: integer read fCount write SetCount;
    procedure Clear; virtual;
    procedure Assign(Source: TIEList); virtual;
    procedure Sort(Compare: TIEListSortCompareFunc);

{!!
<FS>TIEList.Changed

<FM>Declaration<FC>
property Changed: TIEListChanges;

<FM>Description<FN>
Changed is True whenever the items array, Range or CurrentValue changes.
!!}
    property Changed: TIEListChanges read fChanged write fChanged;

  end;

{!!
<FS>TIEDoubleList

<FM>Declaration<FC>
TIEDoubleList = class(<A TIEList>);

<FM>Description<FN>
TIEDoubleList is a list of double values. You can handle this object as a standard TList object.
An ImageEn list contains an array of values, a current value (not an index of the array), and an allowed range of values.

<FM>Methods and Properties<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TIEDoubleList.Add></C> </R>
<R> <C_IMG_METHOD> <C><A TIEDoubleList.Clear></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEDoubleList.CurrentValue></C> </R>
<R> <C_IMG_METHOD> <C><A TIEDoubleList.IndexOf></C> </R>
<R> <C_IMG_METHOD> <C><A TIEDoubleList.Insert></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEDoubleList.Items></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEDoubleList.RangeMax></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEDoubleList.RangeMin></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEDoubleList.RangeStep></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEList.Changed> (inherited from TIEList)</C> </R>
</TABLE>
!!}
  TIEDoubleList = class(TIEList)
  private
    fRangeMin: double;
    fRangeMax: double;
    fRangeStep: double;
    fCurrentValue: double;
    function GetItem(idx: integer): double;
    procedure SetItem(idx: integer; v: double);
    procedure SetRangeMax(v: double);
    procedure SetRangeMin(v: double);
    procedure SetRangeStep(v: double);
    procedure SetCurrentValue(v: double);
    function GetCurrentValue(): double;
  public
    constructor Create(OnGetCurrentValue: TIEListCurrentValueEvent = nil; OnSetCurrentValue: TIEListCurrentValueEvent = nil); overload;
    function Add(v: double): integer;
    procedure Insert(idx: integer; v: double);
    procedure Clear; override;
    function IndexOf(v: double): integer;
    property RangeMin: double read fRangeMin write SetRangeMin;
    property RangeMax: double read fRangeMax write SetRangeMax;
    property RangeStep: double read fRangeStep write SetRangeStep;
    property Items[idx: integer]: double read GetItem write SetItem; default;
    procedure Assign(Source: TIEList); override;
    property CurrentValue: double read GetCurrentValue write SetCurrentValue;
  end;

{!!
<FS>TIEIntegerList

<FM>Declaration<FC>
TIEIntegerList = class(<A TIEList>);

<FM>Description<FN>
TIEIntegerList is a list of integer values. You can handle this object as a standard TList object.
An ImageEn list contains an array of values, a current value (not an index of the array), and an allowed range of values.

<FM>Methods and Properties<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TIEIntegerList.Add></C> </R>
<R> <C_IMG_METHOD> <C><A TIEIntegerList.Clear></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEIntegerList.CurrentValue></C> </R>
<R> <C_IMG_METHOD> <C><A TIEIntegerList.IndexOf></C> </R>
<R> <C_IMG_METHOD> <C><A TIEIntegerList.Insert></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEIntegerList.Items></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEIntegerList.RangeMax></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEIntegerList.RangeMin></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEIntegerList.RangeStep></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEList.Changed> (inherited from TIEList)</C> </R>
</TABLE>
!!}
  TIEIntegerList = class(TIEList)
  private
    fRangeMin: integer;
    fRangeMax: integer;
    fRangeStep: integer;
    fCurrentValue: integer;
    function GetItem(idx: integer): integer;
    procedure SetItem(idx: integer; v: integer);
    procedure SetRangeMax(v: integer);
    procedure SetRangeMin(v: integer);
    procedure SetRangeStep(v: integer);
    procedure SetCurrentValue(v: integer);
    function GetCurrentValue(): integer;
  public
    constructor Create(OnGetCurrentValue: TIEListCurrentValueEvent = nil; OnSetCurrentValue: TIEListCurrentValueEvent = nil); overload;
    function Add(v: integer): integer;
    procedure Insert(idx: integer; v: integer);
    procedure Clear; override;
    function IndexOf(v: integer): integer;
    property RangeMin: integer read fRangeMin write SetRangeMin;
    property RangeMax: integer read fRangeMax write SetRangeMax;
    property RangeStep: integer read fRangeStep write SetRangeStep;
    property Items[idx: integer]: integer read GetItem write SetItem; default;
    procedure Assign(Source: TIEList); override;
    property CurrentValue: integer read GetCurrentValue write SetCurrentValue;
  end;

  TIERecordList = class(TIEList)
  private
    function GetItem(idx: integer): pointer;
    procedure SetItem(idx: integer; v: pointer);
  public
    constructor Create(RecordSize: integer; OnGetCurrentValue: TIEListCurrentValueEvent = nil; OnSetCurrentValue: TIEListCurrentValueEvent = nil); overload;
    function Add(v: pointer): integer;
    procedure Insert(idx: integer; v: pointer);
    function IndexOf(v: pointer): integer;
    property Items[idx: integer]: pointer read GetItem write SetItem; default;
  end;

                                                                                 
/// TIELIST and associated classes
/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////


  TIETemporaryFileStream = class(THandleStream)
  private
    FHandle: THandle;
  public
    constructor Create(const FileName: string);
    destructor Destroy; override;
  end;

  TIEWideFileStream = class(THandleStream)
  private
    FFileName: WideString;
  public
    constructor Create(const FileName: WideString; Mode: Word);
    destructor Destroy; override;
    property FileName: WideString read FFileName;
  end;

  TIEFileBufferItem = record
    Pos: int64; // buffer position inside the file
    Size: int64; // buffer size
    ptr: pointer; // allocated buffer
    access: TIEDataAccess;
  end;
  PIEFileBufferItem = ^TIEFileBufferItem;

  // emulates a memory mapped file
  TIEFileBuffer = class
  private
    function IndexOf(ptr: pointer): integer;
  public
    fSimFile: TStream; // 3.0.3, can be TIETemporaryFileStream or TMemoryStream
    fFileName: string;
    fMapped: TList; // list of TIEFileBufferItem structures

    constructor Create;
    destructor Destroy; override;
    function AllocateFile(InSize: int64; const Descriptor: string; UseDisk: boolean): boolean;
    procedure ReAllocateFile(NewSize: int64);
    function Map(InPos, InSize: int64; DataAccess: TIEDataAccess): pointer;
    procedure UnMap(ptr: pointer);
    procedure UnMapAll;
    function IsAllocated: boolean;
    procedure DeAllocate;
    procedure CopyTo(Dest: TIEFileBuffer; InPos, InSize: int64); overload;
    procedure CopyTo(Dest: TStream; InPos, InSize: int64); overload;
    procedure CopyFrom(DestPos: int64; Source: pointer; Size: int64);
  end;


{$ifdef IEINCLUDERESOURCEEXTRACTOR}

{!!
<FS>TIEResourceBookmark

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\InputOutput\ResourceLoader\ResourceLoader.dpr </C> </R>
</TABLE>

<FM>Methods and properties<FN>
- <A TIEResourceBookmark.TypeIndex>
- <A TIEResourceBookmark.NameIndex>
- <A TIEResourceBookmark.FrameIndex>
!!}
TIEResourceBookmark = class
  private
    m_TypeIndex: integer;
    m_NameIndex: integer;
    m_FrameIndex: integer;

  public


{!!
<FS>TIEResourceBookmark.TypeIndex

<FM>Declaration<FC>
property TypeIndex: integer;

<FM>Description<FN>
Resource type index of this bookmark.
!!}
    property TypeIndex: integer read m_TypeIndex;

{!!
<FS>TIEResourceBookmark.NameIndex

<FM>Declaration<FC>
property NameIndex: integer;

<FM>Description<FN>
Resource name index of this bookmark.
!!}
    property NameIndex: integer read m_NameIndex;

{!!
<FS>TIEResourceBookmark.FrameIndex

<FM>Declaration<FC>
property FrameIndex: integer;

<FM>Description<FN>
Frame index of a grouped resource of this bookmark.
!!}
    property FrameIndex: integer read m_FrameIndex;

    constructor Create(TypeIndex_, NameIndex_, FrameIndex_: integer);
end;


{!!
<FS>TIEResourceExtractor

<FM>Description<FN>
TIEResourceExtractor class helps to extract resources from a PE files like EXE, DLL, OCX, ICL, BPL, etc..
In details, it is intended to extract Icons, Bitmaps, Cursors and other image resources.

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\InputOutput\ResourceLoader\ResourceLoader.dpr </C> </R>
</TABLE>

<FM>Example<FC>
// loads resource 143, in "Bitmap"s, from "explorer.exe" (should be a little Windows logo)
var
  re: TIEResourceExtractor;
  buffer: pointer;
  bufferLen: integer;
begin
  re := TIEResourceExtractor.Create('explorer.exe');
  try
    buffer := re.GetBuffer('Bitmap', 'INTRESOURCE:143', bufferLen);
    ImageEnView1.IO.Params.IsResource := true;
    ImageEnView1.IO.LoadFromBuffer(buffer, bufferLen, ioBMP);
  finally
    re.Free;
  end;
end;

<FM>Methods and Properties<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TIEResourceExtractor.Create></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEResourceExtractor.FriendlyTypes></C> </R>
<R> <C_IMG_METHOD> <C><A TIEResourceExtractor.GetBuffer></C> </R>
<R> <C_IMG_METHOD> <C><A TIEResourceExtractor.GetFrameBuffer></C> </R>
<R> <C_IMG_METHOD> <C><A TIEResourceExtractor.GetGroupAndFrame></C> </R>
<R> <C_IMG_METHOD> <C><A TIEResourceExtractor.GetResourceBookmark></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEResourceExtractor.GroupCountFrames></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEResourceExtractor.GroupFrameDepth></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEResourceExtractor.GroupFrameHeight></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEResourceExtractor.GroupFrameName></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEResourceExtractor.GroupFrameWidth></C> </R>
<R> <C_IMG_METHOD> <C><A TIEResourceExtractor.IndexOfType></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEResourceExtractor.IsGroup></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEResourceExtractor.IsGrouped></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEResourceExtractor.IsValid></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEResourceExtractor.Names></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEResourceExtractor.NamesCount></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEResourceExtractor.TypesCount></C> </R>
<R> <C_IMG_PROPERTY> <C><A TIEResourceExtractor.Types></C> </R>
</TABLE>

!!}
TIEResourceExtractor = class
  private
    m_hlib: THandle;
    m_typesList: TStringList;
    m_resourceBookmarks: TList;
    function GetTypesCount: integer;
    function GetNamesCount(TypeIndex: integer): integer;
    function GetTypes(TypeIndex: integer): AnsiString;
    function GetNames(TypeIndex: integer; NameIndex: integer): AnsiString;
    function GetFriendlyTypes(TypeIndex: integer): AnsiString;
    function GetIsValid: boolean;
    function GetGroupCountFrames(TypeIndex: integer; NameIndex: integer): integer;
    function GetGroupFrameWidth(TypeIndex: integer; NameIndex: integer; FrameIndex: integer): integer;
    function GetGroupFrameHeight(TypeIndex: integer; NameIndex: integer; FrameIndex: integer): integer;
    function GetGroupFrameDepth(TypeIndex: integer; NameIndex: integer; FrameIndex: integer): integer;
    function GetGroupFrameName(TypeIndex: integer; NameIndex: integer; FrameIndex: integer): AnsiString;
    function GetIsGroup(TypeIndex: integer): boolean;
    function GetIsGrouped(TypeIndex: integer): boolean;
  public
    constructor Create(const Filename: WideString);
    destructor Destroy; override;
    property TypesCount: integer read GetTypesCount;
    property Types[TypeIndex: integer]: AnsiString read GetTypes;
    property FriendlyTypes[TypeIndex: integer]: AnsiString read GetFriendlyTypes;
    property NamesCount[TypeIndex: integer]: integer read GetNamesCount;
    property Names[TypeIndex: integer; NameIndex: integer]: AnsiString read GetNames;
    function GetBuffer(TypeIndex: integer; NameIndex: integer; var BufferLength: integer): pointer; overload;
    function GetBuffer(const TypeStr: AnsiString; const NameStr: AnsiString; var BufferLength: integer): pointer; overload;
    function GetBuffer(ResourceBookmark: TIEResourceBookmark; var BufferLength: integer): pointer; overload;
    property IsValid: boolean read GetIsValid;
    property IsGroup[TypeIndex: integer]: boolean read GetIsGroup;
    property IsGrouped[TypeIndex: integer]: boolean read GetIsGrouped;
    property GroupCountFrames[TypeIndex: integer; NameIndex: integer]: integer read GetGroupCountFrames;  // number of frames for specified icon/cursor
    property GroupFrameWidth[TypeIndex: integer; NameIndex: integer; FrameIndex: integer]: integer read GetGroupFrameWidth;
    property GroupFrameHeight[TypeIndex: integer; NameIndex: integer; FrameIndex: integer]: integer read GetGroupFrameHeight;
    property GroupFrameDepth[TypeIndex: integer; NameIndex: integer; FrameIndex: integer]: integer read GetGroupFrameDepth;
    property GroupFrameName[TypeIndex: integer; NameIndex: integer; FrameIndex: integer]: AnsiString read GetGroupFrameName;
    procedure GetGroupAndFrame(TypeIndex: integer; NameIndex: integer; var GroupTypeIndex: integer; var GroupIndex: integer; var GroupFrameIndex: integer);
    function IndexOfType(TypeName: AnsiString): integer;
    function GetFrameBuffer(TypeIndex: integer; NameIndex: integer; FrameIndex: integer; var BufferLength: integer): pointer;
    function GetResourceBookmark(TypeIndex: integer; NameIndex: integer; FrameIndex: integer = -1): TIEResourceBookmark;
end;

{$endif}  // IEINCLUDERESOURCEEXTRACTOR

///////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////


// Xorshift pseudo number generator by George Marsaglia
//type
TIERandomGenerator = class
  private
    x, y, z, w: dword;
  public
    constructor Create(Seed: dword); overload;
    constructor Create(Seed: AnsiString); overload;
    constructor Create(Seed1, Seed2, Seed3, Seed4: dword); overload;
    function NextDWORD(): dword;
    function NextINT64(): int64;
end;


/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////

TIE8087ExceptionsDisabler = class
  private
    FPUControlWord: Word;
  public
    constructor Create();
    destructor Destroy(); override;
end;


/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
// TIEStringSplitter
// Another way to split a string using delimiters
// Use inplace of TStringList.DelimitedText, when possible

TIEStringSplitter = class
private
  procedure SetText(const Text: string);
  function GetText(): string;
  function GetString(Index: integer): string;
  function GetCount(): integer;
  function GetDelimiters(): string;
  procedure SetDelimiters(const Value: string);
  function GetBypassSpaces(): boolean;
  procedure SetBypassSpaces(Value: boolean);
  function IsSpace(c: char): boolean;

protected
  procedure Update();

public
  constructor Create(const Text: string = ''; const Delimiters: string = ' ');
  destructor Destroy(); override;

  property Text: string read GetText write SetText;
  property Strings[Index: integer]: string read GetString; default;
  property Count: integer read GetCount;
  property Delimiters: string read GetDelimiters write SetDelimiters;
  property BypassSpaces: boolean read GetBypassSpaces write SetBypassSpaces;

private
  m_text: string;
  m_strings: TStringList;
  m_delimiters: string;
  m_bypassSpaces: boolean;
end;



/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
// Functions

function _GetBitCount(b: Integer): Integer;
function IEGetFirstSetBit(b: Integer): Integer;
function _NColToBitsPixel(NCol: integer): integer;
function IEBitmapRowLen(Width: integer; BitCount: integer; align: integer): int64;
function IEVCLPixelFormat2RowLen(Width: integer; PixelFormat: TPixelFormat): integer;
function IEVCLPixelFormat2BitCount(PixelFormat: TPixelFormat): integer;
function IEBitCount2VCLPixelformat(Bitcount: integer): TPixelFormat;
function IEVCLPixelFormat2ImageEnPixelFormat(PixelFormat: TPixelFormat): TIEPixelFormat;
function IEPixelFormat2BitCount(PixelFormat: TIEPixelFormat): integer;
function IEPixelFormat2ChannelCount(PixelFormat: TIEPixelFormat): integer;

{$ifdef IEUSEASM}
procedure ReverseBits(var inp: dword); assembler;
{$else}
procedure ReverseBits(var inp: dword);
{$endif}

procedure ReverseBitsB(var inp: byte);
procedure _CastPolySelCC(const x1, y1: integer; var x2, y2: integer);
function _RectXRect(ax1, ay1, ax2, ay2, bx1, by1, bx2, by2: integer): boolean;
function _RectPRect(ax1, ay1, ax2, ay2, bx1, by1, bx2, by2: integer): integer;
function IEPointInRect(xx, yy, x1, y1, x2, y2: integer): boolean; overload;
function IEPointInRect(xx, yy : integer; ARect: TRect): boolean; overload;
function _InRectO(xx, yy, x1, y1, x2, y2: integer): boolean;
function IEGetFileSize(const FileName: string): int64; 
function PromptForColor(var AColor : TColor): Boolean;
procedure IESaveStringToStream(Stream: TStream; const ss: AnsiString); overload;
procedure IELoadStringFromStream(Stream: TStream; var ss: AnsiString); overload;
{$IfDef UNICODE}
procedure IESaveStringToStream(Stream: TStream; const ss: UnicodeString); overload;
procedure IELoadStringFromStream(Stream: TStream; var ss: UnicodeString); overload;
{$EndIf}
procedure IESaveStringToStreamW(Stream: TStream; const ss: widestring);
procedure IELoadStringFromStreamW(Stream: TStream; var ss: widestring); overload;
procedure IELoadStringFromStreamW(Stream: TStream; var ss: String); overload;
procedure IESaveStringListToStream(Stream: TStream; sl: TStringList);
procedure IELoadStringListFromStream(Stream: TStream; sl: TStringList);

procedure IELoadFontFromStream(Stream: TStream; var Font: TFont);
procedure IESaveFontToStream(Stream: TStream; const Font: TFont);

function _GetNumCol(BitsPerSample: integer; SamplesPerPixel: integer): integer;
function iemsg(const msg: TMsgLanguageWords): WideString;

procedure IESetTranslationWord(const lang: TMsgLanguage; const msg: TMsgLanguageWords; const trans: AnsiString);
procedure IESetTranslationWordU(const lang: TMsgLanguage; const msg: TMsgLanguageWords; const trans: string);

function _DistPoint2Line(xp, yp, x1, y1, x2, y2: integer): double;
function _DistPoint2Seg(xp, yp, x1, y1, x2, y2: integer): double;
function _DistPoint2Point(x1, y1, x2, y2: integer): double;
function IEDDistPoint2Point(x1, y1, x2, y2: double): double;
function _DistPoint2Polyline(x, y: integer; PolyPoints: PPointArray; PolyPointsCount: integer; ToSubX, ToSubY, ToAddX, ToAddY: integer; ToMulX, ToMulY: double; penWidth: integer; closed: boolean): double;
function IEDistPoint2Ellipse(x, y, x1, y1, x2, y2: integer; filled: boolean; penWidth: integer): double;
function IEDist2Box(x, y, x1, y1, x2, y2: integer; filled: boolean; penWidth: integer): double;
function IEDistParallelLines(FirstLinePointA: TIE2DPoint; FirstLinePointB: TIE2DPoint; SecondLinePoint: TIE2DPoint): double;
function IESignedTriangleArea(Point1: TIE2DPoint; Point2: TIE2DPoint; Point3: TIE2DPoint): double;
procedure IEOrthogonalTranslate(OrigSegmentA, OrigSegmentB: TIE2DPoint; Point: TIE2DPoint; out OffsetX: double; out OffsetY: double);

function IEMMXSupported: bytebool;
//procedure IEMul64(op1, op2: dword; resultlo: pdword; resulthi: pdword);
//function IEAdd64(op1_lo, op1_hi, op2_lo, op2_hi: dword; result_lo, result_hi: pdword): integer;
//function IEGreater64(op1_lo, op1_hi, op2_lo, op2_hi: dword): boolean;
procedure SafeStreamWrite(Stream: TStream; var Aborting: boolean; const Buffer; Count: Longint);
// procedure IEBitmapMapXCopy(map: pbyte; maprowlen: dword; mapbitcount: dword; bitmap: TBitmap; mapx, mapy, bitmapx, bitmapy, dx, dy: dword; dir: integer);
function IEPower2(const Base, Exponent: Double): Double;
function IESwapWord(i: word): word;
function IESwapDWord(i: integer): integer;
function IESwapInt64(i: int64): int64;

procedure IESwap(var a: integer; var b: integer); overload;
procedure IESwap(var a: double; var b: double); overload;
procedure IESwap(var a: boolean; var b: boolean); overload;
procedure IESwap(var a: TIELayerMagnification; var b: TIELayerMagnification); overload;
procedure IESwap(var a: TIERenderOperation; var b: TIERenderOperation); overload;
procedure IESwap(var a: pointer; var b: pointer); overload;
procedure IESwap(var a: TResampleFilter; var b: TResampleFilter); overload;
procedure IESwap(var a: AnsiString; var b: AnsiString); overload;
{$IfDef UNICODE}
procedure IESwap(var a: UnicodeString; var b: UnicodeString); overload;
{$EndIf}
procedure IESwap(var a: TGuid; var b: TGuid); overload;
procedure IESwap(var a: TRGB; var b: TRGB); overload;
procedure IESwap(var a: TIEArrayOfTRGB; var b: TIEArrayOfTRGB); overload;
procedure IESwap(var a: TRect; var b: TRect); overload;
procedure IESwap(var a: TIEShape; var b: TIEShape); overload;
procedure IESwap(var a: TColor; var b: TColor); overload;
procedure IESwap(var a: TFont; var b: TFont); overload;
procedure IESwap(var a: TPoint; var b: TPoint); overload;

procedure IEChangeEndiannessWordArray(buffer: pword; items: integer);
procedure IEChangeEndiannessDWordArray(buffer: pdword; items: integer);

procedure IERightShadow(Canvas: TCanvas; DestBitmap: TBitmap; x1, y1, x2, y2: integer; st: TIEShadowType; dstColor: TColor);
procedure IEBottomShadow(Canvas: TCanvas; DestBitmap: TBitmap; x1, y1, x2, y2: integer; st: TIEShadowType; dstColor: TColor);
procedure IERectShadow(Bitmap: TBitmap; x1, y1, x2, y2: integer; dstColor: TColor);
function IEFloatToStrA(Value: Extended): AnsiString;
function IEFloatToStrW(Value: Extended): WideString;
function IEFloatToStrS(Value: Extended): string;
function IEFindHandle(cmp: TComponent): HWND;
procedure DrawDibDrawEmu(hdd: THandle; hDC: THandle; xDst, yDst, dxDst, dyDst: Integer; var lpbi: TBitmapInfoHeader; Bits: Pointer; xSrc, ySrc, dxSrc, dySrc: Integer; wFlags: UInt);
procedure DrawDib(hDC: THandle; xDst, yDst, dxDst, dyDst: Integer; var lpbi: TBitmapInfoHeader; Bits: Pointer; xSrc, ySrc, dxSrc, dySrc: Integer);
function IEDrawDibClose(hdd: hDrawDib): Boolean;
function IEDrawDibDraw(hdd: hDrawDib; hDC: THandle; xDst, yDst, dxDst, dyDst: Integer; var lpbi: TBitmapInfoHeader; Bits: Pointer; xSrc, ySrc, dxSrc, dySrc: Integer; wFlags: UInt): Boolean;
function IEDrawDibOpen: hDrawDib;
function IEDrawDibRealize(hdd: hDrawDib; hDC: THandle; fBackground: Bool): UInt;
procedure IECenterWindow(Wnd: HWnd);
procedure IEResetPrinter;
function IEStrToFloatDefA(s: AnsiString; Def: extended): extended;
function IEStrToFloatDefW(s: WideString; Def: extended): extended;
function IEStrToFloatDefS(s: String; Def: extended): extended;
function IEStrToFloatDef(s: String; Def: extended): extended;
function IERGB2CIELAB(rgb: TRGB): TCIELAB;
function IECIELAB2RGB(const lab: TCIELAB): TRGB;
procedure IEDraw3DRect(Canvas: TCanvas; x1, y1, x2, y2: integer; cl1, cl2: TColor);
procedure IEDraw3DRect2(Canvas: TObject; x1, y1, x2, y2: integer; cl1, cl2: TColor);
procedure IEDrawHint(Canvas: TCanvas; var x, y: integer; const ss: string; Font: TFont; Brush: TBrush; var SaveBitmap: TBitmap; MaxWidth, MaxHeight: integer; Border1, Border2: TColor);
procedure IEDrawHint2(Canvas: TCanvas; var x, y: integer; const ss: string; const minText: string);
function IEDirectoryExists(const Name: string): Boolean;
procedure IEForceDirectories(Dir: string);
function IEGetMemory(freememory: boolean): int64;
procedure IECalcUnitsPerPixel(DpiX, DpiY: Integer; mu: TIEUnits; out cx, cy: double);
procedure IESetPlim(var plim: trect; x, y: integer);
function IEAngle(x1, y1, x2, y2, x3, y3: double): double;
function IEAngle2(x1, y1, x2, y2: integer): double;
function IEAngle3(x1, y1, xc, yc, x2, y2: integer): double;
function IEGetReferenceAngle(Angle: double): double;
function IEArcCos(X: Extended): Extended;
function IEDegreesToRadians(Angle: Double): Double;
function IERadiansToDegrees(Rad: Double): Double;
function IEExtractStylesFromLogFont(logfont: PLogFontA): TFontStyles;
function IEExtractStylesFromLogFontW(logfont: PLogFontW): TFontStyles;
procedure IECopyLogFont(src: PLogFontA; dst: PLogFontW);
function IEConvertGUIDToString(g: PGUID): AnsiString;
function CompareGUID(const g1, g2: TGuid): boolean;
procedure IEConvertAStringToGUID(invar: AnsiString; gg: PGUID);
procedure IEConvertWStringToGUID(invar: WideString; gg: PGUID);
procedure IEGetFitResampleSize(owidth, oheight, fwidth, fheight: integer; out rwidth, rheight: integer);
procedure IEGetFitResampleSizeWithAutoCrop(iImageWidth, iImageHeight, iAvailableWidth, iAvailableHeight: integer; out RWidth, RHeight: integer;
                                           iAutoCropPercent : Integer; out RAutoWidth, RAutoHeight: integer);
function IEIsRemoteSession(): boolean;


// timeout support
function IESetupTimeout(): dword;
function IEIsTimeoutExpired(startTime: dword; timeout: dword): boolean;

procedure IERotatePoints(var rpt: array of TPoint; PointCount: Integer; angle: double; CenterX, CenterY: integer);
procedure IEDRotatePoints(var rpt: array of TIE2DPoint; angle: double);
procedure IEDRotatePointsWithCenter(var rpt: array of TIE2DPoint; angle: double; CenterX, CenterY: double);
procedure IEDRotateTwoPoints(Angle: double; const P1: TIE2DPoint; const P2: TIE2DPoint; out OutP1: TIE2DPoint; out OutP2: TIE2DPoint);
procedure IERotatePoint(var px, py: integer; angle: double; CenterX, CenterY: integer);
procedure IEDRotatePoint(var px, py: double; angle: double; CenterX, CenterY: double);
function IECalcRotatedRectBoundingBox(Rectangle: TIEDRectangle; RotationCenter: TIE2DPoint; RotationAngle: double): TIEDRectangle;
procedure IECalcRotatedBitmapSizes(Width, Height: integer; RotationCenter: TIE2DPoint; RotationAngle: double; out NewWidth: integer; out NewHeight: integer);
procedure IERotateBits(Bits: TIEArrayOfByte; Width, Height: integer; RowAlignment: integer; RotationCenter: TIE2DPoint; RotationAngle: double; Background: integer; MaintainOriginalSize: boolean; out outBits: TIEArrayOfByte; out outWidth: integer; out outHeight: integer);

procedure IEGetPointsRange(rpt: array of TPoint; PointCount: Integer; out MinX: Integer; out MinY: Integer; out MaxX: Integer; out MaxY: Integer);
procedure IEScalePoints(var rpt: array of TPoint; PointCount: Integer; MinX, MinY, MaxX, MaxY: Integer; MaintainAR: Boolean = False);

function IECalcOrthogonalLinesIntersectingPoint(FirstLinePoint: TIE2DPoint; FirstLineSlope: double; SecondLinePoint: TIE2DPoint): TIE2DPoint;

function IECalcPolygonCentroid(polygon: array of TIE2DPoint): TIE2DPoint;

function IECreateRotatedCursor(CursorIntResource: integer; RotationAngle: double): HCURSOR;

procedure IECenterRectInRect(OuterRectX1, OuterRectY1, OuterRectX2, OuterRectY2: integer; var InnerRectX1: integer; var InnerRectY1: integer; var InnerRectX2: integer; var InnerRectY2: integer);
procedure CalcLineWithinRect(R: TRect; Angle: Integer; out Pt1, Pt2: TPoint);
function OffsetPoint(Pt: TPoint; Dist: Double; Angle: Double) : TPoint;

function IEISPointInPoly(x, y: integer; poly: array of TPoint): boolean;
function IEDISPointInPoly(x, y: double; poly: array of TIE2DPoint): boolean;
function IEISPointInPoly2(x, y: integer; PolyPoints: PPointArray; PolyPointsCount: integer; ToSubX, ToSubY, ToAddX, ToAddY: integer; ToMulX, ToMulY: double): boolean;

function IEASCII85EncodeBlock(var inbytes: pbyte; buflen: integer; var outstr: PAnsiChar; var asciilen: integer): integer;
function IEASCII85DecodeBlock(var instr: PAnsiChar; buflen: integer; var outbytes: pbyte): integer;
function IEPSRunLengthEncode(inbytes: pbytearray; inlen: integer; outbytes: pbytearray): integer;
procedure IEWriteStrLn(s: TStream; ss: AnsiString);
function IECopyFrom(Dest: TStream; Source: TStream; Count: int64): int64;

function IEStrLen(const Str: PAnsiChar): Cardinal;
function IEStrLenW(Str: PWideChar): Cardinal;
function IEStrCopy(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar;
function IEStrCopyW(Dest: PWideChar; Source: PWideChar): PWideChar;
function IEStrPCopy(Dest: PAnsiChar; const Source: AnsiString): PAnsiChar;
function IEStrPCopyW(Dest: PWideChar; const Source: WideString): PWideChar;
function IEStrPCopyWA(Dest: PWideChar; Source: TIEArrayOfAnsiChar): PWideChar;
function IEStrMove(Dest: PAnsiChar; const Source: PAnsiChar; Count: Cardinal): PAnsiChar;
function IEAnsiStrScan(Str: PAnsiChar; Chr: AnsiChar): PAnsiChar;
function IEStrScan(const Str: PAnsiChar; Chr: AnsiChar): PAnsiChar;
function IEStrRScan(const Str: PAnsiChar; Chr: AnsiChar): PAnsiChar;
function IETextToFloat(Buffer: PAnsiChar; var Value; ValueType: TFloatValue): Boolean; overload;

function IEGetDecimalSeparator: Char;
procedure IESetDecimalSeparator(c: Char);


function IEOpenClipboard: boolean;

procedure IEDrawGrayedOut(Canvas: TCanvas; XDst, YDst, WidthDst, HeightDst: integer; SX1, SY1, SX2, SY2: integer);

{!!
<FS>IEGetCoresCount

<FM>Declaration<FC>
function IEGetCoresCount(): integer;

<FM>Description<FN>
Returns the total amount of processor's cores present on the system.

Some Windows operating system versions cannot communicate this information, so it defaults to <A TIEImageEnGlobalSettings.DefaultCoresCount>.
!!}
function IEGetCoresCount(): integer;


function IEGetRequiredThreads(ImageWidth, ImageHeight: integer): integer;


procedure IEEncode64(SrcStream: TStream; DstStream: TStream; linesize: integer); overload;
function IEEncode64(SrcBuffer: pbyte; SrcBufferLength: integer; linesize: integer): AnsiString; overload;
procedure IEDecode64(SrcStream: TStream; DstStream: TStream); overload;
function IEDecode64(SrcString: AnsiString): TIEArrayOfByte; overload;

function IEStreamFindString(Stream: TStream; Text: AnsiString; StopAtPos: int64): int64;

function IEGetDosOutput(CommandLine: AnsiString; Work: AnsiString = 'C:\'): AnsiString;


{$ifndef IEHASUINT64}
function UInt64(v : Pointer) : int64; overload;
function UInt64(v : Integer) : int64; overload;
{$endif}

{$ifndef IEHASNATIVEINT}
function Nativeint(v: Pointer): DWORD; overload;
function Nativeint(v: Char): DWORD; overload;
{$endif}



{$IfNDef Delphi6orNewer}
function Get8087CW: Word; // for D5
{$ENDIF}

function IESetScrollRange(hWnd: HWND; nBar, nMinPos, nMaxPos: Integer; bRedraw: BOOL; flat: boolean): BOOL;
procedure IESetSBPageSize(HScrollBar: THandle; fnBar: integer; PageSize: Integer; Redraw: boolean; flat: boolean);
function IESetScrollPos(hWnd: HWND; nBar, nPos: Integer; bRedraw: BOOL; flat: boolean): Integer;
function IEEnableScrollBar(hWnd: HWND; wSBflags, wArrows: UINT; flat: boolean = False): BOOL;
function IEShowScrollBar(hWnd: HWND; wBar: Integer; bShow: BOOL; flat: boolean = False): BOOL;
function IESetScrollInfo(hWnd: HWND; BarFlag: Integer; const ScrollInfo: TScrollInfo; Redraw: BOOL; flat: boolean): Integer;
procedure IESetScrollBar(hWnd: HWND; nBar: integer; nMinPos: integer; nMaxPos: integer; PageSize: integer; nPos: integer; bRedraw: boolean; flat: boolean = False);

function IEIsSpace(c: AnsiChar): boolean;

function IERemoveCtrlCharsA(const text: AnsiString): AnsiString;
function IERemoveCtrlCharsW(const text: WideString): WideString;
function IERemoveCtrlCharsS(const text: String): String;

function IERGBColorsMatch(rgb1, rgb2 : TRGB; Tolerance : Integer = 0): Boolean;
function IERGB2StrS(c: TRGB): string;
function IERGB2StrW(c: TRGB): WideString;
function IEBool2StrS(v: boolean): string;
function IEBool2StrW(v: boolean): WideString;
function IEStr2RGBS(const rgbstr: string): TRGB;
function IEStr2RGBW(const rgbstr: WideString): TRGB;
function IEStr2BoolS(const v: string): boolean;
function IEStr2BoolW(const v: WideString): boolean;
function IEStr2BoolA(const v: AnsiString): boolean;
function IEStr2ColorDefS(const v : string; ADefault : TColor) : TColor;

function IECopyArrayOfByte(const Input: TIEArrayOfByte): TIEArrayOfByte;
function IECopyArrayOfInteger(const Input: TIEArrayOfInteger): TIEArrayOfInteger;

procedure IEQuickSort(ItemsCount: integer; CompareFunction: TIECompareFunction; SwapFunction: TIESwapFunction);

function IEGetTempFileName(const Descriptor: string; const Directory: string): string;
function IEGetTempFileName2: string;
function IEGetNewFilename(const sBaseFilename: string; const sSepChar: Char = ' '): string;

procedure IERGB2YCbCr(rgb: TRGB; var Y, Cb, Cr: integer);
procedure IEYCbCr2RGB(var rgb: TRGB; Y, Cb, Cr: integer);

function IESystemAlloc(ASize: int64): pointer;
procedure IESystemFree(var P);
function IEAutoAlloc(ASize: int64): pointer;
procedure IEAutoFree(var P);

procedure IESilentGetMem(var P; Size: Integer);

procedure IECreateOSXBackgroundPaper(bmp: TBitmap; width, height: integer);
procedure IECreateOSXBackgroundMetal(bmp: TBitmap; width, height: integer);

// clipboard helpers
function IEEnumClipboardNames: TStringList;
function IEGetClipboardDataByName(const name: string): THandle;

// alpha/opacity
function IEAlphaToOpacity(Alpha: integer ): integer;
function IEOpacityToAlpha(Opacity: integer): integer;

function IEIsLeftMouseButtonPressed: boolean;

function IERGBToStr(rgb: TRGB): AnsiString;

function IEExtractFileExtS(const FileName: string; includeDot: boolean=true): string;
function IEExtractFileExtW(const FileName: WideString; includeDot: boolean=true): WideString;
function IEExtractFileExtA(const FileName: AnsiString; includeDot: boolean=true): AnsiString;
function IEAddBackSlash(const Path: String): String;
function IETrim(const v: AnsiString): AnsiString;
function IEUpperCase(const v: AnsiString): AnsiString;
function IELowerCase(const v: AnsiString): AnsiString;
function IEIntToStr(v: integer): AnsiString;
function IEStrToIntDef(const s: AnsiString; def: integer): integer;
function IEBytesToStr(v: integer; iThreshold: Integer = 100 * 1024): AnsiString;
function IEBytesToStr2(iBytes: Int64) : AnsiString;
function IEIntToFormattedStr(v: integer; iMaxDigitsOfPrecision: Integer = 0): AnsiString;
function IECopy(S: AnsiString; Index, Count: Integer): AnsiString;
function IEFloatToStrFA(Value: Extended; Format: TFloatFormat; Precision, Digits: Integer): AnsiString;
function IEFloatToStrFS(Value: Extended; Format: TFloatFormat; Precision, Digits: Integer): string;
function IEIntToHex(Value: Integer; Digits: Integer): AnsiString;
function IEPos(Substr: AnsiString; S: AnsiString): Integer;
function IEStrDup(s: PAnsiChar): PAnsiChar;
function IEStrDupW(s: PWideChar): PWideChar;
function IEExtractFilePathA(const FileName: AnsiString): AnsiString;
function IEExtractFilePathW(const FileName: WideString): WideString;
function IEExtractFileNameW(const FileName: WideString): WideString;
function IEExtractFileNameWithoutExt(const FileName: String): String;
function IE2DPoint(X, Y: double): TIE2DPoint;
function IEFindNearestColor(color: TRGB; palette: TIEArrayOfTRGB; colorCount: integer): integer;

function IEGetOpSys(): TIEOpSys;
function IEGetDisplayOrientation(): integer;

function IEFilenameInExtensions(const sFileName, sExtensions : String) : Boolean;
function IEFileExtInExtensions(sFileExt : String; const sExtensions : String) : Boolean;

function GetImageRectWithinArea(iImageWidth, iImageHeight : Integer;
                                iAvailableWidth, iAvailableHeight : Integer;
                                iHorzOffset : Integer = 0;
                                iVertOffset : integer = 0;
                                bAllowStretching : boolean = true;
                                bAllowShrinking : boolean = true;
                                bCenterHorz : boolean = true;
                                bCenterVert : boolean = true;
                                iAutoCropPercent : Integer = 0;
                                FitMethod: TFitMethod = _fmFitWithinRect) : TRect; overload;

function GetImageRectWithinArea(iImageWidth, iImageHeight: Integer;
                                ADestRect : TRect;
                                bAllowStretching : boolean = true;
                                bAllowShrinking : boolean = true;
                                bCenterHorz : boolean = true;
                                bCenterVert : boolean = true;
                                iAutoCropPercent : Integer = 0;
                                FitMethod: TFitMethod = _fmFitWithinRect) : TRect; overload;

function GetImageSizeWithinArea(iImageWidth, iImageHeight : integer;
                                iAvailableWidth, iAvailableHeight : integer;
                                bAllowStretching : boolean = TRUE;
                                FitMethod: TFitMethod = _fmFitWithinRect
                                ) : TPoint;

function IEAdjustRectToAspectRatio(InRect : TRect;
                                   iImageWidth, iImageHeight: Integer;
                                   iDisplayWidth, iDisplayHeight : Integer;
                                   FitMethod: TFitMethod = _fmFitWithinRect ) : TRect;

function IERectifiedRectangleAspectRatio(x0, y0, x1, y1, x2, y2, x3, y3, cx, cy: double): double;

function IEBilinear(needX, needY: Double; centerValue, rightValue, bottomValue, BottomRightValue: integer): integer;


function AngleToImageEnRotateAngle(Angle: Double): Double;
function ImageEnRotateAngleToAngle(Angle: Double): Double;

procedure IEInitializeComboBox(AComboBox : TComboBox);
procedure IEDrawComboListBoxItem(ControlCanvas : TCanvas;
                                 CanvasRect : trect;
                                 ControlEnabled: Boolean;
                                 const Text : string;
                                 AnImageList : TImageList = nil;
                                 iGlyph : Short = -1);

function GetNextZoomValue(iCurrentZoom: double;
                          bZoomIn: boolean;
                          iIdealZoom: double = 0) : double;

function IEIsWindowsVistaOrNewer : Boolean;

function IEIsKeyPressed(aKey: Word): Boolean;

function IEFileExists(const FileName: string): Boolean;
function IEFileExistsW(const FileName: WideString): Boolean;
procedure IEDecimalToFraction(value: double; var numerator: integer; var denominator: integer; accuracy: double = 0.000000005);

procedure IECopyTList(source: TList; dest: TList);

function IERectangle(x, y, width, height: integer): TIERectangle; overload;
function IERectangle(Rect: TRect): TIERectangle; overload;

function IETextWidthW(Canvas: TCanvas; const Text: WideString): integer;
function IETextHeightW(Canvas: TCanvas; const Text: WideString): integer;

function IETruncateStr(sCaption : WideString; TruncSide: TIEMTruncSide; ACanvas : TCanvas; iMaxWidth : Integer) : Widestring;

function IEFileTimeToDateTime(ft: TFileTime): TDateTime;
function IELargeFileSize(nFileSizeHigh, nFileSizeLow: DWORD) : Int64;
function IEGetFileDetails(const sFilename: string;
                          out iFileSizeBytes: Int64;
                          out dtCreateDate: TDateTime;
                          out dtEditDate: TDateTime
                          ): boolean;
function IEFileSetDate(const sFilename: string; DateTime: TDateTime): boolean;

// convert a real value into a string with decimal places
function IEFloatToFormatString(Value: Extended;
                               iDecimalCount: Integer;
                               bStripZeros: boolean): string;

// Returns a suitable font to use for Preview dialogs.  Segoe UI 9 on Vista, 7.  Tahoma 8 on XP, etc
function IEGetDefaultDialogFont() : TFont;

{$IfNdef Delphi6orNewer}
function RoundTo(const AValue: Double; ADigit: Integer): Double;
{$endif}


type
TIEURLType = (ieurlUNKNOWN, ieurlHTTP, ieurlHTTPS, ieurlFTP);

function IEGetURLTypeA(const URL: AnsiString): TIEURLType;
function IEGetURLTypeW(const URL: WideString): TIEURLType;


function IESendMessageTimeout(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM; fuFlags, uTimeout: UINT; lpdwResult: pointer): LRESULT;


function IEIsPrime(x: integer): boolean;
function IENextPrime(x: integer): integer;

// GPS
function IEGPSConvertDMSToDegDec(degrees: Double; minutes: Double; seconds: Double; ref: AnsiString): Double;
procedure IEGPSConvertDegDecToDMS(dir: AnsiString; value: Double; var degrees: Double; var minutes: Double; var seconds: Double; var ref: AnsiString);


{$ifdef IEVISION}
function IEVisionBGR8ToTRGB(visionBGR8: TIEVisionBGR8): TRGB;
function IETRGBToVisionBGR8(rgb: TRGB): TIEVisionBGR8;
procedure IEVisionConvPixelFormat(PixelFormat: TIEPixelFormat; out channelFormat: TIEVisionChannelFormat; out channelCount: integer); overload;
function IEVisionConvPixelFormat(channelFormat: TIEVisionChannelFormat; channelCount: integer): TIEPixelFormat; overload;
//function IEVision
{$endif}  


procedure IEBlend(var src: TRGB; var dst: TRGB; RenderOperation: TIERenderOperation; row: integer);
procedure IEBlendRGBA(var src: TRGBA; var dst: TRGBA; RenderOperation: TIERenderOperation; row: integer);
procedure IEBezier2D4Controls(p0: TPoint; c0: TPoint; c1: TPoint; p1: TPoint; pResultArray: PPointArray; nSteps: integer);

function IEWStrCopy(Dest: PWideChar; const Source: PWideChar): PWideChar;

{$IfNdef Delphi6orNewer}
function Sign(const AValue: Double): Integer;
{$ENDIF}

// Hash Functions
function IE_ELFHash(const str: WideString; bucketCount: cardinal): cardinal;
function IE_RSHash(const str: WideString; bucketCount: cardinal): cardinal;
function IE_JSHash(const str: WideString; bucketCount: cardinal): cardinal;
function IE_MMHash(const str: WideString; const Seed: Cardinal = $9747b28c): Cardinal;

function IEDrawGradient(R: TRect; DC: HDC; ColorStart, ColorStop: TColor; bVertical: boolean): Boolean;
procedure IEPixelFormatToBPSAndSPP(PixelFormat: TIEPixelFormat; out iBitsPerSample: Integer; out iSamplesPerPixel: Integer);
procedure BitCountToBPSAndSPP(BitCount: Integer; bAllow32bit: Boolean; out iBitsPerSample: Integer; out iSamplesPerPixel: Integer);

procedure IEPrintLogWrite(const ss: String);

procedure IESetStringA(var S: AnsiString; Buffer: PAnsiChar; Length: Integer);

{$IfNdef Delphi7orNewer}
function BoolToStr(B: Boolean): string;
{$endif}

function IECreateRect(Left, Top, Right, Bottom: Integer): TRect;



{!!
<FS>dmin

<FM>Declaration<FC>
function dmin(v1, v2: Double): Double;

<FM>Description<FN>
Returns the minimum of v1 and v2.
!!}
function dmin(v1, v2: Double): Double;

{!!
<FS>dmax

<FM>Declaration<FC>
function dmax(v1, v2: Double): Double;

<FM>Description<FN>
Returns the maximum of v1 and v2.
!!}
function dmax(v1, v2: Double): Double;

function dwmax(v1, v2: DWord): DWord;

{!!
<FS>imin

<FM>Declaration<FC>
function imin(v1, v2: Integer): Integer;

<FM>Description<FN>
Returns the minimum of v1 and v2.
!!}
function imin(v1, v2: Integer): Integer;


{$IFDEF IEHASUINT64}
function u64min(v1, v2: uint64): uint64;
{$ENDIF}
function i64min(v1, v2: int64): int64;
function i64max(v1, v2: int64): int64;

{!!
<FS>imax

<FM>Declaration<FC>
function imax(v1, v2: Integer): Integer;

<FM>Description<FN>
Returns the maximum of v1 and v2.
!!}
function imax(v1, v2: Integer): Integer;

{!!
<FS>ilimit

<FM>Declaration<FC>
function ilimit(vv, min, max: Integer): Integer;

<FM>Description<FN>
Ensures vv is in the range of min and max.
!!}
function ilimit(vv, min, max: Integer): Integer;

{!!
<FS>blimit

<FM>Declaration<FC>
function blimit(vv: Integer): Integer;

<FM>Description<FN>
Ensures vv is in the range of 0 to 255.
!!}
function blimit(vv: Integer): Integer;

{!!
<FS>wlimit

<FM>Declaration<FC>
function wlimit(vv: Integer): word;

<FM>Description<FN>
Ensures vv is in the range of 0 to 65535.
!!}
function wlimit(vv: Integer): word;

{!!
<FS>iswap

<FM>Declaration<FC>
procedure iswap(var B1, B2: LongInt);

<FM>Description<FN>
Swap B1 with B2.
!!}
procedure iswap(var B1, B2: LongInt); assembler;

procedure dwswap(var B1, B2: dword); assembler;

procedure dswap(var v1, v2: Double);

{!!
<FS>bswap

<FM>Declaration<FC>
procedure bswap(var B1, B2: Byte);

<FM>Description<FN>
Swap B1 with B2.
!!}
procedure bswap(var B1, B2: Byte); assembler;

procedure iedswap(var d1, d2: Double);

procedure i64swap(var v1, v2: int64);

{!!
<FS>OrdCor

<FM>Declaration<FC>
procedure OrdCor(var x1, y1, x2, y2: Integer);

<FM>Description<FN>
Sorts x1, y1, x2, y2 so that x1, y1 is at the top-left and x2, y2 is at the bottom-right vertex of the rectangle.
!!}
procedure OrdCor(var x1, y1, x2, y2: Integer);

{!!
<FS>TRGB2TColor

<FM>Declaration<FC>
function TRGB2TColor(rgb: <A TRGB>): TColor;

<FM>Description<FN>
Converts a TRGB color to TColor.

<FM>Example<FC>
Panel1.Color := TRGB2TColor(CreateRGB(255, 0, 0)); // Panel1.Color will be clRed

<FM>See Also<FN>
- <A CreateRGB>
- <A TColor2TRGB>
!!}
function TRGB2TColor(rgb: TRGB): TColor;


{!!
<FS>RGB2TColor

<FM>Declaration<FC>
function RGB2TColor(r, g, b: Integer): TColor;

<FM>Description<FN>
Converts R, G, B values to TColor.

<FM>Example<FC>
Panel1.Color := RGB2TColor(255, 0, 0); // Panel1.Color will be clRed

<FM>See Also<FN>
- <A TRGB2TColor>
- <A RGB2TColor>
!!}
function RGB2TColor(r, g, b: Integer): TColor;

{!!
<FS>TColor2TRGB

<FM>Declaration<FC>
function TColor2TRGB(cl: TColor): <A TRGB>;

<FM>Description<FN>
Converts a TColor to TRGB.

<FM>Example<FC>
var
  rgb: TRGB;
Begin
  rgb := TColor2TRGB( clRed );
  // Which is the same as rgb := CreateRGB( 255, 0, 0 );
...
End;

<FM>See Also<FN>
- <A CreateRGB>
- <A TRGB2TColor>
!!}
function TColor2TRGB(cl: TColor): TRGB;


{!!
<FS>TColor2TRGBA

<FM>Declaration<FC>
function TColor2TRGBA(cl: TColor): <A TRGBA>; overload;
function TColor2TRGBA(cl: TColor; transparency: Integer): <A TRGBA>;

<FM>Description<FN>
Converts TColor and transparency to TRGBA.

<FM>Example<FC>
var
  rgb: TRGBA;
Begin
  rgb := TColor2TRGBA( clRed, 255 );
...
End;
!!}
function TColor2TRGBA(cl: TColor; transparency: Integer): TRGBA; overload;
function TColor2TRGBA(cl: TColor): TRGBA; overload;


{!!
<FS>IEApplyAlphaToColor

<FM>Declaration<FC>
function IEApplyAlphaToColor(Color: TColor; Alpha: Integer): TColor;  overload;
function IEApplyAlphaToColor(rgb: <A TRGB>; Alpha: Integer): <A TRGB>;  overload;

<FM>Description<FN>
Applies Alpha (0=fully transparent, 255=fully visible) to the specified color.

<FM>Examples<FC>
Color := IEApplyAlphaToColor( clRed, 255 ); // Returns Pure Red
Color := IEApplyAlphaToColor( clRed, 175 ); // Returns Dark Pink
Color := IEApplyAlphaToColor( clRed, 50 );  // Returns Pale Pink
Color := IEApplyAlphaToColor( clRed, 0 );   // Returns White
!!}
function IEApplyAlphaToColor(Color: TColor; Alpha: Integer): TColor;  overload;
function IEApplyAlphaToColor(rgb: TRGB; Alpha: Integer): TRGB;  overload;

{!!
<FS>RGB2HSL

<FM>Declaration<FC>
procedure RGB2HSL(px: <A TRGB>; var Hue, Sat, Lum: Double);

<FM>Description<FN>
Converts a TRGB color to HSL values.

Note: Hue, Sat and Lum will be in range 0 to 1.

<FM>See Also<FN>
- <A CreateRGB>
- <A TRGB2TColor>
- <A TColor2TRGB>
!!}
procedure RGB2HSL(px: TRGB; var Hue, Sat, Lum: Double);

{!!
<FS>ColorToHSL

<FM>Declaration<FC>
procedure ColorToHSL(cl: TColor; var Hue, Sat, Lum: Double);

<FM>Description<FN>
Converts a TColor to HSL values.

Note: Hue, Sat and Lum will be in range 0 to 1.
!!}
procedure ColorToHSL(cl: TColor; var Hue, Sat, Lum: Double);

{!!
<FS>HSL2RGB

<FM>Declaration<FC>
procedure HSL2RGB(var px: <A TRGB>; Hue, Sat, Lum: Double);

<FM>Description<FN>
Converts an HSL value (Hue, Sat, Lum) with a TRGB (px).

Hue, Sat and Lum are in range 0 to 1.

<FM>See Also<FN>
- <A CreateRGB>
- <A TRGB2TColor>
- <A TColor2TRGB>
!!}
procedure HSL2RGB(var px: TRGB; Hue, Sat, Lum: Double);

{!!
<FS>HSLToColor

<FM>Declaration<FC>
function HSLToColor(Hue, Sat, Lum: Double) : TColor;

<FM>Description<FN>
Converts HSL values (Hue, Sat, Lum) to a TColor.

Hue, Sat and Lum are in range 0 to 1.
!!}
function HSLToColor(Hue, Sat, Lum: Double) : TColor;

{!!
<FS>HSV2RGB

<FM>Declaration<FC>
procedure HSV2RGB(var px: <A TRGB>; H, S, V: Integer);

<FM>Description<FN>
Converts a HSV values to TRGB.

H (Hue) is from 0 to 359 (corresponding to 0..359 degrees around a hexcone).
S (Saturation) is from 0 (shade of gray) to 99 (pure color).
V (Value) is from 0 (black) to 99 (white).

<FM>See Also<FN>
- <A CreateRGB>
- <A TRGB2TColor>
- <A TColor2TRGB>
!!}
procedure HSV2RGB(var px: TRGB; H, S, V: Integer);


{!!
<FS>HSVToColor

<FM>Declaration<FC>
function HSVToColor(h, s, v: Integer): TColor;

<FM>Description<FN>
Converts HSV values to a TColor.

H (Hue) is from 0 to 359 (corresponding to 0..359 degrees around a hexcone).
S (Saturation) is from 0 (shade of gray) to 99 (pure color).
V (Value) is from 0 (black) to 99 (white).
!!}
function HSVToColor(h, s, v: Integer): TColor;



{!!
<FS>RGB2HSV

<FM>Declaration<FC>
procedure RGB2HSV(RGB: <A TRGB>; var h, s, v: Integer);

<FM>Description<FN>
Converts a TRGB color to HSV values.

H (Hue) is from 0 to 359 (corresponding to 0..359 degrees around a hexcone).
S (Saturation) is from 0 (shade of gray) to 99 (pure color).
V (Value) is from 0 (black) to 99 (white).

<FM>See Also<FN>
- <A CreateRGB>
- <A TRGB2TColor>
- <A TColor2TRGB>
!!}
procedure RGB2HSV(RGB: TRGB; var h, s, v: Integer);


{!!
<FS>ColorToHSV

<FM>Declaration<FC>
procedure ColorToHSV(cl: TColor; var h, s, v: Integer);

<FM>Description<FN>
Converts a TColor to HSV values.

H (Hue) is from 0 to 359 (corresponding to 0..359 degrees around a hexcone).
S (Saturation) is from 0 (shade of gray) to 99 (pure color).
V (Value) is from 0 (black) to 99 (white).
!!}
procedure ColorToHSV(cl: TColor; var h, s, v: Integer);


{!!
<FS>ColorToHex

<FM>Declaration<FC>
function ColorToHex(Color : TColor): string;

<FM>Description<FN>
Returns a hex representation of a TColor (e.g. for use in HTML)

<FM>Example<FC>
sHex := ColorToHex(clWhite); // Would return "#FFFFFF'
!!}
function ColorToHex(Color : TColor): string;

{!!
<FS>CreateRGB

<FM>Declaration<FC>
function CreateRGB(r, g, b: byte): <A TRGB>;

<FM>Description<FN>
Returns a TRGB record.

<FM>Example<FC>
rgb := CreateRGB( 255, 0, 0 );
// Which is the same as rgb := TColor2TRGB( clRed );

<FM>See Also<FN>
- <A TRGB2TColor>
- <A TColor2TRGB>
!!}
function CreateRGB(r, g, b: byte): TRGB;

{!!
<FS>CreateRGB48

<FM>Declaration<FC>
function CreateRGB48(r, g, b: word): <A TRGB48>;

<FM>Description<FN>
Returns a TRGB48 record.
!!}
function CreateRGB48(r, g, b: word): TRGB48;


{!!
<FS>CreateCMYK

<FM>Declaration<FC>
function CreateCMYK(c, m, y, k: byte): <A TCMYK>;

<FM>Description<FN>
Returns a TCMYK record.
!!}
function CreateCMYK(c, m, y, k: byte): TCMYK;


{!!
<FS>CreateRGBA

<FM>Declaration<FC>
function CreateRGBA(r, g, b, a: byte): <A TRGBA>;

<FM>Description<FN>
Returns a TRGBA record.
!!}
function CreateRGBA(r, g, b, a: byte): TRGBA;


function CreateRGBFromInt(r, g, b: Integer): TRGB;

{!!
<FS>EqualRGB

<FM>Declaration<FC>
function EqualRGB(rgb1, rgb2: <A TRGB>): Boolean;

<FM>Description<FN>
Returns True if rgb1 and rgb2 are equal.

<FM>See Also<FN>
- <A CreateRGB>
- <A TRGB2TColor>
- <A TColor2TRGB>
!!}
function EqualRGB(rgb1, rgb2: TRGB): Boolean;

{!!
<FS>IEAverageColor

<FM>Declaration<FC>
function IEAverageColor(c1, c2 : TColor): TColor; overload;
function IEAverageColor(c1, c2 : TRGB): TRGB; overload;

<FM>Description<FN>
Returns the average of two colors.
!!}
function IEAverageColor(c1, c2 : TColor): TColor; overload;
function IEAverageColor(rgb1, rgb2 : TRGB): TRGB; overload;



procedure YUV2RGB(y, u, v: Integer; var RGB: TRGB);
procedure IERGBtoHSB(const cRed, cGreen, cBlue: byte; var H, S, B: word);
procedure IEHSBtoRGB(const H, S, B: word; var cRed, cGreen, cBlue: byte);




procedure IEInitializeImageEn;
procedure IEFinalizeImageEn;
procedure IEInitialize_hyieutils;
procedure IEFinalize_hyieutils;


// Gestures
procedure IEInitialize_gestures();
procedure IEFinalize_gestures();
function IEHasGestures(): boolean;


function ProgressRec(Sender: TObject; OnProgress: TIEProgressEvent; var bAborting: Boolean) : TProgressRec; overload;
function ProgressRec(Sender: TObject; OnProgress: TIEProgressEvent; pAborting: PBoolean) : TProgressRec; overload;
function NullProgressRec(var bAborting: Boolean; bResetAborting : Boolean = true) : TProgressRec; overload;
function NullProgressRec(pAborting: PBoolean; bResetAborting : Boolean = true) : TProgressRec; overload;

var
  IEGetGestureInfo:         function(hGestureInfo: HGESTUREINFO; pGestureInfo: PIEGESTUREINFO): longbool; stdcall = nil;
  IECloseGestureInfoHandle: function(hGestureInfo: HGESTUREINFO): longbool; stdcall = nil;
  IESetGestureConfig:       function(hwnd: THandle; dwReserved: DWORD; cIDS: DWORD; pGestureConfig: PIEGESTURECONFIG; cbSize: DWORD): longbool; stdcall = nil;
  IEUnregisterTouchWindow:  function(hwnd: THandle): longbool; stdcall = nil;

var
  // Windows CMS
  mscms: THandle;

implementation

uses
  math,
  SyncObjs,
  {$ifdef Delphi7orNewer}
  Types,
  {$endif}
  {$ifdef DelphiXE4orNewer}
  AnsiStrings,
  {$endif}
  {$ifdef IEHASUITYPES}System.UITypes,{$endif}
  imageenview, imageenproc, imageenio, ieview, neurquant, tiffilt, ievect, printers, ielcms,
  iej2000, tifccitt, ietextc, iewia, iewic, iepresetim, iesettings, iedicom, iemiscplugins, iemview
  {$ifdef IEUSEVCLZLIB}, zlib{$else}, iezlib{$endif}
  {$ifdef IEINCLUDEFLATSB}, flatsb{$endif}
  , iegdiplus, iewords, Dialogs, iexBitmaps;

{$R-}

var
  IECosineTab: array[0..255] of integer;



// DRAWDIB LIBRARY
const
  DLL = 'MsVfW32.dll';

function DrawDibClose(hdd: hDrawDib): Boolean; stdcall; external DLL name 'DrawDibClose';
function DrawDibDraw(hdd: hDrawDib; hDC: THandle; xDst, yDst, dxDst, dyDst: Integer; var lpbi: TBitmapInfoHeader; Bits: Pointer; xSrc, ySrc, dxSrc, dySrc: Integer; wFlags: UInt): Boolean; stdcall; external DLL name 'DrawDibDraw';
function DrawDibOpen: hDrawDib; stdcall; external DLL name 'DrawDibOpen';
function DrawDibRealize(hdd: hDrawDib; hDC: THandle; fBackground: Bool): UInt; stdcall; external DLL name 'DrawDibRealize';

// not available on old Delphi versions
function IE_EnumDisplaySettingsExW(lpszDeviceName: PWideChar; iModeNum: DWORD; var lpDevMode: TIEDeviceModeW; dwFlags: DWORD): BOOL; stdcall; external user32 name 'EnumDisplaySettingsExW';




////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////
// TIEResourceExtractor

{$ifdef IEINCLUDERESOURCEEXTRACTOR}

function IEIS_INTRESOURCE(const ResID: PAnsiChar): boolean;
begin
  Result := (Windows.HiWord(Windows.DWORD(ResID)) = 0);
end;

function EnumTypesProc(hModule: THandle; lpszType: PAnsiChar; lParam: pointer): longbool; stdcall;
var
  typesList: TStringList;
begin
  typesList := TStringList(lParam);
  if IEIS_INTRESOURCE(lpszType) then
    typesList.Add('INTRESOURCE:'+IntToStr(NativeInt(lpszType)))
  else
    typesList.Add(string(AnsiString(lpszType)));
  result := true;
end;

function EnumNamesProc(hModule: THandle; lpszType: PAnsiChar; lpszName: PAnsiChar; lParam: pointer): longbool; stdcall;
var
  namesList: TStringList;
begin
  namesList := TStringList(lParam);
  if IEIS_INTRESOURCE(lpszName) then
    namesList.Add('INTRESOURCE:'+IntToStr(NativeInt(lpszName)))
  else
    namesList.Add(string(AnsiString(lpszName)));
  result := true;
end;



{!!
<FS>TIEResourceExtractor.Create

<FM>Declaration<FC>
constructor Create(const Filename: WideString);

<FM>Description<FN>
Creates a new instance of TIEResourceExtractor loading the specified PE file (EXE, DLL, OCX, ICL, BPL, etc..).
It is possible to check the success of loading reading <A TIEResourceExtractor.IsValid> property.
<FC>FileName<FN> specifies the path and filename of PE module.

<FM>Example<FC>
re := TIEResourceExtractor.Create('explorer.exe');
try
  ...
finally
  re.Free;
end;

!!}
constructor TIEResourceExtractor.Create(const Filename: WideString);
const
  LOAD_LIBRARY_AS_DATAFILE_EXCLUSIVE = $00000040;
  LOAD_LIBRARY_AS_IMAGE_RESOURCE = $00000020;
var
  resType: PAnsiChar;
  resTypeStr: AnsiString;
  i: integer;
begin
  inherited Create;

  m_hlib := 0;
  m_typesList := nil;
  m_resourceBookmarks := nil;

  if IEGlobalSettings().OpSys < ieosWinVista then
    m_hlib := LoadLibraryExW(PWideChar(Filename), 0, LOAD_LIBRARY_AS_DATAFILE or DONT_RESOLVE_DLL_REFERENCES)
  else
    m_hlib := LoadLibraryExW(PWideChar(Filename), 0, LOAD_LIBRARY_AS_DATAFILE_EXCLUSIVE or LOAD_LIBRARY_AS_IMAGE_RESOURCE);
  if m_hlib=0 then
    exit;

  // enum types
  m_typesList := TStringList.Create;
  EnumResourceTypesA(m_hlib, @EnumTypesProc, NativeInt(m_typesList));

  // enum names
  for i := 0 to m_typesList.Count-1 do
  begin
    m_typesList.Objects[i] := TStringList.Create;  // associates a list of names to this resource type
    resTypeStr := AnsiString(m_typesList[i]);
    if copy(resTypeStr, 1, 12) = 'INTRESOURCE:' then
      resType := MakeIntResourceA(IEStrToIntDef(IECopy(resTypeStr, 13, length(resTypeStr)-12), 0))
    else
      resType := PAnsiChar(resTypeStr);
    EnumResourceNamesA(m_hlib, resType, @EnumNamesProc, NativeInt(m_typesList.Objects[i]));
  end;

  m_resourceBookmarks := TList.Create;
end;


destructor TIEResourceExtractor.Destroy;
var
  i: integer;
begin

  if assigned(m_resourceBookmarks) then
  begin
    for i := 0 to m_resourceBookmarks.Count-1 do
      TIEResourceBookmark(m_resourceBookmarks[i]).Free;
    m_resourceBookmarks.Free;
  end;

  if assigned(m_typesList) then
  begin
    for i := 0 to m_typesList.Count-1 do
      if assigned(TStringList(m_typesList.Objects[i])) then
        TStringList(m_typesList.Objects[i]).Free;
    m_typesList.Free;
  end;

  if m_hlib<>0 then
    FreeLibrary(m_hlib);

  inherited;
end;



type
  TRES_ICOHEADER = packed record
    wReserved: word;
    wResID: word;
    wNumImages: word;
  end;
  PRES_ICOHEADER = ^TRES_ICOHEADER;

  TRES_ICODIRENTRY = packed record
    bWidth: byte;
    bHeight: byte;
    bColors: byte;
    bReserved: byte;
    wPlanes: word;
    wBitCount: word;
    dwBytesInImage: dword;
    wID: word;
  end;
  PRES_ICODIRENTRY = ^TRES_ICODIRENTRY;

  TRES_CURHEADER = packed record
    wReserved: word;
    wResID: word;
    wNumImages: word;
  end;
  PRES_CURHEADER = ^TRES_CURHEADER;

  TRES_CURDIRENTRY = packed record
    wWidth: word;
    wHeight: word;
    wPlanes: word;
    wBitCount: word;
    dwBytesInImage: dword;
    wID: word;
  end;
  PRES_CURDIRENTRY = ^TRES_CURDIRENTRY;


{!!
<FS>TIEResourceExtractor.IsGroup

<FM>Declaration<FC>
property IsGroup[TypeIndex: integer]: boolean;

<FM>Description<FN>
Returns <FC>true<FN> if the resource type is "GroupIcon" (RT_GROUP_ICON) or "GroupCursor" (RT_GROUP_CURSOR).
This means that resources inside this type must be handled as groups.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>TypeIndex<FN></C> <C>Index of resource type. 0 is first resource type, <A TIEResourceExtractor.TypesCount>-1 is last resource type.</C> </R>
</TABLE>

!!}
function TIEResourceExtractor.GetIsGroup(TypeIndex: integer): boolean;
begin
  result := (FriendlyTypes[TypeIndex] = 'GroupIcon') or (FriendlyTypes[TypeIndex] = 'GroupCursor');
end;


{!!
<FS>TIEResourceExtractor.IsGrouped

<FM>Declaration<FC>
property IsGrouped[TypeIndex: integer]: boolean;

<FM>Description<FN>
Returns <FC>true<FN> if the resource type is "Icon" (RT_ICON) or "Cursor" (RT_CURSOR).
This means that resources inside this type must be grouped in "GroupIcon" or "GroupCursor" resources.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>TypeIndex<FN></C> <C>Index of resource type. 0 is first resource type, <A TIEResourceExtractor.TypesCount>-1 is last resource type.</C> </R>
</TABLE>
!!}
function TIEResourceExtractor.GetIsGrouped(TypeIndex: integer): boolean;
begin
  result := (FriendlyTypes[TypeIndex] = 'Icon') or (FriendlyTypes[TypeIndex] = 'Cursor');
end;


{!!
<FS>TIEResourceExtractor.GroupCountFrames

<FM>Declaration<FC>
property GroupCountFrames[TypeIndex: integer; NameIndex: integer]: integer;

<FM>Description<FN>
Returns the number of frames of specified resource (can be Icon or Cursor resource).

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>TypeIndex<FN></C> <C>Index of resource type. 0 is first resource type, <A TIEResourceExtractor.TypesCount>-1 is last resource type.</C> </R>
<R> <C><FC>NameIndex<FN></C> <C>Index of actual resource. 0 is first resource name, <A TIEResourceExtractor.NamesCount>-1 is last resource name.</C> </R>
</TABLE>
!!}
function TIEResourceExtractor.GetGroupCountFrames(TypeIndex: integer; NameIndex: integer): integer;
var
  iconGroupIndex: integer;
  iconHeader: PRES_ICOHEADER;
  curGroupIndex: integer;
  curHeader: PRES_CURHEADER;
  buffer: pointer;
  bufferLen: integer;
begin
  if FriendlyTypes[TypeIndex] = 'GroupIcon' then
  begin
    iconGroupIndex := IndexOfType('GroupIcon');
    buffer := GetBuffer(iconGroupIndex, NameIndex, bufferLen);
    iconHeader := PRES_ICOHEADER(buffer);
    result := iconHeader^.wNumImages;
  end
  else
  if FriendlyTypes[TypeIndex] = 'GroupCursor' then
  begin
    curGroupIndex := IndexOfType('GroupCursor');
    buffer := GetBuffer(curGroupIndex, NameIndex, bufferLen);
    curHeader := PRES_CURHEADER(buffer);
    result := curHeader^.wNumImages;
  end
  else
    result := 0;
end;

function GetIconFrameInfo(ResourceExtractor: TIEResourceExtractor; TypeIndex: integer; IconIndex: integer; FrameIndex: integer): PRES_ICODIRENTRY;
var
  buffer: pointer;
  bufferLen: integer;
begin
  result := nil;

  buffer := ResourceExtractor.GetBuffer(TypeIndex, IconIndex, bufferLen);

  // check for buffer overrun
  if sizeof(TRES_ICOHEADER) + sizeof(TRES_ICODIRENTRY)*(FrameIndex+1) > bufferLen then
    exit;

  inc(PRES_ICOHEADER(buffer));                // bypass TRES_ICOHEADER
  inc(PRES_ICODIRENTRY(buffer), FrameIndex);  // bypass unwanted frames (TRES_ICODIRENTRY)
  result := PRES_ICODIRENTRY(buffer);
end;

function GetCurFrameInfo(ResourceExtractor: TIEResourceExtractor; TypeIndex: integer; CurIndex: integer; FrameIndex: integer): PRES_CURDIRENTRY;
var
  buffer: pointer;
  bufferLen: integer;
begin
  buffer := ResourceExtractor.GetBuffer(TypeIndex, CurIndex, bufferLen);
  inc(pbyte(buffer), sizeof(TRES_CURHEADER)); // bypass TRES_CURHEADER
  inc(pbyte(buffer), sizeof(TRES_CURDIRENTRY)*FrameIndex);  // bypass unwanted frames (TRES_CURDIRENTRY)
  result := PRES_CURDIRENTRY(buffer);
end;


{!!
<FS>TIEResourceExtractor.GroupFrameWidth

<FM>Declaration<FC>
property GroupFrameWidth[TypeIndex: integer; NameIndex: integer; FrameIndex: integer]: integer;

<FM>Description<FN>
Returns the icon or cursor width. <FC>TypeIndex<FN> must refer to a "GroupIcon" or "GroupCursor" resource type.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>TypeIndex<FN></C> <C>Index of resource type. 0 is first resource type, <A TIEResourceExtractor.TypesCount>-1 is last resource type.</C> </R>
<R> <C><FC>NameIndex<FN></C> <C>Index of actual resource. 0 is first resource name, <A TIEResourceExtractor.NamesCount>-1 is last resource name.</C> </R>
</TABLE>
!!}
function TIEResourceExtractor.GetGroupFrameWidth(TypeIndex: integer; NameIndex: integer; FrameIndex: integer): integer;
begin
  if FriendlyTypes[TypeIndex] = 'GroupIcon' then
  begin
    result := GetIconFrameInfo(self, TypeIndex, NameIndex, FrameIndex)^.bWidth;
    if result = 0 then
      result := 256;
  end
  else
  if FriendlyTypes[TypeIndex] = 'GroupCursor' then
    result := GetCurFrameInfo(self, TypeIndex, NameIndex, FrameIndex)^.wWidth
  else
    result := 0;
end;


{!!
<FS>TIEResourceExtractor.GroupFrameHeight

<FM>Declaration<FC>
property GroupFrameHeight[TypeIndex: integer; NameIndex: integer; FrameIndex: integer]: integer;

<FM>Description<FN>
Returns the icon or cursor height. <FC>TypeIndex<FN> must refer to a "GroupIcon" or "GroupCursor" resource type.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>TypeIndex<FN></C> <C>Index of resource type. 0 is first resource type, <A TIEResourceExtractor.TypesCount>-1 is last resource type.</C> </R>
<R> <C><FC>NameIndex<FN></C> <C>Index of actual resource. 0 is first resource name, <A TIEResourceExtractor.NamesCount>-1 is last resource name.</C> </R>
</TABLE>
!!}
function TIEResourceExtractor.GetGroupFrameHeight(TypeIndex: integer; NameIndex: integer; FrameIndex: integer): integer;
begin
  if FriendlyTypes[TypeIndex] = 'GroupIcon' then
  begin
    result := GetIconFrameInfo(self, TypeIndex, NameIndex, FrameIndex)^.bHeight;
    if result = 0 then
      result := 256;
  end
  else
  if FriendlyTypes[TypeIndex] = 'GroupCursor' then
    result := GetCurFrameInfo(self, TypeIndex, NameIndex, FrameIndex)^.wHeight div 2
  else
    result := 0;
end;


{!!
<FS>TIEResourceExtractor.GroupFrameDepth

<FM>Declaration<FC>
property GroupFrameDepth[TypeIndex: integer; NameIndex: integer; FrameIndex: integer]: integer;

<FM>Description<FN>
Returns the icon or cursor bit depth. <FC>TypeIndex<FN> must refer to a "GroupIcon" or "GroupCursor"  resource type.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>TypeIndex<FN></C> <C>Index of resource type. 0 is first resource type, <A TIEResourceExtractor.TypesCount>-1 is last resource type.</C> </R>
<R> <C><FC>NameIndex<FN></C> <C>Index of actual resource. 0 is first resource name, <A TIEResourceExtractor.NamesCount>-1 is last resource name.</C> </R>
</TABLE>
!!}
function TIEResourceExtractor.GetGroupFrameDepth(TypeIndex: integer; NameIndex: integer; FrameIndex: integer): integer;
begin
  if FriendlyTypes[TypeIndex] = 'GroupIcon' then
    result := GetIconFrameInfo(self, TypeIndex, NameIndex, FrameIndex)^.wBitCount
  else
  if FriendlyTypes[TypeIndex] = 'GroupCursor' then
    result := GetCurFrameInfo(self, TypeIndex, NameIndex, FrameIndex)^.wBitCount
  else
    result := 0;
end;


{!!
<FS>TIEResourceExtractor.GroupFrameName

<FM>Declaration<FC>
property GroupFrameName[TypeIndex: integer; NameIndex: integer; FrameIndex: integer]: AnsiString;

<FM>Description<FN>
Returns the icon or cursor resource name. <FC>TypeIndex<FN> must refer to a "GroupIcon" or "GroupCursor"  resource type.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>TypeIndex<FN></C> <C>Index of resource type. 0 is first resource type, <A TIEResourceExtractor.TypesCount>-1 is last resource type.</C> </R>
<R> <C><FC>NameIndex<FN></C> <C>Index of actual resource. 0 is first resource name, <A TIEResourceExtractor.NamesCount>-1 is last resource name.</C> </R>
</TABLE>
!!}
function TIEResourceExtractor.GetGroupFrameName(TypeIndex: integer; NameIndex: integer; FrameIndex: integer): AnsiString;
begin
  if FriendlyTypes[TypeIndex] = 'GroupIcon' then
    result := 'INTRESOURCE:'+IEIntToStr(GetIconFrameInfo(self, TypeIndex, NameIndex, FrameIndex)^.wID)
  else
  if FriendlyTypes[TypeIndex] = 'GroupCursor' then
    result := 'INTRESOURCE:'+IEIntToStr(GetCurFrameInfo(self, TypeIndex, NameIndex, FrameIndex)^.wID)
  else
    result := '';
end;


{!!
<FS>TIEResourceExtractor.GetGroupAndFrame

<FM>Declaration<FC>
procedure GetGroupAndFrame(TypeIndex: integer; NameIndex: integer; var GroupTypeIndex: integer; var GroupIndex: integer; var GroupFrameIndex: integer);

<FM>Description<FN>
This method finds the associated grouping resource for the specified resource.
Grouping resources types are "GroupIcon" or "GroupCursor".
<FC>TypeIndex<FN> must be "Icon" or "Cursor", otherwise returns values are undefined.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>TypeIndex<FN></C> <C>Index of resource type. 0 is first resource type, <A TIEResourceExtractor.TypesCount>-1 is last resource type.</C> </R>
<R> <C><FC>NameIndex<FN></C> <C>Index of actual resource. 0 is first resource name, <A TIEResourceExtractor.NamesCount>-1 is last resource name.</C> </R>
<R> <C><FC>GroupTypeIndex<FN></C> <C><Return value: associated group resource type./C> </R>
<R> <C><FC>GroupIndex<FN></C> <C><Return value: associated group resource name./C> </R>
<R> <C><FC>GroupFrameIndex<FN></C> <C><Return value: associated group resource frame./C> </R>
</TABLE>
!!}
procedure TIEResourceExtractor.GetGroupAndFrame(TypeIndex: integer; NameIndex: integer; var GroupTypeIndex: integer; var GroupIndex: integer; var GroupFrameIndex: integer);
var
  a_GroupCount: integer;
  a_GroupCountFrames: integer;
begin
  if FriendlyTypes[TypeIndex] = 'Icon' then
    GroupTypeIndex := IndexOfType('GroupIcon')
  else
  if FriendlyTypes[TypeIndex] = 'Cursor' then
    GroupTypeIndex := IndexOfType('GroupCursor')
  else
    exit;

  a_GroupCount := NamesCount[GroupTypeIndex];
  GroupIndex := 0;
  while GroupIndex < a_GroupCount do
  begin
    a_GroupCountFrames := GroupCountFrames[GroupTypeIndex, GroupIndex];
    GroupFrameIndex := 0;
    while GroupFrameIndex < a_GroupCountFrames do
    begin
      if GroupFrameName[GroupTypeIndex, GroupIndex, GroupFrameIndex] = Names[TypeIndex, NameIndex] then
        exit;
      inc(GroupFrameIndex);
    end;
    inc(GroupIndex);
  end;
end;


{!!
<FS>TIEResourceExtractor.GetFrameBuffer

<FM>Declaration<FC>
function GetFrameBuffer(TypeIndex: integer; NameIndex: integer; FrameIndex: integer; var BufferLength: integer): pointer;

<FM>Description<FN>
Returns the buffer of specified frame, for multi-frame resources.
TypeIndex must be 'GroupIcon' or 'GroupCursor'.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>TypeIndex<FN></C> <C>Index of resource type. 0 is first resource type, <A TIEResourceExtractor.TypesCount>-1 is last resource type.</C> </R>
<R> <C><FC>NameIndex<FN></C> <C>Index of actual resource. 0 is first resource name, <A TIEResourceExtractor.NamesCount>-1 is last resource name.</C> </R>
<R> <C><FC>FrameIndex<FN></C> <C>The frame index. 0 is first resource name, <A TIEResourceExtractor.GroupCountFrames>-1 is last frame.</C> </R>
<R> <C><FC>BufferLength<FN></C> <C></C> </R>
</TABLE>

!!}
function TIEResourceExtractor.GetFrameBuffer(TypeIndex: integer; NameIndex: integer; FrameIndex: integer; var BufferLength: integer): pointer;
begin
  if FriendlyTypes[TypeIndex] = 'GroupIcon' then
    result := GetBuffer('Icon', GroupFrameName[TypeIndex, NameIndex, FrameIndex], BufferLength)
  else
    result := GetBuffer('Cursor', GroupFrameName[TypeIndex, NameIndex, FrameIndex], BufferLength);
end;


{!!
<FS>TIEResourceExtractor.IndexOfType

<FM>Declaration<FC>
function IndexOfType(TypeName: AnsiString): integer;

<FM>Description<FN>
Finds the index of specified type name (ex. 'Icon', 'Cursor', 'GroupIcon'...).
!!}
function TIEResourceExtractor.IndexOfType(TypeName: AnsiString): integer;
var
  i: integer;
begin
  result := m_typesList.IndexOf(string(TypeName));
  if result=-1 then
    // search as friendly type
    for i := 0 to m_typesList.Count-1 do
      if FriendlyTypes[i] = TypeName then
      begin
        result := i;
        break;
      end;
end;


{!!
<FS>TIEResourceExtractor.IsValid

<FM>Declaration<FC>
property IsValid: boolean;

<FM>Description<FN>
Checks if TIEResourceExtractor contains valid data.

<FM>Example<FC>
re := TIEResourceExtractor.Create('explorer.exe');
if re.IsValid then
begin
  ...
end;
re.Free;
!!}
function TIEResourceExtractor.GetIsValid: boolean;
begin
  result := (m_hlib<>0);
end;


{!!
<FS>TIEResourceExtractor.TypesCount

<FM>Declaration<FC>
property TypesCount: integer;

<FM>Description<FN>
Returns number of resource types found in the PE module.
!!}
function TIEResourceExtractor.GetTypesCount: integer;
begin
  result := m_typesList.Count;
end;


{!!
<FS>TIEResourceExtractor.NamesCount

<FM>Declaration<FC>
property NamesCount[TypeIndex: integer]: integer;

<FM>Description<FN>
Returns number of resource names found in the PE module, for the specified resource type.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>TypeIndex<FN></C> <C>Index of resource type. 0 is first resource type, <A TIEResourceExtractor.TypesCount>-1 is last resource type.</C> </R>
</TABLE>

!!}
function TIEResourceExtractor.GetNamesCount(TypeIndex: integer): integer;
begin
  if TypeIndex < 0 then
    result := 0
  else
    result := TStringList(m_typesList.Objects[TypeIndex]).Count;
end;


{!!
<FS>TIEResourceExtractor.Types

<FM>Declaration<FC>
property Types[TypeIndex: integer]: AnsiString;

<FM>Description<FN>
Returns the specified resource type name.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>TypeIndex<FN></C> <C>Index of resource type. 0 is first resource type, <A TIEResourceExtractor.TypesCount>-1 is last resource type.</C> </R>
</TABLE>

See also: <A TIEResourceExtractor.FriendlyTypes> for more friendly type strings.
!!}
function TIEResourceExtractor.GetTypes(TypeIndex: integer): AnsiString;
begin
  result := AnsiString(m_typesList[TypeIndex]);
end;


{!!
<FS>TIEResourceExtractor.Names

<FM>Declaration<FC>
property Names[TypeIndex: integer; NameIndex: integer]: AnsiString;

<FM>Description<FN>
Returns the resource name for specified type and name index.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>TypeIndex<FN></C> <C>Index of resource type. 0 is first resource type, <A TIEResourceExtractor.TypesCount>-1 is last resource type.</C> </R>
<R> <C><FC>NameIndex<FN></C> <C>Index of actual resource. 0 is first resource name, <A TIEResourceExtractor.NamesCount>-1 is last resource name.</C> </R>
</TABLE>

!!}
function TIEResourceExtractor.GetNames(TypeIndex: integer; NameIndex: integer): AnsiString;
begin
  result := AnsiString(TStringList(m_typesList.Objects[TypeIndex])[NameIndex]);
end;

{!!
<FS>TIEResourceExtractor.FriendlyTypes

<FM>Declaration<FC>
property FriendlyTypes[TypeIndex: integer]: AnsiString;

<FM>Description<FN>
Returns the specified resource type friendly name (for know types like RT_CURSOR, RT_BITMAP, etc...).

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>TypeIndex<FN></C> <C>Index of resource type. 0 is first resource type, <A TIEResourceExtractor.TypesCount>-1 is last resource type.</C> </R>
</TABLE>

Here is the list of Windows resource types and related friendly string.

<TABLE>
<R> <H>Windows resource</H> <H>Friendly type name</H> </R>
<R> <C><FC>RT_ACCELERATOR<FN></C> <C>'Accelerator'</C> </R>
<R> <C><FC>RT_ANICURSOR<FN></C> <C>'AniCursor'</C> </R>
<R> <C><FC>RT_ANIICON<FN></C> <C>'AniIcon'</C> </R>
<R> <C><FC>RT_BITMAP<FN></C> <C>'Bitmap'</C> </R>
<R> <C><FC>RT_CURSOR<FN></C> <C>'Cursor'</C> </R>
<R> <C><FC>RT_DIALOG<FN></C> <C>'Dialog'</C> </R>
<R> <C><FC>RT_DLGINCLUDE<FN></C> <C>'DlgInclude'</C> </R>
<R> <C><FC>RT_FONT<FN></C> <C>'Font'</C> </R>
<R> <C><FC>RT_FONTDIR<FN></C> <C>'FontDir'</C> </R>
<R> <C><FC>RT_GROUP_CURSOR<FN></C> <C>'GroupCursor'</C> </R>
<R> <C><FC>RT_GROUP_ICON<FN></C> <C>'GroupIcon'</C> </R>
<R> <C><FC>RT_HTML<FN></C> <C>'HTML'</C> </R>
<R> <C><FC>RT_ICON<FN></C> <C>'Icon'</C> </R>
<R> <C><FC>RT_MANIFEST<FN></C> <C>'Manifest'</C> </R>
<R> <C><FC>RT_MENU<FN></C> <C>'Menu'</C> </R>
<R> <C><FC>RT_MESSAGETABLE<FN></C> <C>'MessageTable'</C> </R>
<R> <C><FC>RT_PLUGPLAY<FN></C> <C>'PlugPlay'</C> </R>
<R> <C><FC>RT_RCDATA<FN></C> <C>'RCData'</C> </R>
<R> <C><FC>RT_STRING<FN></C> <C>'String'</C> </R>
<R> <C><FC>RT_VERSION<FN></C> <C>'Version'</C> </R>
<R> <C><FC>RT_VXD<FN></C> <C>'VXD'</C> </R>
</TABLE>

See also: <A TIEResourceExtractor.Types> for less friendly type strings.
!!}
function TIEResourceExtractor.GetFriendlyTypes(TypeIndex: integer): AnsiString;
const
  RT_ACCELERATOR  = $00000009;
  RT_ANICURSOR    = $00000015;
  RT_ANIICON      = $00000016;
  RT_BITMAP       = $00000002;
  RT_CURSOR       = $00000001;
  RT_DIALOG       = $00000005;
  RT_DLGINCLUDE   = $00000011;
  RT_FONT         = $00000008;
  RT_FONTDIR      = $00000007;
  RT_GROUP_CURSOR = $0000000C;
  RT_GROUP_ICON   = $0000000E;
  RT_HTML         = $00000017;
  RT_ICON         = $00000003;
  RT_MANIFEST     = $00000018;
  RT_MENU         = $00000004;
  RT_MESSAGETABLE = $0000000B;
  RT_PLUGPLAY     = $00000013;
  RT_RCDATA       = $0000000A;
  RT_STRING       = $00000006;
  RT_VERSION      = $00000010;
  RT_VXD          = $00000014;
var
  resInt: integer;
begin
  result := Types[TypeIndex];
  if copy(result, 1, 12) = 'INTRESOURCE:' then
  begin
    resInt := IEStrToIntDef(copy(result, 13, length(result)-12), 0);
    case resInt of
      integer(RT_ACCELERATOR):  result := 'Accelerator';
      integer(RT_ANICURSOR):    result := 'AniCursor';
      integer(RT_ANIICON):      result := 'AniIcon';
      integer(RT_BITMAP):       result := 'Bitmap';
      integer(RT_CURSOR):       result := 'Cursor';
      integer(RT_DIALOG):       result := 'Dialog';
      integer(RT_DLGINCLUDE):   result := 'DlgInclude';
      integer(RT_FONT):         result := 'Font';
      integer(RT_FONTDIR):      result := 'FontDir';
      integer(RT_GROUP_CURSOR): result := 'GroupCursor';
      integer(RT_GROUP_ICON):   result := 'GroupIcon';
      integer(RT_HTML):         result := 'HTML';
      integer(RT_ICON):         result := 'Icon';
      integer(RT_MANIFEST):     result := 'Manifest';
      integer(RT_MENU):         result := 'Menu';
      integer(RT_MESSAGETABLE): result := 'MessageTable';
      integer(RT_PLUGPLAY):     result := 'PlugPlay';
      integer(RT_RCDATA):       result := 'RCData';
      integer(RT_STRING):       result := 'String';
      integer(RT_VERSION):      result := 'Version';
      integer(RT_VXD):          result := 'VXD';
    end;
  end;
end;


{!!
<FS>TIEResourceExtractor.GetBuffer

<FM>Declaration<FC>
function GetBuffer(TypeIndex: integer; NameIndex: integer; var BufferLength: integer): pointer;
function GetBuffer(const TypeStr: AnsiString; const NameStr: AnsiString; var BufferLength: integer): pointer;
function GetBuffer(ResourceBookmark: <A TIEResourceBookmark>; var BufferLength: integer): pointer;

<FM>Description<FN>
Returns memory buffer for the specified resource.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>TypeIndex<FN></C> <C>Index of resource type. 0 is first resource type, <A TIEResourceExtractor.TypesCount>-1 is last resource type.</C> </R>
<R> <C><FC>NameIndex<FN></C> <C>Index of actual resource. 0 is first resource name, <A TIEResourceExtractor.NamesCount>-1 is last resource name.</C> </R>
<R> <C><FC>BufferLength<FN></C> <C>Field filled with the resulting buffer length (in bytes).</C> </R>
<R> <C><FC>TypeStr<FN></C> <C>Type as string (ie 'Bitmap', 'Cursor').</C> </R>
<R> <C><FC>NameStr<FN></C> <C>Resource name as string (ie 'INTRESOURCE:100', 'Hand').</C> </R>
<R> <C><FC>ResourceBookmark<FN></C> <C>A resource bookmark returned by <A TIEResourceExtractor.GetResourceBookmark>.</C> </R>
</TABLE>

The buffer must not be freed.

<FM>Example<FC>
// loads resource 143, in "Bitmap"s, from "explorer.exe" (should be a little Windows logo)
var
  re: TIEResourceExtractor;
  buffer: pointer;
  bufferLen: integer;
begin
  re := TIEResourceExtractor.Create('explorer.exe');
  try
    buffer := re.GetBuffer('Bitmap', 'INTRESOURCE:143', bufferLen);
    ImageEnView1.IO.Params.IsResource := true;
    ImageEnView1.IO.LoadFromBuffer(buffer, bufferLen, ioBMP);
  finally
    re.Free;
  end;
end;


// loads the resource specified by parameters "resTypeIndex" and "resNameIndex"
var
  buffer: pointer;
  bufferLen: integer;
begin
  buffer := m_ResourceExtractor.GetBuffer(resTypeIndex, resNameIndex, bufferLen);

  ImageEnView1.IO.Params.IsResource := true;

  if m_ResourceExtractor.FriendlyTypes[resTypeIndex] = 'Bitmap' then
    ImageEnView1.IO.LoadFromBuffer(buffer, bufferLen, ioBMP)
  else
  if m_ResourceExtractor.FriendlyTypes[resTypeIndex] = 'Cursor' then
    ImageEnView1.IO.LoadFromBuffer(buffer, bufferLen, ioCUR)
  else
  if m_ResourceExtractor.FriendlyTypes[resTypeIndex] = 'Icon' then
    ImageEnView1.IO.LoadFromBuffer(buffer, bufferLen, ioICO)
  else
    // We cannot use ioUnknown (autodect) for BMP, CUR and ICO because it is not possible to autodetect BMP, CUR and ICO when they are resources.
    ImageEnView1.IO.LoadFromBuffer(buffer, bufferLen, ioUnknown)  // for jpegs, GIF, etc...

end;
!!}
function TIEResourceExtractor.GetBuffer(TypeIndex: integer; NameIndex: integer; var BufferLength: integer): pointer;
var
  resName: PAnsiChar;
  resType: PAnsiChar;
  resNameStr: AnsiString;
  resTypeStr: AnsiString;
  resInfo: THandle;
  resData: THandle;
begin
  result := nil;
  BufferLength := 0;

  resTypeStr := Types[TypeIndex];
  if copy(resTypeStr, 1, 12) = 'INTRESOURCE:' then
    resType := MakeIntResourceA(IEStrToIntDef(copy(resTypeStr, 13, length(resTypeStr)-12), 0))
  else
    resType := PAnsiChar(resTypeStr);

  resNameStr := Names[TypeIndex, NameIndex];
  if copy(resNameStr, 1, 12) = 'INTRESOURCE:' then
    resName := MakeIntResourceA(IEStrToIntDef(IECopy(resNameStr, 13, length(resNameStr)-12), 0))
  else
    resName := PAnsiChar(resNameStr);

  resInfo := FindResourceA(m_hlib, resName, resType);
  if resInfo = 0 then
    exit;

  resData := LoadResource(m_hlib, resInfo);
  if resData = 0 then
    exit;

  BufferLength := SizeOfResource(m_hlib, resInfo);
  result := LockResource(resData);
end;

function TIEResourceExtractor.GetBuffer(const TypeStr: AnsiString; const NameStr: AnsiString; var BufferLength: integer): pointer;
var
  TypeIndex: integer;
  NameIndex: integer;
  i: integer;
begin
  result := nil;

  TypeIndex := m_typesList.IndexOf(string(TypeStr));
  if TypeIndex=-1 then
    for i := 0 to m_typesList.Count-1 do
      if FriendlyTypes[i] = TypeStr then
      begin
        TypeIndex := i;
        break;
      end;

  if TypeIndex>-1 then
  begin
    NameIndex := TStringList(m_typesList.Objects[TypeIndex]).IndexOf(string(NameStr));
    if NameIndex>-1 then
      result := GetBuffer(TypeIndex, NameIndex, BufferLength);
  end;
end;


{!!
<FS>TIEResourceExtractor.GetResourceBookmark

<FM>Declaration<FC>
function GetResourceBookmark(TypeIndex: integer; NameIndex: integer; FrameIndex: integer = -1): <A TIEResourceBookmark>;

<FM>Description<FN>
Creates a bookmark for the specified resource (or resource frame).
Bookmarks are automatically freed.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>TypeIndex<FN></C> <C>Index of resource type. 0 is first resource type, <A TIEResourceExtractor.TypesCount>-1 is last resource type.</C> </R>
<R> <C><FC>NameIndex<FN></C> <C>Index of actual resource. 0 is first resource name, <A TIEResourceExtractor.NamesCount>-1 is last resource name.</C> </R>
<R> <C><FC>FrameIndex<FN></C> <C>The frame index. 0 is first resource name, <A TIEResourceExtractor.GroupCountFrames>-1 is last frame.</C> </R>
</TABLE>

!!}
function TIEResourceExtractor.GetResourceBookmark(TypeIndex: integer; NameIndex: integer; FrameIndex: integer = -1): TIEResourceBookmark;
begin
  result := TIEResourceBookmark.Create(TypeIndex, NameIndex, FrameIndex);
  m_resourceBookmarks.Add(result);
end;

function TIEResourceExtractor.GetBuffer(ResourceBookmark: TIEResourceBookmark; var BufferLength: integer): pointer;
begin
  if ResourceBookmark.m_FrameIndex < 0 then
    result := GetBuffer(ResourceBookmark.m_TypeIndex, ResourceBookmark.m_NameIndex, BufferLength)
  else
    result := GetFrameBuffer(ResourceBookmark.m_TypeIndex, ResourceBookmark.m_NameIndex, ResourceBookmark.m_FrameIndex, BufferLength);
end;

constructor TIEResourceBookmark.Create(TypeIndex_, NameIndex_, FrameIndex_: integer);
begin
  inherited Create;
  m_TypeIndex := TypeIndex_;
  m_NameIndex := NameIndex_;
  m_FrameIndex := FrameIndex_;
end;

{$endif}  // IEINCLUDERESOURCEEXTRACTOR

// TIEResourceExtractor
////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////




/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////


constructor TIERandomGenerator.Create(Seed: dword);
begin
  x := 123456789 xor (Seed);
  y := 362436069 xor (Seed shl 8);
  z := 521288629 xor (Seed shl 16);
  w := 88675123 xor (Seed shl 24);
end;

constructor TIERandomGenerator.Create(Seed: AnsiString);
var
  i: integer;
begin
  x := 123456789;
  y := 362436069;
  z := 521288629;
  w := 88675123;
  for i := 1 to length(Seed) do
  begin
    x := x xor (ord(Seed[i]));
    y := y xor (ord(Seed[i]) shl 8);
    z := z xor (ord(Seed[i]) shl 16);
    w := w xor (ord(Seed[i]) shl 24);
  end;
end;

constructor TIERandomGenerator.Create(Seed1, Seed2, Seed3, Seed4: dword);
begin
  x := Seed1;
  y := Seed2;
  z := Seed3;
  w := Seed4;
end;

function TIERandomGenerator.NextDWORD(): dword;
var
  t: dword;
begin
  t := x xor (x shl 11);
  x := y; y := z; z := w;
  w := w xor (w shr 19) xor (t xor (t shr 8));
  result := w;
end;

function TIERandomGenerator.NextINT64(): int64;
begin
  result := NextDWORD() or (NextDWORD() shl 32);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////


constructor TIE8087ExceptionsDisabler.Create();
begin
  inherited;
  FPUControlWord := Get8087CW();
  Set8087CW($133F);
end;

destructor TIE8087ExceptionsDisabler.Destroy();
begin
  Set8087CW(FPUControlWord);
  inherited;
end;


/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////


constructor TIEStringSplitter.Create(const Text: string; const Delimiters: string);
begin
  inherited Create();

  m_text         := Text;
  m_strings      := TStringList.Create();
  m_delimiters   := Delimiters;
  m_bypassSpaces := true;

  try
    Update();
  except
    m_strings.Free();
    raise;
  end;
end;

destructor TIEStringSplitter.Destroy();
begin
  m_strings.Free();
  inherited;
end;

procedure TIEStringSplitter.SetText(const Text: string);
begin
  m_text := Text;
  Update();
end;

function TIEStringSplitter.GetText(): string;
begin
  result := m_text;
end;

function TIEStringSplitter.GetString(Index: integer): string;
begin
  result := m_strings[Index];
end;

function TIEStringSplitter.GetCount(): integer;
begin
  result := m_strings.Count;
end;

function TIEStringSplitter.GetDelimiters(): string;
begin
  result := m_delimiters;
end;

procedure TIEStringSplitter.SetDelimiters(const Value: string);
begin
  if Value <> m_delimiters then
  begin
    m_delimiters := Value;
    Update();
  end;
end;

function TIEStringSplitter.GetByPassSpaces(): boolean;
begin
  result := m_bypassSpaces;
end;

procedure TIEStringSplitter.SetByPassSpaces(Value: boolean);
begin
  if Value <> m_bypassSpaces then
  begin
    m_bypassSpaces := Value;
    Update();
  end;
end;

function TIEStringSplitter.IsSpace(c: char): boolean;
begin
  result := (c = #$20) or (c = #$09) or (c = #$0a) or (c = #$0b) or (c = #$0c) or (c = #$0d);
end;

procedure TIEStringSplitter.Update();
var
  p, i, l, len: integer;

  procedure bypassSpaces();
  begin
    if m_bypassSpaces then
      while (i <= len) and IsSpace(m_text[i]) do
        inc(i);
  end;

  function isDelimiter(c: char): boolean;
  begin
    result := Pos(c, m_delimiters) > 0;
  end;

  procedure add(start: integer; length: integer);
  begin
    if m_bypassSpaces then
      m_strings.Add(trim(Copy(m_text, start, length)))
    else
      m_strings.Add(Copy(m_text, start, length));
  end;

begin
  m_strings.Clear();

  len := length(m_text);
  if m_bypassSpaces then
    while (len > 0) and (IsSpace(m_text[len])) do
      dec(len);

  i := 1;
  bypassSpaces();
  p := i;
  while i <= len do
  begin
    if isDelimiter(m_text[i]) then
    begin
      add(p, i - p);
      inc(i);
      bypassSpaces();
      p := i;
    end
    else
      inc(i);
  end;

  l := len - p + 1;
  if (l > 0) or ((length(m_text) > 0) and isDelimiter(m_text[i - 1])) then
    add(p, l);
end;



/////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
// TIEFileBuffer
/////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////

constructor TIEFileBuffer.Create;
begin
  inherited;
  fFileName := '';
  fMapped := TList.Create;
  fSimFile := nil;
end;

destructor TIEFileBuffer.Destroy;
begin
  DeAllocate;
  FreeAndNil(fMapped);
  inherited;
end;

procedure TIEFileBuffer.DeAllocate;
begin
  if IsAllocated then
  begin
    UnMapAll;
    FreeAndNil(fSimFile);
    DeleteFile(fFileName);
  end;
end;

function TIEFileBuffer.IsAllocated: boolean;
begin
  result := fSimFile <> nil
end;

// if FileName is '', creates a temp file name in DefTEMPPATH
function TIEFileBuffer.AllocateFile(InSize: int64; const Descriptor: string; UseDisk: boolean): boolean;
var
  temppath: array[0..MAX_PATH] of Char;
  tp: string;
begin
  if IsAllocated then
    DeAllocate;
  result := false;
  if IEGlobalSettings().DefTEMPPATH = '' then
  begin
    GetTempPath(250, temppath);
    tp := string(temppath);
  end
  else
    tp := IEGlobalSettings().DefTEMPPATH;
  fFileName := IEGetTempFileName(Descriptor, tp);
  try
    if UseDisk then
    begin
      (*
        problems of DiskFree: cannot detect disk>2GB, (0)=current directory (imagine changing directory to USB disk or CDROM)
      if InSize>(DiskFree(0)-128000000) then
        exit;
      *)
      fSimFile := TIETemporaryFileStream.Create(fFileName);
    end
    else
      fSimFile := TMemoryStream.Create;
    fSimFile.Size := InSize;
    result := true;
  except
  end;
end;

procedure TIEFileBuffer.ReAllocateFile(NewSize: int64);
begin
  fSimFile.Size := NewSize;
end;

// can copy maximum 2^31 bytes

procedure TIEFileBuffer.CopyTo(Dest: TIEFileBuffer; InPos, InSize: int64);
const
  BUFSIZE = 1024 * 1024;
var
  i: integer;
  buf: pbyte;
begin
  if (not IsAllocated) or (not Dest.IsAllocated) then
    exit;
  UnMapAll;
  Dest.UnMapAll;
  (*
  // disabled because since 2.2.7 we use TIETemporaryFileStream instead of TFileStream
  if (InPos = 0) and (InSize = fSimFile.Size) then
  begin
    // copy the full file using operating system functions
    FreeAndNil(fSimFile);
    FreeAndNil(Dest.fSimFile);
    deletefile(Dest.fFileName);
    copyfile(PAnsiChar(fFileName), PAnsiChar(Dest.fFileName), false);
    Dest.fSimFile := TFileStream.Create(Dest.fFileName, fmOpenReadWrite);
    fSimFile := TFileStream.Create(fFileName, fmOpenReadWrite);
  end
  else
  *)
  begin
    fSimFile.Position := InPos;
    Dest.fSimFile.Position := InPos;
    getmem(buf, BUFSIZE);
    repeat
      if InSize < BUFSIZE then
        i := InSize
      else
        i := BUFSIZE;
      fSimFile.Read(buf^, i);
      Dest.fSimFile.Write(buf^, i);
      dec(InSize, i);
    until InSize <= 0;
    freemem(buf);
  end;
end;

procedure TIEFileBuffer.CopyTo(Dest: TStream; InPos, InSize: int64);
begin
  if (not IsAllocated) then
    exit;
  UnMapAll;
  fSimFile.Position := InPos;
  IECopyFrom(Dest, fSimFile, InSize);
end;

function TIEFileBuffer.IndexOf(ptr: pointer): integer;
var
  i: integer;
begin
  result := -1;
  for i := 0 to fMapped.Count - 1 do
    if PIEFileBufferItem(fMapped[i])^.ptr = ptr then
    begin
      result := i;
      break;
    end;
end;

function TIEFileBuffer.Map(InPos, InSize: int64; DataAccess: TIEDataAccess): pointer;
var
  item: PIEFileBufferItem;
begin
  result := IEAutoAlloc(InSize);
  if result <> nil then
  begin
    if (fSimFile <> nil) and (iedRead in DataAccess) then
    begin
      fSimFile.Position := InPos;
      fSimFile.Read(pbyte(result)^, InSize);
    end;
    new(item);
    item^.Pos := InPos;
    item^.Size := InSize;
    item^.ptr := result;
    item^.access := DataAccess;
    fMapped.Add(item);
  end;
end;

procedure TIEFileBuffer.UnMap(ptr: pointer);
var
  i: integer;
  item: PIEFileBufferItem;
begin
  if ptr <> nil then
  begin
    i := IndexOf(ptr);
    item := fMapped[i];
    if (fSimFile<>nil) and (iedWrite in item^.access) then
    begin
      fSimFile.Position := item^.Pos;
      fSimFile.Write(pbyte(ptr)^, item^.Size);
    end;
    dispose(item);
    fMapped.Delete(i);
    IEAutoFree(ptr);
  end;
end;

procedure TIEFileBuffer.UnMapAll;
begin
  if IsAllocated then
    while fMapped.Count > 0 do
      UnMap(PIEFileBufferItem(fMapped[fMapped.Count - 1]).ptr);
end;

procedure TIEFileBuffer.CopyFrom(DestPos: int64; Source: pointer; Size: int64);
begin
  if fSimFile <> nil then
  begin
    fSimFile.Position := DestPos;
    fSimFile.Write(pbyte(Source)^, Size);
  end;
end;


/////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
// TIETemporaryFileStream

constructor TIETemporaryFileStream.Create(const FileName: string);
begin
  FHandle := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_FLAG_DELETE_ON_CLOSE or FILE_ATTRIBUTE_TEMPORARY, 0);
  if FHandle = INVALID_HANDLE_VALUE then
    raise EInOutError.Create('Unable to create '+FileName);
  inherited Create(FHandle);
end;

destructor TIETemporaryFileStream.Destroy;
begin
  if FHandle <> INVALID_HANDLE_VALUE then
    FileClose(FHandle);
  inherited Destroy;
end;

/////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////



////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////
// Hash functions

function IE_ELFHash(const str: WideString; bucketCount: cardinal): cardinal;
var
  i: cardinal;
  x: cardinal;
begin
  result := 0;
  for i := 1 to length(str) do
  begin
    result := (result shl 4) + ord(str[i]);
    x      := result and $F0000000;
    if (x <> 0) then
      result := (result xor (x shr 24)) and (not x);
  end;
  result := result mod bucketCount;
end;


function IE_RSHash(const str: WideString; bucketCount: cardinal): cardinal;
const
  b = 378551;
var
  a : cardinal;
  i : integer;
begin
  a      := 63689;
  result := 0;
  for i := 1 to length(str) do
  begin
    result := result * a + ord(str[i]);
    a      := a * b;
  end;
  result := result mod bucketCount;
end;


function IE_JSHash(const str: WideString; bucketCount: cardinal): cardinal;
var
  i: integer;
begin
  result := 1315423911;
  for i := 1 to length(str) do
    result := result xor ((result shl 5) + ord(str[i]) + (result shr 2));
  result := result mod bucketCount;
end;

// MurmurHash
function IE_MMHash(const str: WideString; const Seed: Cardinal = $9747b28c): Cardinal;
var
  h: Cardinal;
  len: Cardinal;
  k: Cardinal;
  data: Integer;
const
  // 'm' and 'r' are mixing constants that work well.
  m = $5bd1e995;
  r = 24;
begin
  len := Length( str );
  h := seed xor len;

  // Mix 4 bytes at a time into the hash
  data := 1;
  while len >= 4 do
  begin
    k := pCardinal( @str[ data ] )^;

    k := k * m;
    k := k xor (k shr r);
    k := k * m;

    h := h * m;
    h := h xor k;

    data := data + 4;
    len := len - 4;
  end;

  // Handle last few bytes of the input array
  if len = 3 then
    h := h xor ( Cardinal( str[ data + 2 ]) shl 16 );
  if len >= 2 then
    h := h xor ( Cardinal( str[ data + 1 ]) shl 8 );
  if len >= 1 then
  begin
    h := h xor ( Cardinal( str[ data ]));
    h := h * m;
  end;

  // Do a few final mixes of the hash to ensure the last few
  // bytes are well-incorporated.
  h := h xor ( h shr 13 );
  h := h * m;
  h := h xor ( h shr 15 );

  Result := h;
end;


////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////
// TIEDictionary


constructor TIEDictionaryValueWideString.Create(value: WideString);
begin
  self.value := value;
end;

destructor TIEDictionaryValueWideString.Destroy();
begin
  inherited;
end;


constructor TIEDictionaryValueInteger.Create(value: integer);
begin
  self.value := value;
end;

destructor TIEDictionaryValueInteger.Destroy();
begin
  inherited;
end;


constructor TIEDictionaryValueDouble.Create(value: double);
begin
  self.value := value;
end;

destructor TIEDictionaryValueDouble.Destroy();
begin
  inherited;
end;


constructor TIEDictionaryValueBoolean.Create(value: boolean);
begin
  self.value := value;
end;

destructor TIEDictionaryValueBoolean.Destroy();
begin
  inherited;
end;


constructor TIEDictionaryBucket.Create(const key_: WideString; const value_: TObject; next_: TIEDictionaryBucket);
begin
  inherited Create;
  key   := key_;
  value := value_;
  next  := next_;
end;


destructor TIEDictionaryBucket.Destroy();
begin
  value.Free();
end;


constructor TIEStrStrEnumerator.Create();
begin
  inherited Create;
  bucket := 0;
  item   := nil;
end;

destructor TIEStrStrEnumerator.Destroy();
begin
  inherited;
end;



procedure TIEDictionary.CheckInit();
var
  i: cardinal;
begin
  if not m_initDone then
  begin
    if not IEIsPrime(m_bucketCount) then
      m_bucketCount := IENextPrime(m_bucketCount);

    SetLength(m_buckets, m_bucketCount);
    for i := 0 to m_bucketCount - 1 do
      m_buckets[i] := nil;

    m_initDone := true;
  end;
end;


{!!
<FS>TIEDictionary.Create

<FM>Declaration<FC>
constructor Create(buckets: cardinal; hashFunction: TIEStrHashFunction; caseSensitive: boolean = false); overload;
constructor Create(buckets: cardinal = 103; caseSensitive: boolean = false); overload;

<FM>Description<FN>
Creates a new instance of TIEDictionary.
!!}
constructor TIEDictionary.Create(buckets: cardinal; hashFunction: TIEStrHashFunction; caseSensitive: boolean);
begin
  inherited Create;
  m_initDone := false;
  m_bucketCount := buckets;
  m_hashFunction := hashFunction;
  m_caseSensitive := caseSensitive;
  m_count := 0;
end;


constructor TIEDictionary.Create(buckets: cardinal; caseSensitive: boolean);
begin
  inherited Create;
  m_initDone := false;
  m_bucketCount := buckets;
  m_hashFunction := @IE_ELFHash;
  m_caseSensitive := caseSensitive;
  m_count := 0;
end;


destructor TIEDictionary.Destroy();
begin
  Clear();
  inherited;
end;


function TIEDictionary.execHash(const str: WideString; bucketCount: cardinal): cardinal;
begin
  if m_caseSensitive then
    result := m_hashFunction(str, bucketCount)
  else
    result := m_hashFunction(UpperCase(str), bucketCount);
end;


{!!
<FS>TIEDictionary.Clear

<FM>Declaration<FC>
procedure Clear();

<FM>Description<FN>
Empties the dictionary.
!!}
procedure TIEDictionary.Clear();
var
  i: cardinal;
  nxt, ths: TIEDictionaryBucket;
begin
  if m_initDone then
  begin
    for i := 0 to m_bucketCount - 1 do
    begin
      ths := m_buckets[i];
      while ths <> nil do
      begin
        nxt := ths.next;
        ths.Free();
        ths := nxt;
      end;
      m_buckets[i] := nil;
    end;
    m_count := 0;
  end;
end;


function TIEDictionary.keysMatch(const key1: WideString; const key2: WideString): boolean;
begin
  if m_caseSensitive then
    result := key1 = key2
  else
    result := UpperCase(key1) = UpperCase(key2);
end;


function TIEDictionary.GetInBucket(bucket: cardinal; key: WideString; out lastItem: TIEDictionaryBucket): TIEDictionaryBucket;
var
  ths: TIEDictionaryBucket;
begin
  CheckInit();
  result := nil;
  ths := m_buckets[bucket];
  lastItem := ths;
  while (ths <> nil) and (result = nil) do
  begin
    lastItem := ths;
    if keysMatch(ths.key, key) then
      result := ths;
    ths := ths.next;
  end;
end;


{!!
<FS>TIEDictionary.HasKey

<FM>Declaration<FC>
function HasKey(key: WideString; recursive: boolean = true): boolean;

<FM>Description<FN>
Returns the true if the key exists.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>key<FN></C> <C>A key in this dictionary</C> </R>
<R> <C><FC>recursive<FN></C> <C>If true then search this key inside subdictionaries</C> </R>
</TABLE>
!!}
function TIEDictionary.HasKey(key: WideString; recursive: boolean): boolean;
begin
  result := Get(key, true, recursive) <> nil;
end;


// recursive key search
function TIEDictionary.FindInDictionaries(key: WideString): TObject;
var
  current: TIEStrStrEnumerator;
  olist: TObjectList;
  i: integer;
begin
  result := nil;
  current := TIEStrStrEnumerator.Create();
  while GetNext(current) do
  begin
    if current.item.value is TIEDictionary then
    begin
      result := (current.item.value as TIEDictionary).Get(key, true, true);
      if result <> nil then
        break;
    end
    else if current.item.value is TObjectList then
    begin
      olist := current.item.value as TObjectList;
      for i := 0 to olist.Count - 1 do
      begin
        if olist[i] is TIEDictionary then
          result := (olist[i] as TIEDictionary).Get(key, true, true);
        if result <> nil then
          break;
      end;
    end;
  end;
  current.Free();
end;


{!!
<FS>TIEDictionary.Get

<FM>Declaration<FC>
function Get(key: WideString; silent: boolean = false; recursive: boolean = true): TObject;

<FM>Description<FN>
Returns the value to which the key is mapped in this dictionary. If the key doesn't exist returns <FC>nil<FN> or raises an exception.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>key<FN></C> <C>A key in this dictionary</C> </R>
<R> <C><FC>silent<FN></C> <C>If true no exception is raised if the key doesn't exist</C> </R>
<R> <C><FC>recursive<FN></C> <C>If true then search this key inside subdictionaries</C> </R>
</TABLE>
!!}
function TIEDictionary.Get(key: WideString; silent: boolean; recursive: boolean): TObject;
var
  bucket: cardinal;
  ths, lst: TIEDictionaryBucket;
begin
  CheckInit();
  bucket := execHash(key, m_bucketCount);
  ths    := GetInBucket(bucket, key, lst);
  if ths <> nil then
    result := ths.value
  else
  begin
    result := nil;
    if recursive then
      result := FindInDictionaries(key);
    if (result = nil) and not silent then
      raise EIEException.Create(Format('Key "%s" not found', [key]));
  end;
end;


{!!
<FS>TIEDictionary.GetString

<FM>Declaration<FC>
function GetString(key: WideString; recursive: boolean = true): WideString;

<FM>Description<FN>
Returns the string value to which the key is mapped in this dictionary. If the key doesn't exist an exception is raised.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>key<FN></C> <C>A key in this dictionary</C> </R>
<R> <C><FC>recursive<FN></C> <C>If true then search this key inside subdictionaries</C> </R>
</TABLE>

<FM>Examples<FC>
// Return the photo description from the XMP metadata
sDescription := ImageEnView1.IO.Params.Dict.GetDictionary( 'XMP' ).GetString( 'dc:description' );

// Return the creation date from the XMP metadata (XMP date strings are formatted the same EXIF date strings)
dtCreateDate := EXIFDateToDateTime( ImageEnView1.IO.Params.Dict.GetDictionary( 'XMP' ).GetString( 'xmp:CreateDate' ));

// Return the creator or author of the asset from the XMP metadata
sCreator := ImageEnView1.IO.Params.Dict.GetDictionary( 'XMP' ).GetString( 'dc:creator' );

// Return location information about the content being shown in the image
sLocation := ImageEnView1.IO.Params.Dict.GetDictionary( 'XMP' ).GetString( 'photoshop:City' ) + ', ' +
             ImageEnView1.IO.Params.Dict.GetDictionary( 'XMP' ).GetString( 'photoshop:State' ) + ', ' +
             ImageEnView1.IO.Params.Dict.GetDictionary( 'XMP' ).GetString( 'photoshop:Country' );

// Return the document title from the XMP metadata
sTitle := ImageEnView1.IO.Params.Dict.GetDictionary( 'XMP' ).GetString( 'dc:title' );

// Return the document keywords from the XMP metadata
sKeywords := ImageEnView1.IO.Params.Dict.GetDictionary( 'XMP' ).GetString( 'dc:subject' );

// Return the document copyright information from the XMP metadata
sCopyright := ImageEnView1.IO.Params.Dict.GetDictionary( 'XMP' ).GetString( 'dc:rights' );

// Return the Photoshop Headline from the XMP metadata
sHeadline := ImageEnView1.IO.Params.Dict.GetDictionary( 'XMP' ).GetString( 'photoshop:Headline' );

// Return the Windows Rating from the XMP metadata (0 to 5)
sRating := ImageEnView1.IO.Params.Dict.GetDictionary( 'XMP' ).GetString( 'xmp:Rating' );

!!}
function TIEDictionary.GetString(key: WideString; recursive: boolean): WideString;
var
  obj: TObject;
begin
  obj := Get(key, false, recursive);
  if obj is TIEDictionaryValueInteger then
    result := IntToStr((obj as TIEDictionaryValueInteger).value)
  else
  if obj is TIEDictionaryValueDouble then
    result := IEFloatToStrW((obj as TIEDictionaryValueDouble).value)
  else
  if obj is TIEDictionary then
    result := (obj as TIEDictionary).GetString('#text', true)
  else
    result := (obj as TIEDictionaryValueWideString).value;
end;


{!!
<FS>TIEDictionary.GetInteger

<FM>Declaration<FC>
function GetInteger(key: WideString; recursive: boolean = true): integer;

<FM>Description<FN>
Returns the integer value to which the key is mapped in this dictionary. If the key doesn't exist an exception is raised.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>key<FN></C> <C>A key in this dictionary</C> </R>
<R> <C><FC>recursive<FN></C> <C>If true then search this key inside subdictionaries</C> </R>
</TABLE>

<FM>Examples<FC>
// Return the Photoshop Color Mode from the XMP metadata
iColorMode := ImageEnView1.IO.Params.Dict.GetDictionary( 'XMP' ).GetInteger( 'photoshop:ColorMode' );

!!}
function TIEDictionary.GetInteger(key: WideString; recursive: boolean): integer;
var
  obj: TObject;
begin
  obj := Get(key, false, recursive);
  if obj is TIEDictionaryValueDouble then
    result := trunc( (obj as TIEDictionaryValueDouble).value )
  else
  if obj is TIEDictionaryValueWideString then
    result := StrToInt((obj as TIEDictionaryValueWideString).value)
  else
  if obj is TIEDictionary then
    result := (obj as TIEDictionary).GetInteger('#text', true)
  else
    result := (obj as TIEDictionaryValueInteger).value;
end;


{!!
<FS>TIEDictionary.GetDouble

<FM>Declaration<FC>
function GetDouble(key: WideString; recursive: boolean = true): double;

<FM>Description<FN>
Returns the double value to which the key is mapped in this dictionary. If the key doesn't exist an exception is raised.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>key<FN></C> <C>A key in this dictionary</C> </R>
<R> <C><FC>recursive<FN></C> <C>If true then search this key inside subdictionaries</C> </R>
</TABLE>
!!}
function TIEDictionary.GetDouble(key: WideString; recursive: boolean): double;
var
  obj: TObject;
begin
  obj := Get(key, false, recursive);
  if obj is TIEDictionaryValueInteger then
    result := (obj as TIEDictionaryValueInteger).value
  else
  if obj is TIEDictionaryValueWideString then
    result := IEStrToFloatDefW((obj as TIEDictionaryValueWideString).value, 0.0)
  else
  if obj is TIEDictionary then
    result := (obj as TIEDictionary).GetDouble('#text', true)
  else
    result := (obj as TIEDictionaryValueDouble).value;
end;


{!!
<FS>TIEDictionary.GetBoolean

<FM>Declaration<FC>
function GetBoolean(key: WideString; recursive: boolean = true): boolean;

<FM>Description<FN>
Returns the boolean value to which the key is mapped in this dictionary. If the key doesn't exist an exception is raised.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>key<FN></C> <C>A key in this dictionary</C> </R>
<R> <C><FC>recursive<FN></C> <C>If true then search this key inside subdictionaries</C> </R>
</TABLE>
!!}
function TIEDictionary.GetBoolean(key: WideString; recursive: boolean): boolean;
var
  obj: TObject;
begin
  obj := Get(key, false, recursive);
  if obj is TIEDictionaryValueInteger then
    result := (obj as TIEDictionaryValueInteger).value <> 0
  else
  if obj is TIEDictionaryValueDouble then
    result := (obj as TIEDictionaryValueDouble).value <> 0.0
  else
  if obj is TIEDictionaryValueWideString then
    result := (obj as TIEDictionaryValueWideString).value = 'true'
  else
  if obj is TIEDictionary then
    result := (obj as TIEDictionary).GetBoolean('#text', true)
  else
    result := (obj as TIEDictionaryValueBoolean).value;
end;


{!!
<FS>TIEDictionary.GetDictionary

<FM>Declaration<FC>
function GetDictionary(key: WideString; recursive: boolean = true): <A TIEDictionary>;

<FM>Description<FN>
Returns the <A TIEDictionary> value to which the key is mapped in this dictionary. If the key doesn't exist an exception is raised.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>key<FN></C> <C>A key in this dictionary</C> </R>
<R> <C><FC>recursive<FN></C> <C>If true then search this key inside subdictionaries</C> </R>
</TABLE>
!!}
function TIEDictionary.GetDictionary(key: WideString; recursive: boolean): TIEDictionary;
begin
  result := Get(key, false, recursive) as TIEDictionary;
end;


{!!
<FS>TIEDictionary.GetList

<FM>Declaration<FC>
function GetList(key: WideString; recursive: boolean = true): TObjectList;

<FM>Description<FN>
Returns the TObjectList value to which the key is mapped in this dictionary. If the key doesn't exist an exception is raised.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>key<FN></C> <C>A key in this dictionary</C> </R>
<R> <C><FC>recursive<FN></C> <C>If true then search this key inside subdictionaries</C> </R>
</TABLE>
!!}
function TIEDictionary.GetList(key: WideString; recursive: boolean): TObjectList;
begin
  result := Get(key, false, recursive) as TObjectList;
end;


{!!
<FS>TIEDictionary.Insert

<FM>Declaration<FC>
procedure Insert(key: WideString; value: TObject); overload;
procedure Insert(key: WideString; value: WideString); overload;
procedure Insert(key: WideString; value: integer); overload;
procedure Insert(key: WideString; value: double); overload;
procedure Insert(key: WideString; value: boolean); overload;
procedure Insert(key: WideString; value: <A TIEDictionary>); overload;
procedure Insert(key: WideString; value: TObjectList); overload;

<FM>Description<FN>
Maps the specified key to the specified object or value in this dictionary.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>key<FN></C> <C>A string key</C> </R>
<R> <C><FC>value<FN></C> <C>Object/value to store. The dictionary owns the object: it will be automatically disposed.</C> </R>
</TABLE>
!!}
procedure TIEDictionary.Insert(key: WideString; value: TObject);
var
  bucket: cardinal;
  ths, lst: TIEDictionaryBucket;
begin
  CheckInit();
  bucket := execHash(key, m_bucketCount);
  if m_buckets[bucket] = nil then
  begin
    // bucket free, just set this item
    m_buckets[bucket] := TIEDictionaryBucket.Create(key, value);
    inc(m_count);
  end
  else
  begin
    // bucket not free, find for equal item
    ths := GetInBucket(bucket, key, lst);
    if ths = nil then
    begin
      // not equal item, insert this item after the last one
      lst.next := TIEDictionaryBucket.Create(key, value, nil);
      inc(m_count);
    end
    else
    begin
      // equal item found, just replace value
      ths.value.Free();
      ths.value := value;
      // do not inc m_count!
    end;
  end;
end;


procedure TIEDictionary.Insert(key: WideString; value: WideString);
begin
  Insert(key, TIEDictionaryValueWideString.Create(value));
end;


procedure TIEDictionary.Insert(key: WideString; value: integer);
begin
  Insert(key, TIEDictionaryValueInteger.Create(value));
end;


procedure TIEDictionary.Insert(key: WideString; value: double);
begin
  Insert(key, TIEDictionaryValueDouble.Create(value));
end;


procedure TIEDictionary.Insert(key: WideString; value: boolean);
begin
  Insert(key, TIEDictionaryValueBoolean.Create(value));
end;


procedure TIEDictionary.Insert(key: WideString; value: TIEDictionary);
begin
  Insert(key, TObject(value));
end;


procedure TIEDictionary.Insert(key: WideString; value: TObjectList);
begin
  Insert(key, TObject(value));
end;


{!!
<FS>TIEDictionary.Erase

<FM>Declaration<FC>
function Erase(key: WideString): boolean;

<FM>Description<FN>
Remove the specified key.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>key<FN></C> <C>A key in this dictionary</C> </R>
<R> <C><FC>freeValue<FN></C> <C>If True the value is deallocated</C> </R>
</TABLE>
!!}
function TIEDictionary.Erase(key: WideString; freeValue: boolean): boolean;
var
  bucket: cardinal;
  ths, prev: TIEDictionaryBucket;
begin
  CheckInit();
  result := false;
  bucket := execHash(key, m_bucketCount);
  prev := nil;
  ths  := m_buckets[bucket];
  while (ths <> nil) do
  begin
    if keysMatch(ths.key, key) then
    begin
      // found
      if prev = nil then
        // this is the first item in bucket
        m_buckets[bucket] := ths.next
      else
        // has a previous item, change it
        prev.next := ths.next;
      if not freeValue then
        ths.value := nil;
      ths.Free();
      dec(m_count);
      result := true;
      break;
    end;
    prev := ths;
    ths  := ths.next;
  end;
end;


{!!
<FS>TIEDictionary.GetNext

<FM>Declaration<FC>
function GetNext(current: TIEStrStrEnumerator): boolean;


<FM>Description<FN>
Allows to iterate among all dictionary elements.
Returns <FC>true<FN> if an element is available.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>current<FN></C> <C>An object used to store current enumerator state.</C> </R>
</TABLE>


<FM>Example<FC>
var current: TIEStrStrEnumerator;
current := TIEStrStrEnumerator.Create();
while dict.GetNext(current) do
begin
  key   := current.item.key;
  value := current.item.value;
       ...
end;
current.Free();
!!}
function TIEDictionary.GetNext(current: TIEStrStrEnumerator): boolean;
var
  next: TIEDictionaryBucket;
begin
  CheckInit();
  result := false;
  if current.item <> nil then
  begin
    // current doesn't point to "before the first item", so check in current bucket
    next := current.item.next;
    if next <> nil then
    begin
      // return next item of current bucket
      current.item := next;
      result       := true;
      exit;
    end;
    inc(current.bucket);  // try next bucket
  end;
  while current.bucket < m_bucketCount do
  begin
    current.item := m_buckets[current.bucket];
    if current.item <> nil then
    begin
      result := true;
      break;
    end;
    inc(current.bucket);
  end;
  if result = false then
  begin
    current.bucket := 0;
    current.item := nil;
  end;
end;


{!!
<FS>TIEDictionary.IsEmpty

<FM>Declaration<FC>
function IsEmpty(): boolean;


<FM>Description<FN>
Returns True if the dictionary contains no elements.
!!}
function TIEDictionary.IsEmpty(): boolean;
begin
  result := (m_count = 0);
end;


function TIEDictionary.EncodeString(Text: WideString): WideString;
var
  i: integer;
begin
  result := '';
  for i := 1 to length(Text) do
    if Text[i] = '"' then
      result := result + '\"'
    else
      result := result + Text[i];
end;


function TIEDictionary.DumpJSON(obj: TObject): WideString;
begin
  if obj is TIEDictionaryValueWideString then
    result := '"' + EncodeString((obj as TIEDictionaryValueWideString).value) + '"'
  else
  if obj is TIEDictionaryValueInteger then
    result := IntToStr((obj as TIEDictionaryValueInteger).value)
  else
  if obj is TIEDictionaryValueDouble then
    result := IEFloatToStrW((obj as TIEDictionaryValueDouble).value)
  else
  if obj is TIEDictionaryValueBoolean then
    case (obj as TIEDictionaryValueBoolean).value of
      false : result := 'false';
      true  : result := 'true';
    end
  else
  if obj is TIEDictionary then
    result := (obj as TIEDictionary).DumpJSON()
  else
  if obj is TObjectList then
    result := DumpJSON(TObjectList(obj))
  else
    result := obj.ClassName; // unknown
end;


function TIEDictionary.DumpJSON(obj: TObjectList): WideString;
var
  i: integer;
begin
  result := '[';
  for i := 0 to obj.Count - 1 do
  begin
    result := result + DumpJSON(obj[i]);
    if i < obj.Count - 1 then
      result := result + ',';
  end;
  result := result + ']';
end;


function TIEDictionary.DumpJSON(): WideString;
var
  current: TIEStrStrEnumerator;
  isfirst: boolean;
begin
  result := '{';
  current := TIEStrStrEnumerator.Create();
  try
    isfirst := true;
    while GetNext(current) do
    begin
      if not isfirst then
        result := result + ',';
      result := result + '"' + EncodeString(current.item.key) + '"' + ':';
      result := result + DumpJSON(current.item.value);
      isfirst := false;
    end;
  finally
    current.Free();
  end;
  result := result + '}';
end;


function TIEDictionary.DumpXML(obj: TObject): WideString;
begin
  if obj is TIEDictionaryValueWideString then
    result := EncodeString((obj as TIEDictionaryValueWideString).value)
  else
  if obj is TIEDictionaryValueInteger then
    result := IntToStr((obj as TIEDictionaryValueInteger).value)
  else
  if obj is TIEDictionaryValueDouble then
    result := IEFloatToStrW((obj as TIEDictionaryValueDouble).value)
  else
  if obj is TIEDictionaryValueBoolean then
    case (obj as TIEDictionaryValueBoolean).value of
      false : result := 'false';
      true  : result := 'true';
    end
  else
  if obj is TIEDictionary then
    result := (obj as TIEDictionary).DumpXML()
  else
  if obj is TObjectList then
    result := DumpXML(TObjectList(obj))
  else
    result := obj.ClassName; // unknown
end;


function TIEDictionary.DumpXML(obj: TObjectList): WideString;
var
  i: integer;
begin
  result := '';
  for i := 0 to obj.Count - 1 do
    result := result + DumpXML(obj[i]);
end;


function TIEDictionary.DumpXML(): WideString;
var
  current: TIEStrStrEnumerator;
begin
  result := '';
  current := TIEStrStrEnumerator.Create();
  try
    while GetNext(current) do
    begin
      result := result + '<' + EncodeString(current.item.key) + '>';
      result := result + DumpXML(current.item.value);
      result := result + '</' + EncodeString(current.item.key) + '>';
    end;
  finally
    current.Free();
  end;
end;


{!!
<FS>TIEDictionary.Dump

<FM>Declaration<FC>
function Dump(dumpType: <A TIEDictionaryParserLang>): WideString;


<FM>Description<FN>
Returns a JSON-like or XML representation of the dictionary.
Not all dictionary contents can be dumped to XML and correctly parsed back.

<FM>See Also<FN>
- <A TIEDictionary.Parse>
!!}
function TIEDictionary.Dump(dumpType: TIEDictionaryParserLang): WideString;
begin
  case dumpType of
    ieplJSON:
      result := DumpJSON();
    ieplXML:
      result := DumpXML();
  end;
end;


{!!
<FS>TIEDictionary.Parse

<FM>Declaration<FC>
function Parse(text: WideString): boolean;


<FM>Description<FN>
Parses the JSON-like string and populates the dictionary.
This method doesn't remove existing items.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>text<FN></C> <C>A JSON-like text</C> </R>
</TABLE>

<FM>See Also<FN>
- <A TIEDictionary.Dump>

<FM>Example<FC>
}
// dict.Parse('{"string" : "string content", "myinteger": 1234, "mydouble": 123.456, "a_bool_true" : true, "a_bool_false" : false, "subdict" : {"name": "john", "surname" : "mad"}, "array": [1,2,3,4,"hello", {}, {"alfa":"beta"}, [9,10]] }');
{!!}
function TIEDictionary.Parse(text: WideString): boolean;
var
  parser: TIEDictionaryParser;
begin
  parser := TIEDictionaryParser.Create(text);
  try
    parser.Parse(self);
    result := not parser.Aborted;
  finally
    parser.Free();
  end;
end;


procedure TIEDictionary.Assign(Source: TIEDictionary);
begin
  Clear();
  Parse(Source.Dump(ieplJSON));
end;


constructor TIEDictionaryParser.Create(Text: WideString);
begin
  m_text    := Text;
  m_textLen := length(Text);
  m_textPos := 1;
  m_abort   := false;

  // check language to decode
  m_lang := ieplJSON;
  if PeekToken() <> '{' then
  begin
    m_lang := ieplXML;
    if PeekToken() <> '<' then
      m_abort := true;
  end;
end;


procedure TIEDictionaryParser.AbortParse();
begin
  m_abort := true;
end;


function TIEDictionaryParser.DecodeString(Text: WideString): WideString;
var
  i: integer;
begin
  result := '';
  i := 1;
  while i <= length(Text) do
  begin
    if (i < length(Text)) and (Text[i] = '\') and (Text[i + 1] = '"') then
    begin
      result := result + '"';
      inc(i);
    end
    else
      result := result + Text[i];
    inc(i);
  end;
end;


function TIEDictionaryParser.IsToken(c: WideChar): boolean;
begin
  case m_lang of
    ieplJSON:
      result := (c = '{') or (c = '}') or (c = '[') or (c = ']') or (c = '"') or (c = ':') or (c = ',');
    ieplXML:
      result := (c = '<') or (c = '>') or (c = '/') or (c = '''') or (c = '"') or (c = '=') or (c = '?');
    else
      result := false;
  end;
end;


function TIEDictionaryParser.IsSpace(c: WideChar): boolean;
begin
  result := (c = ' ') or (c = #8) or (c = #13) or (c = #10);
end;


procedure TIEDictionaryParser.ByPassSpaces();
begin
  while HasChar() and IsSpace(PeekChar()) do
    GetChar();
end;


function TIEDictionaryParser.HasChar(): boolean;
begin
  result := m_textPos <= m_textLen;
end;


function TIEDictionaryParser.GetChar(): WideChar;
begin
  result := m_text[m_textPos];
  inc(m_textPos);
end;


function TIEDictionaryParser.PeekChar(): WideChar;
begin
  result := m_text[m_textPos];
end;


function TIEDictionaryParser.SavePos(): integer;
begin
  result := m_textPos;
end;


procedure TIEDictionaryParser.RestorePos(pos: integer);
begin
  m_textPos := pos;
end;


function TIEDictionaryParser.GetToken(): WideChar;
begin
  while HasChar() do
  begin
    result := GetChar();
    if not IsSpace(result) then
      exit;
  end;
  result := ' ';  // end of string?
end;


function TIEDictionaryParser.PeekToken(): WideChar;
var
  lpos: integer;
begin
  lpos := SavePos();
  result := GetToken();
  RestorePos(lpos);
end;


function TIEDictionaryParser.GetString(): WideString;
var
  c: WideChar;
  prevChar: WideChar;
  marker: WideChar; // character used to open and close string
begin
  result := '';
  marker := GetToken();
  if (marker <> '"') and (marker <> '''') then // accepts both single quote and double quote
  begin
    AbortParse();
    exit;
  end;
  prevChar := ' ';
  while HasChar() do
  begin
    c := GetChar();
    if (prevChar <> '\') and (c = marker) then
      break;
    result := result + c;
    prevChar := c;
  end;
  // ending marker already passed
  result := DecodeString(result);
end;


function TIEDictionaryParser.Parse(mergeWith: TIEDictionary = nil): TIEDictionary;
begin
  case m_lang of
    ieplJSON:
      result := JSON_ParseDictionary(mergeWith);
    ieplXML:
      result := XML_ParseContent(mergeWith);
    else
      result := nil;
  end;
end;


// content can be free text or tags
function TIEDictionaryParser.XML_ParseContent(mergeWith: TIEDictionary): TIEDictionary;
var
  key: WideString;
  value: TIEDictionary;
  content: TIEDictionary;
  tk: WideChar;
  text: WideString;
  lpos: integer;

  procedure Ins(key: WideString; value: TObject);
  var
    evalue: TObject;
    arr: TObjectList;
  begin
    if result.HasKey(key, false) then
    begin
      // key already exist, create an array
      evalue := result.Get(key);
      if not (evalue is TObjectList) then
      begin
        result.Erase(key, false); // evalue still exists
        arr := TObjectList.Create();
        result.Insert(key, arr);
        arr.Add(evalue);
        arr.Add(value);
      end
      else
        (evalue as TObjectList).Add(value);
    end
    else
      result.Insert(key, value);
  end;

begin
  if mergeWith = nil then
    result := TIEDictionary.Create()
  else
    result := mergeWith;
  text := '';
  while HasChar() and not m_abort do
  begin
    lpos := SavePos();
    if PeekToken() = '<' then
    begin
      GetToken(); // bypass '<'
      if PeekToken() = '/' then
      begin
        // this is an upper enclosing tag, end this procedure
        RestorePos(lpos);
        break;
      end
      else
      if PeekToken() = '?' then
      begin
        // this is an xml declaration (like <?...   ?>)
        GetToken(); // bypass '?'
        key   := XML_GetName();
        value := XML_ParseAttributes();
        Ins(key, value);
        if (GetToken() = '?') and (GetToken() = '>') then
          continue;
        AbortParse();
      end
      else
      begin
        // this is a tag
        key   := XML_GetName();
        value := XML_ParseAttributes();
        Ins(key, value);
        tk := GetToken();
        if (tk = '/') and (PeekToken() = '>') then
        begin
          // empty tag (like <tag .... /> )
          GetToken(); // by pass >
        end
        else
        if (tk = '>') then
        begin
          // tag with content, get content (like <tag ...> content </tag>)
          content := XML_ParseContent();
          value.insert('#content', content);
          if (GetToken() = '<') and (GetToken() = '/') and (XML_GetName() = key) and (GetToken() = '>') then
            continue;
        end;
      end;
    end
    else
    begin
      // this is text content
      text := text + GetChar();
    end;
  end;
  text := trim(text);
  if text <> '' then
    result.Insert('#text', text);
end;


function TIEDictionaryParser.XML_GetName(): WideString;
var
  c: WideChar;
begin
  result := '';
  ByPassSpaces();
  while HasChar() do
  begin
    c := PeekChar();
    if IsSpace(c) or IsToken(c) then
      break;
    result := result + GetChar();
  end;
end;


function TIEDictionaryParser.XML_ParseAttributes(): TIEDictionary;
var
  key: WideString;
  value: TIEDictionaryValueWideString;
  tk: WideChar;
begin
  result := TIEDictionary.Create();
  while HasChar() do
  begin
    tk := PeekToken();
    if (tk = '>') or (tk = '?') or (tk = '/') then
      break;
    key := XML_GetName();
    if GetToken() <> '=' then
    begin
      AbortParse();
      exit;
    end;
    value := ParseString();
    result.Insert(key, value);
  end;
end;


function TIEDictionaryParser.JSON_ParseDictionary(mergeWith: TIEDictionary): TIEDictionary;
var
  key: WideString;
  value: TObject;
  tk: WideChar;

  procedure Ins(key: WideString; value: TObject);
  var
    evalue: TObject;
    arr: TObjectList;
  begin
    if result.HasKey(key, false) then
    begin
      // key already exist, create an array
      evalue := result.Get(key);
      if not (evalue is TObjectList) then
      begin
        result.Erase(key, false); // evalue still exists
        arr := TObjectList.Create();
        result.Insert(key, arr);
        arr.Add(evalue);
        arr.Add(value);
      end
      else
        (evalue as TObjectList).Add(value);
    end
    else
      result.Insert(key, value);
  end;

begin
  if mergeWith = nil then
    result := TIEDictionary.Create()
  else
    result := mergeWith;
  if GetToken() <> '{' then
  begin
    AbortParse();
    exit;
  end;
  while HasChar() and not m_abort do
  begin
    if PeekToken() = '}' then
      break;
    key := GetString();
    if GetToken() <> ':' then
    begin
      AbortParse();
      exit;
    end;
    value := JSON_ParseValue();
    Ins(key, value);
    tk := PeekToken();
    if tk = '}' then
      break
    else
    if tk <> ',' then
      AbortParse()
    else
      GetToken(); // gets ','
  end;
  if GetToken() <> '}' then
    AbortParse();
end;


function TIEDictionaryParser.JSON_ParseValue(): TObject;
var
  token: WideChar;
begin
  token := PeekToken();
  if token = '{' then
    result := JSON_ParseDictionary()
  else
  if token = '[' then
    result := JSON_ParseArray()
  else
  if token = '"' then
    result := ParseString()
  else
    result := ParseIdentifier();
end;


function TIEDictionaryParser.JSON_ParseArray(): TObjectList;
var
  value: TObject;
  tk: WideChar;
begin
  result := TObjectList.Create();
  if GetToken() <> '[' then
  begin
    AbortParse();
    exit;
  end;
  while HasChar() and not m_abort do
  begin
    if PeekToken() = ']' then
      break;
    value := JSON_ParseValue();
    if not m_abort then
      result.Add(value);
    tk := PeekToken();
    if tk = ']' then
      break
    else
    if tk <> ',' then
      AbortParse()
    else
      GetToken(); // gets ','
  end;
  if GetToken() <> ']' then
    AbortParse();
end;


function TIEDictionaryParser.ParseString(): TIEDictionaryValueWideString;
begin
  result := TIEDictionaryValueWideString.Create( GetString() );
end;


// true/false/integer/double
function TIEDictionaryParser.ParseIdentifier(): TObject;
var
  c: WideChar;
  s: WideString;
begin
  s := '';
  ByPassSpaces();
  // get identifier up to space
  while HasChar() do
  begin
    c := PeekChar();
    if IsSpace(c) or IsToken(c) then
      break;
    s := s + GetChar();
  end;
  if s = 'false' then
    result := TIEDictionaryValueBoolean.Create(false)
  else
  if s = 'true' then
    result := TIEDictionaryValueBoolean.Create(true)
  else
  begin
    if pos('.', s) > 0 then
      result := TIEDictionaryValueDouble.Create( IEStrToFloatDefW(s, 0.0) )
    else
      result := TIEDictionaryValueInteger.Create( StrToIntDef(s, 0) );
  end;
end;




//////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////
// TIEHashStream

type HCRYPTPROV = pointer;
type HCRYPTKEY = pointer;
type HCRYPTHASH = pointer;
type ALG_ID = DWORD;


function CryptAcquireContext(out phProv: HCRYPTPROV; pszContainer: PAnsiChar; pszProvider: PAnsiChar; dwProvType: DWORD; dwFlags: DWORD): longbool; stdcall; external 'Advapi32.dll' name 'CryptAcquireContextA';
function CryptCreateHash(hProv: HCRYPTPROV; Algid: ALG_ID; hKey: HCRYPTKEY; dwFlags: DWORD; out phHash: HCRYPTHASH): longbool; stdcall; external 'Advapi32.dll' name 'CryptCreateHash';
function CryptHashData(hHash: HCRYPTHASH; pbData: pbyte; dwDataLen: DWORD; dwFlags: DWORD): longbool; stdcall; external 'Advapi32.dll' name 'CryptHashData';
function CryptGetHashParam(hHash: HCRYPTHASH; dwParam: DWORD; pbData: pbyte; pdwDataLen: PDWORD; dwFlags: DWORD): longbool; stdcall; external 'Advapi32.dll' name 'CryptGetHashParam';
function CryptDestroyHash(hHash: HCRYPTHASH): longbool; stdcall; external 'Advapi32.dll' name 'CryptDestroyHash';
function CryptReleaseContext(hProv: HCRYPTPROV; dwFlags: DWORD): longbool; stdcall; external 'Advapi32.dll' name 'CryptReleaseContext';




// ALG_ID values
const
  CALG_3DES                 = $00006603;  // Triple DES encryption algorithm.
  CALG_3DES_112             = $00006609;  // Two-key triple DES encryption with effective key length equal to 112 bits.
  CALG_AES                  = $00006611;  // Advanced Encryption Standard (AES). This algorithm is supported by the Microsoft AES Cryptographic Provider. Windows 2000/NT:  This algorithm is not supported.
  CALG_AES_128              = $0000660e;  // 128 bit AES. This algorithm is supported by the Microsoft AES Cryptographic Provider. Windows 2000/NT:  This algorithm is not supported.
  CALG_AES_192              = $0000660f;  // 192 bit AES. This algorithm is supported by the Microsoft AES Cryptographic Provider. Windows 2000/NT:  This algorithm is not supported.
  CALG_AES_256              = $00006610;  // 256 bit AES. This algorithm is supported by the Microsoft AES Cryptographic Provider. Windows 2000/NT:  This algorithm is not supported.
  CALG_AGREEDKEY_ANY        = $0000aa03;  // Temporary algorithm identifier for handles of Diffie-Hellman–agreed keys.
  CALG_CYLINK_MEK           = $0000660c;  // An algorithm to create a 40-bit DES key that has parity bits and zeroed key bits to make its key length 64 bits. This algorithm is supported by the Microsoft Base Cryptographic Provider.
  CALG_DES                  = $00006601;  // DES encryption algorithm.
  CALG_DESX                 = $00006604;  // DESX encryption algorithm.
  CALG_DH_EPHEM             = $0000aa02;  // Diffie-Hellman ephemeral key exchange algorithm.
  CALG_DH_SF                = $0000aa01;  // Diffie-Hellman store and forward key exchange algorithm.
  CALG_DSS_SIGN             = $00002200;  // DSA public key signature algorithm.
  CALG_ECDH                 = $0000aa05;  // Elliptic curve Diffie-Hellman key exchange algorithm. Windows Server 2003, Windows XP, and Windows 2000/NT:  This algorithm is not supported.
  CALG_ECDSA                = $00002203;  // Elliptic curve digital signature algorithm. Windows Server 2003, Windows XP, and Windows 2000/NT:  This algorithm is not supported.
  CALG_ECMQV                = $0000a001;  // Elliptic curve Menezes, Qu, and Vanstone (MQV) key exchange algorithm. Windows Server 2003, Windows XP, and Windows 2000/NT:  This algorithm is not supported.
  CALG_HASH_REPLACE_OWF     = $0000800b;  // One way function hashing algorithm. Windows 2000/NT:  This algorithm is not supported.
  CALG_HUGHES_MD5           = $0000a003;  // Hughes MD5 hashing algorithm.
  CALG_HMAC                 = $00008009;  // HMAC keyed hash algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.
  CALG_KEA_KEYX             = $0000aa04;  // KEA key exchange algorithm (FORTEZZA).
  CALG_MAC                  = $00008005;  // MAC keyed hash algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.
  CALG_MD2                  = $00008001;  // MD2 hashing algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.
  CALG_MD4                  = $00008002;  // MD4 hashing algorithm.
  CALG_MD5                  = $00008003;  // MD5 hashing algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.
  CALG_NO_SIGN              = $00002000;  // No signature algorithm. Windows 2000/NT:  This algorithm is not supported.
  CALG_OID_INFO_CNG_ONLY    = $ffffffff;  // The algorithm is only implemented in CNG. The macro, IS_SPECIAL_OID_INFO_ALGID, can be used to determine whether a cryptography algorithm is only supported by using the CNG functions.
  CALG_OID_INFO_PARAMETERS  = $fffffffe;  // The algorithm is defined in the encoded parameters. The algorithm is only supported by using CNG. The macro, IS_SPECIAL_OID_INFO_ALGID, can be used to determine whether a cryptography algorithm is only supported by using the CNG functions.
  CALG_PCT1_MASTER          = $00004c04;  // Used by the Schannel.dll operations system. This ALG_ID should not be used by applications.
  CALG_RC2                  = $00006602;  // RC2 block encryption algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.
  CALG_RC4                  = $00006801;  // RC4 stream encryption algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.
  CALG_RC5                  = $0000660d;  // RC5 block encryption algorithm.
  CALG_RSA_KEYX             = $0000a400;  // RSA public key exchange algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.
  CALG_RSA_SIGN             = $00002400;  // RSA public key signature algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.
  CALG_SCHANNEL_ENC_KEY     = $00004c07;  // Used by the Schannel.dll operations system. This ALG_ID should not be used by applications.
  CALG_SCHANNEL_MAC_KEY     = $00004c03;  // Used by the Schannel.dll operations system. This ALG_ID should not be used by applications.
  CALG_SCHANNEL_MASTER_HASH = $00004c02;  // Used by the Schannel.dll operations system. This ALG_ID should not be used by applications.
  CALG_SEAL                 = $00006802;  // SEAL encryption algorithm.
  CALG_SHA                  = $00008004;  // SHA hashing algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider.
  CALG_SHA1                 = $00008004;  // Same as CALG_SHA. This algorithm is supported by the Microsoft Base Cryptographic Provider.
  CALG_SHA_256              = $0000800c;  // 256 bit SHA hashing algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider. Windows XP and Windows 2000/NT:  This algorithm is not supported.
  CALG_SHA_384              = $0000800d;  // 384 bit SHA hashing algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider. Windows XP and Windows 2000/NT:  This algorithm is not supported.
  CALG_SHA_512              = $0000800e;  // 512 bit SHA hashing algorithm. This algorithm is supported by the Microsoft Base Cryptographic Provider. Windows XP and Windows 2000/NT:  This algorithm is not supported.
  CALG_SKIPJACK             = $0000660a;  // Skipjack block encryption algorithm (FORTEZZA).
  CALG_SSL2_MASTER          = $00004c05;  // Used by the Schannel.dll operations system. This ALG_ID should not be used by applications.
  CALG_SSL3_MASTER          = $00004c01;  // Used by the Schannel.dll operations system. This ALG_ID should not be used by applications.
  CALG_SSL3_SHAMD5          = $00008008;  // Used by the Schannel.dll operations system. This ALG_ID should not be used by applications.
  CALG_TEK                  = $0000660b;  // TEK (FORTEZZA).
  CALG_TLS1_MASTER          = $00004c06;  // Used by the Schannel.dll operations system. This ALG_ID should not be used by applications.
  CALG_TLS1PRF              = $0000800a;  // Used by the Schannel.dll operations system. This ALG_ID should not be used by applications.

// Providers (predefined only)
const
  PROV_RSA_FULL           = 1;
  PROV_RSA_SIG            = 2;
  PROV_DSS                = 3;
  PROV_FORTEZZA           = 4;
  PROV_MS_EXCHANGE        = 5;
  PROV_SSL                = 6;
  PROV_RSA_SCHANNEL       = 12;
  PROV_DSS_DH             = 13;
  PROV_DH_SCHANNEL        = 18;
  PROV_RSA_AES            = 24;

// dwFlags definitions for CryptAcquireContext
const
  CRYPT_VERIFYCONTEXT               = $F0000000;
  CRYPT_NEWKEYSET                   = $00000008;
  CRYPT_DELETEKEYSET                = $00000010;
  CRYPT_MACHINE_KEYSET              = $00000020;
  CRYPT_SILENT                      = $00000040;
  CRYPT_DEFAULT_CONTAINER_OPTIONAL  = $00000080;

const
  HP_ALGID         = $0001;  // Hash algorithm
  HP_HASHVAL       = $0002;  // Hash value
  HP_HASHSIZE      = $0004;  // Hash value size
  HP_HMAC_INFO     = $0005;  // information for creating an HMAC
  HP_TLS1PRF_LABEL = $0006;  // label for TLS1 PRF
  HP_TLS1PRF_SEED  = $0007;  // seed for TLS1 PRF


{!!
<FS>TIEHashStream.Create

<FM>Declaration<FC>
constructor Create(Algorithm: <A TIEHashAlgorithm> = iehaMD5; Buffered: boolean = true);

<FM>Description<FN>
Creates a TIEHashStream which will use specified hash algorithm.
If <FC>Buffered<FN> is true the stream data is written in a temporary memory stream. This is necessary when Seek and Read methods are necessary.

<FM>Example<FC>
// saves the file with an unique name (create hash from the jpeg content and use it as file name)
var
  hashStream: TIEHashStream;
begin
  ImageEnView1.IO.LoadFromFile('input.jpg');
  hashStream := TIEHashStream.Create(iehaMD5);
  try
    ImageEnView1.IO.SaveToStreamJpeg(hashStream);
    hashStream.SaveToFile(hashStream.GetHash()+'.jpg');
  finally
    hashStream.Free;
  end;
end;
!!}
constructor TIEHashStream.Create(Algorithm: TIEHashAlgorithm; Buffered: boolean);
begin
  inherited Create;

  if Buffered then
    m_MemStream := TMemoryStream.Create
  else
    m_MemStream := nil;

  if not CryptAcquireContext(m_CryptProvider, nil, nil, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT or CRYPT_MACHINE_KEYSET) then
    raise EIEException.Create('Unable to use CryptoAPI');

  try
    if not CryptCreateHash(m_CryptProvider, DWORD(Algorithm), nil, 0, m_CryptHash) then
      raise EIEException.Create('Unable to create Crypto Hash');
  except
    CryptReleaseContext(m_CryptProvider, 0);
    raise;
  end;
end;


destructor TIEHashStream.Destroy;
begin
  m_MemStream.Free;
  CryptDestroyHash(m_CryptHash);
  CryptReleaseContext(m_CryptProvider, 0);
  inherited Destroy;
end;


{!!
<FS>TIEHashStream.GetHash

<FM>Declaration<FC>
function GetHash: AnsiString;

<FM>Description<FN>
Calculates the hash and returns the string representation of the hash.

<FM>Example<FC>
// saves the file with an unique name (create hash from the jpeg content and use it as file name)
var
  hashStream: TIEHashStream;
begin
  ImageEnView1.IO.LoadFromFile('input.jpg');
  hashStream := TIEHashStream.Create(iehaMD5);
  try
    ImageEnView1.IO.SaveToStreamJpeg(hashStream);
    hashStream.SaveToFile(hashStream.GetHash()+'.jpg');
  finally
    hashStream.Free;
  end;
end;
!!}
function TIEHashStream.GetHash: AnsiString;
var
  hash: pbytearray;
  hashSize: DWORD;
  i: integer;
  dw: DWORD;
begin
  result := '';

  if assigned(m_MemStream) then
    if not CryptHashData(m_CryptHash, pbyte(m_MemStream.Memory), m_MemStream.Size, 0) then
      raise EIEException.Create('Unable to add hash data');

  // get hash size
  dw := 4;
  if not CryptGetHashParam(m_CryptHash, HP_HASHSIZE, @hashSize, @dw, 0) then
    raise EIEException.Create('Unable to create hash');

  getmem(hash, hashSize);

  // get hash data
  dw := hashSize;
  if CryptGetHashParam(m_CryptHash, HP_HASHVAL, @hash[0], @dw, 0) then
    for i := 0 to hashSize - 1 do
      result := result + AnsiString(Format('%.2x', [hash[i]]));

  freemem(hash);

  result := IELowerCase(result);
end;


{!!
<FS>TIEHashStream.Write

<FM>Declaration<FC>
function Write(const Buffer; Count: longint): longint;

<FM>Description<FN>
Writes data in the hash stream.
!!}
function TIEHashStream.Write(const Buffer; Count: longint): longint;
begin
  if assigned(m_MemStream) then
    result := m_MemStream.Write(Buffer, Count)
  else
  begin
    if not CryptHashData(m_CryptHash, pbyte(@Buffer), Count, 0) then
      raise EIEException.Create('Unable to add hash data');
    result := Count;
  end;
end;


{!!
<FS>TIEHashStream.Read

<FM>Declaration<FC>
function Read(var Buffer; Count: longint): Longint;

<FM>Description<FN>
Reads data in the hash stream. It is necessary to create the stream as "buffered" to use this method.
!!}
function TIEHashStream.Read(var Buffer; Count: longint): Longint;
begin
  if assigned(m_MemStream) then
    result := m_MemStream.Read(Buffer, Count)
  else
    raise EIEException.Create('Read error. Hash stream not Buffered, please create Buffered stream.');
end;


{!!
<FS>TIEHashStream.Seek

<FM>Declaration<FC>
function Seek(const Offset: int64; Origin: TSeekOrigin): int64;

<FM>Description<FN>
Seeks data in the hash stream. It is necessary to create the stream as "buffered" to use this method.
!!}
{$ifdef IEOLDSEEKDEF}
function TIEHashStream.Seek(Offset: longint; Origin: word): longint;
{$else}
function TIEHashStream.Seek(const Offset: int64; Origin: TSeekOrigin): int64;
{$endif}
begin
  if assigned(m_MemStream) then
    result := m_MemStream.Seek(Offset, Origin)
  else
    raise EIEException.Create('Seek error. Hash stream not Buffered, please create Buffered stream.');
end;


{!!
<FS>TIEHashStream.SaveToFile

<FM>Declaration<FC>
procedure TIEHashStream.SaveToFile(const filename: WideString);

<FM>Description<FN>
Saves the stream to file (this is the actual data written, not the hash). This is useful to save the hashed data one time.
It is necessary to create the stream as "buffered" to use this method.

See also: <A TIEHashStream.SaveToStream>

<FM>Example<FC>
// saves the file with an unique name (create hash from the jpeg content and use it as file name)
var
  hashStream: TIEHashStream;
begin
  ImageEnView1.IO.LoadFromFile('input.jpg');
  hashStream := TIEHashStream.Create(iehaMD5);
  try
    ImageEnView1.IO.SaveToStreamJpeg(hashStream);
    hashStream.SaveToFile(hashStream.GetHash()+'.jpg');
  finally
    hashStream.Free;
  end;
end;
!!}
procedure TIEHashStream.SaveToFile(const filename: WideString);
var
  stream: TIEWideFileStream;
begin
  stream := TIEWideFileStream.Create(filename, fmCreate);
  try
    SaveToStream(stream);
  finally
    stream.Free();
  end;
end;


{!!
<FS>TIEHashStream.SaveToStream

<FM>Declaration<FC>
procedure SaveToStream(Stream: TStream);

<FM>Description<FN>
Saves data to stream (this is the actual data written, not the hash). This is useful to save the hashed data one time.
It is necessary to create the stream as "buffered" to use this method.

See also: <A TIEHashStream.SaveToFile>.
!!}
procedure TIEHashStream.SaveToStream(Stream: TStream);
begin
  if assigned(m_MemStream) then
    m_MemStream.SaveToStream(Stream)
  else
    raise EIEException.Create('SaveToStream error. Hash stream not Buffered, please create Buffered stream.');
end;


{!!
<FS>TIEHashStream.LoadFromFile

<FM>Declaration<FC>
procedure LoadFromFile(const filename: WideString);

<FM>Description<FN>
Loads data to hash from specified file.
It is necessary to create the stream as "buffered" to use this method.
!!}
procedure TIEHashStream.LoadFromFile(const filename: WideString);
var
  stream: TIEWideFileStream;
begin
  stream := TIEWideFileStream.Create(filename, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(stream);
  finally
    stream.Free();
  end;
end;


{!!
<FS>TIEHashStream.LoadFromStream

<FM>Declaration<FC>
procedure LoadFromStream(Stream: TStream);

<FM>Description<FN>
Loads data to hash from specified stream.
It is necessary to create the stream as "buffered" to use this method.
!!}
procedure TIEHashStream.LoadFromStream(Stream: TStream);
begin
  if assigned(m_MemStream) then
    m_MemStream.LoadFromStream(Stream)
  else
    raise EIEException.Create('LoadFromStream error. Hash stream not Buffered, please create Buffered stream.');
end;



//////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////
// TIEExecutorThread

constructor TIEExecutorThread.Create(execFunc: TIEExecutorFunc);
begin
  inherited Create(true); // create suspended
  fExecFunc := execFunc;
end;

procedure TIEExecutorThread.Execute();
begin
  fExecFunc();
end;


//////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////
// TIEExecutor

constructor TIEExecutor.Create(execInThread: Boolean);
begin
  if execInThread then
    fThread := TIEExecutorThread.Create(execute)
  else
    fThread := nil;
end;

destructor TIEExecutor.Destroy();
begin
  if assigned(fThread) then
    fThread.Free();
end;

function TIEExecutor.GetThread(): TThread;
begin
  result := fThread;
end;



//////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////
// TIEThreadPool

constructor TIEThreadPool.Create();
begin
  inherited Create();
  fThreads := TList.Create;
end;

destructor TIEThreadPool.Destroy;
begin
  Join();
  fThreads.Free;
  inherited;
end;

// like Join() but doesn't destroy threads (you can still access their properties)
procedure TIEThreadPool.WaitFor();
var
  i: integer;
  t: TThread;
begin
  for i := 0 to fThreads.Count - 1 do
  begin
    t := (TObject(fThreads[i]) as TIEExecutor).GetThread();
    if assigned(t) then
      t.WaitFor();
  end;
end;

procedure TIEThreadPool.Join();
var
  i: integer;
  t: TThread;
begin
  for i := 0 to fThreads.Count - 1 do
  begin
    t := (TObject(fThreads[i]) as TIEExecutor).GetThread();
    if assigned(t) then
      t.WaitFor();
    (TObject(fThreads[i]) as TIEExecutor).Free();
  end;
  fThreads.Clear;
end;

function TIEThreadPool.GetThreads(idx: integer): TIEExecutor;
begin
  result := TObject(fThreads[idx]) as TIEExecutor;
end;

procedure TIEThreadPool.Add(Thread: TIEExecutor);
var
  t: TThread;
begin
  fThreads.Add(Thread);
  t := Thread.GetThread();
  if assigned(t) then
  begin
    {$ifdef IEHASTTHREADSTART}
    t.Start();
    {$else}
    t.Resume();
    {$endif}
  end
  else
  begin
    // execute inside this thread
    Thread.Execute();
  end;
end;

// TIEThreadPool
//////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////



/////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////
// TIEWideFileStream

function IECreateFileW(lpFileName: PWideChar; dwDesiredAccess, dwShareMode: DWORD;
                       lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD;
                       hTemplateFile: THandle): THandle;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    result := CreateFileW(lpFileName, dwDesiredAccess, dwShareMode,
                          lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
  else
    result := CreateFileA(PAnsiChar(AnsiString(lpFileName)), dwDesiredAccess, dwShareMode,
                          lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
end;

function WideFileCreate(const FileName: WideString): THandle;
begin
  Result := IECreateFileW(PWideChar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
end;

function WideFileOpen(const FileName: WideString; Mode: LongWord): THandle;
const
  AccessMode: array[0..2] of LongWord = (
    GENERIC_READ,
    GENERIC_WRITE,
    GENERIC_READ or GENERIC_WRITE);
  ShareMode: array[0..4] of LongWord = (
    0,
    0,
    FILE_SHARE_READ,
    FILE_SHARE_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE);
begin
  Result := INVALID_HANDLE_VALUE;
  if ((Mode and 3) <= fmOpenReadWrite) and ((Mode and $F0) <= fmShareDenyNone) then
    Result := IECreateFileW(PWideChar(FileName), AccessMode[Mode and 3], ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
end;

constructor TIEWideFileStream.Create(const FileName: WideString; Mode: Word);
const
  SFCreateError = 'Cannot create file %s';
  SFCreateErrorEx = 'Cannot create file "%s". %s';
  SFOpenError = 'Cannot open file %s';
  SFOpenErrorEx = 'Cannot open file "%s". %s';
var
  CreateHandle: THandle;
  ErrorMessage: WideString;
begin
  FFileName := FileName;
  if Mode = fmCreate then
  begin
    CreateHandle := WideFileCreate(FileName);
    if CreateHandle = INVALID_HANDLE_VALUE then
    begin
      ErrorMessage := SysErrorMessage(GetLastError);
      raise EFCreateError.CreateFmt(SFCreateErrorEx, [ExpandFileName(FileName), ErrorMessage]);
    end;
  end
  else
  begin
    CreateHandle := WideFileOpen(FileName, Mode);
    if CreateHandle = INVALID_HANDLE_VALUE then
    begin
      ErrorMessage := SysErrorMessage(GetLastError);
      raise EFOpenError.CreateFmt(SFOpenErrorEx, [ExpandFileName(FileName), ErrorMessage]);
    end;
  end;
  inherited Create(CreateHandle);
end;

destructor TIEWideFileStream.Destroy;
begin
  if THandle(Handle) <> INVALID_HANDLE_VALUE then
    FileClose(Handle);
  inherited Destroy;
end;

function IEWStrCopy(Dest: PWideChar; const Source: PWideChar): PWideChar;
var
  Src : PWideChar;
begin
  Result := Dest;
  Src := Source;
  while (Src^ <> #$00) do
  begin
    Dest^ := Src^;
    Inc(Src);
    Inc(Dest);
  end;
  Dest^ := #$00;
end;

// TIEWideFileStream
/////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////



//////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////
// TIEWideStrings


constructor TIEWideStrings.Create;
begin
  inherited;
  fStrings := TList.Create;
end;

destructor TIEWideStrings.Destroy;
begin
  Clear;
  fStrings.Free;
  inherited;
end;

procedure TIEWideStrings.Clear;
var
  i: integer;
begin
  for i := 0 to fStrings.Count-1 do
    FreeMem(fStrings[i]);
  fStrings.Clear;
end;

function TIEWideStrings.GetCount: integer;
begin
  result := fStrings.Count;
end;

function TIEWideStrings.CreateCopyBuffer(const S: WideString): PWideChar;
var
  lenInBytes: integer;
begin
  lenInBytes := (length(S)+1)*sizeof(WideChar);
  getmem(result, lenInBytes);
  CopyMemory(result, @S[1], lenInBytes);
end;

function TIEWideStrings.Add(const S: WideString): integer;
begin
  result := fStrings.Add( CreateCopyBuffer(S) );
end;

procedure TIEWideStrings.SetString(idx: integer; const S: WideString);
begin
  FreeMem(fStrings[idx]);
  fStrings[idx] := CreateCopyBuffer(S);
end;

function TIEWideStrings.GetString(idx: integer): WideString;
begin
  result := WideString(PWideChar(fStrings[idx]));
end;



//////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////
// TIEDirContent

constructor TIEDirContent.Create(const dir : WideString);
begin
  inherited Create;
  fHandle := Windows.FindFirstFileW(PWChar(dir), fFindData);
  fFirstGot := false;
end;

destructor TIEDirContent.Destroy;
begin
  if fHandle <> INVALID_HANDLE_VALUE then
    Windows.FindClose(fHandle);
  inherited;
end;

function TIEDirContent.GetItem(out sFilename : WideString; bGetFiles: boolean = True; bGetDirs: boolean = False; bGetHidden : Boolean = True): boolean;

  function allowIt: boolean;
  var
    sTempFilename : WideString;
  begin      
    sTempFilename := fFindData.cFileName;
    if (sTempFilename = '.') or (sTempFilename = '..') then
      Result := False
    else
      result := (bGetFiles and not boolean(fFindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)) or
                (bGetDirs and boolean(fFindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY));

    if Result and (bGetHidden = False) then
      if boolean(fFindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN) or
         boolean(fFindData.dwFileAttributes and FILE_ATTRIBUTE_SYSTEM) then
        Result := False;               
  end;

begin
  result := fHandle <> INVALID_HANDLE_VALUE;

  sFilename      := '';
  fFileSizeBytes := 0;
  fCreateDate    := 0;
  fEditDate      := 0;

  // Is this a valid folder?
  if result = False then
    exit;

  repeat
    if fFirstGot then
      result := Windows.FindNextFileW(fHandle, fFindData);  // return false also when fHandle is INVALID_HANDLE_VALUE
    fFirstGot := true;
  until not result or allowIt();

  fIsDir    := boolean(fFindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY);
  fIsHidden := boolean(fFindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN) or
               boolean(fFindData.dwFileAttributes and FILE_ATTRIBUTE_SYSTEM);
  sFilename := fFindData.cFileName;

  try
    fFileSizeBytes := IELargeFileSize(fFindData.nFileSizeHigh, fFindData.nFileSizeLow);
    fEditDate      := IEFileTimeToDateTime(fFindData.ftLastWriteTime);
    fCreateDate    := IEFileTimeToDateTime(fFindData.ftCreationTime);
  except
    // ERROR
  end;
end;

// path must include wildcard, ie: ".\*.jpeg"
class procedure TIEDirContent.PopulateStrings(const path: WideString; strings: TStrings; bGetFiles: boolean = True; bGetDirs: boolean = False; bGetHidden : Boolean = True);
var
  dir: TIEDirContent;
  fname: WideString;
begin
  strings.Clear();
  dir := TIEDirContent.Create(path);
  try
    while dir.getItem(fname, bGetFiles, bGetDirs, bGetHidden) do
    begin
      strings.Add(string(fname));
    end;
  finally
    dir.Free();
  end;
end;


///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// TIEMemStream

constructor TIEMemStream.Create(Ptr: pointer; Size: integer);
begin
  inherited Create;
  SetPointer(Ptr, Size);
end;

procedure TIEMemStream.SetSize(NewSize: Longint);
begin
  // not implemented
end;

function TIEMemStream.Write(const Buffer; Count: Longint): Longint;
begin
  // not implemented
  result := 0;
end;

/////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////
// TIERecordList

constructor TIERecordList.Create(RecordSize: integer; OnGetCurrentValue: TIEListCurrentValueEvent; OnSetCurrentValue: TIEListCurrentValueEvent);
begin
  inherited Create(OnGetCurrentValue, OnSetCurrentValue);
  fItemSize := RecordSize;
end;

function TIERecordList.GetItem(idx: integer): pointer;
begin
  result := BaseGetItem(idx);
end;

procedure TIERecordList.SetItem(idx: integer; v: pointer);
begin
  BaseSetItem(idx, v);
end;

function TIERecordList.Add(v: pointer): integer;
begin
  result := AddItem(v);
end;

procedure TIERecordList.Insert(idx: integer; v: pointer);
begin
  InsertItem(idx, v);
end;

function TIERecordList.IndexOf(v: pointer): integer;
begin
  result := IndexOfItem(v);
end;


/////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
// TIEIntegerMap
/////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////

// sbits: hash table size in bit.
constructor TIEIntegerMap.Create(bucketsCount: integer);
begin
  inherited Create;
  SetLength(fItems, bucketsCount);
  fKeysCount := 0;
end;

destructor TIEIntegerMap.Destroy();
begin
  Clear();
  inherited;
end;

procedure TIEIntegerMap.Clear();
var
  i: integer;
  curItem, nextItem: TIEIntegerMapItem;
begin
  for i := 0 to length(fItems) - 1 do
  begin
    curItem := fItems[i];
    while curItem <> nil do
    begin
      nextItem := curItem.nextitem;
      curItem.Free();
      curItem := nextItem;
    end;
    fItems[i] := nil;
  end;

  fKeysCount := 0;
end;

// hash function
// uses first fHbits-1 as direct index
function TIEIntegerMap.HashFunc(key: integer): integer;
begin
  //result := key and (length(fItems) - 1);
  result := key mod (length(fItems) - 1)
end;

// insert a new key (if not already exists)
// ret TRUE if key didn't exist previously
function TIEIntegerMap.Insert(key: integer; var item: TIEIntegerMapItem): boolean;
var
  ix: integer;
begin
  item := nil;
  ix := HashFunc(key);

  if fItems[ix] = nil then
  begin
    // bucket empty, add the new key
    item := TIEIntegerMapItem.Create();
    item.key := key;
    item.nextitem := nil;
    fItems[ix] := item;
    result := true;
  end
  else
  begin
    item := fItems[ix];
    while item <> nil do
    begin
      if item.key = key then
      begin
        result := false;
        exit;  // key already exists
      end;
      item := item.nextitem;
    end;
    // key not found, add the new key
    item := TIEIntegerMapItem.Create();
    item.key := key;
    item.nextitem := fItems[ix];
    fItems[ix] := item;
    result := true;
  end;

  inc(fKeysCount);
end;

// insert a new key (if not already exists)
// ret TRUE if key inserted
function TIEIntegerMap.Insert(key: integer): boolean;
var
  item: TIEIntegerMapItem;
begin
  result := Insert(key, item);
end;

// verify if key key exists
function TIEIntegerMap.KeyExists(key: integer): boolean;
var
  curItem: TIEIntegerMapItem;
begin
  result := false;

  curItem := fItems[ HashFunc(key) ];

  while curItem <> nil do
  begin
    if curItem.key = key then
    begin
      result := true;
      break;
    end;
    curItem := curItem.nextitem;
  end;
end;

function TIEIntegerMap.IterateBegin(): boolean;
begin
  fIterateItem := nil;
  fIterateIndex := -1;
  result := IterateNext();
end;

function TIEIntegerMap.IterateNext(): boolean;
begin
  if fIterateItem <> nil then
    fIterateItem := fIterateItem.nextitem;

  while (fIterateItem = nil) do
  begin
    inc(fIterateIndex);
    if fIterateIndex >= length(fItems) then
      break;
    fIterateItem := fItems[fIterateIndex];
  end;

  result := (fIterateItem <> nil);
end;

function TIEIntegerMap.IterateGetValue: integer;
begin
  result := fIterateItem.value;
end;

function TIEIntegerMap.IterateGetKey(): integer;
begin
  result := fIterateItem.key;
end;

function TIEIntegerMap.DumpStats(): string;
var
  i, c: integer;
  item: TIEIntegerMapItem;
begin
  result := '';
  for i := 0 to length(fItems) - 1 do
  begin
    c := 0;
    item := fItems[i];
    while item <> nil do
    begin
      inc(c);
      item := item.nextitem;
    end;
    if c > 0 then
      result := result + Format('%d => %d'#13#10, [i, c]);
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
// TIERGBMap
/////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////

function TIERGBMap.Insert(const key: TRGB): boolean;
begin
  result := Insert((key.r shl 16) or (key.g shl 8) or key.b);
end;

function TIERGBMap.Insert(const key: TRGB; value: integer): boolean;
var
  item: TIEIntegerMapItem;
begin
  result := Insert((key.r shl 16) or (key.g shl 8) or key.b, item);
  item.value := value;
end;

function TIERGBMap.KeyExists(const key: TRGB): boolean;
begin
  result := KeyExists((key.r shl 16) or (key.g shl 8) or key.b);
end;

function TIERGBMap.IterateGetKey(): TRGB;
var
  value: integer;
begin
  value := inherited IterateGetKey();
  result.r := (value shr 16) and $FF;
  result.g := (value shr 8) and $FF;
  result.b := value and $FF;
end;


/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////


constructor TNulStream.Create;
begin
  inherited;
  fposition := 0;
  fsize := 0;
end;

destructor TNulStream.Destroy;
begin
  inherited Destroy;
end;

function TNulStream.Read(var Buffer; Count: Longint): Longint;
begin
  inc(fposition, Count);
  if fposition >= fsize then
    fsize := fposition;
  result := Count;
end;

function TNulStream.Write(const Buffer; Count: Longint): Longint;
begin
  inc(fposition, Count);
  if fposition >= fsize then
    fsize := fposition;
  result := Count;
end;

function TNulStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  case Origin of
    soFromBeginning:
      begin
        fPosition := offset;
        if fposition >= fsize then
          fsize := fposition;
      end;
    soFromCurrent:
      begin
        inc(fposition, offset);
        if fposition >= fsize then
          fsize := fposition;
      end;
    soFromEnd:
      begin
        fposition := fsize - abs(offset); // offset should be <= 0. Positive values handled as negative
      end;
  end;
  result := fPosition;
end;



/////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////
// TIEList

constructor TIEList.Create(OnGetCurrentValue: TIEListCurrentValueEvent = nil; OnSetCurrentValue: TIEListCurrentValueEvent = nil);
begin
  inherited Create;
  fData := nil;
  fOnGetCurrentValue := OnGetCurrentValue;
  fOnSetCurrentValue := OnSetCurrentValue;
  Clear;
end;

destructor TIEList.Destroy;
begin
  freemem(fData);
  inherited Destroy;
end;

{!!
<FS>TIEList.Clear

<FM>Declaration<FC>
procedure Clear;

<FM>Description<FN>
Clear empties the Items array.
!!}
procedure TIEList.Clear;
begin
  fCapacity := 0;
  fCount := 0;
  if assigned(fData) then
    freemem(fData);
  fData := nil;
  fChanged := [];
end;

{!!
<FS>TIEList.Count

<FM>Declaration<FC>
property Count: integer;

<FM>Description<FN>
Count contains the number of items in the Items array.
!!}
procedure TIEList.SetCount(v: integer);
var
  xData: pointer;
begin
  if fCapacity < v then
  begin
    fCapacity := imax(fCapacity * 2, v);
    getmem(xData, fCapacity * fItemSize);
    if assigned(fData) then
    begin
      move(pbyte(fData)^, pbyte(xData)^, imin(fCount, v) * fItemSize);
      freemem(fData);
    end;
    fData := xData;
  end;
  fCount := v;
  fChanged := fChanged + [ielItems];
end;

{!!
<FS>TIEList.Delete

<FM>Declaration<FC>
procedure Delete(idx: integer);

<FM>Description<FN>
Delete the idx value from the list.
!!}
procedure TIEList.Delete(idx: integer);
var
  xData: pointer;
  q: integer;
  psrc, pdst: pbyte;
begin
  if (idx >= 0) and (idx < fCount) then
  begin
    getmem(xData, (fCount - 1) * fItemSize);
    psrc := fData;
    pdst := xData;
    for q := 0 to fCount - 1 do
    begin
      if q <> idx then
      begin
        // copy
        move(psrc^, pdst^, fItemSize);
        inc(pdst, fItemSize);
      end;
      inc(psrc, fItemSize);
    end;
    freemem(fData);
    fData := xData;
    dec(fCount);
    fCapacity := fCount;
    fChanged := fChanged + [ielItems];
  end;
end;

procedure TIEList.InsertItem(idx: integer; v: pointer);
var
  xData: pointer;
  q: integer;
  psrc, pdst: pbyte;
begin
  if idx < fCount then
  begin
    inc(fCount);
    fCapacity := fCount;
    getmem(xData, fCount * fItemSize);
    psrc := fData;
    pdst := xData;
    for q := 0 to fCount - 1 do
    begin
      if q <> idx then
      begin
        // copy
        move(psrc^, pdst^, fItemSize);
        inc(psrc, fItemSize);
      end
      else
        // insert
        move(pbyte(v)^, pdst^, fItemSize);
      inc(pdst, fItemSize);
    end;
    freemem(fData);
    fData := xData;
    fChanged := fChanged + [ielItems];
  end
  else
    AddItem(v);
end;

function TIEList.IndexOfItem(v: pointer): integer;
var
  pp: pbyte;
begin
  pp := fData;
  for result := 0 to fCount - 1 do
  begin
    if CompareMem(pp, v, fItemSize) then
      exit;
    inc(pp, fItemSize);
  end;
  result := -1;
end;

function TIEList.AddItem(v: pointer): integer;
var
  pb: pbyte;
begin
  result := fCount;
  SetCount(fCount + 1);
  pb := fData;
  inc(pb, result * fItemSize);
  move(pbyte(v)^, pb^, fItemSize);
  fChanged := fChanged + [ielItems];
end;

function TIEList.BaseGetItem(idx: integer): pointer;
var
  pb: pbyte;
begin
  pb := fData;
  inc(pb, idx * fItemSize);
  result := pb;
end;

procedure TIEList.BaseSetItem(idx: integer; v: pointer);
var
  pb: pbyte;
begin
  if idx < fCount then
  begin
    pb := fData;
    inc(pb, idx * fItemSize);
    move(pbyte(v)^, pb^, fItemSize);
    fChanged := fChanged + [ielItems];
  end;
end;

procedure TIEList.Assign(Source: TIEList);
begin
  if assigned(Source) then
  begin
    fCount := Source.fCount;
    fItemSize := Source.fItemSize;
    fChanged := Source.fChanged;
    if assigned(fData) then
    begin
      freemem(fData);
      fData := nil;
    end;
    getmem(fData, fItemSize * fCount);
    move(pbyte(Source.fData)^, pbyte(fData)^, fItemSize * fCount);
  end;
end;

{!!
<FS>TIEList.ExchangeItems

<FM>Declaration<FC>
procedure ExchangeItems(idx1, idx2: integer);

<FM>Description<FN>
Swap the position of items at idx1 and idx2.
!!}
procedure TIEList.ExchangeItems(idx1, idx2: integer);
var
  temp: array of byte;
begin
  if (idx1 < 0) or (idx1 >= FCount) then
    raise EIEException.create( format( 'List index out of bounds (%d)', [ idx1 ]));
  if (idx2 < 0) or (idx2 >= FCount) then
    raise EIEException.create( format( 'List index out of bounds (%d)', [ idx2 ]));

  SetLength( temp, fItemSize );
  Move( pbyte(BaseGetItem(idx1))^, temp[0], fItemSize );
  Move( pbyte(BaseGetItem(idx2))^, pbyte(BaseGetItem(idx1))^, fItemSize );
  Move( temp[0], pbyte(BaseGetItem(idx2))^, fItemSize );
end;

procedure TIEList.ListQuickSort(L, R: Integer; SCompare: TIEListSortCompareFunc);
var
  I, J: Integer;
  P: Pointer;
begin
  repeat
    I := L;
    J := R;
    P := BaseGetItem(( L + R ) shr 1 );
    repeat
      while SCompare( BaseGetItem( I ), P ) < 0 do
        Inc( I );
      while SCompare( BaseGetItem( J ), P ) > 0 do
        Dec( J );
      if I <= J then
      begin
        if I <> J then
          ExchangeItems(I, J);
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      ListQuickSort( L, J, SCompare );
    L := I;
  until I >= R;
end;

{!!
<FS>TIEList.Sort

<FM>Declaration<FC>
procedure Sort(const Compare: <A TIEListSortCompareFunc>);

<FM>Description<FN>
Sorts the values of the list
!!}
procedure TIEList.Sort(Compare: TIEListSortCompareFunc);
begin
  if Count > 1 then
    ListQuickSort( 0, Count - 1, Compare);
end;

procedure TIEList.DoGetCurrentValue(value: pointer);
begin
  if assigned(fOnGetCurrentValue) then
    fOnGetCurrentValue(self, value);
end;

procedure TIEList.DoSetCurrentValue(value: pointer);
begin
  if assigned(fOnSetCurrentValue) then
    fOnSetCurrentValue(self, value);
end;


/////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////
// TIEDoubleList

constructor TIEDoubleList.Create(OnGetCurrentValue: TIEListCurrentValueEvent; OnSetCurrentValue: TIEListCurrentValueEvent);
begin
  inherited Create(OnGetCurrentValue, OnSetCurrentValue);
end;

procedure TIEDoubleList.Assign(Source: TIEList);
begin
  inherited;
  if assigned(Source) then
  begin
    fRangeMin := (Source as TIEDoubleList).fRangeMin;
    fRangeMax := (Source as TIEDoubleList).fRangeMax;
    fRangeStep := (Source as TIEDoubleList).fRangeStep;
    fCurrentValue := (Source as TIEDoubleList).fCurrentValue;
  end;
end;

{!!
<FS>TIEDoubleList.Add

<FM>Declaration<FC>
function Add(v: double): integer;

<FM>Description<FN>
Adds a new value to the list.

!!}
function TIEDoubleList.Add(v: double): integer;
begin
  result := AddItem(@v);
end;

{!!
<FS>TIEDoubleList.Clear

<FM>Declaration<FC>
procedure Clear;

<FM>Description<FN>
Removes all items.
!!}
procedure TIEDoubleList.Clear;
begin
  inherited;
  fItemSize := sizeof(double);
  fRangeMin := 0;
  fRangeMax := 0;
  fRangeStep := 0;
  fCurrentValue := 0;
end;



{!!
<FS>TIEDoubleList.Items

<FM>Declaration<FC>
property Items[index]: double;

<FM>Description<FN>
Items returns the double value of index element.
!!}
function TIEDoubleList.GetItem(idx: integer): double;
begin
  result := PDouble(BaseGetItem(idx))^;
end;

procedure TIEDoubleList.SetItem(idx: integer; v: double);
begin
  BaseSetItem(idx, @v);
end;

{!!
<FS>TIEDoubleList.Insert

<FM>Declaration<FC>
procedure Insert(idx: integer; v: double);

<FM>Description<FN>
Insert a new value inside idx position.
!!}
procedure TIEDoubleList.Insert(idx: integer; v: double);
begin
  InsertItem(idx, @v);
end;

{!!
<FS>TIEDoubleList.IndexOf

<FM>Declaration<FC>
function IndexOf(v: double): integer;

<FM>Description<FN>
IndexOf returns the index of v value. Returns -1 if not found.
!!}
function TIEDoubleList.IndexOf(v: double): integer;
begin
  result := IndexOfItem(@v);
end;

{!!
<FS>TIEDoubleList.RangeMin

<FM>Declaration<FC>
property RangeMin: double;

<FM>Description<FN>
RangeMin is the minimum value that you can assign to <A TIEDoubleList.CurrentValue>.
!!}
procedure TIEDoubleList.SetRangeMin(v: double);
begin
  fRangeMin := v;
  fChanged := fChanged + [ielRange];
end;

{!!
<FS>TIEDoubleList.RangeMax

<FM>Declaration<FC>
property RangeMax: double;

<FM>Description<FN>
RangeMax is the max value that you can assign to <A TIEDoubleList.CurrentValue>.
!!}
procedure TIEDoubleList.SetRangeMax(v: double);
begin
  fRangeMax := v;
  fChanged := fChanged + [ielRange];
end;

{!!
<FS>TIEDoubleList.RangeStep

<FM>Declaration<FC>
property RangeStep: double;

<FM>Description<FN>
RangeStep defines the step from <A TIEDoubleList.RangeMin> to <A TIEDoubleList.RangeMax>.
!!}
procedure TIEDoubleList.SetRangeStep(v: double);
begin
  fRangeStep := v;
  fChanged := fChanged + [ielRange];
end;

{!!
<FS>TIEDoubleList.CurrentValue

<FM>Declaration<FC>
property CurrentValue: double;

<FM>Description<FN>
CurrentValue returns the current value of the list. It isn't an index of <A TIEDoubleList.Items>, but a "powerup" value.
No control is made to values assigned to CurrentValue, but it should be one of the values in <A TIEDoubleList.Items> or inside of <A TIEDoubleList.RangeMin> and <A TIEDoubleList.RangeMax> (regarding <A TIEDoubleList.RangeStep> also).
!!}
procedure TIEDoubleList.SetCurrentValue(v: double);
begin
  if fCurrentValue <> v then
  begin
    fCurrentValue := v;
    fChanged := fChanged + [ielCurrentValue];
    DoSetCurrentValue(@fCurrentValue);
  end;
end;

function TIEDoubleList.GetCurrentValue(): double;
begin
  DoGetCurrentValue(@fCurrentValue);
  result := fCurrentValue;
end;

/////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////
// TIEIntegerList


constructor TIEIntegerList.Create(OnGetCurrentValue: TIEListCurrentValueEvent; OnSetCurrentValue: TIEListCurrentValueEvent);
begin
  inherited Create(OnGetCurrentValue, OnSetCurrentValue);
end;

procedure TIEIntegerList.Assign(Source: TIEList);
begin
  inherited;
  if assigned(Source) then
  begin
    fRangeMin := (Source as TIEIntegerList).fRangeMin;
    fRangeMax := (Source as TIEIntegerList).fRangeMax;
    fRangeStep := (Source as TIEIntegerList).RangeStep;
    fCurrentValue := (Source as TIEIntegerList).fCurrentValue;
  end;
end;

{!!
<FS>TIEIntegerList.Add

<FM>Declaration<FC>
function Add(v: integer): integer;

<FM>Description<FN>
Adds a new value to the list.
!!}
function TIEIntegerList.Add(v: Integer): integer;
begin
  result := AddItem(@v);
end;

{!!
<FS>TIEIntegerList.Clear

<FM>Declaration<FC>
procedure Clear;

<FM>Description<FN>
Removes all items.
!!}
procedure TIEIntegerList.Clear;
begin
  inherited;
  fRangeMin := 0;
  fRangeMax := 0;
  fRangeStep := 0;
  fCurrentValue := 0;
  fItemSize := sizeof(Integer);
end;


{!!
<FS>TIEIntegerList.Items

<FM>Declaration<FC>
property Items[index]: integer;

<FM>Description<FN>
<FC>Items<FN> returns the value of <FC>index<FN> element.
!!}
function TIEIntegerList.GetItem(idx: integer): Integer;
begin
  result := PInteger(BaseGetItem(idx))^;
end;

procedure TIEIntegerList.SetItem(idx: integer; v: Integer);
begin
  BaseSetItem(idx, @v);
end;

{!!
<FS>TIEIntegerList.Insert

<FM>Declaration<FC>
procedure Insert(idx: integer; v: integer);

<FM>Description<FN>
Insert a new value inside idx position.
!!}
procedure TIEIntegerList.Insert(idx: integer; v: Integer);
begin
  InsertItem(idx, @v);
end;

{!!
<FS>TIEIntegerList.IndexOf

<FM>Declaration<FC>
function IndexOf(v: integer): integer;

<FM>Description<FN>
IndexOf returns the index of v value. Returns -1 if not found.

!!}
function TIEIntegerList.IndexOf(v: Integer): integer;
begin
  result := IndexOfItem(@v);
end;

{!!
<FS>TIEIntegerList.RangeMin

<FM>Declaration<FC>
property RangeMin: integer;

<FM>Description<FN>
RangeMin is the minimum value that you may assign to <A TIEIntegerList.CurrentValue>.

!!}
procedure TIEIntegerList.SetRangeMin(v: integer);
begin
  fRangeMin := v;
  fChanged := fChanged + [ielRange];
end;

{!!
<FS>TIEIntegerList.RangeMax

<FM>Declaration<FC>
property RangeMax: integer;

<FM>Description<FN>
RangeMax is the maximum value you may assign to <A TIEIntegerList.CurrentValue>.

!!}
procedure TIEIntegerList.SetRangeMax(v: integer);
begin
  fRangeMax := v;
  fChanged := fChanged + [ielRange];
end;

{!!
<FS>TIEIntegerList.RangeStep

<FM>Declaration<FC>
property RangeStep: integer;

<FM>Description<FN>
RangeStep specifies the step from <A TIEIntegerList.RangeMin> to <A TIEIntegerList.RangeMax>.

!!}
procedure TIEIntegerList.SetRangeStep(v: integer);
begin
  fRangeStep := v;
  fChanged := fChanged + [ielRange];
end;

{!!
<FS>TIEIntegerList.CurrentValue

<FM>Declaration<FC>
property CurrentValue: integer;

<FM>Description<FN>
CurrentValue returns the current value of the list. It isn't an index of <A TIEIntegerList.Items>, but a "powerup" value.

No control is made to values assigned to CurrentValue, but it should be one of the values in <A TIEIntegerList.Items> or inside of <A TIEIntegerList.RangeMin> and <A TIEIntegerList.RangeMax> (regarding <A TIEIntegerList.RangeStep> also).

!!}
procedure TIEIntegerList.SetCurrentValue(v: integer);
begin
  if fCurrentValue <> v then
  begin
    fCurrentValue := v;
    fChanged := fChanged + [ielCurrentValue];
    DoSetCurrentValue(@fCurrentValue);
  end;
end;

function TIEIntegerList.GetCurrentValue(): integer;
begin
  DoGetCurrentValue(@fCurrentValue);
  result := fCurrentValue;
end;

////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////
// Prime numbers

function IEIsPrime(x: integer): boolean;
var
  i, q: integer;
begin
  result := true;
  i := 3;
  while true do
  begin
    q := x div i;
    if (q < i) then
      break;
    if (x = q * i) then
    begin
      result := false;
      break;
    end;
    inc(i, 2);
  end;
end;

function IENextPrime(x: integer): integer;
begin
  result := x + 1;
  if (result <= 2) then
  begin
    result := 2;
    exit;
  end;
  if (result and 1) = 0 then
    inc(result);
  while not IEIsPrime(result) do
    inc(result, 2);
end;


////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////



procedure QuickSort1(L, R: Integer; CompareFunction: TIECompareFunction; SwapFunction: TIESwapFunction);
var
  I, J, P: Integer;
begin
  repeat
    I := L;
    J := R;
    P := L + (R - L) shr 1; // 3.0.4
    repeat
      while CompareFunction(I, P) < 0 do Inc(I);
      while CompareFunction(J, P) > 0 do Dec(J);
      if I <= J then
      begin
        if I=P then
          P := J
        else
        if J=P then
          P := I;
        SwapFunction(I, J);
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      QuickSort1(L, J, CompareFunction, SwapFunction);
    L := I;
  until I >= R;
end;

procedure IEQuickSort(ItemsCount: integer; CompareFunction: TIECompareFunction; SwapFunction: TIESwapFunction);
begin
  if ItemsCount > 1 then
    QuickSort1(0, ItemsCount - 1, CompareFunction, SwapFunction);
end;

// returns the full file path
// Directory must contain the last '\'
function IEGetTempFileName(const Descriptor: string; const Directory: string): string;
begin
  repeat
    result := Directory + Descriptor + '-' + IntToHex(random(MAXINT), 8) + '.tmp';
  until not IEFileExists(result);
end;

// returns the full file path
function IEGetTempFileName2: string;
var
  temppath: array[0..MAX_PATH] of Char;
  tp: string;
begin
  if IEGlobalSettings().DefTEMPPATH = '' then
  begin
    GetTempPath(250, temppath);
    tp := string(temppath);
  end
  else
    tp := IEGlobalSettings().DefTEMPPATH;
  result := IEGetTempFileName('ietemp', tp);
end;

// Return a numbered filename that does not exist. I.e. returns sBaseFilename if the file does not already exist. Otherwise returns a numbered version of sBaseFilename
function IEGetNewFilename(const sBaseFilename: string; const sSepChar: Char = ' '): string;
var
  I: Integer;
  iCurrentSuffix: Integer;
  iFileNumber: Integer;
  sCurrentSuffix: string;
  sExt: string;
  sRootFilename: string;
begin
  sRootFilename := IEAddBackSlash( ExtractFilePath( sBaseFilename )) + IEExtractFileNameWithoutExt( sBaseFilename );
  sExt := IEExtractFileExtS( sBaseFilename );
  iFileNumber := 1;

  // Check if it already has a number extension
  sCurrentSuffix := '';
  if ( sSepChar <> '' ) and FileExists( sBaseFilename ) then
    for I := Length( sRootFilename ) downto 1 do
    begin
      if sRootFilename[ I ] = sSepChar then
        break
      else
        sCurrentSuffix := sRootFilename[ I ] + sCurrentSuffix;
      if Length( sCurrentSuffix ) > 8 then
        break; // Not a number
    end;

  // do we have a valid number suffix?
  iCurrentSuffix := StrToIntDef( sCurrentSuffix, -1 );
  if iCurrentSuffix > 0 then
  begin
    iFileNumber := iCurrentSuffix + 1;
    SetLength( sRootFilename, Length( sRootFilename ) - Length( sSepChar + sCurrentSuffix ));
  end;

  // Find the first unique filename
  for I := iFileNumber to MaxInt do
  begin
    if I = 1 then
      result := sBaseFilename
    else
      result := sRootFilename + sSepChar + IntToStr( I ) + sExt;
    if FileExists( result ) = False then
      break;
  end;
end;


function IEGetMem(ASize: dword): pointer;
begin
  result := VirtualAlloc(nil, ASize, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE);
end;

//  Frees memory
procedure IEFreeMem(var P);
begin
  VirtualFree(pointer(P), 0, MEM_RELEASE);
  pointer(P) := nil;
end;


function IEFindNearestColor(color: TRGB; palette: TIEArrayOfTRGB; colorCount: integer): integer;
var
  i: integer;
  dstSqr: integer;
  minDstSqr: integer;
  dr, dg, db: integer;
begin
  result := 0;
  minDstSqr := 195076;
  for i := 0 to colorCount - 1 do
  begin
    dr := integer(color.r) - integer(palette[i].r);
    dg := integer(color.g) - integer(palette[i].g);
    db := integer(color.b) - integer(palette[i].b);
    dstSqr := dr * dr + dg * dg + db * db;
    if dstSqr < minDstSqr then
    begin
      minDstSqr := dstSqr;
      result := i;
    end;
  end;
end;


/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////

// Search a string from current stream position. Returns the start of string position (or -1 if not found)
// The stream position is one character after the end of the string
function IEStreamFindString(Stream: TStream; Text: AnsiString; StopAtPos: int64): int64;
var
  spos: int64;
  c: AnsiChar;
  i: integer;
  textLen: integer;
begin
  textLen := length(Text);
  while (Stream.Position < StopAtpos) do
  begin
    spos := Stream.Position;
    for i := 1 to textLen do
    begin
      Stream.Read(c, 1);
      if c <> Text[i] then
        break
      else
      if i = textLen then
      begin
        result := spos;
        exit;
      end;
    end;
  end;
  result := -1;
end;


// Executes a console command and returns its output
function IEGetDosOutput(CommandLine: AnsiString; Work: AnsiString = 'C:\'): AnsiString;
var
  SA: TSecurityAttributes;
  {$IFDEF UNICODE}
  SI: TStartupInfoA;
  {$ELSE}
  SI: TStartupInfo;
  {$ENDIF}
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array [0..255] of AnsiChar;
  BytesRead: Cardinal;
  WorkDir: AnsiString;
  Handle: Boolean;
begin
  Result := '';
  with SA do begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  try
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE);
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;
    WorkDir := Work;
    Handle := CreateProcessA(nil, PAnsiChar('cmd.exe /C ' + CommandLine),
                             nil, nil, True, 0, nil,
                             PAnsiChar(WorkDir), SI, PI);
    CloseHandle(StdOutPipeWrite);
    if Handle then
      try
        repeat
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
          if BytesRead > 0 then
          begin
            Buffer[BytesRead] := #0;
            Result := Result + Buffer;
          end;
        until not WasOK or (BytesRead = 0);
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
    CloseHandle(StdOutPipeRead);
  end;
end;



function IEGPSConvertDMSToDegDec(degrees: Double; minutes: Double; seconds: Double; ref: AnsiString): Double;
begin
  result := degrees + minutes / 60.0 + seconds / 3600.0;
  if (ref = 'W') or (ref = 'S') then
    result := - result;
end;

// dir must be:
//   'SN' : latitude conversion
//   'WE' : longitude conversion
procedure IEGPSConvertDegDecToDMS(dir: AnsiString; value: Double; var degrees: Double; var minutes: Double; var seconds: Double; var ref: AnsiString);
begin
  if value < 0 then
    ref := dir[1]
  else
    ref := dir[2];
  value   := Abs(value);
  degrees := Trunc(value);
  value   := Frac(value) * 60.0;
  minutes := Trunc(value);
  seconds := Frac(value) * 60.0;
end;


//////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////
// IEGetCoresCount

const

// LOGICAL_PROCESSOR_RELATIONSHIP
  RelationProcessorCore     = 0;
  RelationNumaNode          = 1;
  RelationCache             = 2;
  RelationProcessorPackage  = 3;

// PROCESSOR_CACHE_TYPE
  CacheUnified      = 0;
  CacheInstruction  = 1;
  CacheData         = 2;
  CacheTrace        = 3;

type

  CACHE_DESCRIPTOR = packed record
    Level: BYTE;
    Associativity: BYTE;
    LineSize: WORD;
    Size: DWORD;
    Type_: DWORD;  //PROCESSOR_CACHE_TYPE
  end;

  SYSTEM_LOGICAL_PROCESSOR_INFORMATION = packed record
    ProcessorMask: DWORD;
    Relationship: DWORD; // LOGICAL_PROCESSOR_RELATIONSHIP
    case integer of
      0: (ProcessorCore : packed record Flags: BYTE; end);
      1: (NumaNode : packed record NodeNumber: DWORD; end);
      2: (Cache: CACHE_DESCRIPTOR);
      3: (Reserved : packed record d1: int64; d2: int64; end);
  end;
  PSYSTEM_LOGICAL_PROCESSOR_INFORMATION = ^SYSTEM_LOGICAL_PROCESSOR_INFORMATION;

  TIEGetLogicalProcessorInformation = function(buffer: PSYSTEM_LOGICAL_PROCESSOR_INFORMATION; ReturnLength: PDWORD): longbool; stdcall;

function IEGetCoresCount(): integer;
var
  buffer: pointer;
  l, c: integer;
  byteOff: integer;
  curInfo: PSYSTEM_LOGICAL_PROCESSOR_INFORMATION;
  hLib: THandle;
  IEGetLogicalProcessorInformation: TIEGetLogicalProcessorInformation;
begin
  if IEGlobalSettings().DefaultCoresCount = -1 then
  begin
    IEGlobalSettings().DefaultCoresCount := 1;
    l := 0;
    buffer := nil;
    hLib := LoadLibrary('Kernel32.dll');
    if hlib<>0 then
    begin
      @IEGetLogicalProcessorInformation := GetProcAddress(hLib, 'GetLogicalProcessorInformation');
      if @IEGetLogicalProcessorInformation<>nil then
      begin
        IEGetLogicalProcessorInformation(buffer, @l); // get length of buffer to allocate
        if GetLastError() = ERROR_INSUFFICIENT_BUFFER then
        begin
          getmem(buffer, l);
          if IEGetLogicalProcessorInformation(buffer, @l) then
          begin
            c := 0;
            curInfo := PSYSTEM_LOGICAL_PROCESSOR_INFORMATION(buffer);
            byteOff := 0;
            while byteOff < l do
            begin
              if curInfo^.Relationship = RelationProcessorCore then
                inc(c);
              inc(curInfo);
              inc(byteOff, sizeof(SYSTEM_LOGICAL_PROCESSOR_INFORMATION));
            end;
            IEGlobalSettings().DefaultCoresCount := c;
          end;
        end;
      end;
      FreeLibrary(hLib);
    end;
    freemem(buffer);
  end;
  result := IEGlobalSettings().DefaultCoresCount;
end;


function IEGetRequiredThreads(ImageWidth, ImageHeight: integer): integer;
begin
  if ImageWidth * ImageHeight >= IEGlobalSettings().ImageProcThreadsMinSize then
    result := imin(IEGlobalSettings().ImageProcMaxThreads, IEGetCoresCount())
  else
    result := 1;
end;


// Returns true if the O/S is Vista, 7, 8 or something as yet undiscovered
function IEIsWindowsVistaOrNewer : Boolean;
begin
  Result := IEGlobalSettings().OpSys in [ieosUnknown, ieosWinVista, ieosWin7, ieosWin8, ieosWin10];
end;


function IEIsKeyPressed(aKey: Word): Boolean;
begin
  Result := ( GetKeyState( aKey ) and $8000 ) <> 0;
end;


// Returns a suitable font to use for Preview dialogs.  Segoe UI 9 on Vista, 7.  Tahoma 8 on XP, etc
function IEGetDefaultDialogFont() : TFont;
const
  Vista_GUI_Font_Name   = 'Segoe UI';
  Vista_GUI_Font_Height = -12;  
  XP_GUI_Font_Name      = 'Tahoma';
  XP_GUI_Font_Height    = -11;
begin
  // Note: could use Screen.IconFont but our dialogs may not support unexpected fonts
  if assigned(IEGlobalSettings().DefaultDialogFont) = False then
  begin
    IEGlobalSettings().DefaultDialogFont := TFont.Create;

    IEGlobalSettings().DefaultDialogFont.Charset := DEFAULT_CHARSET;
    IEGlobalSettings().DefaultDialogFont.Color := clWindowText;
    IEGlobalSettings().DefaultDialogFont.Style := [];

    if IEIsWindowsVistaOrNewer and (Screen.Fonts.IndexOf(Vista_GUI_Font_Name) >= 0) then
    begin
      IEGlobalSettings().DefaultDialogFont.Height := Vista_GUI_Font_Height;
      IEGlobalSettings().DefaultDialogFont.Name   := Vista_GUI_Font_Name;
    end
    else
    begin
      IEGlobalSettings().DefaultDialogFont.Height := XP_GUI_Font_Height;
      IEGlobalSettings().DefaultDialogFont.Name   := XP_GUI_Font_Name;
    end
  end;

  Result := IEGlobalSettings().DefaultDialogFont;
end;  


/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////



procedure IECenterWindow(Wnd: HWnd);
var
  Rect: TRect;
  Monitor: TMonitor;
begin
  if assigned(IEGlobalSettings().DefDialogCenter) then
    IEGlobalSettings().DefDialogCenter(Wnd)
  else
  begin
    GetWindowRect(Wnd, Rect);
    if Application.MainForm <> nil then
    begin
      if Assigned(Screen.ActiveForm) then
        Monitor := Screen.ActiveForm.Monitor
      else
        Monitor := Application.MainForm.Monitor;
    end
    else
      Monitor := Screen.Monitors[0];
    SetWindowPos(Wnd, 0,
                 Monitor.Left + ((Monitor.Width - Rect.Right + Rect.Left) div 2),
                 Monitor.Top + ((Monitor.Height - Rect.Bottom + Rect.Top) div 3),
                 0, 0, SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOZORDER);
  end;
end;



type
  TMEMORYSTATUSEX=packed record
    dwLength: DWORD;
    dwMemoryLoad: DWORD;
    ullTotalPhys: int64;
    ullAvailPhys: int64;
    ullTotalPageFile: int64;
    ullAvailPageFile: int64;
    ullTotalVirtual: int64;
    ullAvailVirtual: int64;
    ullAvailExtendedVirtual: int64;
  end;
  PMEMORYSTATUSEX=^TMEMORYSTATUSEX;

TIEGlobalMemoryStatusEx = function(lpBuffer: PMEMORYSTATUSEX): longbool; stdcall;

// freememory = false -> total memory
// freememory = true -> free memory
function IEGetMemory(freememory: boolean): int64;
var
  ms: TMemoryStatus;
  msx: TMEMORYSTATUSEX;
  h: THandle;
  IEGlobalMemoryStatusEx: TIEGlobalMemoryStatusEx;
begin
  h := LoadLibrary('Kernel32.dll');
  if h <> 0 then
  begin
    @IEGlobalMemoryStatusEx := GetProcAddress(h, 'GlobalMemoryStatusEx');
    if @IEGlobalMemoryStatusEx<>nil then
    begin
      FillChar(msx, sizeof(TMEMORYSTATUSEX), 0);
      msx.dwLength := sizeof(TMEMORYSTATUSEX);
      IEGlobalMemoryStatusEx(@msx);
      if freememory then
        result := msx.ullAvailPhys
      else
        result := msx.ullTotalPhys;
      FreeLibrary(h);
      exit;
    end;
    FreeLibrary(h);
  end;

  ms.dwLength := sizeof(ms);
  GlobalMemoryStatus(ms);
  if freememory then
    result := ms.dwAvailPhys
  else
    result := ms.dwTotalPhys;
end;



procedure IECalcUnitsPerPixel(DpiX, DpiY: Integer; mu: TIEUnits; out cx, cy: double);
const
  Inches_per_Foot = 12;
  Inches_per_Yard = 36;
  Inches_per_Mile = 63360;
begin
  if mu = ieuPIXELS then
  begin
    cx := 1;
    cy := 1;
  end
  else
  if ( DpiX = 0 ) or ( DpiY = 0 ) then
  begin
    cx := 1;
    cy := 1;
  end
  else
  begin
    cx := 1 / DpiX;
    cy := 1 / DpiY;
    case mu of
      ieuKM:
        begin
          cx := (cx * CM_per_Inch) / 100000;
          cy := (cy * CM_per_Inch) / 100000;
        end;
      ieuMETERS:
        begin
          cx := (cx * CM_per_Inch) / 100;
          cy := (cy * CM_per_Inch) / 100;
        end;
      ieuCENTIMETERS:
        begin
          cx := cx * CM_per_Inch;
          cy := cy * CM_per_Inch;
        end;
      ieuMILLIMETERS:
        begin
          cx := (cx * CM_per_Inch) * 10;
          cy := (cy * CM_per_Inch) * 10;
        end;
      ieuMICRONS:
        begin
          cx := (cx * CM_per_Inch) * 10000;
          cy := (cy * CM_per_Inch) * 10000;
        end;
      ieuNANOMETERS:
        begin
          cx := (cx * CM_per_Inch) * 10000000;
          cy := (cy * CM_per_Inch) * 10000000;
        end;
      ieuFEET:
        begin
          cx := cx / Inches_per_Foot;
          cy := cy / Inches_per_Foot;
        end;
      ieuYARDS:
        begin
          cx := cx / Inches_per_Yard;
          cy := cy / Inches_per_Yard;
        end;
      ieuMILES:
        begin
          cx := cx / Inches_per_Mile;
          cy := cy / Inches_per_Mile;
        end;
    end;
  end;
end;



procedure IESetPlim(var plim: trect; x, y: integer);
begin
  if x < plim.Left then
    plim.left := x;
  if x > plim.Right then
    plim.right := x;
  if y < plim.Top then
    plim.top := y;
  if y > plim.Bottom then
    plim.bottom := y;
end;


function IEArcCos(X: Extended): Extended;
begin
  if (X = 1) or (X = -1) then
    result := 0
  else
    Result := ArcTan2(Sqrt(1 - X * X), X);
end;


function IEDegreesToRadians(Angle: Double): Double;
begin
  Result := Angle * PI / 180.0;
end;

function IERadiansToDegrees(Rad: Double): Double;
begin
  Result := Rad * 180.0 / PI;
end;


// calculates the angle (rad) of the specified triangle. x2, y2 is the angle center
function IEAngle(x1, y1, x2, y2, x3, y3: double): double;
var
  vx1, vy1, vx2, vy2: double;
  d1, d2: double;
begin
  vx1 := x2 - x1;
  vy1 := y2 - y1;
  vx2 := x3 - x2;
  vy2 := y3 - y2;
  try
    d1 := sqrt(vx1 * vx1 + vy1 * vy1);
  except
    d1 := 0;
  end;
  try
    d2 := sqrt(vx2 * vx2 + vy2 * vy2);
  except
    d2 := 0;
  end;
  if (d1 = 0) or (d2 = 0) then
    result := 0
  else
  begin
    d1 := (vx1 * vx2 + vy1 * vy2) / (d1 * d2);
    if abs(d1) <= 1 then
      result := IEArcCos(d1)
    else
      result := 0;
  end;
end;

// Calc angle (rad) of segment x1, y1-x2, y2 relative to the X axis
function IEAngle2(x1, y1, x2, y2: integer): double;
begin
  if (x1 < x2) and (y2 < y1) then // 1
    result := pi - ieangle(x2, y2, x1, y1, x2, y1)
  else
  if (x1 < x2) and (y1 < y2) then // 4
    result := pi + ieangle(x2, y1, x1, y1, x2, y2)
  else
  if (x2 < x1) and (y1 < y2) then // 3
    result := 2 * pi - ieangle(x2, y1, x1, y1, x2, y2)
  else
  if (x2 < x1) and (y2 < y1) then // 2
    result := ieangle(x2, y1, x1, y1, x2, y2)
  else
  if (x2 = x1) and (y1 > y2) then
    result := pi / 2
  else
  if (x2 = x1) and (y1 < y2) then
    result := 1.5 * pi
  else
  if (y1 = y2) and (x1 > x2) then
    result := pi
  else
    result := 0;
end;

function ccw(x0, y0, x1, y1, x2, y2: integer): integer;
var
  dx1, dx2, dy1, dy2: integer;
begin
  dx1 := x1 - x0;
  dy1 := y1 - y0;
  dx2 := x2 - x0;
  dy2 := y2 - y0;
  if dx1 * dy2 > dy1 * dx2 then
    result := 1
  else
  if dx1 * dy2 < dy1 * dx2 then
    result := -1
  else
  if (dx1 * dx2 < 0) or (dy1 * dy2 < 0) then
    result := -1
  else
  if (dx1 * dx1 + dy1 * dy1) < (dx2 * dx2 + dy2 * dy2) then
    result := 1
  else
    result := 0;
end;

function IEAngle3(x1, y1, xc, yc, x2, y2: integer): double;
var
  a, b, c: double;
begin
  // a is (xc, yc)-(x2, y2)
  // b is (x1, y1)-(x2, y2)
  // c is (xc, yc)-(x1, y1)
  a := sqrt(sqr(x2 - xc) + sqr(y2 - yc));
  if a = 0 then
    a := 1;
  b := sqrt(sqr(x2 - x1) + sqr(y2 - y1));
  if b = 0 then
    b := 1;
  c := sqrt(sqr(xc - x1) + sqr(yc - y1));
  if c = 0 then
    c := 1;
  result := IEArcCos((sqr(a) + sqr(c) - sqr(b)) / (2 * a * c));
  if ccw(x1, y1, xc, yc, x2, y2) = -1 then
    result := 2 * PI - result;
end;


// returns reference angle (ex. 45.5 = 45.5,  361 = 1,  1000.5 =
// Angles in degrees
function IEGetReferenceAngle(Angle: double): double;
begin
  result := Angle - Floor (Angle / 360.0) * 360.0;
  if Angle < 0 then
    result := - 360 + result;
end;


function IEExtractStylesFromLogFont(logfont: PLogFontA): TFontStyles;
begin
  result := [];
  if LogFont <> nil then
    with LogFont^ do
    begin
      if lfItalic <> 0 then
        include(result, fsItalic);
      if lfUnderline <> 0 then
        include(result, fsUnderline);
      if lfStrikeOut <> 0 then
        include(result, fsStrikeOut);
      if lfWeight >= FW_BOLD then
        include(result, fsBold);
    end;
end;


function IEExtractStylesFromLogFontW(logfont: PLogFontW): TFontStyles;
begin
  result := [];
  if LogFont <> nil then
    with LogFont^ do
    begin
      if lfItalic <> 0 then
        include(result, fsItalic);
      if lfUnderline <> 0 then
        include(result, fsUnderline);
      if lfStrikeOut <> 0 then
        include(result, fsStrikeOut);
      if lfWeight >= FW_BOLD then
        include(result, fsBold);
    end;
end;


procedure IECopyLogFont(src: PLogFontA; dst: PLogFontW);
begin
  dst^.lfHeight := src^.lfHeight;
  dst^.lfWidth := src^.lfWidth;
  dst^.lfEscapement := src^.lfEscapement;
  dst^.lfOrientation := src^.lfOrientation;
  dst^.lfWeight := src^.lfWeight;
  dst^.lfItalic := src^.lfItalic;
  dst^.lfUnderline := src^.lfUnderline;
  dst^.lfStrikeOut := src^.lfStrikeOut;
  dst^.lfCharSet := src^.lfCharSet;
  dst^.lfOutPrecision := src^.lfOutPrecision;
  dst^.lfClipPrecision := src^.lfClipPrecision;
  dst^.lfQuality := src^.lfQuality;
  dst^.lfPitchAndFamily := src^.lfPitchAndFamily;
  IEStrPCopyW(@dst^.lfFaceName[0], WideString(AnsiString(src^.lfFaceName)));
end;


function CompareGUID(const g1, g2: TGuid): boolean;
begin
  result := CompareMem(@g1, @g2, sizeof(TGuid));
end;

function IEConvertGUIDToString(g: PGUID): AnsiString;
var
  p: pbyte;
  i: integer;
begin
  p := pbyte(g);
  result := '{' + IEIntToHex(pinteger(p)^, 8) + '-';
  inc(p, 4);
  result := result + IEIntToHex(pword(p)^, 4) + '-';
  inc(p, 2);
  result := result + IEIntToHex(pword(p)^, 4) + '-';
  inc(p, 2);
  result := result + IEIntToHex(p^, 2);
  inc(p);
  result := result + IEIntToHex(p^, 2) + '-';
  inc(p);
  for i := 0 to 5 do
  begin
    result := result + IEIntToHex(p^, 2);
    inc(p);
  end;
  result := IELowerCase(result) + '}';
end;

procedure IEConvertWStringToGUID(invar: WideString; gg: PGUID);
begin
  IEConvertAStringToGUID(AnsiString(invar), gg);
end;

procedure IEConvertAStringToGUID(invar: AnsiString; gg: PGUID);
const
  cv: array[48..70] of integer = (0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0, 0, 0, 0, 0, 0, 10, 11, 12, 13, 14, 15);
  mm: array[0..7] of integer = (268435456, 16777216, 1048576, 65536, 4096, 256, 16, 1);
var
  i: integer;
  v: cardinal;
begin
  invar := IEUpperCase(invar);
  v := 0;
  for i := 2 to 9 do
    v := v + cardinal(cv[ord(invar[i])] * mm[i - 2]);
  gg^.D1 := v;
  gg^.D2 := 0;
  for i := 11 to 14 do
    gg^.D2 := gg^.D2 + cv[ord(invar[i])] * mm[i - 11 + 4];
  gg^.D3 := 0;
  for i := 16 to 19 do
    gg^.D3 := gg^.D3 + cv[ord(invar[i])] * mm[i - 16 + 4];
  invar := IECopy(invar, 21, 4) + IECopy(invar, 26, 12);
  for i := 0 to 7 do
  begin
    gg^.D4[i] := cv[ord(invar[i * 2 + 1])] * mm[6] + cv[ord(invar[i * 2 + 2])] * mm[7];
  end;
end;

procedure IEResetPrinter;
var
  Device, Driver, Port: pointer;
  DevMode: THandle;
  lCopies: integer;
  lOrient: TPrinterOrientation;
  lTitle: WideString;
begin
  lCopies := Printer.Copies;
  lOrient := Printer.Orientation;
  lTitle  := Printer.Title;
  getmem(Device, 512);
  getmem(Driver, 512);
  getmem(Port, 512);
  try
    Printer.GetPrinter(Device, Driver, Port, DevMode);
    Printer.SetPrinter(Device, Driver, Port, 0);
  finally
    freemem(Device);
    freemem(Driver);
    freemem(Port);
  end;
  Printer.Copies := lCopies;
  Printer.Orientation := lOrient;
  Printer.Title := lTitle;
end;

// Adjust the resampling size to match fwidth and fheight
// owidth, oheight: source image size
// fwidth, fheight: container box size
// rwidth, rheight: output - new size
// was: IEFitResample
procedure IEGetFitResampleSize(OWidth, OHeight, FWidth, FHeight: integer; out RWidth, RHeight: integer);
var
  zz: double;
begin
  if (owidth <> 0) and (oheight <> 0) then
  begin
    zz := dmin(fwidth / owidth, fheight / oheight);
    rwidth := trunc(owidth * zz);
    if rwidth = 0 then
      rwidth := 1;
    rheight := trunc(oheight * zz);
    if rheight = 0 then
      rheight := 1;
  end;
end;



// Adjust the resampling size to match fwidth and fheight
// iImageWidth, iImageHeight: source image size
// iAvailableWidth, iAvailableHeight: container box size
// rwidth, rheight: output - new size
// if iAutoCropPercent > 0 then RAutoWidth, RAutoHeight will return an enlarged size that is bigger than the container box size (overlaps)
procedure IEGetFitResampleSizeWithAutoCrop(iImageWidth, iImageHeight, iAvailableWidth, iAvailableHeight: integer; out RWidth, RHeight: integer;
                                           iAutoCropPercent : Integer; out RAutoWidth, RAutoHeight: integer);
var
  dResizeRatio, dMaxResizeRatio: Double;
  dCroppedWidth, dCroppedHeight: Double;
begin
  if iAutoCropPercent > 100 then
    iAutoCropPercent := 100;
  if (iImageHeight = 0) or (iImageWidth = 0) or (iAvailableHeight = 0) or (iAvailableWidth = 0) then    
  begin
    RWidth      := 0;
    RHeight     := 0;
    RAutoWidth  := 0;
    RAutoHeight := 0;
  end
  else
  if (iImageHeight / iAvailableHeight) < (iImageWidth / iAvailableWidth) then
  // WIDTH IS IMPORTANT
  begin
    // if we are allowing a percentage of the image to be auto-cropped then
    // calculate the maximum possible ratio we can increase by without
    // without the Height exceeding the available widht
    if iAutoCropPercent > 0 then
    begin
      dCroppedWidth := iImageWidth * (100 - iAutoCropPercent) / 100; 
      if iAutoCropPercent = 100 then
        dMaxResizeRatio := 1000
      else
        dMaxResizeRatio := iAvailableWidth / dCroppedWidth;

      if round(iImageHeight * dMaxResizeRatio) > iAvailableHeight then
        dMaxResizeRatio := iAvailableHeight / iImageHeight;

      RAutoWidth  := round(iImageWidth  * dMaxResizeRatio);
      RAutoHeight := round(iImageHeight * dMaxResizeRatio);

      RWidth  := imin(iAvailableWidth,  RAutoWidth);
      RHeight := imin(iAvailableHeight, RAutoHeight);
    end
    else
    begin
      dResizeRatio := iAvailableWidth / iImageWidth;
      RWidth  := round(iImageWidth * dResizeRatio);
      RHeight := round(iImageHeight * dResizeRatio);
      RAutoWidth  := RWidth;
      RAutoHeight := RHeight;
    end;
  end
  ELSE
  // HEIGHT IS IMPORTANT
  begin
    // if we are allowing a percentage of the image to be auto-cropped then
    // calculate the maximum possible ratio we can increase by without
    // without the width exceeding the available widht
    if iAutoCropPercent > 0 then
    begin
      dCroppedHeight := iImageHeight * (100 - iAutoCropPercent) / 100;
      if iAutoCropPercent = 100 then
        dMaxResizeRatio := 1000
      else
        dMaxResizeRatio := iAvailableHeight / dCroppedHeight;

      if round(iImageWidth * dMaxResizeRatio) > iAvailableWidth then
        dMaxResizeRatio := iAvailableWidth / iImageWidth;

      RAutoWidth  := round(iImageWidth  * dMaxResizeRatio);
      RAutoHeight := round(iImageHeight * dMaxResizeRatio);  

      RWidth  := imin(iAvailableWidth,  RAutoWidth);
      RHeight := imin(iAvailableHeight, RAutoHeight);
    end
    else
    begin  
      dResizeRatio := iAvailableHeight / iImageHeight;
      RWidth  := round(iImageWidth * dResizeRatio);
      RHeight := round(iImageHeight * dResizeRatio);
      RAutoWidth  := RWidth;
      RAutoHeight := RHeight;
    end;
  end;
end;


// encode maximum 4 bytes (len can be 1 to 4)
// pad if len<4
// return chars wrote
function _IEASCII85Encode4(var inbytes: pbyte; inlen: integer; var outstr: PAnsiChar): integer;
var
  c: array[1..5] of dword;
  value: dword;
  i: integer;
begin
  value := 0;
  for i := 0 to inlen-1 do
  begin
    value := value or (inbytes^ shl (24-i*8));
    inc(inbytes);
  end;
  (*
  value := inbytes^ shl 24;
  inc(inbytes);
  value := value or (inbytes^ shl 16);
  inc(inbytes);
  value := value or (inbytes^ shl 8);
  inc(inbytes);
  value := value or inbytes^;
  inc(inbytes);
  *)

  if (value = 0) and (inlen = 4) then
  begin
    outstr^ := 'z';
    inc(outstr);
    result := 1;
  end
  else
  begin
    c[1] := value div 52200625;
    value := value - c[1] * 52200625;
    c[2] := value div 614125;
    value := value - c[2] * 614125;
    c[3] := value div 7225;
    value := value - c[3] * 7225;
    c[4] := value div 85;
    value := value - c[4] * 85;
    c[5] := value;
    for i := 1 to inlen + 1 do
    begin
      outstr^ := AnsiChar(c[i] + 33);
      inc(outstr);
    end;
    result := inlen + 1;
  end;
end;

function IEASCII85EncodeBlock(var inbytes: pbyte; buflen: integer; var outstr: PAnsiChar; var asciilen: integer): integer;
var
  w: integer;
  row: integer;
begin
  result := 0;
  row := 0;
  repeat
    w := _IEASCII85Encode4(inbytes, imin(4, buflen), outstr);
    inc(result, w);
    inc(asciilen, w);
    inc(row, w);
    dec(buflen, 4);
    if row >= 75 then
    begin
      outstr^ := #13;
      inc(outstr);
      outstr^ := #10;
      inc(outstr);
      inc(result, 2);
      row := 0;
    end;
  until buflen <= 0;
  outstr^ := '~';
  inc(outstr);
  outstr^ := '>';
  inc(outstr);
  outstr^ := #13;
  inc(outstr);
  outstr^ := #10;
  inc(outstr);
  inc(result, 4);
end;

// decode maximum 5 characters (inlen)

procedure _IEASCII85Decode5(var instr: PAnsiChar; inlen: integer; var outbytes: pbyte);
var
  value: cardinal;
begin
  if instr^ = 'z' then
  begin
    value := 0;
    inc(instr);
  end
  else
  begin
    value := (ord(instr^) - 33) * 52200625;
    inc(instr);
    if inlen >= 2 then
    begin
      value := value + cardinal(ord(instr^) - 33) * 614125;
      inc(instr);
    end;
    if inlen >= 3 then
    begin
      value := value + cardinal(ord(instr^) - 33) * 7225;
      inc(instr);
    end;
    if inlen >= 4 then
    begin
      value := value + cardinal(ord(instr^) - 33) * 85;
      inc(instr);
    end;
    if inlen >= 5 then
    begin
      value := value + cardinal(ord(instr^) - 33);
      inc(instr);
    end;
  end;
  outbytes^ := value div 16777216;
  value := value - (outbytes^ * 16777216);
  inc(outbytes);
  outbytes^ := value div 65536;
  value := value - (outbytes^ * 65536);
  inc(outbytes);
  outbytes^ := value div 256;
  value := value - (outbytes^ * 256);
  inc(outbytes);
  outbytes^ := value;
  inc(outbytes);
end;

// a block is terminates with a '~>' (EOD)
// buflen refers to instr length
// return output length

function IEASCII85DecodeBlock(var instr: PAnsiChar; buflen: integer; var outbytes: pbyte): integer;
var
  i, l, flatlen: integer;
  flatbuf, ptr, instr2: PAnsiChar;
begin
  result := 0;
  flatlen := 0;
  getmem(flatbuf, buflen);
  ptr := flatbuf;
  i := 0;
  while i < buflen do
  begin
    while ((ord(instr^) < 33) or (ord(instr^) > 117)) and (instr^ <> '~') and (instr^ <> '>') do
    begin
      inc(instr);
      inc(i);
    end;
    if instr^ = '~' then
    begin
      instr2 := instr;
      l := i;
      inc(instr);
      while ((ord(instr^) < 33) or (ord(instr^) > 117)) and (instr^ <> '~') and (instr^ <> '>') do
        inc(instr);
      if instr^ = '>' then
      begin
        inc(instr);
        break;
      end
      else
      begin
        instr := instr2;
        i := l;
      end;
    end;
    ptr^ := instr^;
    inc(instr);
    inc(i);
    inc(ptr);
    inc(flatlen);
  end;
  ptr := flatbuf;
  repeat
    i := imin(flatlen, 5);
    _IEASCII85Decode5(ptr, i, outbytes);
    inc(result, i - 1);
    dec(flatlen, i);
  until flatlen <= 0;
  freemem(flatbuf);
end;

// return the number of bytes actually written

function IEPSRunLengthEncode(inbytes: pbytearray; inlen: integer; outbytes: pbytearray): integer;
var
  inpos, i, l, j: integer;
begin
  result := 0; // this is output position
  inpos := 0;
  while inpos < inlen do
  begin

    // search for run lengths

    i := inpos + 1;
    while (i < inlen) and (inbytes[inpos] = inbytes[i]) and (i-inpos < 128) do
      inc(i);
    l := i - inpos;
    if (l > 1) then
    begin
      // do run length
      outbytes[result] := 257 - l;
      inc(result);
      outbytes[result] := inbytes[inpos];
      inc(result);
      inpos := i;
    end
    else
    begin

      // search for literals

      i := inpos + 1;
      while (i < inlen) and (inbytes[i-1] <> inbytes[i]) and (i-inpos < 128) do
        inc(i);
      l := i - inpos;
      // do literals
      outbytes[result] := l - 1;
      inc(result);
      for j := 0 to l - 1 do
      begin
        outbytes[result] := inbytes[inpos];
        inc(result);
        inc(inpos);
      end;

    end;

  end;

  // do EOD
  outbytes[result] := 128;
  inc(result);

end;

procedure IEWriteStrLn(s: TStream; ss: AnsiString);
begin
  ss := ss + #13#10;
  s.Write(PAnsiChar(ss)^, length(ss));
end;


function IEGetDecimalSeparator: Char;
begin
  {$ifdef IEHASFORMATSETTINGS}
  result := FormatSettings.DecimalSeparator;
  {$else}
  result := DecimalSeparator;
  {$endif}
end;

procedure IESetDecimalSeparator(c: Char);
begin
  {$ifdef IEHASFORMATSETTINGS}
  FormatSettings.DecimalSeparator := c;
  {$else}
  DecimalSeparator := c;
  {$endif}
end;

function IEFloatToStrA(Value: Extended): AnsiString;
var
  i: integer;
begin
  result := AnsiString(floattostr(Value));
  for i := 1 to length(result) do
    if (result[i]=',') or (result[i]=AnsiChar(IEGetDecimalSeparator)) then
      result[i] := '.';
end;

function IEFloatToStrS(Value: Extended): string;
var
  i: integer;
begin
  result := FloatToStr(Value);
  for i := 1 to length(result) do
    if (result[i]=',') or (result[i]=IEGetDecimalSeparator()) then
      result[i] := '.';
end;

function IEFloatToStrW(Value: Extended): WideString;
var
  i: integer;
begin
  result := floattostr(Value);
  for i := 1 to length(result) do
    if (result[i]=',') or (result[i]=WideString(IEGetDecimalSeparator())) then
      result[i] := '.';
end;

function IEIsSpace(c: AnsiChar): boolean;
begin
  result := (c = ' ') or (c = #8) or (c = #13) or (c = #10);
end;

function IERemoveCtrlCharsA(const text: AnsiString): AnsiString;
var
  q: integer;
  c: integer;
begin
  result := '';
  for q := 1 to length(text) do
  begin
    c := ord(text[q]);
     if (c>31) and (c<>127) then
      result := result+AnsiChar(c);
  end;
end;

function IERemoveCtrlCharsS(const text: String): String;
begin
  result := IERemoveCtrlCharsW(text);
end;

function IERemoveCtrlCharsW(const text: WideString): WideString;
var
  q: integer;
  c: integer;
begin
  result := '';
  for q := 1 to length(text) do
  begin
    c := ord(text[q]);
     if (c>31) and (c<>127) then
      result := result+WideChar(c);
  end;
end;


// Returns true if rgb1, rgb2 are the equal (Tolerance = 0) or closely matched (Tolerance is between 1 and 255)
function IERGBColorsMatch(rgb1, rgb2 : TRGB; Tolerance : Integer = 0): Boolean;
var
  dr, dg, db: Integer;
begin
  dr := abs(rgb1.r - rgb2.r);
  dg := abs(rgb1.g - rgb2.g);
  db := abs(rgb1.b - rgb2.b);
  result := (dr <= tolerance) and (dg <= tolerance) and (db <= tolerance);
end;

function IERGB2StrS(c: TRGB): string;
begin
  with c do
    result := IntToStr(r)+', '+IntToStr(g)+', '+IntToStr(b);
end;

function IERGB2StrW(c: TRGB): WideString;
begin
  with c do
    result := IntToStr(r)+', '+IntToStr(g)+', '+IntToStr(b);
end;

function IEBool2StrS(v: boolean): string;
begin
  if v then
    result := '1'
  else
    result := '0';
end;

function IEBool2StrW(v: boolean): WideString;
begin
  if v then
    result := '1'
  else
    result := '0';
end;

function IEStr2RGBW(const rgbstr: WideString): TRGB;
begin
  result := IEStr2RGBS(string(rgbstr));
end;

function IEStr2RGBS(const rgbstr: string): TRGB;
var
  p: integer;
  ps1, q: integer;
  ss: string;
  l: integer;
begin
  try
  l := length(rgbstr);
  ps1 := 1;
  p := 0;
  for q := 1 to l+1 do
  begin
    if (rgbstr[q]=',') or (q=l+1) then
    begin
      ss := Trim(copy(rgbstr, ps1, (q-ps1)));
      case p of
        0: result.r := StrToIntDef(ss, 0);
        1: result.g := StrToIntDef(ss, 0);
        2: result.b := StrToIntDef(ss, 0);
      end;
      inc(p);
      ps1 := q+1;
    end;
  end;
  except
    result := creatergb(0, 0, 0);
  end;
end;

function IEStr2BoolS(const v: string): boolean;
var
  ss: string;
begin
  ss := UpperCase(v);
  result := (ss='1') or (ss='TRUE') or (ss='T');
end;

function IEStr2BoolW(const v: WideString): boolean;
begin
  result := IEStr2BoolS(string(v));
end;

function IEStr2BoolA(const v: AnsiString): boolean;
begin
  result := IEStr2BoolS(string(v));
end;


function IEStr2ColorDefS(const v : string; ADefault : TColor) : TColor;
begin
  Try
    Result := StringToColor(v);
  except
    Result := ADefault;
  End;
end;

/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////

{!!
<FS>IESetTranslationWord

<FM>Declaration<FC>
procedure IESetTranslationWord(const lang: <A TMsgLanguage>; const msg: <A TMsgLanguageWords>; const trans: AnsiString);
procedure IESetTranslationWordU(const lang: <A TMsgLanguage>; const msg: <A TMsgLanguageWords>; const trans: String);

<FM>Description<FN>
IESetTranslationWord allows applications to set a customized word/sentence translation.
<FC>lang<FN> is the target language.
<FC>msg<FN> is the message to translate.
<FC>trans<FN> is the translated message.

See also: iewords.pas file.
!!}
procedure IESetTranslationWord(const lang: TMsgLanguage; const msg: TMsgLanguageWords; const trans: AnsiString);
{$ifdef UNICODE}
var
  rbs: RawByteString;
begin
  rbs := trans;
  SetCodePage(rbs, IELANGUAGECHARINFO[lang].CodePage, false);
  ieMessages[lang][msg] := string(rbs);
end;
{$else}
begin
  ieMessages[lang][msg] := string(trans);
end;
{$endif}

procedure IESetTranslationWordU(const lang: TMsgLanguage; const msg: TMsgLanguageWords; const trans: string);
begin
  ieMessages[lang][msg] := trans;
end;


// returns the message "msg" in current selected language
function iemsg(const msg: TMsgLanguageWords): WideString;
begin
  if IEGlobalSettings().MsgLanguage = msSystem then
  begin
    case syslocale.PriLangID of
      {$IFDEF IESUPPORTITALIAN}
      LANG_ITALIAN: result := ieMessages[msItalian][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTPORTUGUESE}
      LANG_PORTUGUESE: result := ieMessages[msPortuguese][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTENGLISH}
      LANG_ENGLISH: result := ieMessages[msEnglish][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTSPANISH}
      LANG_SPANISH: result := ieMessages[msSpanish][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTFRENCH}
      LANG_FRENCH: result := ieMessages[msFrench][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTGERMAN}
      LANG_GERMAN: result := ieMessages[msGerman][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTGREEK}
      LANG_GREEK: result := ieMessages[msGreek][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTRUSSIAN}
      LANG_RUSSIAN: result := ieMessages[msRussian][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTDUTCH}
      LANG_DUTCH: result := ieMessages[msDutch][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTSWEDISH}
      LANG_SWEDISH: result := ieMessages[msSwedish][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTPOLISH}
      LANG_POLISH: result := ieMessages[msPolish][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTJAPANESE}
      LANG_JAPANESE: result := ieMessages[msJapanese][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTCZECH}
      LANG_CZECH: result := ieMessages[msCzech][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTFINNISH}
      LANG_FINNISH: result := ieMessages[msFinnish][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTFARSI}
      LANG_FARSI: result := ieMessages[msFarsi][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTDANISH}
      LANG_DANISH: result := ieMessages[msDanish][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTTURKISH}
      LANG_TURKISH: result := ieMessages[msTurkish][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTKOREAN}
      LANG_KOREAN: result := ieMessages[msKorean][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTHUNGARIAN}
      LANG_HUNGARIAN: result := ieMessages[msHungarian][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTARABIC}
      LANG_ARABIC: result := ieMessages[msArabic][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTSERBIAN}
      LANG_SERBIAN: result := ieMessages[msSerbian][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTNORWEGIAN}
      LANG_NORWEGIAN: result := ieMessages[msNorwegian][msg];
      {$ENDIF}
      {$IFDEF IESUPPORTCHINESE}
      LANG_CHINESE:
        case syslocale.SubLangID of
          SUBLANG_CHINESE_SIMPLIFIED:  result := ieMessages[msChinese][msg];
          SUBLANG_CHINESE_TRADITIONAL: result := ieMessages[msChineseTraditionalBig5][msg];
        end;
      {$ENDIF}
      else
        {$IFDEF IESUPPORTENGLISH}
        result := ieMessages[msEnglish][msg];
        {$ELSE}
        result := ieMessages[TMsgLanguage(1)][msg];
        {$ENDIF}
    end;
  end
  else
  begin
    result := ieMessages[IEGlobalSettings().MsgLanguage][msg];
  end;

  // Fall back to English or whatever language is available
  if result = '' then
    {$IFDEF IESUPPORTENGLISH}
    result := ieMessages[msEnglish][msg];
    {$ELSE}
    result := ieMessages[TMsgLanguage(1)][msg];
    {$ENDIF}
end;

////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////


{
function CalcLineLenWithinRect(R: TRect; Angle: Integer): Double;
var
  Pt1, Pt2: TPoint;
begin
  CalcLineWithinRect( R, Angle,  Pt1, Pt2 );
  result := _DistPoint2Point( Pt1.x, Pt1.y, Pt2.x, Pt2.Y );
end;
}

// point to point distance
function _DistPoint2Point(x1, y1, x2, y2: integer): double;
begin
  result := sqrt(sqr(x2 - x1) + sqr(y2 - y1));
end;

function IEDDistPoint2Point(x1, y1, x2, y2: double): double;
begin
  result := sqrt(sqr(x2 - x1) + sqr(y2 - y1));
end;


// point to line distance
function _DistPoint2Line(xp, yp, x1, y1, x2, y2: integer): double;
var
  a, b, c: double;  // leave a, b, c as double (not integers! otherwise an overflow could occur)
begin
  a := y1 - y2;
  b := x2 - x1;
  c := x1 * y2 - x2 * y1;
  result := abs(a * xp + b * yp + c) / sqrt(a * a + b * b);
end;

// Point<->Segment distance
function _DistPoint2Seg(xp, yp, x1, y1, x2, y2: integer): double;
var
  r: double;
begin
  result := 1000000;
  try
    if (x1 = x2) and (y1 = y2) then
      result := sqrt(sqr(xp - x1) + sqr(yp - y1))
    else
    begin
      r := ((y1 - yp) * (y1 - y2) - (x1 - xp) * (x2 - x1)) / (sqr(x2 - x1) + sqr(y2 - y1));
      if r > 1 then
      begin
        // distance from xp, yp to x2, y2
        if abs(xp - x2) > 45000 then
          exit;
        if abs(yp - y2) > 45000 then
          exit;
        result := sqrt(sqr(xp - x2) + sqr(yp - y2));
      end
      else
      if r < 0 then
      begin
        // distance from xp, yp to x1, y1
        if abs(x1 - xp) > 45000 then
          exit;
        if abs(y1 - yp) > 45000 then
          exit;
        result := sqrt(sqr(x1 - xp) + sqr(y1 - yp))
      end
      else
      begin
        // distance from the line
        result := _DistPoint2Line(xp, yp, x1, y1, x2, y2);
      end;
    end;
  except
  end;
end;

function _DistPoint2Polyline(x, y: integer; PolyPoints: PPointArray; PolyPointsCount: integer; ToSubX, ToSubY, ToAddX, ToAddY: integer; ToMulX, ToMulY: double; penWidth: integer; closed: boolean): double;
var
  i: integer;
  d: double;
  x1, y1, x2, y2: integer;

  procedure comp;
  var
    j, k: integer;
  begin
    d := _DistPoint2Seg(x, y, x1, y1, x2, y2);
    if penWidth > 1 then
      for j := -penWidth div 2 to penWidth div 2 do
        for k := 2 to penWidth div 2 do
        begin
          d := dmin(d, _DistPoint2Seg(x, y, x1+j, y1+k, x2+j, y2+k));
        end;
    if d < result then
      result := d;
    iswap(x1, x2);
    iswap(y1, y2);
  end;

begin
  result := 1000000;
  if PolyPointsCount > 0 then
  begin
    x1 := round((PolyPoints^[0].x - ToSubX) * ToMulX + ToAddX);
    y1 := round((PolyPoints^[0].y - ToSubY) * ToMulY + ToAddY);
    for i := 1 to PolyPointsCount - 1 do
    begin
      x2 := round((PolyPoints^[i].x - ToSubX) * ToMulX + ToAddX);
      y2 := round((PolyPoints^[i].y - ToSubY) * ToMulY + ToAddY);
      comp;
    end;
    if closed then
    begin
      x2 := round((PolyPoints^[0].x - ToSubX) * ToMulX + ToAddX);
      y2 := round((PolyPoints^[0].y - ToSubY) * ToMulY + ToAddY);
      comp;
    end;
  end;
end;


///////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////


function IEGetOpSys(): TIEOpSys;
var
  ver: TOSVersionInfo;
begin
  result := ieosUnknown;
  ver.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  if not GetVersionEx(ver) then
    Exit;
  case ver.dwPlatformId of
    VER_PLATFORM_WIN32_WINDOWS:
      begin
        if (ver.dwMajorVersion=4) then
        begin
          if (ver.dwMinorVersion=0) then
            result := ieosWin95
          else
          if (ver.dwMinorVersion = 10) then
            result := ieosWin98
          else
          if  (ver.dwMinorVersion = 90) then
            result := ieosWinME;
        end;
      end;
    VER_PLATFORM_WIN32_NT:
      begin
        if (ver.dwMajorVersion=4) and (ver.dwMinorVersion=0) then
          result := ieosWinNT4
        else
        if (ver.dwMajorVersion = 5) and (ver.dwMinorVersion = 0) then
          result := ieosWin2000
        else
        if (ver.dwMajorVersion = 5) and (ver.dwMinorVersion = 1) then
          result := ieosWinXP
        else
        if (ver.dwMajorVersion = 5) and (ver.dwMinorVersion = 2) then
          result := ieosWin2003
        else
        if (ver.dwMajorVersion = 6) and (ver.dwMinorVersion = 0) then
          result := ieosWinVista
        else
        if (ver.dwMajorVersion = 6) and (ver.dwMinorVersion = 1) then
          result := ieosWin7
        else
        if (ver.dwMajorVersion = 6) and (ver.dwMinorVersion = 2) then
          result := ieosWin8
        else
        if (ver.dwMajorVersion = 10) and (ver.dwMinorVersion = 0) then
          result := ieosWin10;
      end;
  end;
end;


function IEGetDisplayOrientation(): integer;
var
  devmode: TIEDeviceModeW;
begin
  FillChar(devmode, sizeof(devmode), 0);
  devmode.dmSize := sizeof(devmode);
  IE_EnumDisplaySettingsExW(nil, DWORD(-1), devmode, 4);
  result := devmode.dmDisplayOrientation * 90;
end;


function IEStrToFloatDefA(s: AnsiString; Def: extended): extended;
var
  q: integer;
begin
  if not IETextToFloat(PAnsiChar(s), result, fvExtended) then
  begin
    q := IEPos(',', s);
    if q > 0 then
      s[q] := '.'
    else
    begin
      q := IEPos('.', s);
      if q > 0 then
        s[q] := ',';
    end;
    if not IETextToFloat(PAnsiChar(s), result, fvExtended) then
      result := Def;
  end;
end;

function IEStrToFloatDefW(s: WideString; Def: extended): extended;
begin
  result := IEStrToFloatDefA(AnsiString(s), Def);
end;

function IEStrToFloatDefS(s: String; Def: extended): extended;
begin
  result := IEStrToFloatDefA(AnsiString(s), Def);
end;

function IEStrToFloatDef(s: String; Def: extended): extended;
begin
  result := IEStrToFloatDefA(AnsiString(s), Def);
end;

function IEStrLen(const Str: PAnsiChar): Cardinal;
begin
  {$ifdef DelphiXE4orNewer}
  result := AnsiStrings.StrLen(Str);
  {$else}
  result := StrLen(Str);
  {$endif}
end;

function IEStrLenW(Str: PWideChar): Cardinal;
begin
  result := 0;
  while Str^ <> #0 do
  begin
    inc(result);
    inc(Str);
  end;
end;

function IEStrCopy(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar;
begin
  {$ifdef DelphiXE4orNewer}
  result := AnsiStrings.StrCopy(Dest, Source);
  {$else}
  result := StrCopy(Dest, Source);
  {$endif}
end;

function IEStrCopyW(Dest: PWideChar; Source: PWideChar): PWideChar;
begin
  result := Dest;
  while Source^ <> #0 do
  begin
    Dest^ := Source^;
    inc(Dest);
    inc(Source);
  end;
  Dest^ := #0;
end;

function IEStrPCopy(Dest: PAnsiChar; const Source: AnsiString): PAnsiChar;
begin
  {$ifdef DelphiXE4orNewer}
  result := AnsiStrings.StrPCopy(Dest, Source);
  {$else}
  result := StrPCopy(Dest, Source);
  {$endif}
end;

function IEStrPCopyW(Dest: PWideChar; const Source: WideString): PWideChar;
var
  i: integer;
begin
  result := Dest;
  for i := 1 to length(Source) do
  begin
    Dest^ := Source[i];
    inc(Dest);
  end;
  Dest^ := #0;
end;

// Copies array of ansichar to PWideChar
function IEStrPCopyWA(Dest: PWideChar; Source: TIEArrayOfAnsiChar): PWideChar;
var
  i: integer;
begin
  result := Dest;
  for i := 1 to length(Source) do
  begin
    Dest^ := WideChar(Source[i]);
    inc(Dest);
  end;
  Dest^ := #0;
end;

function IEStrMove(Dest: PAnsiChar; const Source: PAnsiChar; Count: Cardinal): PAnsiChar;
begin
  {$ifdef DelphiXE4orNewer}
  result := AnsiStrings.StrMove(Dest, Source, Count);
  {$else}
  result := StrMove(Dest, Source, Count);
  {$endif}
end;

function IEAnsiStrScan(Str: PAnsiChar; Chr: AnsiChar): PAnsiChar;
begin
  {$ifdef DelphiXE4orNewer}
  result := AnsiStrings.AnsiStrScan(Str, Chr);
  {$else}
  result := AnsiStrScan(Str, Chr);
  {$endif}
end;

function IEStrScan(const Str: PAnsiChar; Chr: AnsiChar): PAnsiChar;
begin
  {$ifdef DelphiXE4orNewer}
  result := AnsiStrings.StrScan(Str, Chr);
  {$else}
  result := StrScan(Str, Chr);
  {$endif}
end;

function IEStrRScan(const Str: PAnsiChar; Chr: AnsiChar): PAnsiChar;
begin
  {$ifdef DelphiXE4orNewer}
  result := AnsiStrings.StrRScan(Str, Chr);
  {$else}
  result := StrRScan(Str, Chr);
  {$endif}
end;

function IETextToFloat(Buffer: PAnsiChar; var Value; ValueType: TFloatValue): Boolean;
begin
  {$ifdef DelphiXE4orNewer}
  result := AnsiStrings.TextToFloat(Buffer, Value, ValueType);
  {$else}
  result := TextToFloat(Buffer, Value, ValueType);
  {$endif}
end;


function IECopyArrayOfByte(const Input: TIEArrayOfByte): TIEArrayOfByte;
begin
  SetLength(result, length(Input));
  move(Input[0], result[0], sizeof(byte) * length(Input));
end;


function IECopyArrayOfInteger(const Input: TIEArrayOfInteger): TIEArrayOfInteger;
begin
  SetLength(result, length(Input));
  move(Input[0], result[0], sizeof(integer) * length(Input));
end;


////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////


// L: 0..255
// A: -127...127
// B: -127...127
function IERGB2CIELAB(rgb: TRGB): TCIELAB;
var
  X, Y, Z, fX, fY, fZ: double;
  RR, GG, BB: double;
  L: double;
begin
  RR := rgb.r / 255.0;
  GG := rgb.g / 255.0;
  BB := rgb.b / 255.0;

  if (RR > 0.04045) then
    RR := IEPower2(((RR + 0.055) / 1.055), 2.4)
  else
    RR := RR / 12.92;
  if (GG > 0.04045) then
    GG := IEPower2(((GG + 0.055) / 1.055), 2.4)
  else
    GG := GG / 12.92;
  if (BB > 0.04045) then
    BB := IEPower2(((BB + 0.055) / 1.055), 2.4)
  else
    BB := BB / 12.92;

  X := (0.412453*RR + 0.357580*GG + 0.180423*BB) / 0.95047;
  Y := (0.212671*RR + 0.715160*GG + 0.072169*BB);
  Z := (0.019334*RR + 0.119193*GG + 0.950227*BB) / 1.088883;

  if (Y > 0.008856) then
  begin
    fY := IEPower2(Y, 1.0/3.0);
    L := 116.0*fY - 16.0;
  end
  else
  begin
    fY := 7.787*Y + 16.0/116.0;
    L := 903.3*Y;
  end;

  if (X > 0.008856) then
    fX := IEPower2(X, 1.0/3.0)
  else
    fX := 7.787*X + 16.0/116.0;

  if (Z > 0.008856) then
    fZ := IEPower2(Z, 1.0/3.0)
  else
    fZ := 7.787*Z + 16.0/116.0;

  result.L := trunc(L*2.55);
  result.a := trunc(500.0*(fX - fY));
  result.b := trunc(200.0*(fY - fZ));
end;

function IECIELAB2RGB(const lab: TCIELAB): TRGB;
var
  var_R, var_G, var_B: double;
  X, Y, Z: double;
begin
  with lab do
  begin
    Y := ( L * 0.39215686275 + 16 ) / 116;
    X := a / 500 + Y;
    Z := Y - b / 200;
  end;

  if ( IEPower2(Y, 3) > 0.008856 ) then
    Y := IEPower2(Y, 3)
  else
    Y := ( Y - 0.13793103448 ) / 7.787;

  if ( IEPower2(X, 3) > 0.008856 ) then
    X := IEPower2(X, 3)
  else
    X := ( X - 0.13793103448 ) / 7.787;

  if ( IEPower2(Z, 3) > 0.008856 ) then
    Z := IEPower2(Z, 3)
  else
    Z := ( Z - 0.13793103448 ) / 7.787;

  X := X * 0.95047;
  Z := Z * 1.08883;

  var_R := X * 3.2406 +    Y * (-1.5372) + Z * (-0.4986);
  var_G := X * (-0.9689) + Y * 1.8758 +    Z * 0.0415;
  var_B := X * 0.0557 +    Y * (-0.2040) + Z * 1.0570;

  if ( var_R > 0.0031308 ) then
    var_R := 1.055 * ( IEPower2(var_R, 0.41666666667) ) - 0.055
  else
    var_R := 12.92 * var_R;

  if ( var_G > 0.0031308 ) then
    var_G := 1.055 * ( IEPower2(var_G, 0.41666666667) ) - 0.055
  else
    var_G := 12.92 * var_G;

  if ( var_B > 0.0031308 ) then
    var_B := 1.055 * ( IEPower2(var_B, 0.41666666667) ) - 0.055
  else
    var_B := 12.92 * var_B;

  with result do
  begin
    r := blimit(round(var_R * 255));
    g := blimit(round(var_G * 255));
    b := blimit(round(var_B * 255));
  end;
end;



// draw a 3d rect
procedure IEDraw3DRect(Canvas: TCanvas; x1, y1, x2, y2: integer; cl1, cl2: TColor);
begin
  with Canvas do
  begin
    Pen.Mode := pmCopy;
    Pen.Style := psSolid;
    Pen.Color := cl1;
    Pen.Width := 1;
    MoveTo(x1, y2);
    LineTo(x1, y1);
    LineTo(x2, y1);
    Pen.Color := cl2;
    MoveTo(x1, y2);
    LineTo(x2, y2);
    LineTo(x2, y1);
  end;
end;

// Same as IEDraw3DRect but using TIECanvas
// Canvas must be TIECanvas
procedure IEDraw3DRect2(Canvas: TObject; x1, y1, x2, y2: integer; cl1, cl2: TColor);
begin
  with Canvas as TIECanvas do
  begin
    Pen.Mode := pmCopy;
    Pen.Style := psSolid;
    Pen.Color := cl1;
    MoveTo(x1, y2);
    LineTo(x1, y1);
    LineTo(x2, y1);
    Pen.Color := cl2;
    MoveTo(x1, y2);
    LineTo(x2, y2);
    LineTo(x2, y1);
  end;
end;



procedure IEDrawHint(Canvas: TCanvas; var x, y: integer; const ss: string; Font: TFont; Brush: TBrush; var SaveBitmap: TBitmap; MaxWidth, MaxHeight: integer; Border1, Border2: TColor);
const
  ox = 6;
  oy = 6;
var
  tw, th: integer;
begin
  Canvas.Font.Assign(Font);
  Canvas.Brush.Assign(Brush);
  tw := Canvas.TextWidth(ss) + 6 + ox;
  th := Canvas.TextHeight(ss) + 6 + oy;
  if x < 0 then
    x := 0;
  if y < 0 then
    y := 0;
  x := imin(x, MaxWidth - 1 - tw);
  y := imin(y, MaxHeight - 1 - th);
  SaveBitmap.PixelFormat := pf24bit;
  SaveBitmap.Width := tw;
  SaveBitmap.Height := th;
  SaveBitmap.Canvas.CopyMode := cmSrcCopy;
  SaveBitmap.Canvas.CopyRect(rect(0, 0, tw, th), Canvas, rect(x, y, x + tw, y + th));
  canvas.FillRect(rect(x + ox, y + oy, x + tw, y + th));
  IEDraw3DRect(Canvas, x + ox, y + oy, x + tw - 1, y + th - 1, Border1, Border2);
  Canvas.TextOut(x + 3 + ox, y + 3 + oy, string(ss));
end;

procedure IEDrawHint2(Canvas: TCanvas; var x, y: integer; const ss: string; const minText: string);
const
  ox = 6;
  oy = 6;
var
  tw, th: integer;
  iec: TIECanvas;
begin
  iec := TIECanvas.Create(Canvas, true, true);
  iec.Font.Name := 'Arial';
  iec.Font.Size := 9;
  iec.Font.Color := clBlack;
  iec.Brush.Color := $0060FFFF;
  iec.Brush.Style := bsSolid;
  iec.Brush.Transparency := 128;
  tw := imax( iec.TextWidth(ss) + 6 + ox , iec.TextWidth(minText) + 6 + ox );
  th := iec.TextHeight(ss) + 6 + oy;
  if x < 0 then
    x := 0;
  if y < 0 then
    y := 0;
  iec.FillRect(rect(x + ox, y + oy, x + tw, y + th));
  IEDraw3DRect2(iec, x + ox, y + oy, x + tw - 1, y + th - 1, clWhite, clGray);
  iec.Brush.Style := bsClear;
  iec.TextOut(x + 3 + ox, y + 3 + oy, ss);
  iec.Free;
end;

function IEDrawDibClose(hdd: hDrawDib): Boolean;
begin
  result := DrawDibClose(hdd);
end;

function IEDrawDibDraw(hdd: hDrawDib; hDC: THandle; xDst, yDst, dxDst, dyDst: Integer; var lpbi: TBitmapInfoHeader; Bits: Pointer; xSrc, ySrc, dxSrc, dySrc: Integer; wFlags: UInt): Boolean;
begin
  result := DrawDibDraw(hdd, hDC, xDst, yDst, dxDst, dyDst, lpbi, Bits, xSrc, ySrc, dxSrc, dySrc, wFlags);
end;

function IEDrawDibOpen: hDrawDib;
begin
  result := DrawDibOpen;
end;

function IEDrawDibRealize(hdd: hDrawDib; hDC: THandle; fBackground: Bool): UInt;
begin
  result := DrawDibRealize(hdd, hDC, fBackground);
end;




procedure SafeStreamWrite(Stream: TStream; var Aborting: boolean; const Buffer; Count: Longint);
begin
  if Stream.Write(Buffer, Count) < Count then
    Aborting := true;
end;



/////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
// DoPaletteDialog
/////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////

{!!
<FS>TImageEnPaletteDialog.SetPalette

<FM>Declaration<FC>
procedure SetPalette(var Palette: array of <A TRGB>; NumCol: integer);

<FM>Description<FN>
Sets palette to show in the dialog.

<FM>Example<FC>
Var
  fPalDial: TImageEnPaletteDialog;
Begin
  fPalDial := TImageEnPaletteDialog.Create(self);
  fPalDial.SetPalette(ImageEnIO1.Params.ColorMap^, ImageEnIO1.Params.ColorMapCount);
  if fPalDial.Execute then
    Panel1.Color := fPalDial.SelCol;
  fPalDial.free;
End;

<FM>See Also<FN>
- <A CreateRGB>
- <A TRGB2TColor>
- <A TColor2TRGB>
!!}
procedure TImageEnPaletteDialog.SetPalette(var Palette: array of TRGB; NumCol: integer);
begin
  fPalette := PRGBROW(@(Palette[0]));
  fNumCol := NumCol;
end;


constructor TImageEnPaletteDialog.Create(AOwner: TComponent);
const
  Right_Border = 8;
begin
  inherited CreateNew(AOwner);
  OnPaint := self.FormPaint;
  OnMouseMove := self.FormMouseMove;
  OnClick := self.FormClick;
  BorderIcons := [biSystemMenu];
  BorderStyle := bsDialog;
  Caption := 'Palette';
  Height := 199;
  Position := poScreenCenter;
  Width := 520;
  ButtonCancel := TButton.Create(self);
  with ButtonCancel do
  begin
    Parent := self;
    ModalResult := mrCancel;
    Caption := 'Cancel';
    Cancel := true;
    Top := 136;
  end;
  ButtonCancel.Left := ClientWidth - ButtonCancel.Width - Right_Border;
  MouseCol := -1;
  SelCol := -1;
end;


procedure TImageEnPaletteDialog.FormPaint(Sender: TObject);
var
  c, x, y: integer;
begin
  for c := 0 to fNumCol - 1 do
  begin
    y := 1 + (c div 32) * 16;
    x := 1 + (c - (c div 32) * 32) * 16;
    Canvas.Brush.Color := TRGB2TColor(fPalette^[c]);
    if MouseCol = c then
      Canvas.Pen.Color := clBlack
    else
    if Canvas.Brush.Color = SelCol then
      Canvas.Pen.Color := $00555555
    else
      Canvas.Pen.Color := clWhite;
    Canvas.Rectangle(x, y, x + 15, y + 15);
  end;
end;


procedure TImageEnPaletteDialog.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  c: integer;
begin
  c := ((x - 1) div 16) + ((y - 1) div 16) * 32;
  if (c >= 0) and (c < fNumCol) and (c <> MouseCol) then
  begin
    MouseCol := c;
    FormPaint(self);
  end;
end;


procedure TImageEnPaletteDialog.FormClick(Sender: TObject);
begin
  SelCol := TRGB2TCOLOR(fPalette^[MouseCol]);
  modalresult := mrOK;
end;


{!!
<FS>TImageEnPaletteDialog.Execute

<FM>Declaration<FC>
function Execute: boolean;

<FM>Description<FN>
Executes the dialog. Returns True if the user select a color, otherwise False if the user Cancel the dialog.

Use SelCol property to get the color selected as TColor or NumCol to get as integer index.

<FM>Example<FC>
Var
  fPalDial: TImageEnPaletteDialog;
Begin
  fPalDial := TImageEnPaletteDialog.Create(self);
  fPalDial.SetPalette(ImageEnIO1.Params.ColorMap^, ImageEnIO1.Params.ColorMapCount);
  if fPalDial.Execute then
    Panel1.Color := fPalDial.SelCol;
  fPalDial.free;
End;

!!}
function TImageEnPaletteDialog.Execute: boolean;
begin
  if fPalette = nil then
    raise EIEException.create('Invalid Palette!');

  result := ShowModal = mrOK;
end;



/////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////

function IEDirectoryExists(const Name: string): Boolean;
var
  Code: Integer;
begin
  Code := GetFileAttributes(PChar(Name));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;

procedure IEForceDirectories(Dir: string);
begin
  if Length(Dir) = 0 then
    exit;
  if (AnsiLastChar(Dir) <> nil) and (AnsiLastChar(Dir)^ = '\') then
    Delete(Dir, Length(Dir), 1);
  if (Length(Dir) < 3) or IEDirectoryExists(Dir) or (ExtractFilePath(Dir) = Dir) then
    exit;
  IEForceDirectories(ExtractFilePath(Dir));
  CreateDir(Dir);
end;

// count consecutive bits
// ex  000111110000  return 5
function _GetBitCount(b: Integer): Integer;
var
  i: Integer;
begin
  i := 0;
  while (i < 31) and (((1 shl i) and b) = 0) do
    Inc(i);
  Result := 0;
  while (((1 shl i) and b) <> 0) and (i < 32) do
  begin
    Inc(i);
    Inc(Result);
  end;
end;

// return first set bit
// ex 000011100000 return 6 (first bit is "1")
// return 0 if no set bit found
function IEGetFirstSetBit(b: Integer): Integer;
var
  i: Integer;
begin
  i := 0;
  while (i < 32) and (((1 shl i) and b) = 0) do
    Inc(i);
  if i = 32 then
    result := 0
  else
    result := i + 1;
end;

// Converts colors count to needed bits per pixels (rounded)
function _NColToBitsPixel(NCol: integer): integer;
var
  q: integer;
begin
  result := -1;
  for q := 0 to 31 do
    if (NCol and (1 shl q)) <> 0 then
    begin
      if result <> -1 then
        result := q + 1
      else
        result := q;
    end;
end;

// return line length in bytes
// align is the number of bits of alignment. Allowed multiple of 8 bits (8, 16, 24, 32, 48...)
function IEBitmapRowLen(Width: integer; BitCount: integer; align: integer): int64;
begin
  case align of
    32:
      // formula optimized for 32
      result := (((Width * BitCount) + 31) shr 5) shl 2; // (((Width*BitCount)+31) div 32) * 4
  else
    // generic formula
    result := (((Width * BitCount) + (align - 1)) div align) * (align div 8);
  end;
end;

// Converts Pixelformat of TBitmap to BitCount
function IEVCLPixelFormat2BitCount(PixelFormat: TPixelFormat): integer;
const
  conv: array[pfDevice..pfCustom] of integer = (0, 1, 4, 8, 15, 16, 24, 32, 0);
begin
  case PixelFormat of
    pf1bit: result := 1;
    pf4bit: result := 4;
    pf8bit: result := 8;
    pf15bit: result := 15;
    pf16bit: result := 16;
    pf24bit: result := 24;
    pf32bit: result := 32;
  else
    result := 0;
  end;
end;

function IEVCLPixelFormat2ImageEnPixelFormat(PixelFormat: TPixelFormat): TIEPixelFormat;
begin
  case PixelFormat of
    pf1bit: result := ie1g;
    pf4bit: result := ie8p;
    pf8bit: result := ie8p;
    pf15bit: result := ie24RGB;
    pf16bit: result := ie24RGB;
    pf24bit: result := ie24RGB;
    pf32bit: result := ie24RGB;
  else
    result := ie24RGB;
  end;
end;

// Get rowlen from PixelFormat
function IEVCLPixelFormat2RowLen(Width: integer; PixelFormat: TPixelFormat): integer;
begin
  result := IEBitmapRowLen(Width, IEVCLPixelFormat2BitCount(PixelFormat), 32);
end;

// converts BitCount to PixelFormat (of TBitmap)
function IEBitCount2VCLPixelformat(Bitcount: integer): TPixelFormat;
begin
  case BitCount of
    1: result := pf1bit;
    4: result := pf4bit;
    8: result := pf8bit;
    15: result := pf15bit;
    16: result := pf16bit;
    24: result := pf24bit;
    32: result := pf32bit;
  else
    result := pfCustom;
  end;
end;

function IEPixelFormat2BitCount(PixelFormat: TIEPixelFormat): integer;
const
  PIXELFORMAT2BITCOUNT: array [TIEPixelFormat] of integer = ( 0,   // ienull
                                                              1,   // ie1g
                                                              8,   // ie8p
                                                              8,   // ie8g
                                                              16,  // ie16g
                                                              24,  // ie24RGB
                                                              32,  // ie32f
                                                              32,  // ieCMYK
                                                              48,  // ie48RGB
                                                              24,  // ieCIELab
                                                              32); // ie32RGB
begin
  result := PIXELFORMAT2BITCOUNT[PixelFormat];
end;

function IEPixelFormat2ChannelCount(PixelFormat: TIEPixelFormat): integer;
const
  PIXELFORMAT2CHANNELCOUNT: array [TIEPixelFormat] of integer = ( 0,   // ienull
                                                                  1,   // ie1g
                                                                  1,   // ie8p
                                                                  1,   // ie8g
                                                                  1,   // ie16g
                                                                  3,   // ie24RGB
                                                                  1,   // ie32f
                                                                  4,   // ieCMYK
                                                                  3,   // ie48RGB
                                                                  3,   // ieCIELab
                                                                  4);  // ie32RGB
begin
  result := PIXELFORMAT2CHANNELCOUNT[PixelFormat];
end;




const
  invtab: array[0..255] of byte = ($00, $80, $40, $C0, $20, $A0, $60, $E0, $10, $90, $50, $D0, $30, $B0,
    $70, $F0, $08, $88, $48, $C8, $28, $A8, $68, $E8, $18, $98, $58, $D8, $38, $B8, $78, $F8, $04, $84,
    $44, $C4, $24, $A4, $64, $E4, $14, $94, $54, $D4, $34, $B4, $74, $F4, $0C, $8C, $4C, $CC, $2C, $AC,
    $6C, $EC, $1C, $9C, $5C, $DC, $3C, $BC, $7C, $FC, $02, $82, $42, $C2, $22, $A2, $62, $E2, $12, $92,
    $52, $D2, $32, $B2, $72, $F2, $0A, $8A, $4A, $CA, $2A, $AA, $6A, $EA, $1A, $9A, $5A, $DA, $3A, $BA,
    $7A, $FA, $06, $86, $46, $C6, $26, $A6, $66, $E6, $16, $96, $56, $D6, $36, $B6, $76, $F6, $0E, $8E,
    $4E, $CE, $2E, $AE, $6E, $EE, $1E, $9E, $5E, $DE, $3E, $BE, $7E, $FE, $01, $81, $41, $C1, $21, $A1,
    $61, $E1, $11, $91, $51, $D1, $31, $B1, $71, $F1, $09, $89, $49, $C9, $29, $A9, $69, $E9, $19, $99,
    $59, $D9, $39, $B9, $79, $F9, $05, $85, $45, $C5, $25, $A5, $65, $E5, $15, $95, $55, $D5, $35, $B5,
    $75, $F5, $0D, $8D, $4D, $CD, $2D, $AD, $6D, $ED, $1D, $9D, $5D, $DD, $3D, $BD, $7D, $FD, $03, $83,
    $43, $C3, $23, $A3, $63, $E3, $13, $93, $53, $D3, $33, $B3, $73, $F3, $0B, $8B, $4B, $CB, $2B, $AB,
    $6B, $EB, $1B, $9B, $5B, $DB, $3B, $BB, $7B, $FB, $07, $87, $47, $C7, $27, $A7, $67, $E7, $17, $97,
    $57, $D7, $37, $B7, $77, $F7, $0F, $8F, $4F, $CF, $2F, $AF, $6F, $EF, $1F, $9F, $5F, $DF, $3F, $BF,
    $7F, $FF);

// reverse byte bits
procedure ReverseBitsB(var inp: byte);
begin
  inp := invtab[inp];
end;

{$ifdef IEUSEASM}
procedure ReverseBits(var inp: dword); assembler;
asm
      push esi
      push ebx
      mov  esi, eax
      mov  eax, DWord Ptr [esi]
      BSWAP   EAX
      MOV     EDX, EAX
      AND     EAX, 0AAAAAAAAh
      SHR     EAX, 1
      AND     EDX, 055555555h
      SHL     EDX, 1
      OR      EAX, EDX
      MOV     EDX, EAX
      AND     EAX, 0CCCCCCCCh
      SHR     EAX, 2
      AND     EDX, 033333333h
      SHL     EDX, 2
      OR      EAX, EDX
      MOV     EDX, EAX
      AND     EAX, 0F0F0F0F0h
      SHR     EAX, 4
      AND     EDX, 00F0F0F0Fh
      SHL     EDX, 4
      OR      EAX, EDX
      mov DWord Ptr [esi], eax
      pop    ebx
      pop    esi
end;
{$else}
procedure ReverseBits(var inp: dword);
begin
  inp := (invtab[(inp shr 24) and $FF]) or
         (invtab[(inp shr 16) and $FF] shl 8) or
         (invtab[(inp shr 8)  and $FF] shl 16) or
         (invtab[(inp)        and $FF] shl 24);
end;
{$endif}


{$ifdef IEUSEASM}
function IEPower2(const Base, Exponent: Double): Double;
const
 MAXINTFP : Extended = $7fffffff;
asm
   sub    esp,$14
   //if (Abs(Exponent) <= MaxInt) then
   fld    MAXINTFP
   fld    Exponent
   fld    st(0)
   fabs
   fcomp  st(2)
   fstsw  ax
   sahf
   ffree  st(1)
   jae    @IfEnd1
   //Y := Round(Exponent);
   fld    st(0)
   frndint
   fist   dword ptr [esp]
   fcomp  st(1)
   fstsw  ax
   sahf
   ffree  st(0)
   jnz    @IfEnd2
   //Result := IntPowerDKCIA32_4e(Base, Y)
   //if Base = 0 then
   fldz
   fld    Base
   fcom   st(1)
   fstsw  ax
   sahf
   jnz    @IntPowIfEnd2
   //if Exponent = 0 then
   mov    ecx,[esp]
   test   ecx,ecx
   jnz    @IntPowElse2
   //ResultX := 1
   ffree  st(1)
   ffree  st(0)
   fld1
   wait
   mov    esp,ebp
   pop    ebp
   ret    $10
 @IntPowElse2 :
   //ResultX := 0;
   fxch   st(1)
   ffree  st(1)
   wait
   mov    esp,ebp
   pop    ebp
   ret    $10
 @IntPowIfEnd2 :
   //else if Exponent = 0 then
   mov    ecx,[esp]
   test   ecx,ecx
   jnz    @IntPowElseIf2
   //ResultX := 1
   ffree  st(1)
   ffree  st(0)
   fld1
   wait
   mov    esp,ebp
   pop    ebp
   ret    $10
 @IntPowElseIf2 :
   //else if Exponent = 1 then
   cmp    ecx,1
   jnz    @IntPowElseIf3
   //ResultX := Base
   ffree  st(1)
   wait
   mov    esp,ebp
   pop    ebp
   ret    $10
 @IntPowElseIf3 :
   //else if Exponent = 2 then
   cmp    ecx,2
   jnz    @IntPowElseIf4
   //ResultX := Base * Base
   ffree  st(1)
   fmul   st(0),st(0)
   wait
   mov    esp,ebp
   pop    ebp
   ret    $10
 @IntPowElseIf4 :
   //else if Exponent > 2 then
   cmp    ecx,2
   jle    @IntPowElseIf5
   ffree  st(1)
   //ResultX2 := 1;
   fld1
   //ResultX := Base;
   fxch   st(1)
   mov    eax,ecx
   //I := 2;
   mov    edx,2
   //I2 := Exponent;
 @IntPowRepeat1Start :
   //I2 := I2 shr 1;
   shr    ecx,1
   jnc    @IntPowIfEnd8
   //ResultX2 := ResultX2 * ResultX;
   fmul   st(1),st(0)
 @IntPowIfEnd8 :
   //ResultX := ResultX * ResultX;
   fmul   st(0),st(0)
   //I := I * 2;
   add    edx,edx
   //until(I > Exponent);
   cmp    eax,edx
   jnl    @IntPowRepeat1Start
   //ResultX := ResultX * ResultX2;
   fmulp  st(1),st(0)
   wait
   mov    esp,ebp
   pop    ebp
   ret    $10
 @IntPowElseIf5 :
   //else if Exponent = -1 then
   cmp    ecx,-1
   jnz    @IntPowElseIf6
   ffree  st(1)
   //ResultX := 1/Base
   fld1
   fdivrp st(1),st(0)
   wait
   mov    esp,ebp
   pop    ebp
   ret    $10
 @IntPowElseIf6 :
   //else if Exponent = -2 then
   cmp    ecx,-2
   jnz    @IntPowElse7
   //ResultX := 1/(Base*Base)
   ffree  st(1)
   fmul   st(0),st(0)
   fld1
   fdivrp
   wait
   mov    esp,ebp
   pop    ebp
   ret    $10
 @IntPowElse7 :
   ffree  st(1)
   //else //if Exponent < -2 then
   //I2 := -Exponent;
   mov    eax,ecx
   neg    eax
   mov    edx,eax
   //I := 2;
   mov    ecx,2
   //ResultX2 := 1;
   fld1
   //ResultX := Base;
   fxch   st(1)
 @IntPowRepeat2Start :
   //I2 := I2 shr 1;
   shr    eax,1
   jnc    @IntPowIfEnd7
   //ResultX2 := ResultX2 * ResultX;
   fmul   st(1),st(0)
 @IntPowIfEnd7 :
   //ResultX := ResultX * ResultX;
   fmul   st(0),st(0)
   //I := I * 2;
   add    ecx,ecx
   //until(I > -Exponent);
   cmp    ecx,edx
   jle    @IntPowRepeat2Start
   //ResultX := ResultX * ResultX2;
   fmulp  st(1),st(0)
   //ResultX := 1 / ResultX;
   fld1
   fdivr
   wait
   mov    esp,ebp
   pop    ebp
   ret    $10
 @IfEnd2 :
   //Result := Exp(Exponent * Ln(Base))
   fld    Base
   fldln2
   fxch   st(1)
   fyl2x
   fld    Exponent
   fmulp
   fldl2e
   fmulp
   fld    st(0)
   frndint
   fsub   st(1),st(0)
   fxch   st(1)
   f2xm1
   fld1
   faddp
   fscale
   ffree  st(1)
   wait
   mov    esp,ebp
   pop    ebp
   ret    $10
 @IfEnd1 :
   //if (Exponent > 0) and (Base <> 0) then
   fldz
   fcom   st(1)
   fstsw  ax
   sahf
   jbe    @IfEnd3
   fld    Base
   fcom   st(1)
   fstsw  ax
   sahf
   jz     @IfEnd3
   ffree  st(1)
   //Result := Exp(Exponent * Ln(Base))
   fldln2
   fxch   st(1)
   fyl2x
   fmul   st(0), st(2)
   ffree  st(2)
   fldl2e
   fmulp
   fld    st(0)
   frndint
   fsub   st(1),st(0)
   fxch   st(1)
   f2xm1
   fld1
   faddp
   fscale
   ffree  st(1)
   wait
   mov    esp,ebp
   pop    ebp
   ret    $10
 @IfEnd3 :
   //else if Base = 0 then
   fld    Base
   fcom   st(1)
   fstsw  ax
   sahf
   ffree  st(1)
   jnz    @ElseIfEnd4
   //Result := 0
   ffree  st(2)
   wait
   mov    esp,ebp
   pop    ebp
   ret    $10
 @ElseIfEnd4 :
   //Result := Exp(Exponent * Ln(Base))
   fldln2
   fxch   st(1)
   fyl2x
   fmul   st(0),st(2)
   ffree  st(2)
   fldl2e
   fmulp
   fld    st(0)
   frndint
   fsub   st(1),st(0)
   fxch   st(1)
   f2xm1
   fld1
   faddp
   fscale
   ffree  st(1)
   wait
   mov    esp,ebp
end;
{$else}
function IEPower2(const Base, Exponent: Double): Double;
begin
  result := Power(Base, Exponent);
end;
{$endif}

// if hdd<>0 uses DibDrawDib otherwise StetchDIBits
// USE THIS ONLY ON PRINTING FUNCTION OF TIMAGEENIO
procedure DrawDibDrawEmu(hdd: THandle; hDC: THandle; xDst, yDst, dxDst, dyDst: Integer; var lpbi: TBitmapInfoHeader; Bits: Pointer; xSrc, ySrc, dxSrc, dySrc: Integer; wFlags: UInt);
var
  fr: boolean;
begin
  fr := (lpbi.biBitCount = 24) and (hdd = 0);
  if fr then
    hdd := drawdibopen;
  if hdd = 0 then
  begin
    StretchDIBits(hDC, xDst, yDst, dxDst, dyDst, xSrc, ySrc, dxSrc, dySrc, Bits, PBITMAPINFO(@lpbi)^, DIB_RGB_COLORS, SRCCOPY);
  end
  else
    DrawDibDraw(hdd, hDC, xDst, yDst, dxDst, dyDst, lpbi, Bits, xSrc, ySrc, dxSrc, dySrc, wFlags);
  if fr then
    drawdibclose(hdd);
end;

procedure DrawDib(hDC: THandle; xDst, yDst, dxDst, dyDst: Integer; var lpbi: TBitmapInfoHeader; Bits: Pointer; xSrc, ySrc, dxSrc, dySrc: Integer);
begin
  SetStretchBltMode(hDC, HALFTONE);
  StretchDIBits(hDC, xDst, yDst, dxDst, dyDst, xSrc, ySrc, dxSrc, dySrc, Bits, PBITMAPINFO(@lpbi)^, DIB_RGB_COLORS, SRCCOPY);
end;


////////////////////////////////////////////////////////////////////////////////////
// exchanges WORD [ ex result := hibyte(i) or (lobyte(i) shl 8); ]
{$ifdef IEUSEASM}
function IESwapWord(i: word): word; assembler;
asm
  ror ax,8
end;
{$else}
function IESwapWord(i: word): word;
begin
  result := (i and $FF shl 8) or (i and $FF00 shr 8);
end;
{$endif}

procedure IEChangeEndiannessWordArray(buffer: pword; items: integer);
begin
  for items := items - 1 downto 0 do
  begin
    buffer^ := (buffer^ and $FF shl 8) or (buffer^ and $FF00 shr 8);
    inc(buffer);
  end;
end;

procedure IEChangeEndiannessDWordArray(buffer: pdword; items: integer);
begin
  for items := items - 1 downto 0 do
  begin
    buffer^ := (buffer^ and $FF shl 24) or (buffer^ and $FF00 shl 8) or (buffer^ and $FF0000 shr 8) or (buffer^ and $FF000000 shr 24);
    inc(buffer);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////
// swap DWORD and int64

function IESwapDWord(i: integer): integer;
begin
  {$ifdef IEUSEASM}
  asm
     mov EAX,i
     bswap EAX
    mov @result,EAX
  end;
  {$else}
  PByteArray(@result)[0] := PByteArray(@i)[3];
  PByteArray(@result)[1] := PByteArray(@i)[2];
  PByteArray(@result)[2] := PByteArray(@i)[1];
  PByteArray(@result)[3] := PByteArray(@i)[0];
  {$endif}
end;

// cannot compile with Delphi 5 (internal error) if "result" and "i" are directly indexed
function IESwapInt64(i: int64): int64;
var
  dst, src: PByteArray;
begin
  dst := PByteArray(@result);
  src := PByteArray(@i);
  dst[0] := src[7];
  dst[1] := src[6];
  dst[2] := src[5];
  dst[3] := src[4];
  dst[4] := src[3];
  dst[5] := src[2];
  dst[6] := src[1];
  dst[7] := src[0];
end;



/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////


// changes x2, y2 to make an angle of 45° or 90° with the line to x1, y1
// useful when CTRL is pressed
procedure _CastPolySelCC(const x1, y1: integer; var x2, y2: integer);
var
  dx, dy: integer;
  adx, ady: integer;
begin
  dx := x1 - x2;
  adx := abs(dx);
  dy := y1 - y2;
  ady := abs(dy);
  if adx + 30 < ady then
    x2 := x1
  else
  if adx - 30 > ady then
    y2 := y1
  else
  begin
    if (dx < 0) and (dy < 0) then
    begin
      if (adx < ady) then
        inc(x2, abs(adx - ady))
      else
        inc(y2, abs(adx - ady));
    end
    else
    if (dx > 0) and (dy > 0) then
    begin
      if (adx < ady) then
        inc(y2, abs(adx - ady))
      else
        inc(x2, abs(adx - ady));
    end
    else
    if (dx > 0) then
    begin
      if (adx < ady) then
        dec(x2, abs(adx - ady))
      else
        inc(y2, abs(adx - ady));
    end
    else
    if (dy > 0) then
    begin
      if (adx < ady) then
        inc(x2, abs(adx - ady))
      else
        dec(y2, abs(adx - ady));
    end;
  end;
end;

// Return true if the two rectangles have a common region
// The rectangles must have ordered coordinates
function _RectXRect(ax1, ay1, ax2, ay2, bx1, by1, bx2, by2: integer): boolean;
begin
  result := not ((IMAX(ax1, ax2) < bx1) or (IMIN(ax1, ax2) > bx2) or
    (IMAX(ay1, ay2) < by1) or (IMIN(ay1, ay2) > by2));
end;

// Return "How much" the rectangle "b" is included in "a"
// 0 = no common region
// 1 = common region (not all)
// 2 = common region
// The rectangles must have ordered coordinates
function _RectPRect(ax1, ay1, ax2, ay2, bx1, by1, bx2, by2: integer): integer;
var
  vx1, vx2: boolean;
  vy1, vy2: boolean;
begin
  vx1 := (bx1 >= ax1) and (bx1 <= ax2);
  vx2 := (bx2 >= ax1) and (bx2 <= ax2);
  vy1 := (by1 >= ay1) and (by1 <= ay2);
  vy2 := (by2 >= ay1) and (by2 <= ay2);
  if (vx1 xor vx2) and (vy1 or vy2) then
    result := 1 // partial x
  else
  if (vx1 or vx2) and (vy1 xor vy2) then
    result := 1 // partial y
  else
  if (vx1 xor vx2) and (vy1 xor vy2) then
    result := 1 // partial xy
  else
  if vx1 and vx2 and vy1 and vy2 then
    result := 2 // full
  else
    result := 0; // null
end;

// return true if the point xx, yy is inside the rectangle x1, y1, x2, y2
// x1, y1, x2, y2 must be ordered
function IEPointInRect(xx, yy, x1, y1, x2, y2: integer): boolean;
begin
  result := (xx >= x1) and (xx <= x2) and (yy >= y1) and (yy <= y2);
end;

function IEPointInRect(xx, yy : integer; ARect: TRect): boolean;
begin
  Result := IEPointInRect(xx, yy, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
end;

// return true if the point xx, yy is inside the rectangle x1, y1, x2, y2
// x1, y1, x2, y2 ordered or not ordered
function _InRectO(xx, yy, x1, y1, x2, y2: integer): boolean;
begin
  OrdCor(x1, y1, x2, y2);
  result := (xx >= x1) and (xx <= x2) and (yy >= y1) and (yy <= y2);
end;


{!!
<FS>IEGetFileSize

<FM>Declaration<FC>
function IEGetFileSize(const Filename: string): int64;

<FM>Description<FN>
Returns the size of a file (even if larger than 2GB). Result is 0 if an error occured.

<FM>See Also<FN>
- <A IEGetFileDetails>
!!}
function IEGetFileSize(const Filename: string): int64;
var
  sr: TSearchRec;
begin
  if FindFirst(filename, faAnyFile, sr) = 0 then
    result := int64(sr.FindData.nFileSizeHigh) shl int64(32) + int64(sr.FindData.nFileSizeLow)
  else
    result := 0;
  FindClose(sr);
end;

// Displays the TColorDialog so the user can select a color. Result is false if user cancels out
function PromptForColor(var AColor : TColor): Boolean;
var
  cl: TColorDialog;
begin         
  Result := False;
  cl := TColorDialog.Create(nil);
  try                   
    cl.CustomColors.Clear;
    if IEGlobalSettings().ColorDialogCustomColors <> '' then
      cl.CustomColors.Text := IEGlobalSettings().ColorDialogCustomColors
    else
    begin
      cl.CustomColors.Add('ColorA=D670DA');
      cl.CustomColors.Add('ColorB=8B3D48');
      cl.CustomColors.Add('ColorC=FF901E');
      cl.CustomColors.Add('ColorD=ED9564');
      cl.CustomColors.Add('ColorE=EBCE87');
      cl.CustomColors.Add('ColorF=908070');
      cl.CustomColors.Add('ColorG=4F4F2F');
      cl.CustomColors.Add('ColorH=2F6B55');
      cl.CustomColors.Add('ColorI=008080');
      cl.CustomColors.Add('ColorJ=7FFF00');
      cl.CustomColors.Add('ColorK=00FC7C');
      cl.CustomColors.Add('ColorL=32CD9A');
      cl.CustomColors.Add('ColorM=B9DAFF');
      cl.CustomColors.Add('ColorN=00D7FF');
      cl.CustomColors.Add('ColorO=20A5DA');
      cl.CustomColors.Add('ColorP=1E69D2');
    end;

    cl.Color := AColor;

    If cl.Execute then
    begin
      AColor := cl.Color;
      Result := True;
    end;
    IEGlobalSettings().ColorDialogCustomColors := cl.CustomColors.Text
  finally      
    FreeAndNil(cl);
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////
// search for the window handle that contains cmp, going back (start from cmp)
function IEFindHandle(cmp: TComponent): HWND;
var
  xowner: TComponent;
begin
  xowner := cmp;
  while assigned(xowner) and not (xowner is TWinControl) do
    xowner := xowner.owner;
  if assigned(xowner) and (xowner as TWinControl).handleallocated then
    result := (xowner as TWinControl).Handle
  else
    result := 0;
end;


procedure IERightShadow(Canvas: TCanvas; DestBitmap: TBitmap; x1, y1, x2, y2: integer; st: TIEShadowType; dstColor: TColor);
var
  y, x, ww, hh: integer;
  cl1, cl2, cl: integer;
  o: integer;
  cl_c, radius, Temp: double;
  dstRGB: TRGB;
  cl_r, cl_g, cl_b: integer;
  //bmp: TIEBitmap;
  px: PRGB;
  bmpw, bmph: integer;
begin
  ww := x2 - x1 + 1;
  hh := y2 - y1 + 1;
  case st of
    iestSolid:
      Canvas.FillRect(Rect(x1, y1 + ww, x2, y2 + 1));
    iestSmooth1:
      begin
        bmpw := 0;
        bmph := 0;
        if assigned(DestBitmap) then
        begin
          bmpw := DestBitmap.Width;
          bmph := DestBitmap.Height;
        end;
        radius := ww/3;
        for x := 0 to ww - 1 do
        begin
          Temp := (ww-x) / radius;
          cl_c := Exp(-0.1 - Temp * Temp / 6);
          for y := y1+ww to y2-ww+x+3 do
          begin
            if assigned(DestBitmap) and (x+x1>=0) and (y>=0) and (x+x1<bmpw) and (y<bmph) then
            begin
              px := DestBitmap.Scanline[y]; inc(px, x+x1);
              with px^ do
              begin
                r := trunc(cl_c*r);
                g := trunc(cl_c*g);
                b := trunc(cl_c*b);
              end;
            end
            else
            begin
              dstRGB := TColor2TRGB( Canvas.Pixels[x1+x, y] );
              cl_r := trunc(cl_c*dstRGB.r);
              cl_g := trunc(cl_c*dstRGB.g);
              cl_b := trunc(cl_c*dstRGB.b);
              Canvas.Pixels[x1+x, y] := TColor((cl_r) + (cl_g shl 8) + (cl_b shl 16));
            end;
          end;
        end;
      end;
    iestSmooth2:
      begin
        o := 0;
        for y := 0 to hh do
        begin
          cl2 := blimit(trunc(exp((hh - y * 3) / hh) / exp(1) * 255));
          if y > hh - ww + 1 then
            inc(o);
          for x := o to ww do
          begin
            cl1 := trunc(exp(x / ww) / exp(1) * 255);
            cl := imax(cl1, cl2);
            Canvas.Pixels[x1 + x, y1 + y] := TColor((cl) + (cl shl 8) + (cl shl 16));
          end;
        end;
      end;
    (*
    iestSmooth3:
      // EXPERIMENTAL!
      begin
        o := hh+20;
        bmp := TIEBitmap.Create(o, o, ie8g);
        bmp.Fill(0);
        bmp.FillRect(10, 10, o-10, o-10, 255);
        _IEGBlurRect8(bmp, 0, 0, o-1, o-1, 4);
        for y := y1 to y2 do                     
        begin
          for x := x1 to x2 do
          begin
            dstRGB := TColor2TRGB(Canvas.Pixels[x, y]);
            cl_c := 1-bmp.Pixels_ie8[x-x1+o-10, y-y1+10]/255;
            cl_r := trunc(cl_c*dstRGB.r);
            cl_g := trunc(cl_c*dstRGB.g);
            cl_b := trunc(cl_c*dstRGB.b);
            Canvas.pixels[x, y] := TColor((cl_r) + (cl_g shl 8) + (cl_b shl 16));
          end;
        end;
        bmp.free;
      end;
    *)
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////

procedure IEBottomShadow(Canvas: TCanvas; DestBitmap: TBitmap; x1, y1, x2, y2: integer; st: TIEShadowType; dstColor: TColor);
var
  y, x, ww, hh: integer;
  cl1, cl2, cl: integer;
  o: integer;
  cl_c, radius, Temp: double;
  dstRGB: TRGB;
  cl_r, cl_g, cl_b: integer;
  bmpw, bmph: integer;
  px: PRGB;
begin
  ww := x2 - x1 + 1;
  hh := y2 - y1 + 1;
  case st of
    iestSolid:
      Canvas.FillRect(Rect(x1 + hh, y1, x2 + 1, y2));
    iestSmooth1:
      begin
        bmpw := 0;
        bmph := 0;
        if assigned(DestBitmap) then
        begin
          bmpw := DestBitmap.Width;
          bmph := DestBitmap.Height;
        end;
        px := nil;
        radius := hh/3;
        for y := 0 to hh - 1 do
        begin
          Temp := (y-hh) / radius;
          cl_c := Exp(-0.1 - Temp * Temp / 6);
          if assigned(DestBitmap) and (y+y1>0) and (y+y1<bmph) then
          begin
            px := DestBitmap.Scanline[y+y1];
            inc(px, x1+hh);
          end;
          for x := x1+hh to x2-hh+y+1 do
          begin
            if assigned(DestBitmap) and (x>=0) and (y+y1>=0) and (x<bmpw) and (y+y1<bmph) then
            begin
              with px^ do
              begin
                r := trunc(cl_c*r);
                g := trunc(cl_c*g);
                b := trunc(cl_c*b);
              end;
              inc(px);
            end
            else
            begin
              dstRGB := TColor2TRGB( Canvas.Pixels[x, y1+y] );
              cl_r := trunc(cl_c*dstRGB.r);
              cl_g := trunc(cl_c*dstRGB.g);
              cl_b := trunc(cl_c*dstRGB.b);
              Canvas.Pixels[x, y1+y] := TColor((cl_r) + (cl_g shl 8) + (cl_b shl 16));
            end;
          end;
        end;
      end;
    iestSmooth2:
      begin
        o := 0;
        for x := 0 to ww do
        begin
          cl2 := blimit(trunc(exp((ww - x * 3) / ww) / exp(1) * 255));
          if x > ww - hh + 1 then
            inc(o);
          for y := o to hh do
          begin
            cl1 := trunc(exp(y / hh) / exp(1) * 255);
            cl := imax(cl1, cl2);
            Canvas.Pixels[x1 + x, y1 + y] := TColor((cl) + (cl shl 8) + (cl shl 16));
          end;
        end;
      end;
  end;
end;

procedure IERectShadow(Bitmap: TBitmap; x1, y1, x2, y2: integer; dstColor: TColor);
var
  ww, hh: integer;
  bmp: TIEBitmap;
  cl_c: double;
  radius: integer;
  bmpw, bmph: integer;
  pb: pbyte;
  px: PRGB;
  x, y: integer;
  offx, offy: integer;
begin
  radius := 5;
  offx := 2;
  offy := 2;

  bmpw := Bitmap.Width;
  bmph := Bitmap.Height;
  ww := x2 - x1 + 1;
  hh := y2 - y1 + 1;
  bmp := TIEBitmap.Create(ww+radius*2, hh+radius*2, ie8g);
  bmp.Fill(0);
  bmp.FillRect(radius, radius, ww+radius-1+offx, hh+radius-1+offy, 255);
  _IEGBlurRect8(bmp, 0, 0, ww+radius*2-1, hh+radius*2-1, radius/2);
  for y := y1-radius to y2+radius do
  begin
    if (y>=0) and (y<bmph) then
    begin
      px := Bitmap.Scanline[y]; inc(px, x1-radius);
      pb := bmp.Scanline[y-y1+radius];
      for x := x1-radius to x2+radius do
      begin
        if (x>=0) and (x<bmpw) and ((x<x1) or (x>=x2) or (y<y1) or (y>=y2)) then
        begin
          cl_c := 1-pb^/255;
          with px^ do
          begin
            r := trunc(cl_c*r);
            g := trunc(cl_c*g);
            b := trunc(cl_c*b);
          end;
        end;
        inc(px);
        inc(pb);
      end;
    end;
  end;
  bmp.free;
end;

/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////


// Saves the string ss to Stream. Saves the size (integer) then the string.
// Compatible with LoadStringFromStream
procedure IESaveStringToStream(Stream: TStream; const ss: AnsiString);
var
  i: integer;
begin
  i := length(ss);
  Stream.Write(i, sizeof(integer));
  Stream.Write(PAnsiChar(ss)^, i);
end;

// Loads a string from Stream. Compatible with SaveStringToStream
procedure IELoadStringFromStream(Stream: TStream; var ss: AnsiString);
var
  i: integer;
begin
  Stream.Read(i, sizeof(integer));
  SetLength(ss, i);
  Stream.Read(PAnsiChar(ss)^, i);
end;

{$IfDef UNICODE}
// Saves the string ss to Stream. Saves the size (integer) then the string.
// Compatible with LoadStringFromStream
procedure IESaveStringToStream(Stream: TStream; const ss: UnicodeString);
var
  strLen: integer;
begin
  strLen := Length( ss );
  Stream.Write( strLen, sizeof( integer ));
  if strLen > 0 then
    Stream.Write( ss[1], strLen * SizeOf( ss[1] ));
end;

// Loads a string from Stream. Compatible with SaveStringToStream
procedure IELoadStringFromStream(Stream: TStream; var ss: UnicodeString);
var
  strLen: integer;
begin
  Stream.Read( strLen, sizeof(integer));
  SetLength( ss, strLen );
  if strLen > 0 then
    Stream.Read( ss[1], strLen * SizeOf( ss[1] ));
end;
{$EndIf}

// Saves the string ss to Stream. Saves the size (integer) then the string.
// Compatible with LoadStringFromStreamW
procedure IESaveStringToStreamW(Stream: TStream; const ss: widestring);
var
  i: integer;
begin
  i := length(ss);
  Stream.Write(i, sizeof(integer));
  Stream.Write(ss[1], i*2);
end;

// Loads a string from Stream. Compatible with SaveStringToStreamW
procedure IELoadStringFromStreamW(Stream: TStream; var ss: widestring);
var
  i: integer;
begin
  Stream.Read(i, sizeof(integer));
  SetLength(ss, i);
  Stream.Read(ss[1], i*2);
end;


procedure IELoadStringFromStreamW(Stream: TStream; var ss: String);
var
  ws: Widestring;
begin
  IELoadStringFromStreamW( Stream, ws );
  ss := ws;
end;


procedure IESaveStringListToStream(Stream: TStream; sl: TStringList);
var
  i: integer;
begin
  i := sl.Count;
  Stream.Write(i, sizeof(integer));
  for i := 0 to sl.Count - 1 do
    IESaveStringToStream(Stream, AnsiString(sl[i]));
end;

procedure IELoadStringListFromStream(Stream: TStream; sl: TStringList);
var
  i, w: integer;
  ss: AnsiString;
begin
  Stream.Read(w, sizeof(integer));
  sl.Clear;
  for i := 0 to w - 1 do
  begin
    IELoadStringFromStream(Stream, ss);
    sl.Add(string(ss));
  end;
end;


procedure IELoadFontFromStream(Stream: TStream; var Font: TFont);
var
  fontName    : string;
  fontCharset : TFontCharset;
  fontColor   : TColor;
  fontHeight  : Integer;
  fontStyle   : TFontStyles;
begin
  IELoadStringFromStreamW(Stream, fontName);
  Font.Name := fontName;
  Stream.Read( fontCharset , SizeOf( TFontCharset ));
  Font.Charset := fontCharset;
  Stream.Read( fontColor   , SizeOf( TColor ));
  Font.Color := fontColor ;
  Stream.Read( fontHeight  , SizeOf( Integer ));
  Font.Height := fontHeight;
  Stream.Read( fontStyle   , SizeOf( TFontStyles ));
  Font.Style := fontStyle;
end;

procedure IESaveFontToStream(Stream: TStream; const Font: TFont);
var
  fontName    : string;
  fontCharset : TFontCharset;
  fontColor   : TColor;
  fontHeight  : Integer;
  fontStyle   : TFontStyles;
begin
  fontName := Font.Name;
  IESaveStringToStreamW(Stream, fontName);
  fontCharset := Font.Charset;
  Stream.Write( fontCharset , SizeOf( TFontCharset ));
  fontColor := Font.Color;
  Stream.Write( fontColor   , SizeOf( TColor ));
  fontHeight := Font.Height;
  Stream.Write( fontHeight  , SizeOf( Integer ));
  fontStyle := Font.Style;
  Stream.Write( fontStyle   , SizeOf( TFontStyles ));
end;

// Returns number of colors calculated from BitsPerSample and SamplesperPixel
function _GetNumCol(BitsPerSample: integer; SamplesPerPixel: integer): integer;
begin
  result := 1;
  while SamplesPerPixel > 0 do
  begin
    result := result * (1 shl BitsPerSample);
    dec(SamplesPerPixel);
  end;
end;


procedure IEBlendRGBA(var src: TRGBA; var dst: TRGBA; RenderOperation: TIERenderOperation; row: integer);
var
  osrc, odst: TRGB;
begin
  osrc.r := src.r;
  osrc.g := src.g;
  osrc.b := src.b;
  odst.r := dst.r;
  odst.g := dst.g;
  odst.b := dst.b;
  IEBlend(osrc, odst, RenderOperation, row);
  src.r := osrc.r;
  src.g := osrc.g;
  src.b := osrc.b;
  dst.r := odst.r;
  dst.g := odst.g;
  dst.b := odst.b;
end;


procedure IEBlend(var src: TRGB; var dst: TRGB; RenderOperation: TIERenderOperation; row: integer);
// filters
  function softlight(ib, ia: integer): integer; {$ifdef IESUPPORTINLINE} inline; {$endif}
  var
    a, b, r: double;
  begin
    a := ia / 255;
    b := ib / 255;
    if b < 0.5 then
      r := 2 * a * b + sqr(a) * (1 - 2 * b)
    else
      r := sqrt(a) * (2 * b - 1) + (2 * a) * (1 - b);
    result := trunc(r * 255);
  end;

  function xfader(b, a: integer): integer; {$ifdef IESUPPORTINLINE} inline; {$endif}
  var
    c: integer;
  begin
    c := a * b shr 8;
    result := c + a * (255 - ((255 - a) * (255 - b) shr 8) - c) shr 8;
  end;

  function coloredge(b, a: integer): integer; {$ifdef IESUPPORTINLINE} inline; {$endif}
  var
    c: integer;
  begin
    if b = 255 then
      result := 255
    else
    begin
      c := (a shl 8) div (255 - b);
      if c > 255 then
        result := 255
      else
        result := c;
    end;
  end;

  function colorburn(b, a: integer): integer; {$ifdef IESUPPORTINLINE} inline; {$endif}
  var
    c: integer;
  begin
    if b = 0 then
      result := 0
    else
    begin
      c := 255 - (((255 - a) shl 8) div b);
      if c < 0 then
        result := 0
      else
        result := c;
    end;
  end;

  function inversecolordodge(b, a: integer): integer; {$ifdef IESUPPORTINLINE} inline; {$endif}
  var
    c: integer;
  begin
    if a = 255 then
      result := 255
    else
    begin
      c := (b shl 8) div (255 - a);
      if c > 255 then
        result := 255
      else
        result := c;
    end;
  end;

  function inversecolorburn(b, a: integer): integer; {$ifdef IESUPPORTINLINE} inline; {$endif}
  var
    c: integer;
  begin
    if a = 0 then
      result := 0
    else
    begin
      c := 255 - (((255 - b) shl 8) div a);
      if c < 0 then
        result := 0
      else
        result := c;
    end;
  end;

  function softdodge(b, a: integer): integer; {$ifdef IESUPPORTINLINE} inline; {$endif}
  var
    c: integer;
  begin
    if a + b < 256 then
    begin
      if b = 255 then
        result := 255
      else
      begin
        c := (a shl 7) div (255 - b);
        if c > 255 then
          result := 255
        else
          result := c;
      end;
    end
    else
    begin
      c := 255 - (((255 - b) shl 7) div a);
      if c < 0 then
        result := 0
      else
        result := c;
    end;
  end;

  function softburn(b, a: integer): integer; {$ifdef IESUPPORTINLINE} inline; {$endif}
  var
    c: integer;
  begin
    if a + b < 256 then
    begin
      if a = 255 then
        Result := 255
      else
      begin
        c := (b shl 7) div (255 - a);
        if c > 255 then
          Result := 255
        else
          Result := c;
      end;
    end
    else
    begin
      c := 255 - (((255 - a) shl 7) div b);
      if c < 0 then
        Result := 0
      else
        Result := c;
    end;
  end;

  function reflect(b, a: integer): integer; {$ifdef IESUPPORTINLINE} inline; {$endif}
  var
    c: integer;
  begin
    if b = 255 then
      result := 255
    else
    begin
      c := a * a div (255 - b);
      if c > 255 then
        result := 255
      else
        result := c;
    end;
  end;

  function glow(b, a: integer): integer; {$ifdef IESUPPORTINLINE} inline; {$endif}
  var
    c: integer;
  begin
    if a = 255 then
      result := 255
    else
    begin
      c := b * b div (255 - a);
      if c > 255 then
        result := 255
      else
        result := c;
    end;
  end;

  function freeze(b, a: integer): integer; {$ifdef IESUPPORTINLINE} inline; {$endif}
  var
    c: integer;
  begin
    if b = 0 then
      result := 0
    else
    begin
      c := 255 - sqr(255 - a) div b;
      if c < 0 then
        result := 0
      else
        result := c;
    end;
  end;

  function eat(b, a: integer): integer; {$ifdef IESUPPORTINLINE} inline; {$endif}
  var
    c: integer;
  begin
    if a = 0 then
      result := 0
    else
    begin
      c := 255 - sqr(255 - b) div a;
      if c < 0 then
        result := 0
      else
        result := c;
    end;
  end;

  function interpolation(b, a: integer): integer; {$ifdef IESUPPORTINLINE} inline; {$endif}
  var
    c: integer;
  begin
    c := IECosineTab[b] + IECosineTab[a];
    if c > 255 then
      result := 255
    else
      result := c;
  end;
  
  function stamp(b, a: integer): integer; {$ifdef IESUPPORTINLINE} inline; {$endif}
  var
    c: integer;
  begin
    c := a + 2 * b - 256;
    if c < 0 then
      result := 0
    else
    if c > 255 then
      result := 255
    else
      result := c;
  end;
  //
var
  Ha, Sa, La: double;
  Hb, Sb, Lb: double;
  tmp: TRGB;
  v1, v2: byte;
  Y_1, Cb_1, Cr_1: integer;
  Y_2, Cb_2, Cr_2: integer;
  RedToGrayCoef, GreenToGrayCoef, BlueToGrayCoef: integer;
begin
  case RenderOperation of
    ielNormal:
      begin
        dst := src;
      end;
    ielAdd:
      begin
        dst.r := blimit(dst.r + src.r);
        dst.g := blimit(dst.g + src.g);
        dst.b := blimit(dst.b + src.b);
      end;
    ielSub:
      begin
        dst.r := abs(dst.r - src.r);
        dst.g := abs(dst.g - src.g);
        dst.b := abs(dst.b - src.b);
      end;
    ielDiv:
      begin
        dst.r := blimit(dst.r div ilimit(src.r, 1, 255));
        dst.g := blimit(dst.g div ilimit(src.g, 1, 255));
        dst.b := blimit(dst.b div ilimit(src.b, 1, 255));
      end;
    ielMul:
      begin
        dst.r := (dst.r * src.r) shr 8;
        dst.g := (dst.g * src.g) shr 8;
        dst.b := (dst.b * src.b) shr 8;
      end;
    ielOR:
      begin
        dst.r := blimit(dst.r or src.r);
        dst.g := blimit(dst.g or src.g);
        dst.b := blimit(dst.b or src.b);
      end;
    ielAND:
      begin
        dst.r := blimit(dst.r and src.r);
        dst.g := blimit(dst.g and src.g);
        dst.b := blimit(dst.b and src.b);
      end;
    ielXOR:
      begin
        dst.r := blimit(dst.r xor src.r);
        dst.g := blimit(dst.g xor src.g);
        dst.b := blimit(dst.b xor src.b);
      end;
    ielMAX:
      begin
        dst.r := imax(dst.r, src.r);
        dst.g := imax(dst.g, src.g);
        dst.b := imax(dst.b, src.b);
      end;
    ielMIN:
      begin
        dst.r := imin(dst.r, src.r);
        dst.g := imin(dst.g, src.g);
        dst.b := imin(dst.b, src.b);
      end;
    ielAverage:
      begin
        dst.r := (dst.r + src.r) shr 1;
        dst.g := (dst.g + src.g) shr 1;
        dst.b := (dst.b + src.b) shr 1;
      end;
    ielScreen:
      begin
        dst.r := trunc( 255 - ((255 - dst.r) * (255 - src.r) / 255) );
        dst.g := trunc( 255 - ((255 - dst.g) * (255 - src.g) / 255) );
        dst.b := trunc( 255 - ((255 - dst.b) * (255 - src.b) / 255) );
      end;
    ielNegation:
      begin
        dst.r := 255 - abs(255 - src.r - dst.r);
        dst.g := 255 - abs(255 - src.g - dst.g);
        dst.b := 255 - abs(255 - src.b - dst.b);
      end;
    ielExclusion:
      begin
        dst.r := src.r + dst.r - (src.r * dst.r shr 7);
        dst.g := src.g + dst.g - (src.g * dst.g shr 7);
        dst.b := src.b + dst.b - (src.b * dst.b shr 7);
      end;
    ielOverlay:
      begin
        if dst.r < 128 then
          dst.r := (src.r * dst.r) shr 7
        else
          dst.r := 255 - ((255 - src.r) * (255 - dst.r) shr 7);
        if dst.g < 128 then
          dst.g := (src.g * dst.g) shr 7
        else
          dst.g := 255 - ((255 - src.g) * (255 - dst.g) shr 7);
        if dst.b < 128 then
          dst.b := (src.b * dst.b) shr 7
        else
          dst.b := 255 - ((255 - src.b) * (255 - dst.b) shr 7);
      end;
    ielHardLight:
      begin
        if src.r < 128 then
          dst.r := (src.r * dst.r) shr 7
        else
          dst.r := 255 - ((255 - src.r) * (255 - dst.r) shr 7);
        if src.g < 128 then
          dst.g := (src.g * dst.g) shr 7
        else
          dst.g := 255 - ((255 - src.g) * (255 - dst.g) shr 7);
        if src.b < 128 then
          dst.b := (src.b * dst.b) shr 7
        else
          dst.b := 255 - ((255 - src.b) * (255 - dst.b) shr 7);
      end;
    ielSoftLight:
      begin
        dst.r := softlight(src.r, dst.r);
        dst.g := softlight(src.r, dst.g);
        dst.b := softlight(src.r, dst.b);
      end;
    ielXFader:
      begin
        dst.r := XFader(src.r, dst.r);
        dst.g := XFader(src.g, dst.g);
        dst.b := XFader(src.b, dst.b);
      end;
    ielColorEdge:
      begin
        dst.r := ColorEdge(src.r, dst.r);
        dst.g := ColorEdge(src.g, dst.g);
        dst.b := ColorEdge(src.b, dst.b);
      end;
    ielColorBurn:
      begin
        dst.r := ColorBurn(src.r, dst.r);
        dst.g := ColorBurn(src.g, dst.g);
        dst.b := ColorBurn(src.b, dst.b);
      end;
    ielInverseColorDodge:
      begin
        dst.r := InverseColorDodge(src.r, dst.r);
        dst.g := InverseColorDodge(src.g, dst.g);
        dst.b := InverseColorDodge(src.b, dst.b);
      end;
    ielInverseColorBurn:
      begin
        dst.r := InverseColorBurn(src.r, dst.r);
        dst.g := InverseColorBurn(src.g, dst.g);
        dst.b := InverseColorBurn(src.b, dst.b);
      end;
    ielSoftDodge:
      begin
        dst.r := SoftDodge(src.r, dst.r);
        dst.g := SoftDodge(src.g, dst.g);
        dst.b := SoftDodge(src.b, dst.b);
      end;
    ielSoftBurn:
      begin
        dst.r := SoftBurn(src.r, dst.r);
        dst.g := SoftBurn(src.g, dst.g);
        dst.b := SoftBurn(src.b, dst.b);
      end;
    ielReflect:
      begin
        dst.r := Reflect(src.r, dst.r);
        dst.g := Reflect(src.g, dst.g);
        dst.b := Reflect(src.b, dst.b);
      end;
    ielGlow:
      begin
        dst.r := Glow(src.r, dst.r);
        dst.g := Glow(src.g, dst.g);
        dst.b := Glow(src.b, dst.b);
      end;
    ielFreeze:
      begin
        dst.r := Freeze(src.r, dst.r);
        dst.g := Freeze(src.g, dst.g);
        dst.b := Freeze(src.b, dst.b);
      end;
    ielEat:
      begin
        dst.r := Eat(src.r, dst.r);
        dst.g := Eat(src.g, dst.g);
        dst.b := Eat(src.b, dst.b);
      end;
    ielSubtractive:
      begin
        dst.r := blimit(dst.r + src.r - 256);
        dst.g := blimit(dst.g + src.g - 256);
        dst.b := blimit(dst.b + src.b - 256);
      end;
    ielInterpolation:
      begin
        dst.r := Interpolation(src.r, dst.r);
        dst.g := Interpolation(src.g, dst.g);
        dst.b := Interpolation(src.b, dst.b);
      end;
    ielStamp:
      begin
        dst.r := Stamp(src.r, dst.r);
        dst.g := Stamp(src.g, dst.g);
        dst.b := Stamp(src.b, dst.b);
      end;
    ielRed:
      begin
        dst.r := src.r;
      end;
    ielGreen:
      begin
        dst.g := src.g;
      end;
    ielBlue:
      begin
        dst.b := src.b;
      end;
    ielHue:
      begin
        RGB2HSL(src, Ha, Sa, La);
        RGB2HSL(dst, Hb, Sb, Lb);
        HSL2RGB(dst, Ha, Sb, Lb);
      end;
    ielSaturation:
      begin
        RGB2HSL(src, Ha, Sa, La);
        RGB2HSL(dst, Hb, Sb, Lb);
        HSL2RGB(dst, Hb, Sa, Lb);
      end;
    ielColor:
      begin
        RGB2HSL(src, Ha, Sa, La);
        RGB2HSL(dst, Hb, Sb, Lb);
        HSL2RGB(dst, Ha, Sa, Lb);
      end;
    ielLuminosity:
      begin
        RGB2HSL(src, Ha, Sa, La);
        RGB2HSL(dst, Hb, Sb, Lb);
        HSL2RGB(dst, Hb, Sb, La);
      end;
    ielLuminosity2:
      begin
        IERGB2YCbCr(src, Y_1, Cb_1, Cr_1);
        IERGB2YCbCr(dst, Y_2, Cb_2, Cr_2);
        IEYCbCr2RGB(dst, Y_1, Cb_2, Cr_2);
      end;
    ielStereoBW:   // black&white
      begin
        RedToGrayCoef   := IEGlobalSettings().RedToGrayCoef;
        GreenToGrayCoef := IEGlobalSettings().GreenToGrayCoef;
        BlueToGrayCoef  := IEGlobalSettings().BlueToGrayCoef;
        v1 := (src.r * RedToGrayCoef + src.g * GreenToGrayCoef + src.b * BlueToGrayCoef) div 100;
        v2 := (dst.r * RedToGrayCoef + dst.g * GreenToGrayCoef + dst.b * BlueToGrayCoef) div 100;
        dst.r := v2;
        dst.g := v1;
        dst.b := v1;
      end;
    ielStereoColor:
      begin
        dst.r := dst.r;
        dst.g := src.g;
        dst.b := src.b;
      end;
    ielStereoColorDubois:
      begin
        tmp.r := blimit(round(
          0.456100*dst.r
         +0.500484*dst.g
         +0.176381*dst.b
         -0.0434706*src.r
         -0.0879388*src.g
         -0.00155529*src.b));
        tmp.g := blimit(round(
         -0.0400822*dst.r
         -0.0378246*dst.g
         -0.0157589*dst.b
         +0.378476*src.r
         +0.73364*src.g
         -0.0184503*src.b));
        tmp.b := blimit(round(
         -0.0152161*dst.r
         -0.0205971*dst.g
         -0.00546856*dst.b
         -0.0721527*src.r
         -0.112961*src.g
         +1.2264*src.b));
        dst := tmp;
      end;
    ielStereoEven:
      if not Odd(row) then
        dst := src;
    ielStereoOdd:
      if Odd(row) then
        dst := src;   end;
end;



////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////
// TIEScrollBarParams

constructor TIEScrollBarParams.Create;
begin
  inherited Create;
  fLineStep := -1;
  fPageStep := -1;
  fTracking := true;
end;

destructor TIEScrollBarParams.Destroy;
begin
  inherited;
end;

////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////

constructor TIEMouseWheelParams.Create(DefaultAction : TIEMouseWheelParamsAction);
begin
  inherited Create;

  InvertDirection := false;
  Action          := DefaultAction;
  Variation       := iemwPercentage;
  Value           := 8;
  ZoomPosition    := iemwCenter;
end;

destructor TIEMouseWheelParams.Destroy;
begin
  inherited;
end;

procedure TIEMouseWheelParams.Assign(Source: TPersistent);
begin
  if Source is TIEMouseWheelParams then
  begin
    InvertDirection := TIEMouseWheelParams( Source ).InvertDirection;
    Action          := TIEMouseWheelParams( Source ).Action         ;
    Variation       := TIEMouseWheelParams( Source ).Variation      ;
    Value           := TIEMouseWheelParams( Source ).Value          ;
    ZoomPosition    := TIEMouseWheelParams( Source ).ZoomPosition   ;
  end
  else
    inherited;
end;


///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////

function IEIsRemoteSession(): boolean;
const
  SM_REMOTESESSION = $1000;
begin
  result := Windows.GetSystemMetrics( SM_REMOTESESSION ) <> 0;
end;



///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// Base64 support

const
  encoding_table: array [0..63] of AnsiChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

procedure IEEncodeBlock64(xin: pbytearray; xout: PAnsiChar; len: integer);
begin
  xout[0] := encoding_table[ xin[0] shr 2 ];
  xout[1] := encoding_table[ ((xin[0] and $03) shl 4) or ((xin[1] and $f0) shr 4) ];
  if len > 1 then
    xout[2] := encoding_table[ ((xin[1] and $0f) shl 2) or ((xin[2] and $c0) shr 6) ]
  else
    xout[2] := '=';
  if len > 2 then
    xout[3] := encoding_table[ xin[2] and $3f ]
  else
    xout[3] := '=';
end;

procedure IEEncode64(SrcStream: TStream; DstStream: TStream; linesize: integer);
var
  xin: array [0..2] of byte;
  xout: array [0..3] of AnsiChar;
  i, len, blocksout: integer;
  SrcStreamSize: int64;
begin
  SrcStreamSize := SrcStream.Size;
  blocksout := 0;
  while SrcStream.Position < SrcStreamSize do
  begin
    len := 0;
    for i := 0 to 2 do
    begin
      if SrcStream.Position < SrcStreamSize then
      begin
        SrcStream.Read(xin[i], 1);
        inc(len);
      end
      else
        xin[i] := 0;
    end;
    if len > 0 then
    begin
      IEEncodeBlock64(@xin, xout, len);
      DstStream.Write(xout[0], 4);
      inc(blocksout);
    end;
    if (blocksout >= (linesize / 4)) or (SrcStream.Position >= SrcStreamSize) then
    begin
      if blocksout > 0 then
        IEStreamWriteLn(DstStream, '');
      blocksout := 0;
    end;
  end;
end;

function IEEncode64(SrcBuffer: pbyte; SrcBufferLength: integer; linesize: integer): AnsiString;
var
  srcStream: TIEMemStream;
  dstStream: TMemoryStream;
begin
  srcStream := TIEMemStream.Create(SrcBuffer, SrcBufferLength);
  dstStream := TMemoryStream.Create();
  try
    IEEncode64(srcStream, dstStream, linesize);
    SetLength(result, dstStream.size);
    CopyMemory(@result[1], dstStream.Memory, dstStream.Size);
  finally
    dstStream.Free();
    srcStream.Free();
  end;
end;


procedure IEDecode64(SrcStream: TStream; DstStream: TStream);
const
  mod_table: array [0..2] of integer = (0, 2, 1);
  EQCHR: byte = ord('=');
var
  decoding_table: array of byte;
  i: integer;
  input_length: int64;
  data: TIEBufferedReadStream;
  sextet_a: dword;
  sextet_b: dword;
  sextet_c: dword;
  sextet_d: dword;
  triple: dword;
  b: byte;

  procedure NextByte();
  begin
    while i < input_length do
    begin
      data.Read(b, 1);
      inc(i);
      if not IEIsSpace(AnsiChar(b)) then
        break;
      b := 0; // in case "i = input_length" we returns always 0
    end;
  end;

begin
  data := TIEBufferedReadStream.Create(SrcStream, 8192);
  try
    input_length  := data.Size;

    SetLength(decoding_table, 256);
    for i := 0 to 63 do
      decoding_table[ord(encoding_table[i])] := i;
    decoding_table[EQCHR] := 0; // '=' -> 0

    i := 0;
    while i < input_length do
    begin
      NextByte();
      sextet_a := decoding_table[b];

      NextByte();
      sextet_b := decoding_table[b];

      NextByte();
      sextet_c := decoding_table[b];

      NextByte();
      sextet_d := decoding_table[b];

      triple := (sextet_a shl 18) + (sextet_b shl 12) + (sextet_c shl 6) + sextet_d;

      IEStreamWriteByte(DstStream, (triple shr 16) and $FF);
      IEStreamWriteByte(DstStream, (triple shr 8) and $FF);
      IEStreamWriteByte(DstStream, triple and $FF);
    end;
  finally
    data.Free();
  end;
end;

function IEDecode64(SrcString: AnsiString): TIEArrayOfByte;
var
  srcStream: TIEMemStream;
  dstStream: TMemoryStream;
begin
  srcStream := TIEMemStream.Create(@SrcString[1], length(SrcString));
  dstStream := TMemoryStream.Create();
  try
    IEDecode64(srcStream, dstStream);
    SetLength(result, dstStream.Size);
    CopyMemory(@result[0], dstStream.Memory, dstStream.Size);
  finally
    dstStream.Free();
    srcStream.Free();
  end;
end;



// Base64 support
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////


const
  WSB_PROP_CYVSCROLL  =$00000001;
  WSB_PROP_CXHSCROLL  =$00000002;
  WSB_PROP_CYHSCROLL  =$00000004;
  WSB_PROP_CXVSCROLL  =$00000008;
  WSB_PROP_CXHTHUMB   =$00000010;
  WSB_PROP_CYVTHUMB   =$00000020;
  WSB_PROP_VBKGCOLOR  =$00000040;
  WSB_PROP_HBKGCOLOR  =$00000080;
  WSB_PROP_VSTYLE     =$00000100;
  WSB_PROP_HSTYLE     =$00000200;
  WSB_PROP_WINSTYLE   =$00000400;
  WSB_PROP_PALETTE    =$00000800;
  WSB_PROP_MASK       =$00000FFF;

  FSB_FLAT_MODE        =   2;
  FSB_ENCARTA_MODE     =   1;
  FSB_REGULAR_MODE     =   0;

procedure IESetScrollBar(hWnd: HWND; nBar: integer; nMinPos: integer; nMaxPos: integer; PageSize: integer; nPos: integer; bRedraw: boolean; flat: boolean = False);
var
  ScrollInfo: TScrollInfo;
begin
  FillChar(ScrollInfo, sizeof(ScrollInfo), 0);
  ScrollInfo.cbSize := SizeOf(ScrollInfo);
  ScrollInfo.fMask := SIF_RANGE or SIF_POS or SIF_PAGE;
  ScrollInfo.nMin := nMinPos;
  ScrollInfo.nMax := nMaxPos;
  ScrollInfo.nPos := nPos;
  ScrollInfo.nPage := PageSize;
  IESetScrollInfo(hWnd, nBar, ScrollInfo, bRedraw, flat);
end;


// 3.0.3
function IESetScrollRange(hWnd: HWND; nBar, nMinPos, nMaxPos: Integer; bRedraw: BOOL; flat: boolean): BOOL;
var
  ScrollInfo: TScrollInfo;
begin
  FillChar(ScrollInfo, sizeof(ScrollInfo), 0);
  ScrollInfo.cbSize := SizeOf(ScrollInfo);
  ScrollInfo.fMask := SIF_RANGE;
  ScrollInfo.nMin := nMinPos;
  ScrollInfo.nMax := nMaxPos;
  IESetScrollInfo(hWnd, nBar, ScrollInfo, bRedraw, flat);
  result := true;
end;

// 3.0.3
function IESetScrollPos(hWnd: HWND; nBar, nPos: Integer; bRedraw: BOOL; flat: boolean): Integer;
var
  ScrollInfo: TScrollInfo;
begin
  FillChar(ScrollInfo, sizeof(ScrollInfo), 0);
  ScrollInfo.cbSize := SizeOf(ScrollInfo);
  ScrollInfo.fMask := SIF_POS;
  ScrollInfo.nPos := nPos;
  result := IESetScrollInfo(hWnd, nBar, ScrollInfo, bRedraw, flat);
end;

// Set cursor size (pagesize) of a scroll bar
// fnBar can be SB_HORZ or SB_VERT
procedure IESetSBPageSize(HScrollBar: THandle; fnBar: integer; PageSize: Integer; Redraw: boolean; flat: boolean);
var
  ScrollInfo: TScrollInfo;
begin
  FillChar(ScrollInfo, sizeof(ScrollInfo), 0);
  ScrollInfo.cbSize := Sizeof(ScrollInfo);
  ScrollInfo.fMask := SIF_PAGE;
  ScrollInfo.nPage := PageSize;
  IESetScrollInfo(HScrollBar, fnBar, ScrollInfo, Redraw, flat);
end;

function IESetScrollInfo(hWnd: HWND; BarFlag: Integer; const ScrollInfo: TScrollInfo; Redraw: BOOL; flat: boolean): Integer;
begin
  {$ifdef IEINCLUDEFLATSB}
  if flat then
    result := FlatSB_SetScrollInfo(hWnd, BarFlag, ScrollInfo, Redraw)
  else
    result := SetScrollInfo(hWnd, BarFlag, ScrollInfo, Redraw);
  {$else}
  result := SetScrollInfo(hWnd, BarFlag, ScrollInfo, Redraw);
  {$endif}
end;

function IEEnableScrollBar(hWnd: HWND; wSBflags, wArrows: UINT; flat: boolean = False): BOOL;
begin
  {$ifdef IEINCLUDEFLATSB}
  if flat then
  begin
    result := FlatSB_EnableScrollBar(hWnd, wSBflags, wArrows);
  end
  else
    result := EnableScrollBar(hWnd, wSBflags, wArrows);
  {$else}
  result := EnableScrollBar(hWnd, wSBflags, wArrows);
  {$endif}
end;

function IEShowScrollBar(hWnd: HWND; wBar: Integer; bShow: BOOL; flat: boolean = False): BOOL;
begin
  {$ifdef IEINCLUDEFLATSB}
  if flat then
  begin
    result := FlatSB_ShowScrollBar(hWnd, wBar, bShow);
  end
  else
    result := ShowScrollBar(hWnd, wBar, bShow);
  {$else}
  result := ShowScrollBar(hWnd, wBar, bShow);
  {$endif}
end;





{!!
<FS>GetImageSizeWithinArea

<FM>Declaration<FC>
function GetImageSizeWithinArea(iImageWidth, iImageHeight : integer;           
                                iAvailableWidth, iAvailableHeight : integer;   
                                bAllowStretching : boolean = TRUE;
                                FitMethod: <A TFitMethod> = _fmFitWithinRect
                                ): TPoint;

<FM>Description<FN>
Return the new size of an image we wish to fit within an area of size iAvailableWidth x iAvailableHeight while maintaining the original aspect ratio

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>iImageWidth, iImageHeight<FN></C> <C>The dimensions of the image</C> </R>
<R> <C><FC>iAvailableWidth, iAvailableHeight<FN></C> <C>The space available for the image (e.g. the client area of a display control, such as a TImageEnView)</C> </R>
<R> <C><FC>bAllowStretching<FN></C> <C>If the image is smaller than the available area it will be stretched to the full available size (otherwise result is the original width/height)</C> </R>
<R> <C><FC>FitMethod<FN></C> <C>Generally _fmFitWithinRect, but _fmFillRect_WithOverlap will return an image that makes the image as large as possible without any border area (so one dimension will match the available size, and the other will generally be larger)</C> </R>
</TABLE>

<FM>See Also<FN>
- <A GetImageRectWithinArea>
- <A IEAdjustRectToAspectRatio>
!!}
function GetImageSizeWithinArea(iImageWidth, iImageHeight : integer;           // height and width of object
                                iAvailableWidth, iAvailableHeight : integer;   // the space available
                                bAllowStretching : boolean = TRUE;             // if the image is smaller than the available area it will be stretched to the full available size;
                                FitMethod: TFitMethod = _fmFitWithinRect
                                ): TPoint;
// NPC: 24/10/11
var
  TempRect : TRect;
begin
  TempRect := GetImageRectWithinArea(iImageWidth, iImageHeight,
                                     iAvailableWidth, iAvailableHeight,
                                     0, 0,
                                     bAllowStretching, True,
                                     false, False, 0,
                                     FitMethod);
  result.x := TempRect.Right;
  result.y := TempRect.Bottom;
end;


// Estimate aspect ratio of rectified rectangle having four perspective quadrilater points
// tech report: "Whiteboard Scanning and Image Enhancement", Zhengyou Zhang
// x0, y0 = top-left
// x1, y1 = top-right
// x2, y2 = bottom-right
// x3, y3 = bottom-left
// cx, cy = center of image (Bitmap.Width / 2, Bitmap.Height / 2)
function IERectifiedRectangleAspectRatio(x0, y0, x1, y1, x2, y2, x3, y3, cx, cy: double): double;
var
  k2, k3: double;
  f2: double;
  r2: double;
begin
  x0 := x0 - cx;
  y0 := y0 - cy;
  x1 := x1 - cx;
  y1 := y1 - cy;
  x2 := x2 - cx;
  y2 := y2 - cy;
  x3 := x3 - cx;
  y3 := y3 - cy;

  k2 := ((y3 - y1) * x0 - (x3 - x1) * y0 + x3 * y1 - y3 * x1) / ((y2 - y1) * x0 - (x2 - x1) * y0 + x2 * y1 - y2 * x1) ;
  k3 := ((y3 - y1) * x2 - (x3 - x1) * y2 + x3 * y1 - y3 * x1) / ((y0 - y1) * x2 - (x0 - x1) * y2 + x0 * y1 - y0 * x1) ;

  result := 0;

  if (k2 <> 1) and (k3 <> 1) then
  begin
    f2 := -((k3 * y0 - y3) * (k2 * y2 - y3) + (k3 * x0 - x3) * (k2 * x2 - x3)) / ((k3 - 1) * (k2 - 1));
    r2 := (sqr(k2 - 1) + sqr(k2 * y2 - y3) / f2 + sqr(k2 * x2 - x3) / f2) / (sqr(k3 - 1) + sqr(k3 * y0 - y3) / f2 + sqr(k3 * x0 - x3) / f2);
    if r2 > 0 then
      result := sqrt(r2);
  end;

  if result = 0 then
    result := sqrt((sqr(y2 - y3) + sqr(x2 - x3)) / (sqr(y0 - y3) + sqr(x0 - x3)));
end;



{!!
<FS>GetImageRectWithinArea

<FM>Declaration<FC>
function GetImageRectWithinArea(iImageWidth, iImageHeight : Integer;
                                iAvailableWidth, iAvailableHeight : Integer;
                                iHorzOffset : Integer = 0;
                                iVertOffset : integer = 0;
                                bAllowStretching : boolean = true;
                                bAllowShrinking : boolean = true;
                                bCenterHorz : boolean = true;
                                bCenterVert : boolean = true;
                                iAutoCropPercent : Integer = 0;
                                FitMethod: <A TFitMethod> = _fmFitWithinRect) : TRect; overload;

function GetImageRectWithinArea(iImageWidth, iImageHeight: Integer;
                                ADestRect : TRect;
                                bAllowStretching : boolean = true;
                                bAllowShrinking : boolean = true;
                                bCenterHorz : boolean = true;
                                bCenterVert : boolean = true;
                                iAutoCropPercent : Integer = 0;
                                FitMethod: <A TFitMethod> = _fmFitWithinRect) : TRect; overload;

<FM>Description<FN>
Return the new size and position of an image within an area assuming that we maintain the aspect ratio of the image.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>iImageWidth/iImageHeight<FN></C> <C>The dimensions of the image</C> </R>
<R> <C><FC>iAvailableWidth/iAvailableHeight or ADestRect<FN></C> <C>The space available for the image (e.g. the client area of a display control, such as a TImageEnView)</C> </R>
<R> <C><FC>iHorzOffset/iVertOffset<FN></C> <C>Added to the left/top of the image position, e.g. to add a margin</C> </R>
<R> <C><FC>bAllowStretching<FN></C> <C>If image is smaller than iAvailableWidth/iAvailableHeight its dimensions will be enlarged</C> </R>
<R> <C><FC>bAllowShrinking<FN></C> <C>If image is larger than iAvailableWidth/iAvailableHeight its dimensions will be reduced</C> </R>
<R> <C><FC>bCenterHorz<FN></C> <C>Image is positioned in the horizontal center (Otherwise result.Left will be zero)</C> </R>
<R> <C><FC>bCenterVert<FN></C> <C>Image is positioned in the vertical center (Otherwise result.Top will be zero)</C> </R>
<R> <C><FC>iAutoCropPercent<FN></C> <C>An advanced parameter that allows the image to be positioned outside of the display area to that it appears larger (i.e. part of the image is cropped). For example, if a portrait image is shown on screen generally there are wide side borders. An autocrop value of 10% would see (up to) 5% of the image not shown at the top and bottom so the border areas are reduced</C> </R>
<R> <C><FC>FitMethod<FN></C> <C>Generally _fmFitWithinRect, but _fmFillRect_WithOverlap will return an image that makes the image as large as possible without any border area (but with part of the image offscreen). This is the same as using an iAutoCropPercent of 100</C> </R>
</TABLE>

<FM>Examples<FC>
// Stretch Draw an image centered within a TIEBitmap
aRect := GetImageRectWithinArea( SrcBMP.Width, SrcBMP.Height, DestBMP.Width, DestBMP.Height);
SrcBMP.DrawToTIEBitmap( DestBMP, IERectangle( aRect ), IERectangle( 0, 0, SrcBMP.Width, SrcBMP.Height ) );

// Col 1 of a TStringGrid displays a thumbnail drawn from a TImageEnMView
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Longint;
  Rect: TRect; State: TGridDrawState);
var
  aIEBitmap: IEBitmap;
  aCanvas: TCanvas;
  idx: Integer;
begin
  // Col 1 contains thumbnail. Row 0 is fixed header row
  if (ACol <> 1) or (ARow = 0) then
    Exit;

  idx := ARow;
  aCanvas := (Sender as TStringGrid).Canvas;

  // Clear current cell rect
  aCanvas.FillRect( Rect );

  // Get our image
  // Note: don't need to create or free the TIEBitmap
  aIEBitmap := ImageEnMView1.GetIEBitmap( idx );

  // Adjust our rect to maintain the image aspect ratio
  Rect := GetImageRectWithinArea( Rect, aIEBitmap.Width, aIEBitmap.Height );

  // Draw the image
  aIEBitmap := RenderToCanvas( aCanvas, Rect.Left, Rect.Top, Rect.Right - Rect.Left,   Rect.Bottom - Rect.Top, rfFastLinear, 0 );

  // Release our image
  ImageEnMView1.ReleaseBitmap( idx, False );
end;

<FM>See Also<FN>
- <A GetImageSizeWithinArea>
- <A IEAdjustRectToAspectRatio>
!!}
// pass the dimensions of an image and the space available to display it
// Result will be a rectangle to with the position and size to show the image within that area (with aspect ratio maintained)
function GetImageRectWithinArea(iImageWidth, iImageHeight : Integer;             // height and widht of object being put within the space
                                iAvailableWidth, iAvailableHeight : Integer;     // the space available
                                iHorzOffset : Integer = 0;                       // Added to the left of the object
                                iVertOffset : integer = 0;                       // Added to the top of the object
                                bAllowStretching : boolean = true;               // if the image is smaller than the available area it will be stretched to the full available size
                                bAllowShrinking : boolean = true;                // if the image is larger than the available area it will be shrunk to the full available size
                                bCenterHorz : boolean = true;                    // center the image horizontally if it is narrower than the available area (otherwise placed on the left)
                                bCenterVert : boolean = true;                    // center the image vertically if it is shorter than the available area  (otherwise placed on the Top)
                                iAutoCropPercent : Integer = 0;                  // if > 0 then that percentage of the image will be be placed OUTSIDE the available area (for cropping) to better match the aspect ratio of the available area
                                FitMethod: TFitMethod = _fmFitWithinRect         // See TFitMethod declaration
                                ) : TRect; overload;
var
  iNewObjHeight, iNewObjWidth: integer;
  bWidthIsCloserRatioMatch: Boolean;
  bSizeToWidth: Boolean;

  procedure SetImageNoChange;  // no change to size of object
  begin
    iNewObjWidth := iImageWidth;
    iNewObjHeight := iImageHeight;
  end;

  procedure SetImageToWidth;  // object Width is set to max, Height is calculated
  var
    dResizeRatio, dMaxResizeRatio: Double;
    dCroppedWidth: Double;
  begin
    dResizeRatio := iAvailableWidth / iImageWidth;

    // if we are allowing a percentage of the image to be auto-cropped then
    // calculate the maximum possible ratio we can increase by without
    // without the Height exceeding the available widht
    if iAutoCropPercent > 0 then
    begin
      dCroppedWidth := iImageWidth * (100 - iAutoCropPercent) / 100;   
      if iAutoCropPercent = 100 then
        dMaxResizeRatio := 1000
      else
        dMaxResizeRatio := iAvailableWidth / dCroppedWidth;

      if round(iImageHeight * dMaxResizeRatio) > iAvailableHeight then
        dMaxResizeRatio := iAvailableHeight / iImageHeight;

      dResizeRatio := dMaxResizeRatio;
    end;

    iNewObjHeight := round(iImageHeight * dResizeRatio);
    iNewObjWidth  := round(iImageWidth * dResizeRatio);
  end;

  procedure SetImageToHeight;  // object height is set to max, width is calculated
  var
    dResizeRatio, dMaxResizeRatio: Double;
    dCroppedHeight: Double;
  begin
    dResizeRatio := iAvailableHeight / iImageHeight;

    // if we are allowing a percentage of the image to be auto-cropped then
    // calculate the maximum possible ratio we can increase by without
    // without the width exceeding the available widht
    if iAutoCropPercent > 0 then
    begin
      dCroppedHeight := iImageHeight * (100 - iAutoCropPercent) / 100;  
      if iAutoCropPercent = 100 then
        dMaxResizeRatio := 1000
      else
        dMaxResizeRatio := iAvailableHeight / dCroppedHeight;

      if round(iImageWidth * dMaxResizeRatio) > iAvailableWidth then
        dMaxResizeRatio := iAvailableWidth / iImageWidth;

      dResizeRatio := dMaxResizeRatio;
    end;

    iNewObjWidth  := round(iImageWidth * dResizeRatio);
    iNewObjHeight := round(iImageHeight * dResizeRatio);
  end;

begin
  if ( iImageWidth = 0 ) or ( iImageHeight = 0 ) or ( iAvailableHeight = 0 ) or ( iAvailableWidth = 0 ) then
  begin
    result := rect(iHorzOffset, iVertOffset, 0, 0);
    exit;
  end;

  bWidthIsCloserRatioMatch := (iImageHeight / iAvailableHeight)<(iImageWidth / iAvailableWidth);
  if FitMethod = _fmFitWithinRect then
    bSizeToWidth := bWidthIsCloserRatioMatch
  else                            
    bSizeToWidth := not bWidthIsCloserRatioMatch;

  if bSizeToWidth then
  // WIDTH IS IMPORTANT
  begin
    if iImageWidth > iAvailableWidth then
    begin
      if bAllowShrinking = False then
        SetImageNoChange
      else
        SetImageToWidth;
    end
    else
    begin
      if bAllowStretching = False then
        SetImageNoChange
      else
        SetImageToWidth;
    end;
  end
  ELSE
  // HEIGHT IS IMPORTANT
  begin
    if iImageHeight > iAvailableHeight then
    begin
      if bAllowShrinking=False then
        SetImageNoChange
      else
        SetImageToHeight;
    end
    else
    begin
      if bAllowStretching = False then
        SetImageNoChange
      else
        SetImageToHeight;
    end;
  end;

  result.Left := iHorzOffset;
  result.Top  := iVertOffset;

  // center image in the available area
  if bCenterHorz then
    result.left := (trunc((iAvailableWidth /2)-(iNewObjWidth /2)))+iHorzOffset;
  if bCenterVert then
    result.top := (trunc((iAvailableHeight / 2)-(iNewObjHeight / 2)))+iVertOffset;

  result.right  := result.left + iNewObjWidth;
  result.bottom := result.top + iNewObjHeight;
end;


// pass the dimensions of an image and the Rect where it will be displayed
// Result will be a rectangle to with the position and size to show the image within that area (with aspect ratio maintained)
function GetImageRectWithinArea(iImageWidth, iImageHeight: Integer;              // height and width of object being put within the space
                                ADestRect : TRect;                               // The rect that iImageWidth/iImageHeight must fit within
                                bAllowStretching : boolean = true;               // if the image is smaller than the available area it will be stretched to the full available size
                                bAllowShrinking : boolean = true;                // if the image is larger than the available area it will be shrunk to the full available size
                                bCenterHorz : boolean = true;                    // center the image horizontally if it is narrower than the available area (otherwise placed on the left)
                                bCenterVert : boolean = true;                    // center the image vertically if it is shorter than the available area  (otherwise placed on the Top)
                                iAutoCropPercent : Integer = 0;                  // if > 0 then that percentage of the image will be be placed OUTSIDE the available area (for cropping) to better match the aspect ratio of the available area
                                FitMethod: TFitMethod = _fmFitWithinRect         // See TFitMethod declaration
                                ) : TRect; overload;
var
  iRectWidth, iRectHeight : Integer;
begin
  iRectWidth  := ADestRect.Right  - ADestRect.Left;
  iRectHeight := ADestRect.Bottom - ADestRect.Top;

  Result := GetImageRectWithinArea(iImageWidth, iImageHeight,
                                   iRectWidth, iRectHeight,
                                   ADestRect.Left, ADestRect.Top,
                                   bAllowStretching,
                                   bAllowShrinking,
                                   bCenterHorz,
                                   bCenterVert,
                                   iAutoCropPercent,
                                   FitMethod);
end;



{!!
<FS>IEAdjustRectToAspectRatio

<FM>Declaration<FC>
function IEAdjustRectToAspectRatio(InRect : TRect;
                                   iImageWidth, iImageHeight: Integer;
                                   iDisplayWidth, iDisplayHeight : Integer;
                                   FitMethod: <A TFitMethod> = _fmFitWithinRect ) : TRect;

<FM>Description<FN>
Adjusts the past rect so that it matches the aspect ratio of an image. For example, if InRect specifies a selected area where you want to draw an image, you can adjust the selection so that the image is not stretched (maintains its aspect ratio).

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>InRect<FN></C> <C>The source rect (to be adjusted)</C> </R>
<R> <C><FC>iImageWidth, iImageHeight<FN></C> <C>The dimensions of the image (to which inRect will be adjusted)</C> </R>
<R> <C><FC>iDisplayWidth, iDisplayHeight<FN></C> <C>The maximum width/height for the rect (typically the client area of a display control, such as a TImageEnView)</C> </R>
<R> <C><FC>FitMethod<FN></C> <C>Rather than reducing the area of InRect, it is increased. The returned rect will cover the entire passed rect</C> </R>
</TABLE>

Assuming InRect does not already match the ratio of iImageWidth/iImageHeight then IEAdjustRectToAspectRatio will return a rect with either:
- Left and Right unchanged but Top increased and Bottom decreased
- Top and Bottom unchanged but Left increased and Right decreased

But if FitMethod is _fmFillRect_WithOverlap then result wil be either:
- Left and Right unchanged but Top decreased and Bottom increased
- Top and Bottom unchanged but Left decreased and Right increased

<FM>Compatibility Notes<FN>
This is the same as the AdjustRectToAspectRatio() method in versions prior to v6.0.0 but note the change of parameter order

<FM>See Also<FN>
- <A GetImageRectWithinArea>
- <A GetImageSizeWithinArea>
!!}
function IEAdjustRectToAspectRatio(InRect : TRect;
                                   iImageWidth, iImageHeight: Integer;
                                   iDisplayWidth, iDisplayHeight : Integer;
                                   FitMethod: TFitMethod = _fmFitWithinRect ) : TRect;
var
  bAdjustWidth: Boolean;
  iNewLeft, iNewTop, iNewWidth, iNewHeight: Integer;
  iObjLeft, iObjTop, iObjHeight, iObjWidth: Integer;
begin
  iObjLeft    := imax(0, InRect.left);
  iObjTop     := imax(0, InRect.Top);
  iObjWidth   := imin(iImageWidth, InRect.Right-InRect.Left);
  iObjHeight  := imin(iImageHeight, InRect.Bottom-InRect.Top);

  if FitMethod = _fmFillRect_WithOverlap then
    bAdjustWidth := iObjHeight / iDisplayHeight < iObjWidth / iDisplayWidth
  else
    bAdjustWidth := iObjHeight / iDisplayHeight > iObjWidth / iDisplayWidth;


  if bAdjustWidth then
  // ADJUST WIDTH
  begin
    iNewHeight := iObjHeight;
    iNewTop    := iObjTop;
    iNewWidth  := round(iObjHeight * iDisplayWidth / iDisplayHeight);
    iNewLeft   := iObjLeft-((iNewWidth-iObjWidth) div 2);

    if FitMethod = _fmFillRect_WithOverlap then
    begin
      if iNewLeft < 0 then
        iNewLeft := 0;
      if iNewWidth > iImageWidth then
      begin
        iNewWidth  := iImageWidth;
        iNewHeight := round(iNewWidth * iDisplayHeight / iDisplayWidth);
        iNewTop    := iObjTop - ((iNewHeight - iObjHeight) div 2);
      end;
    end;
  end
  ELSE
  // ADJUST HEIGHT
  begin
    iNewWidth  := iObjWidth;
    iNewLeft   := iObjLeft;
    iNewHeight := round(iObjWidth * iDisplayHeight / iDisplayWidth);
    iNewTop    := iObjTop - ((iNewHeight - iObjHeight) div 2);

    if FitMethod = _fmFillRect_WithOverlap then
    begin
      if iNewTop < 0 then
        iNewTop := 0;
      if iNewHeight>iImageHeight then
      begin
        iNewHeight := iImageHeight;
        iNewWidth  := round(iNewHeight * iDisplayWidth / iDisplayHeight);
        iNewLeft   := iObjLeft-((iNewWidth-iObjWidth) div 2);
      end;
    end;
  end;

  
  if FitMethod = _fmFillRect_WithOverlap then
  begin
    if iNewLeft + iNewWidth > iImageWidth then
      iNewLeft := iImageWidth - iNewWidth;
    if iNewTop + iNewHeight > iImageHeight then
      iNewTop := iNewHeight - iImageHeight;
  end;

  result := rect(iNewLeft, iNewTop, iNewLeft + iNewWidth, iNewTop + iNewHeight);
end;


{!!
<FS>AngleToImageEnRotateAngle

<FM>Declaration<FC>
function AngleToImageEnRotateAngle(Angle: Double): Double;

<FM>Description<FN>
ImageEn's <L TImageEnProc.Rotate>rotation parameter</L> requires a value specified negative or positive degrees counter-clockwise. This method converts a standard positive clockwise value to an ImageEn value.

See also: <A ImageEnRotateAngleToAngle>

<FM>Example<FC>
// Rotate image 90 deg. clockwise
ImageEnView1.Proc.Rotate( AngleToImageEnRotateAngle( 90 ) );
!!}
function AngleToImageEnRotateAngle(Angle: Double): Double;
begin
  result := abs( 360 - Angle );
end;



{!!
<FS>ImageEnRotateAngleToAngle

<FM>Declaration<FC>
function AngleToImageEnRotateAngle(Angle: Double): Double;

<FM>Description<FN>
ImageEn's <L TImageEnProc.Rotate>rotation parameter</L> requires a value specified negative or positive degrees counter-clockwise. This method converts an ImageEn rotation value to a value between -180 and +180.

See also: <A AngleToImageEnRotateAngle>

<FM>Example<FC>
ImageEnView1.Proc.Rotate( 90 );
ShowMessage( Format( 'Rotated by %d degrees', [ ImageEnRotateAngleToAngle( 90 )]);
!!}
function ImageEnRotateAngleToAngle(Angle: Double): Double;
begin
  result := -1 * Angle;
  if Result > 180 then
    Result := Result - 360
  else
  if Result <= 180 then
    Result := Result + 360;
end;



function IEBilinear(needX, needY: Double; centerValue, rightValue, bottomValue, BottomRightValue: integer): integer;
var
  m0, m1: Double;
begin
  needX := needX - trunc(needX);
  needY := needY - trunc(needY);
  if (needX < 0) then
    needX := needX + 1.0;
  if (needY < 0) then
    needY := needY + 1.0;
  m0 := (1.0 - needX) * centerValue + needX * rightValue;
  m1 := (1.0 - needX) * bottomValue + needX * BottomRightValue;
  result := trunc((1.0 - needY) * m0 + needY * m1);
end;


// Adjust the size of ItemHeight for ComboBox Items to cope with windows font scaling
// Can call for any combo box, but only needed for csOwnerDrawFixed
procedure IEInitializeComboBox(AComboBox : TComboBox);
var
  TM : Windows.TTextMetric;
  iSize: Integer;
begin
  if AComboBox.Style = csOwnerDrawFixed then
  try
    GetTextMetrics(AComboBox.Canvas.Handle, TM);
    iSize := GetSystemMetrics(SM_CYBORDER) * 2 + TM.tmHeight;
    if iSize > AComboBox.ItemHeight then
      AComboBox.ItemHeight := iSize;
  except
    // UNEXPECTED FAILURE
  end;
end;


{
Typical Usage:

procedure TfrmMain.cmbSourcesDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
  IEDrawComboListBoxItem( TCombobox(Control).Canvas, Rect, Control.Enabled, TCombobox(Control).Items[ Index ], ImageList1, Drive_Glyph_Index );
end;

Code that was
  IEDrawComboListBoxItem( TCombobox(Control), Rect, TCombobox(Control).Items[ Index ], ImageList1, Drive_Glyph_Index );

Should change to:
  IEDrawComboListBoxItem( TCombobox(Control).Canvas, Rect, Control.Enabled, TCombobox(Control).Items[ Index ], ImageList1, Drive_Glyph_Index );
}
procedure IEDrawComboListBoxItem(ControlCanvas : TCanvas;
                                 CanvasRect : trect;
                                 ControlEnabled: Boolean;
                                 const Text : string;
                                 AnImageList : TImageList = nil;
                                 iGlyph : Short = -1);
const
  DRAW_GLYPH_LEFT         = 2;
  DRAW_GLYPH_TEXT_MARGIN  = 3;
  DRAW_TEXT_LEFT_NO_GLYPH = 4;
var
  AColor: TColor;
  textX  : Integer;
  textY  : Integer;
  glyphX : Integer;
  glyphY : Integer;
begin
  ControlCanvas.FillRect(CanvasRect);
  if ControlEnabled = False then
    ControlCanvas.font.color  := clGrayText;

  if assigned(AnImageList) and (iGlyph >= 0) then
  begin
    glyphX := DRAW_GLYPH_LEFT;
    glyphY := ((CanvasRect.Bottom - CanvasRect.Top) - AnImageList.Height) div 2;
    textX  := DRAW_GLYPH_LEFT + AnImageList.Width + DRAW_GLYPH_TEXT_MARGIN;
    textY  := ((CanvasRect.Bottom - CanvasRect.Top) - ControlCanvas.TextHeight(Text)) div 2;

    ControlCanvas.TextOut(CanvasRect.left + textX, CanvasRect.top + textY, Text);

    AColor := ControlCanvas.Brush.Color;
    AnImageList.Draw(ControlCanvas, CanvasRect.Left + glyphX, CanvasRect.Top + glyphY, iGlyph, ControlEnabled );
    ControlCanvas.Brush.Color := AColor;
  end
  else
  begin
    textX := DRAW_TEXT_LEFT_NO_GLYPH;
    textY := ((CanvasRect.Bottom - CanvasRect.Top) - ControlCanvas.TextHeight(Text)) div 2;

    ControlCanvas.TextOut(CanvasRect.left + textX, CanvasRect.top + textY, Text);
  end;
end;


// Useful to get a suitable next zoom step when clicking a "Zoom In" or "Zoom Out" button
// bZoomIn: true if a "Zoom In" button was pressed or false for "Zoom Out"
// iIdealZoom: Optionally specify the zoom level required to fit to window (i.e. ieImage.GetIdealZoom) and it will be offered as a zoom step
// E.g. ieImage.Zoom := GetNextZoomValue(ieImage.Zoom, Sender = btnZoomIn, ieImage.GetIdealZoom);
function GetNextZoomValue(iCurrentZoom: double;
                          bZoomIn: boolean;
                          iIdealZoom: double = 0) : double;
var
  iZoomInc: integer;
begin
  result := iCurrentZoom;

  if bZoomIn then
  begin
    iZoomInc := 25;
    result := result + 1;
  end
  else
  begin
    if result < 6 then
    begin
      Result := 1;
      exit
    end
    else
    begin
      iZoomInc := 0;
      result := result - 1;
    end;
  end;

  if result < 26 then
    result := ((trunc(result) div 5) * 5) + (iZoomInc div 5)
  else
    if result < 300 then
    result := ((trunc(result) div 25) * 25) + iZoomInc
  else
    result := ((trunc(result) div 100) * 100) + (iZoomInc * 4);

  if (iIdealZoom > 0) and
     (iIdealZoom <> iCurrentZoom) and
     (trunc(iIdealZoom) <> trunc(iCurrentZoom)) and
     (iIdealZoom > Min(trunc(result), trunc(iCurrentZoom))) and
     (iIdealZoom < Max(trunc(result), trunc(iCurrentZoom))) then
    result := iIdealZoom; // snap to fit
end;


(*
      CCIR Recommendation 601-1  (lumaRed=0.299, lumaGreen=0.587, lumaBlue=0.114)

      R = Y                + 1.40200 * Cr
      G = Y - 0.34414 * Cb - 0.71414 * Cr
      B = Y + 1.77200 * Cb

      Y  =  0.29900 * R + 0.58700 * G + 0.11400 * B
      Cb = -0.16874 * R - 0.33126 * G + 0.50000 * B  + 128
      Cr =  0.50000 * R - 0.41869 * G - 0.08131 * B  + 128
*)
procedure IERGB2YCbCr(rgb: TRGB; var Y, Cb, Cr: integer);
begin
  with rgb do
  begin
    Y  := blimit(trunc(0.29900 * R + 0.58700 * G + 0.11400 * B));
    Cb := blimit(trunc(-0.16874 * R - 0.33126 * G + 0.50000 * B  + 128));
    Cr := blimit(trunc(0.50000 * R - 0.41869 * G - 0.08131 * B  + 128));
  end;
end;

procedure IEYCbCr2RGB(var rgb: TRGB; Y, Cb, Cr: integer);
begin
  Cb := Cb-128;
  Cr := Cr-128;
  rgb.r := blimit(trunc(Y + 1.40200 * Cr));
  rgb.g := blimit(trunc(Y - 0.34414 * Cb - 0.71414 * Cr));
  rgb.b := blimit(trunc(Y + 1.77200 * Cb));
end;

function IESystemAlloc(ASize: int64): pointer;
begin
  result := pointer(GlobalAlloc(GPTR, ASize));
end;

//  Frees memory
procedure IESystemFree(var P);
begin
  GlobalFree(THandle(pointer(P)));
  pointer(P) := nil;
end;

const IEMINSYSALLOC = 1048576;

function IEAutoAlloc(ASize: int64): pointer;
begin
  if ASize >= IEMINSYSALLOC then
  begin
    result := IESystemAlloc(ASize + 4);
    if result = nil then
      exit; // FAIL
    pboolean(result)^ := true;
  end
  else
  begin
    try
      GetMem(result, ASize + 4);
      pboolean(result)^ := false;
    except
      result := IESystemAlloc(ASize + 4);
      if result = nil then
        exit; // FAIL
      pboolean(result)^ := true;
    end;
  end;
  inc(pboolean(result));
end;

procedure IEAutoFree(var P);
begin
  dec(pboolean(P));
  if pboolean(P)^ then
    IESystemFree(P)
  else
    FreeMem(pointer(P));
end;

procedure IESilentGetMem(var P; Size: Integer);
begin
  try
    GetMem(pointer(P), Size);
  except
    pointer(P) := nil;
  end;
end;


////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////

// check if mmx available
function IEMMXSupported: bytebool;
begin
  result := false;
  {$ifdef IEUSEASM}
  asm
       push ebx
    // check if the cpuid instruction is available
      pushfd
      pushfd
      pop    eax
      mov    ecx, eax
      xor    eax, 200000h
      push   eax
      popfd
      pushfd
      pop    eax
      popfd
      xor    eax, ecx
      jz @nocpuid
      // cpuid supported, check MMX
      mov eax, 1
      Dw $A20F  // CPUID
      test edx, 800000h
      setnz result
   @nocpuid:
      pop ebx
  end;
  {$endif}
end;




//////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////
// Extra backgrounds

(*
f(x)=(1/(sqrt(2*pi)*var))*e^((-1/2*(var^2))*(x-mean)^2)
mean: center of highest value. 0=centered on zero
var: width of the curve. 0.1=maximum width, 1=minimum, ref=0.2
*)
procedure IECreateGaussCurve(variance: double; curveCount: integer; curveMin, curveMax: integer; var curve: array of double);
const
  mean=0;
var
  i: integer;
  x: double;
  mx: double;
begin
  mx := -100000;
  for i := 0 to curveCount-1 do
  begin
    x := (i/curveCount)*2-1;
    curve[i] := (1/(sqrt(2*pi)*variance))*exp((-1/2*(Power(variance, 2)))*Power(x-mean, 2));
    if curve[i]>mx then
      mx := curve[i];
  end;
  for i := 0 to curveCount-1 do
    curve[i] := curveMin+ curve[i]/mx*(curveMax-curveMin);
end;

procedure IECreateOSXBackgroundPaper(bmp: TBitmap; width, height: integer);
var
  px: PRGB;
  col: TRGB;
  x, y: integer;
  c: integer;
  gauss: array [0..3] of double;
begin
  bmp.Width := width;
  bmp.Height := height;
  bmp.PixelFormat := pf24bit;
  IECreateGaussCurve(0.5, 4, 130, 255, gauss);
  c := 0;
  for y := 0 to bmp.Height-1 do
  begin
    px := bmp.Scanline[y];
    col.r := trunc(gauss[c]);
    col.g := col.r;
    col.b := col.r;
    for x := 0 to bmp.Width-1 do
    begin
      px^ := col;
      inc(px);
    end;
    inc(c);
    if c=4 then
      c := 0;
  end;
end;

procedure IECreateOSXBackgroundMetal(bmp: TBitmap; width, height: integer);
var
  px: PRGB;
  x, y: integer;
  c, a: integer;
  gauss: pdoublearray;
  bmpWidth, bmpHeight: integer;
begin
  bmp.Width := width;
  bmp.Height := height;
  bmp.PixelFormat := pf24bit;
  bmpWidth := bmp.Width;
  bmpHeight := bmp.Height;
  getmem(gauss, bmpWidth*sizeof(double));
  IECreateGaussCurve(3, bmpWidth, 160, 208, gauss^);
  a := 0;
  for y := 0 to bmpHeight-1 do
  begin
    c := 0;
    px := bmp.Scanline[y];
    for x := 0 to bmpWidth-1 do
    begin
      px^.r := trunc(gauss[x])+a;
      px^.g := px^.r;
      px^.b := px^.r;
      inc(px);
      inc(c);
      if c>(100+random(bmpWidth)) then
      begin
        c := 0;
        a := random(11);
      end;
    end;
  end;
  freemem(gauss);
end;

// Extra backgrounds
//////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////
// Clipboard helper functions

// you must call OpenClipboard before call this function
function IEEnumClipboardNames: TStringList;
const
  MX=512;
var
  cf: cardinal;
  pc: PChar;
  len: integer;
begin
  getmem(pc, (MX+1)*sizeof(Char));
  result := TStringList.Create;
  cf := 0;
  while true do
  begin
    cf := EnumClipboardFormats(cf);
    if cf=0 then
      break;
    len := GetClipboardFormatName(cf, pc, MX);
    if len > 0 then
      result.AddObject( copy(pc, 1, len), pointer(cf) );
  end;
  freemem(pc);
end;

// you must call OpenClipboard before call this function
function IEGetClipboardDataByName(const name: string): THandle;
var
  l: TStringList;
  i: integer;
begin
  result := 0;
  l := IEEnumClipboardNames;
  i := l.IndexOf(name);
  if i>-1 then
    result := cardinal(l.Objects[i]);
  l.free;
end;

// Clipboard helper functions
//////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////


// Sometimes OpenClipboard fails. In particular when big images are just copied in and a paste is done immediately.
function IEOpenClipboard: boolean;
var
  i: integer;
begin
  for i := 1 to 10 do
  begin
    if OpenClipboard(0) then
    begin
      result := true;
      exit;
    end;
    sleep(20);  // up to 200 ms (20*10)
  end;
  result := false;
end;

{!!
<FS>IEAlphaToOpacity

<FM>Declaration<FC>
function IEAlphaToOpacity(Alpha: integer ): integer;

<FM>Description<FN>
COnverts an alpha value (in range of 0 - 255) to an opacity percentage (0 - 100).
Opacity is generally referred to as percent.  (e.g. Alpha of 255 would return Opacity of 100% )

See also: <A IEOpacityToAlpha>
!!}
function IEAlphaToOpacity(Alpha: integer ): integer;
begin
  result := Round( Alpha / 255 * 100 );
end;

{!!
<FS>IEOpacityToAlpha

<FM>Declaration<FC>
function IEOpacityToAlpha(Opacity: integer): integer;

<FM>Description<FN>
COnverts a opacity percentage (0 - 100) to an alpha value (in range of 0 - 255). For example Opacity of 100% would return Alpha of 255.

See also: <A IEAlphaToOpacity>
!!}
function IEOpacityToAlpha(Opacity: integer): integer;
begin
  result := ( Opacity * 255 ) div 100;
end;


// calculates coordinates of intersection of two perpendicular lines
// First line is specified by slope and one point
// Second line is specified by a single point
function IECalcOrthogonalLinesIntersectingPoint(FirstLinePoint: TIE2DPoint; FirstLineSlope: double; SecondLinePoint: TIE2DPoint): TIE2DPoint;
var
  A, B, C: double;
  z: double;
begin
  // equation of first line
  A := -FirstLineSlope;
  B := 1;
  C := -FirstLinePoint.Y + FirstLineSlope * FirstLinePoint.X;

  // dropping a perpendicular and find intersection point
  z := (A * SecondLinePoint.X + B * SecondLInePoint.Y + C) / (sqr(A) + sqr(B));
  result := IE2DPoint(SecondLinePoint.X - A * z, SecondLinePoint.Y - B * z);
end;


function IECalcPolygonCentroid(polygon: array of TIE2DPoint): TIE2DPoint;
var
  i, j: integer;
  ai, atmp, xtmp, ytmp: double;
  xi, yi, xj, yj: double;
begin
  result.X := 0;
  result.Y := 0;
  atmp := 0;
  xtmp := 0;
  ytmp := 0;
  i := length(polygon) - 1;
  j := 0;
  while j < length(polygon) do
  begin
    xi := polygon[i].x;
    yi := polygon[i].y;
    xj := polygon[j].x;
    yj := polygon[j].y;
    ai := xi * yj - xj * yi;
    atmp := atmp + ai;
    xtmp := xtmp + (xj + xi) * ai;
    ytmp := ytmp + (yj + yi) * ai;
    i := j;
    inc(j);
  end;
  if (atmp <> 0) then
  begin
    result.x := xtmp / (3 * atmp);
    result.y := ytmp / (3 * atmp);
  end;
end;


procedure IERotatePoints(var rpt: array of TPoint; PointCount: Integer; angle: double; CenterX, CenterY: integer);
var
  aa: double;
  i, x, y: integer;
begin
  aa := -angle * pi / 180;
  for i := 0 to PointCount - 1 do
  begin
    x := rpt[i].X;
    y := rpt[i].Y;
    rpt[i].X := CenterX + trunc( (x-CenterX)*cos(aa) - (y-CenterY)*sin(aa) );
    rpt[i].Y := CenterY + trunc( (x-CenterX)*sin(aa) + (y-CenterY)*cos(aa) );
  end;
end;

procedure IEDRotatePointsWithCenter(var rpt: array of TIE2DPoint; angle: double; CenterX, CenterY: double);
var
  i: integer;
  aa: double;
  x, y: double;
begin
  aa := -angle * pi / 180;
  for i := 0 to High(rpt) do
  begin
    x := rpt[i].X;
    y := rpt[i].Y;
    rpt[i].X := CenterX + (x - CenterX) * cos(aa) - (y - CenterY) * sin(aa);
    rpt[i].Y := CenterY + (x - CenterX) * sin(aa) + (y - CenterY) * cos(aa);
  end;
end;

procedure IEDRotatePoints(var rpt: array of TIE2DPoint; angle: double);
var
  center: TIE2DPoint;
begin
  center := IECalcPolygonCentroid(rpt);
  IEDRotatePointsWithCenter(rpt, angle, Center.X, Center.Y);
end;

procedure IEDRotateTwoPoints(Angle: double; const P1: TIE2DPoint; const P2: TIE2DPoint; out OutP1: TIE2DPoint; out OutP2: TIE2DPoint);
var
  radAngle: double;
  centerX, centerY: double;
begin
  radAngle := -Angle * PI / 180;
  centerX := (P1.X + P2.X) / 2.0;
  centerY := (P1.Y + P2.Y) / 2.0;
  OutP1.X := centerX + (P1.X - centerX) * cos(radAngle) - (P1.Y - centerY) * sin(radAngle);
  OutP1.Y := centerY + (P1.X - centerX) * sin(radAngle) + (P1.Y - centerY) * cos(radAngle);
  OutP2.X := centerX + (P2.X - centerX) * cos(radAngle) - (P2.Y - centerY) * sin(radAngle);
  OutP2.Y := centerY + (P2.X - centerX) * sin(radAngle) + (P2.Y - centerY) * cos(radAngle);
end;

procedure IERotatePoint(var px, py: integer; angle: double; CenterX, CenterY: integer);
var
  aa: double;
  x, y: integer;
begin
  aa := -angle * pi / 180;
  x := px;
  y := py;
  px := CenterX + trunc( (x-CenterX)*cos(aa) - (y-CenterY)*sin(aa) );
  py := CenterY + trunc( (x-CenterX)*sin(aa) + (y-CenterY)*cos(aa) );
end;

procedure IEDRotatePoint(var px, py: double; angle: double; CenterX, CenterY: double);
var
  aa: double;
  x, y: double;
begin
  aa := -angle * pi / 180;
  x := px;
  y := py;
  px := CenterX + (x - CenterX) * cos(aa) - (y - CenterY) * sin(aa);
  py := CenterY + (x - CenterX) * sin(aa) + (y - CenterY) * cos(aa);
end;

function IECalcRotatedRectBoundingBox(Rectangle: TIEDRectangle; RotationCenter: TIE2DPoint; RotationAngle: double): TIEDRectangle;
var
  rotRect: array [0..4] of TIE2DPoint;
  i: integer;
begin
  rotRect[0] := IE2DPoint(Rectangle[0].X, Rectangle[0].Y);
  rotRect[1] := IE2DPoint(Rectangle[1].X, Rectangle[0].Y);
  rotRect[2] := IE2DPoint(Rectangle[1].X, Rectangle[1].Y);
  rotRect[3] := IE2DPoint(Rectangle[0].X, Rectangle[1].Y);
  for i := 0 to 3 do
    IEDRotatePoint(rotRect[i].X, rotRect[i].Y, RotationAngle, RotationCenter.X, RotationCenter.Y);
  result[0] := rotRect[0];
  result[1] := rotRect[0];
  for i := 1 to 3 do
  begin
    result[0].X := dmin(result[0].X, rotRect[i].X);
    result[0].Y := dmin(result[0].Y, rotRect[i].Y);
    result[1].X := dmax(result[1].X, rotRect[i].X);
    result[1].Y := dmax(result[1].Y, rotRect[i].Y);
  end;
end;

procedure IECalcRotatedBitmapSizes(Width, Height: integer; RotationCenter: TIE2DPoint; RotationAngle: double; out NewWidth: integer; out NewHeight: integer);
var
  rc: TIEDRectangle;
  bbox: TIEDRectangle;
begin
  rc[0].X := 0;
  rc[0].Y := 0;
  rc[1].X := Width - 1;
  rc[1].Y := Height - 1;
  bbox := IECalcRotatedRectBoundingBox(rc, RotationCenter, RotationAngle);
  NewWidth  := round(bbox[1].X - bbox[0].X + 1);
  NewHeight := round(bbox[1].Y - bbox[0].Y + 1);
end;

// RotationAngle in degrees
// Background can be 0 or 1
procedure IERotateBits(Bits: TIEArrayOfByte; Width, Height: integer; RowAlignment: integer; RotationCenter: TIE2DPoint; RotationAngle: double; Background: integer; MaintainOriginalSize: boolean; out outBits: TIEArrayOfByte; out outWidth: integer; out outHeight: integer);
var
  i, j: integer;
  radAngle: double;
  rowlen, outRowlen: integer;
  deltaX, deltaY: double;
  rotX, rotY: integer;
  dstRow, srcRow: pbyte;
  newWidth, newHeight: integer;
  offX, offY: integer;
  row, col: integer;
begin
  if RotationAngle = 0.0 then
  begin
    // no rotation
    outWidth := Width;
    outHeight := Height;
    SetLength(outBits, length(Bits));
    for i := 0 to high(Bits) do
      outBits[i] := Bits[i];
    exit;
  end;

  radAngle := RotationAngle * PI / 180.0;

  IECalcRotatedBitmapSizes(Width, Height, RotationCenter, RotationAngle, newWidth, newHeight);

  if MaintainOriginalSize then
  begin
    outWidth  := Width;
    outHeight := Height;
    offX := (outWidth - Width) div 2;
    offY := (outHeight - Height) div 2;
  end
  else
  begin
    outWidth  := newWidth;
    outHeight := newHeight;
    offX := 0;
    offY := 0;
  end;

  rowlen    := IEBitmapRowLen(Width, 1, RowAlignment);
  outRowlen := IEBitmapRowLen(outWidth, 1, RowAlignment);

  SetLength(outBits, outRowlen * outHeight);

  dstRow := @outBits[0];
  for i := 0 to outHeight - 1 do
  begin
    for j := 0 to outWidth - 1 do
    begin
      col := offX + j;
      row := offY + i;
      deltaY := col - RotationCenter.X;
      deltaX := row - RotationCenter.Y;
      rotX := round(RotationCenter.X + deltaX * sin(radAngle) + deltaY * cos(radAngle));
      rotY := round(RotationCenter.Y + deltaX * cos(radAngle) - deltaY * sin(radAngle));
      if (rotX >= 0) and (rotX < Width) and (rotY >= 0) and (rotY < Height) then
      begin
        srcRow := @Bits[0];
        inc(srcRow, rowlen * rotY);
        _SetPixelbw(dstRow, col, _GetPixelbw(srcRow, rotX));
      end
      else
      begin
        _SetPixelbw(dstRow, col, Background);
      end;
    end;
    inc(dstRow, outRowlen);
  end;

end;

// RotationAngle in degrees around cursor hotspot
// No need to call DestroyCursor when assigned to Screen.Cursors[]
function IECreateRotatedCursor(CursorIntResource: integer; RotationAngle: double): HCURSOR;
var
  hresInfo: HRSRC;
  hres: THandle;
  buf: pbyte;
  bufLen: integer;
  ms: TIEMemStream;
  hotSpotX, hotSpotY: word;
  rotationCenter: TIE2DPoint;
  infoHead: TBITMAPINFOHEADER;
  width, height: integer;
  colorMap: array of TRGBQUAD;
  plane: TIEArrayOfByte;
  XORplane: TIEArrayOfByte;
  ANDplane: TIEArrayOfByte;
  rowlen: integer;
  newWidth, newHeight: integer;
begin
  result := 0;

  hresInfo := FindResource(HInstance, MakeIntResource(CursorIntResource), RT_CURSOR);
  hres := LoadResource(HInstance, hresInfo);
  bufLen := SizeOfResource(HInstance, hresInfo);
  buf := LockResource(hres);

  if (buf <> nil) and (buflen > 0) then
  begin
    ms := TIEMemStream.Create(buf, bufLen);

    // hot spot
    ms.Read(hotSpotX, sizeof(word));
    ms.Read(hotSpotY, sizeof(word));

    // rotate around hotsport
    rotationCenter.X := hotSpotX;
    rotationCenter.Y := hotSpotY;

    // Bitmap info header
    FillChar(InfoHead, sizeof(InfoHead), 0);
    ms.Read(infoHead, sizeof(TBITMAPINFOHEADER));

    // here only black/white cursor are supported
    if infoHead.biBitCount = 1 then
    begin
      // color map
      SetLength(colorMap, 2);
      ms.Read(colorMap[0], sizeof(TRGBQUAD) * length(colorMap));

      width  := infoHead.biWidth;
      height := infoHead.biHeight div 2;

      // allocate buffer to contain source XOR and AND planes
      rowlen := IEBitmapRowLen(width, 1, 32);
      SetLength(plane, rowlen * height);

      // load and rotate XOR plane
      ms.Read(plane[0], length(plane));
      IERotateBits(plane, width, height, 32, rotationCenter, RotationAngle, 0, true, XORplane, newWidth, newHeight);

      // load and rotate AND plane
      ms.Read(plane[0], length(plane));
      IERotateBits(plane, width, height, 32, rotationCenter, RotationAngle, 1, true, ANDplane, newWidth, newHeight);

      // creates the new cursor
      result := CreateCursor(HInstance, hotSpotX, hotSpotY, newWidth, newHeight, @ANDplane[0], @XORplane[0]);
    end;

    ms.Free();
  end;

  UnlockResource(hres);
  FreeResource(hres);
end;

// Return the max and min x and y in a point array
procedure IEGetPointsRange(rpt: array of TPoint; PointCount: Integer; out MinX: Integer; out MinY: Integer; out MaxX: Integer; out MaxY: Integer);
var
  i: Integer;
begin
  MinX := 0;
  MaxX := 0;
  MinY := 0;
  MaxY := 0;

  if PointCount < 1 then
    exit;

  MinX := MaxInt;
  MaxX := - MaxInt;
  MinY := MaxInt;
  MaxY := - MaxInt;

  for i := 0 to PointCount - 1 do
  begin
    if rpt[i].X > MaxX then
      MaxX := rpt[i].X;
    if rpt[i].X < MinX then
      MinX := rpt[i].X;
    if rpt[i].Y > MaxY then
      MaxY := rpt[i].Y;
    if rpt[i].Y < MinY then
      MinY := rpt[i].Y;
  end;
end;

// Scale all points so they are in the range minx to maxx and miny to maxy
procedure IEScalePoints(var rpt: array of TPoint; PointCount: Integer; MinX, MinY, MaxX, MaxY: Integer; MaintainAR: Boolean = False);
var
  i, currMinX, currMinY, currMaxX, currMaxY : Integer;
  addX, addY: Integer;
  scaleX, ScaleY: Double;
  rightMostX, bottomMostY: Integer;
begin
  if PointCount < 1 then
    exit;

  IEGetPointsRange(rpt, PointCount, currMinX, currMinY, currMaxX, currMaxY );

  addX := MinX - currMinX;
  scaleX := ( MaxX - MinX ) / (( currMaxX  - CurrMinX ));
  addY := MinY - currMinY;
  scaleY := ( MaxY - MinY ) / (( currMaxY - CurrMinY ));

  if MaintainAR then
  begin
    if scaleX < ScaleY then
    begin
      bottomMostY := Round(( currMaxY - currMinY ) * ScaleX ) + addY + currMinY;
      inc( addY, ( MaxY - bottomMostY ) div 2 );
      ScaleY := scaleX;
    end
    else
    begin
      rightMostX := Round(( currMaxX - currMinX  ) * ScaleY ) + addX + currMinX;
      inc( addX, ( MaxX - rightMostX ) div 2 );
      scaleX := ScaleY;
    end;
  end;

  for i := 0 to PointCount - 1 do
  begin
    rpt[i].X := Round(( rpt[i].X - currMinX  ) * ScaleX ) + addX + currMinX;
    rpt[i].Y := Round(( rpt[i].Y - currMinY  ) * ScaleY ) + addY + currMinY;
  end;
end;


function IEDISPointInPoly(x, y: double; poly: array of TIE2DPoint): boolean;
var
  i, j: integer;
begin
  result := false;
  j := High(poly);
  for i := Low(poly) to High(poly) do
  begin
    if ((((poly[i].y <= y) and (y < poly[j].y)) or ((poly[j].y <= y) and (y < poly[i].y)) ) and (x < ((poly[j].x - poly[i].x) * (y - poly[i].y) / (poly[j].y - poly[i].y) + poly[i].x))) then
      result := not result;
    j := i
  end;
end;

function IEISPointInPoly(x, y: integer; poly: array of TPoint): boolean;
var
  i, j: integer;
begin
  result := false;
  j := High(poly);
  for i := Low(poly) to High(poly) do
  begin
    if ((((poly[i].y <= y) and (y < poly[j].y)) or ((poly[j].y <= y) and (y < poly[i].y)) ) and (x < ((poly[j].x - poly[i].x) * (y - poly[i].y) / (poly[j].y - poly[i].y) + poly[i].x))) then
      result := not result;
    j := i
  end;
end;

function IEISPointInPoly2(x, y: integer; PolyPoints: PPointArray; PolyPointsCount: integer; ToSubX, ToSubY, ToAddX, ToAddY: integer; ToMulX, ToMulY: double): boolean;
var
  i, j: integer;
  xi, yi, xj, yj: double;
begin
  result := false;
  j := PolyPointsCount-1;
  for i := 0 to PolyPointsCount-1 do
  begin
    xi := (PolyPoints[i].x-ToSubX)*ToMulX+ToAddX;
    yi := (PolyPoints[i].y-ToSubY)*ToMulY+ToAddY;
    xj := (PolyPoints[j].x-ToSubX)*ToMulX+ToAddX;
    yj := (PolyPoints[j].y-ToSubY)*ToMulY+ToAddY;
    if ((((yi <= y) and (y < yj)) or ((yj <= y) and (y < yi)) ) and (x < ((xj - xi) * (y - yi) / (yj - yi) + xi))) then
      result := not result;
    j := i
  end;
end;

procedure IECenterRectInRect(OuterRectX1, OuterRectY1, OuterRectX2, OuterRectY2: integer; var InnerRectX1: integer; var InnerRectY1: integer; var InnerRectX2: integer; var InnerRectY2: integer);
var
  outerWidth, outerHeight: integer;
  innerWidth, innerHeight: integer;
  offX, offY: integer;
begin
  outerWidth  := OuterRectX2 - OuterRectX1 + 1;
  outerHeight := OuterRectY2 - OuterRectY1 + 1;
  innerWidth  := InnerRectX2 - InnerRectX1 + 1;
  innerHeight := InnerRectY2 - InnerRectY1 + 1;
  offX := (outerWidth - innerWidth) div 2;
  offY := (outerHeight - innerHeight) div 2;
  InnerRectX1 := OuterRectX1 + offX;
  InnerRectY1 := OuterRectY1 + offY;
  InnerRectX2 := InnerRectX1 + innerWidth - 1;
  InnerRectY2 := InnerRectY1 + innerHeight - 1;
end;


// Given a rect and an angle, for a line passing through the center, where would it intersect with the rect edges?
procedure CalcLineWithinRect(R: TRect; Angle: Integer; out Pt1, Pt2: TPoint);
var
  baseAngle: Integer;
  x1gr, y1gr: Boolean;
  w2, h2 : Double;

  procedure _FitTopAndBottom();
  var
    a: Double;
    xOffset: Double;
  begin
    // Intersects on top and bottom edges
    Pt1.Y := R.Top;
    Pt2.Y := R.Bottom;
    a := IEDegreesToRadians( 90 - angle );
    xOffset := Abs( Tan( a ) * h2 );

    if Angle > 45 then
      xOffset := -1 * xOffset;
    Pt1.X := Round( R.Left + w2 - xOffset );
    Pt2.X := Round( R.Left + w2 + xOffset );
  end;

  procedure _FitLeftAndRight();
  var
    a: Double;
    yOffset: Double;
  begin
    // Intersects on left and right side
    Pt1.X := R.Left;
    Pt2.X := R.Right;

    a := IEDegreesToRadians( angle );
    yOffset := Abs( Tan( a ) * w2 );

    if Angle < 0 then
      yOffset := -1 * yOffset;
    Pt1.Y := Round( R.Top + h2 + yOffset );
    Pt2.Y := Round( R.Top + h2 - yOffset );
  end;

  procedure _SwapX();
  var
    tempX: Integer;
  begin
    tempX := pt1.X;
    pt1.X := pt2.X;
    pt2.X := tempX;
  end;

  procedure _SwapY();
  var
    tempY: Integer;
  begin
    tempY := pt1.Y;
    pt1.Y := pt2.Y;
    pt2.Y := tempY;
  end;

begin
  if ( R.Left > R.Right ) or
     ( R.Top > R.Bottom ) then
  begin
    Pt1 := Point( -1, -1 );
    Pt2 := Point( -1, -1 );
    exit;
  end;


  baseAngle := Angle;
  while baseAngle < 0 do
    baseAngle := baseAngle + 360;

  // Want angle to be in range -90 - 90
  While Angle <= -90 do
    Angle := Angle + 180;
  While Angle > 90 do
    Angle := Angle - 180;

  w2 := ( R.Right - R.Left ) / 2;
  h2 := ( R.Bottom - R.Top ) / 2;

  if ( Angle < -45 ) or ( Angle > 45 ) then
  begin
    _FitTopAndBottom();
    x1gr := ( Pt1.X > Pt2.X );
    y1gr := ( Pt1.Y > Pt2.Y );
    if ( Pt1.X < R.Left ) or ( Pt2.X < R.Left ) then
      _FitLeftAndRight();
  end
  else
  // > -45 and < 45
  begin
    _FitLeftAndRight();
    x1gr := ( Pt1.X > Pt2.X );
    y1gr := ( Pt1.Y > Pt2.Y );
    if ( Pt1.Y < R.Top ) or ( Pt2.Y < R.Top ) then
      _FitTopAndBottom();
  end;

  // Correct for refits
  if x1gr and ( Pt2.X > Pt1.X )  then
    _SwapX()
  else
  if ( x1gr = False ) and ( Pt1.X > Pt2.X ) then
    _SwapX();

  if y1gr and ( Pt2.Y > Pt1.Y )  then
    _SwapY()
  else
  if ( y1gr = False ) and ( Pt1.Y > Pt2.Y ) then
    _SwapY();


  if ( baseAngle > 45 ) and (baseAngle <= 225 )then
    IESwap( Pt1, Pt2 );
end;


// Given a distance and an angle from a point, what would be the new position?
function OffsetPoint(Pt: TPoint; Dist: Double; Angle: Double) : TPoint;
var
  aa: Double;
begin
  aa := -angle * pi / 180;
  Result.X := Pt.X + trunc(( Dist * cos( aa )));
  Result.Y := Pt.Y + trunc(( Dist * sin( aa )));
end;


function IEIsLeftMouseButtonPressed: boolean;
begin
  result := (((GetAsyncKeyState(VK_LBUTTON) and $8000)<>0) and (GetSystemMetrics(SM_SWAPBUTTON)=0)) or
            (((GetAsyncKeyState(VK_RBUTTON) and $8000)<>0) and (GetSystemMetrics(SM_SWAPBUTTON)<>0));
end;

function IERGBToStr(rgb: TRGB): AnsiString;
begin
  with rgb do
    result := IEIntToStr(r)+', '+IEIntToStr(g)+', '+IEIntToStr(b);
end;

function IEGetURLTypeW(const URL: WideString): TIEURLType;
begin
  result := IEGetURLTypeA(AnsiString(URL));
end;

function IEGetURLTypeA(const URL: AnsiString): TIEURLType;
var
  tmp: AnsiString;
begin
  tmp := IELowerCase(URL);
  if IECopy(tmp, 1, 7) = 'http://' then
    result := ieurlHTTP
  else
  if IECopy(tmp, 1, 8) = 'https://' then
    result := ieurlHTTPS
  else
  if IECopy(tmp, 1, 6) = 'ftp://' then
    result := ieurlFTP
  else
    result := ieurlUNKNOWN;
end;

// Return distance between (x, y) and the ellipse inside x1, y1, x2, y2
// Coordinates x1, y1, x2, y2 must be ordered
// 3.0.2 (penWidth)
function IEDistPoint2Ellipse(x, y, x1, y1, x2, y2: integer; filled: boolean; penWidth: integer): double;
var
  g, xr1, yr1, xr2, yr2, rx, ry, p, pw, ox, oy: integer;
  d: double;
begin
  result := 2147483647;
  for pw := -penWidth div 2 to penWidth div 2 do
  begin
    rx := (x2 - x1) div 2 + pw; // ray x
    ry := (y2 - y1) div 2 + pw; // ray y
    ox := x - (x1 + rx)+pw;
    oy := y - (y1 + ry)+pw;
    if filled then
      p := trunc(2 * pi * imin(rx, ry))
    else
      p := trunc(2 * pi * imin(rx, ry)) shr 3;

    if p<2 then p := 2;

    xr1 := rx;
    yr1 := 0;
    for g := 1 to p - 1 do
    begin
      xr2 := trunc(cos((2 * pi / p) * g) * rx);
      yr2 := trunc(sin((2 * pi / p) * g) * ry);
      if filled then
        d := trunc(_DistPoint2Seg(ox, oy, 0, 0, xr2, yr2))
      else
        d := _DistPoint2Seg(ox, oy, xr1, yr1, xr2, yr2);
      if d < result then
        result := d;
      xr1 := xr2;
      yr1 := yr2;
    end;
  end;
end;


// 3.0.2 (penWidth)
function IEDist2Box(x, y, x1, y1, x2, y2: integer; filled: boolean; penWidth: integer): double;
var
  pw: integer;
begin
  result := 2147483647;
  for pw := -penWidth div 2 to penWidth div 2 do
  begin
    result := dmin(result, dmin(_DistPoint2Seg(x, y, x1+pw, y1+pw, x2+pw, y1+pw),
                           dmin(_DistPoint2Seg(x, y, x2+pw, y1+pw, x2+pw, y2+pw),
                           dmin(_DistPoint2Seg(x, y, x2+pw, y2+pw, x1+pw, y2+pw),
                                _DistPoint2Seg(x, y, x1+pw, y2+pw, x1+pw, y1+pw)))));
    if filled and IEPointInRect(x, y, x1+pw, y1+pw, x2+pw, y2+pw) then
    begin
      result := 0;
      break;
    end;
  end;
end;


// calculate the distance of two parallel lines
// line A: defined by two points (FirstLinePointA, FirstLinePointB)
// line B: defined by one point  (SecondLinePoint)
function IEDistParallelLines(FirstLinePointA: TIE2DPoint; FirstLinePointB: TIE2DPoint; SecondLinePoint: TIE2DPoint): double;
var
  AB, BC, AC: double;
  p: double;
  S: double;
begin
  AB := IEDDistPoint2Point(FirstLinePointA.X, FirstLinePointA.Y, FirstLinePointB.X, FirstLinePointB.Y);
  BC := IEDDistPoint2Point(FirstLinePointB.X, FirstLinePointB.Y, SecondLinePoint.X, SecondLinePoint.Y);
  AC := IEDDistPoint2Point(FirstLinePointA.X, FirstLinePointA.Y, SecondLinePoint.X, SecondLinePoint.Y);
  p := (AB + BC + AC) / 2.0;  // perimeter / 2
  S := sqrt(p * (p - AB) * (p - BC) * (p - AC));  // area (Heron's formula)
  result := 2.0 * S / AB; // triangle height
end;


// calculate the signed area of triangle
function IESignedTriangleArea(Point1: TIE2DPoint; Point2: TIE2DPoint; Point3: TIE2DPoint): double;
begin
  result := (-Point2.X * Point1.Y + Point3.X * Point1.Y + Point1.X * Point2.Y - Point3.X * Point2.Y - Point1.X * Point3.Y + Point2.X * Point3.Y) / 2.0;
end;


// calculate the offsets to translate a segment such that it passes by a given point, respecting the original orientation and direction (that is "to offset the coordinates in the orthogonal direction")
// "P" (Point) can be any point in the translated line (even out of segment)
//    P
//   /
//  /    /
// /    /
//     /
procedure IEOrthogonalTranslate(OrigSegmentA, OrigSegmentB: TIE2DPoint; Point: TIE2DPoint; out OffsetX: double; out OffsetY: double);
var
  L, offsetPixels: double;
begin
  offsetPixels := IEDistParallelLines(OrigSegmentA, OrigSegmentB, Point);
  if IESignedTriangleArea(OrigSegmentA, OrigSegmentB, Point) > 0 then
    offsetPixels := -offsetPixels;
  L := sqrt((OrigSegmentA.X - OrigSegmentB.X) * (OrigSegmentA.X - OrigSegmentB.X) + (OrigSegmentA.Y - OrigSegmentB.Y) * (OrigSegmentA.Y - OrigSegmentB.Y));
  OffsetX := offsetPixels * (OrigSegmentB.Y - OrigSegmentA.Y) / L;
  OffsetY := offsetPixels * (OrigSegmentA.X - OrigSegmentB.X) / L;
end;




function IETrim(const v: AnsiString): AnsiString;
begin
{$IFDEF UNICODE}
  result := AnsiString(trim(string(v)));
{$ELSE}
  result := trim(v);
{$ENDIF}
end;

function IEExtractFileExtS(const FileName: string; includeDot: boolean=true): string;
begin
  result := ExtractFileExt(LowerCase(FileName));
  if not includeDot then
    result := Copy(result, 2, length(result)-1);
end;

function IEExtractFileExtA(const FileName: AnsiString; includeDot: boolean): AnsiString;
begin
  {$ifdef IEHASANSISTRINGBUG}
  result := IEExtractFileExtS(string(FileName), includeDot);
  {$else}
  result := AnsiString(IEExtractFileExtS(string(FileName), includeDot));
  {$endif}
end;

function IEExtractFileExtW(const FileName: WideString; includeDot: boolean): WideString;
begin
  result := WideString(IEExtractFileExtS(string(FileName), includeDot));
end;
     

// = IncludeTrailingBackSlash, but if path is '' it returns ''
function IEAddBackSlash(const Path: String): String;
begin
  Result := '';
  if Path <> '' then
    Result := IncludeTrailingBackSlash( Path );
end;


{!!
<FS>IEFilenameInExtensions

<FM>Declaration<FC>
function IEFilenameInExtensions(const sFileName, sExtensions : String) : Boolean;

<FM>Description<FN>
Returns true if the filename has an extension listed in those passed (in format '*.jpeg;*.jpg;*.gif;');

For example: IEFilenameInExtensions('C:\File.avi', '*.AVI;*.mpg;*.mpeg') would return true

<FM>See Also<FN>
- <A General Helper Functions>
!!}
function IEFilenameInExtensions(const sFileName, sExtensions : String) : Boolean;
begin
  Result := IEFileExtInExtensions(ExtractFileExt(sFilename), sExtensions);
end;


{!!
<FS>IEFileExtInExtensions

<FM>Declaration<FC>
function IEFileExtInExtensions(sFileExt : String; const sExtensions : String) : Boolean;

<FM>Description<FN>
Returns true if the extension (with or without the dot) is listed in those passed (in format '*.jpeg;*.jpg;*.gif;');

For example: IEFilenameInExtensions('.avi', '*.AVI;*.mpg;*.mpeg') would return true

Note: <FC>sExtensions<FN> can be '*.*';

<FM>See Also<FN>
- <A General Helper Functions>
!!}
function IEFileExtInExtensions(sFileExt : String; const sExtensions : String) : Boolean;
begin
  Result := False;

  sFileExt := Lowercase(sFileExt);
  if (sFileExt <> '') and (sFileExt[1] <> '.') then
    sFileExt := '.' + sFileExt;

  if ( sExtensions = '*.*' ) or ( sExtensions = '*.*;' ) then
    result := True
  else
  if ( Length( sFileExt ) > 1 ) and ( pos( sFileExt + ';', Lowercase( sExtensions + ';' )) > 0 ) then
    result := True;
end;



function IEUpperCase(const v: AnsiString): AnsiString;
begin
{$IFDEF UNICODE}
  result := AnsiString(UpperCase(string(v)));
{$ELSE}
  result := UpperCase(v);
{$ENDIF}
end;

function IELowerCase(const v: AnsiString): AnsiString;
begin
{$IFDEF UNICODE}
  result := AnsiString(LowerCase(string(v)));
{$ELSE}
  result := LowerCase(v);
{$ENDIF}
end;

function IEIntToStr(v: integer): AnsiString;
begin
{$IFDEF UNICODE}
  result := AnsiString(IntToStr(v));
{$ELSE}
  result := IntToStr(v);
{$ENDIF}
end;
   

// iMaxDigitsOfPrecision: Specifies number of leading digits that are non zero, e.g. 3 woudl make 123,456 return 123,000
function IEIntToFormattedStr(v: integer; iMaxDigitsOfPrecision: Integer = 0): AnsiString;
var
  iRoundTo: Integer;
begin
  if iMaxDigitsOfPrecision > 0 then
  begin
    iRoundTo := Length( IntToStr( v )) - iMaxDigitsOfPrecision;
    if iRoundTo > 0 then
      v := Trunc( RoundTo( v, iRoundTo ));
  end;

{$IFDEF UNICODE}
  result := AnsiString(format('%.0n', [v * 1.0]));
{$ELSE}
  result := format('%.0n', [v * 1.0]);
{$ENDIF}
end;

// MAX VALUE: 2GB!!!
function IEBytesToStr(v: integer; iThreshold: Integer = 100 * 1024) : AnsiString;
begin
{$IFDEF UNICODE}
  if v < iThreshold then
    Result := IEIntToFormattedStr(v) + AnsiString(' bytes')
  else
    Result := IEIntToFormattedStr(v div 1024) + AnsiString(' KB');
{$ELSE}
  if v < iThreshold then
    Result := IEIntToFormattedStr(v) + ' bytes'
  else
    Result := IEIntToFormattedStr(v div 1024) + ' KB';
{$ENDIF}
end;

// Handles very big sizes which may include files in KB, MB or FB
function IEBytesToStr2(iBytes: Int64) : AnsiString;
const
  ONE_KB = 1024;
  ONE_MB = ONE_KB * ONE_KB;
  ONE_GB = ONE_MB * ONE_KB;

  function _FloatToFormatString(Value: Real;
                                iDecimalCount: Integer;
                                bStripZeros: boolean = True): AnsiString;
  begin
    result := AnsiString(Format('%.' + inttostr(iDecimalCount) + 'f', [Value]));

    if bStripZeros and (IEPos('.', result) > 0) then
    begin
      while result[length(result)] = '0'  do
        setlength(result, length(result) - 1);

      if result[length(result)] = '.' then
        setlength(result, length(result) - 1);
    end;
  end;

begin
  {$IFDEF UNICODE}
  if iBytes < 10 * ONE_MB then
    Result := IEBytesToStr(iBytes, ONE_KB)
  else
  if iBytes < 1 * ONE_GB then
    result := _FloatToFormatString(iBytes / ONE_MB, 2) + AnsiString(' MB')
  else
    result := _FloatToFormatString(iBytes / ONE_GB, 2) + AnsiString(' GB');
  {$ELSE}
  if iBytes < 10 * ONE_MB then
    Result := IEBytesToStr(iBytes, ONE_KB)
  else
  if iBytes < 1 * ONE_GB then
    result := _FloatToFormatString(iBytes / ONE_MB, 2) + ' MB'
  else
    result := _FloatToFormatString(iBytes / ONE_GB, 2) + ' GB';
  {$ENDIF}
end;




function IEStrToIntDef(const s: AnsiString; def: integer): integer;
begin
{$IFDEF UNICODE}
  result := StrToIntDef(string(s), def);
{$ELSE}
  result := StrToIntDef(s, def);
{$ENDIF}
end;

function IECopy(S: AnsiString; Index, Count: Integer): AnsiString;
begin
{$IFDEF UNICODE}
  result := AnsiString(Copy(string(S), Index, Count));
{$ELSE}
  result := Copy(S, Index, Count);
{$ENDIF}
end;

function IEFloatToStrFA(Value: Extended; Format: TFloatFormat; Precision, Digits: Integer): AnsiString;
begin
  result := AnsiString(FloatToStrF(Value, Format, Precision, Digits));
end;

function IEFloatToStrFS(Value: Extended; Format: TFloatFormat; Precision, Digits: Integer): string;
begin
  result := FloatToStrF(Value, Format, Precision, Digits);
end;

function IEIntToHex(Value: Integer; Digits: Integer): AnsiString;
begin
{$IFDEF UNICODE}
  result := AnsiString(IntToHex(Value, Digits));
{$ELSE}
  result := IntToHex(Value, Digits);
{$ENDIF}
end;

function IEPos(Substr: AnsiString; S: AnsiString): Integer;
begin
{$IFDEF UNICODE}
  result := Pos(string(Substr), string(S));
{$ELSE}
  result := Pos(Substr, S);
{$ENDIF}
end;

function IEExtractFilePathA(const FileName: AnsiString): AnsiString;
begin
{$IFDEF UNICODE}
  result := AnsiString(ExtractFilePath(string(FileName)));
{$ELSE}
  result := ExtractFilePath(FileName);
{$ENDIF}
end;

function IEExtractFilePathW(const FileName: WideString): WideString;
var
  I: Integer;
begin
  I := LastDelimiter('\:', FileName);
  Result := Copy(FileName, 1, I);
end;

function IEExtractFileNameW(const FileName: WideString): WideString;
var
  I: Integer;
begin
  I := LastDelimiter('\:', FileName);
  Result := Copy(FileName, I + 1, MaxInt);
end;


function IEExtractFileNameWithoutExt(const FileName: String): String;
var
  iExtLen: integer;
begin
  Result := ExtractFilename( FileName );
  iExtLen := length( IEExtractFileExtW( Result ));
  if ( iExtLen > 0 ) and
     ( iExtLen < Length( Result )) then    // avoid issues with folder names with a leading period
    Delete( Result, Length( Result ) - iExtLen + 1, iExtLen );
end;


function IEStrDup(s: PAnsiChar): PAnsiChar;
begin
  if s <> nil then
  begin
    getmem(result, IEStrLen(s) + 1);
    IEStrCopy(result, s);
  end
  else
    result := nil;
end;


function IEStrDupW(s: PWideChar): PWideChar;
begin
  if s <> nil then
  begin
    getmem(result, IEStrLenW(s) * 2 + 2);
    IEStrCopyW(result, s);
  end
  else
    result := nil;
end;


function IEFileExists(const FileName: string): Boolean;
var
  Attr: Cardinal;
begin
  if IEGlobalSettings().UseDefaultFileExists then
    result := FileExists(FileName)
  else
  begin
    // FileGetSize is very slow, GetFileAttributes is much faster
    Attr := GetFileAttributes(Pointer(Filename));
    Result := (Attr <> $FFFFFFFF) and (Attr and FILE_ATTRIBUTE_DIRECTORY = 0);
  end;
end;

function IEFileExistsW(const FileName: WideString): Boolean;
var
  Attr: Cardinal;
begin
  {$IFDEF UNICODE}
  if IEGlobalSettings().UseDefaultFileExists then
    result := FileExists(string(FileName))
  else
  begin
  {$ENDIF}
    if IEGlobalSettings().UnicodeOS then
      Attr := GetFileAttributesW(PWideChar(Filename))
    else
      Attr := GetFileAttributesA(PAnsiChar(AnsiString(Filename)));
    Result := (Attr <> $FFFFFFFF) and (Attr and FILE_ATTRIBUTE_DIRECTORY = 0);
  {$IFDEF UNICODE}
  end;
  {$ENDIF}
end;


procedure IEDrawGrayedOut(Canvas: TCanvas; XDst, YDst, WidthDst, HeightDst: integer; SX1, SY1, SX2, SY2: integer);
var
  iec: TIECanvas;
begin
  if (SX1 < SX2) and (SY1 < SY2) then
  begin
    iec := TIECanvas.Create(Canvas, false);

    iec.Brush.Color := clBlack;
    iec.Brush.Style := bsSolid;
    iec.Brush.Transparency := 150;

    inc(WidthDst);
    inc(HeightDst);

    inc(SX1);
    inc(SY1);
    inc(SX2);
    inc(SY2);

    iec.FillRect(Rect(XDst, YDst, SX1+1, YDst+HeightDst));
    iec.FillRect(Rect(SX2-1, YDst, XDst+WidthDst, YDst+HeightDst));
    iec.FillRect(Rect(SX1, YDst, SX2, SY1+1));
    iec.FillRect(Rect(SX1, SY2, SX2, YDst+HeightDst));

    iec.Free;
  end;
end;

// A TStream.CopyFrom that adjusts "Count" (or autocalculated Count) to source size without raising exceptions
function IECopyFrom(Dest: TStream; Source: TStream; Count: int64): int64;
const
  MaxBufSize = $2FFFF;
var
  BufSize, N: Integer;
  Buffer: pbyte;
begin
  if Count = 0 then
  begin
    Source.Position := 0;
    Count := Source.Size;
  end;

  if not (Source is TZDecompressionStream)
     and not (Source is TZCompressionStream)
     and not (Source is TIEHashStream)
     then
  begin
    Count := i64max(0, i64min(Count, Source.Size-Source.Position));
  end;

  Result := Count;

  if Count > MaxBufSize then
    BufSize := MaxBufSize
  else
    BufSize := Count;

  GetMem(Buffer, BufSize);
  try
    while Count <> 0 do
    begin
      if Count > BufSize then N := BufSize else N := Count;
      Source.ReadBuffer(Buffer^, N);
      Dest.WriteBuffer(Buffer^, N);
      Dec(Count, N);
    end;
  finally
    FreeMem(Buffer, BufSize);
  end;
end;

procedure IEDecimalToFraction(value: double; var numerator: integer; var denominator: integer; accuracy: double);
var
  z: double;
  prevDen, sign, sVal: int64;
  anum, aden: int64;
  num, den: int64;
begin
  if value < 0.0 then
    sign := -1
  else
    sign := +1;
  value := abs(value);
  if value = trunc(value) then
  begin
    numerator := trunc(value * sign);
    denominator := 1;
    exit
  end;
  if value < 1.0E-19 then
  begin
    numerator := sign;
    denominator := 999999999;
    exit
  end;
  if value > 1.0E+19 then
  begin
    numerator := 999999999 * sign;
    denominator := 1;
    exit
  end;

  // in case of failure
  num := trunc(value);
  den := 1;

  z := value;
  prevDen := 0;
  aden := 1;
  repeat
    z := 1.0 / (z - trunc(z));
    sVal := aden;
    aden := aden * trunc(z) + prevDen;
    prevDen := sVal;
    anum := trunc(value * aden + 0.5);
    if (anum > 2147483647) or (aden > 2147483647) then
      break;
    num := anum;
    den := aden;
  until (abs((value - (anum / aden))) < accuracy) or (z = trunc(z));
  numerator   := sign * num;
  denominator := den;
end;


procedure IECopyTList(source: TList; dest: TList);
var
  i: integer;
begin
  dest.Count := source.Count;
  for i := 0 to source.Count-1 do
    dest[i] := source[i];
end;


function IESendMessageTimeout(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM; fuFlags, uTimeout: UINT; lpdwResult: pointer): LRESULT;
begin
  {$ifdef IEUSENEWSENDMESSAGETIMEOUT}
  result := SendMessageTimeout(hWnd, Msg, wParam, lParam, fuFlags, uTimeout, lpdwResult);
  {$else}
  result := SendMessageTimeout(hWnd, Msg, wParam, lParam, fuFlags, uTimeout, PDWORD(lpdwResult)^);
  {$endif}
end;



function IETextWidthW(Canvas: TCanvas; const Text: WideString): integer;
var
  Size: TSize;
begin
  Size.cx := 0;
  Size.cy := 0;
  Windows.GetTextExtentPoint32W(Canvas.Handle, PWideChar(Text), Length(Text), Size);
  result := Size.cx;
end;

function IETextHeightW(Canvas: TCanvas; const Text: WideString): integer;
var
  Size: TSize;
begin
  Size.cx := 0;
  Size.cy := 0;
  Windows.GetTextExtentPoint32W(Canvas.Handle, PWideChar(Text), Length(Text), Size);
  result := Size.cy;
end;

function IETruncateStr(sCaption : WideString; TruncSide: TIEMTruncSide; ACanvas : TCanvas; iMaxWidth : Integer) : Widestring;
var
  tw: integer;
  ws1: WideString;
  q: Integer;
begin
  Result := sCaption;
  case TruncSide of
    iemtsLeft:
      begin
        q := 1;
        repeat
          tw := IETextWidthW(ACanvas, Result);
          if (tw <= iMaxWidth) or (length(Result) < 2) then
            break;
          inc(q);
          ws1 := TrimRight( Copy(sCaption, 1, length(sCaption) - q ));
          if ws1 = '' then
            break;
          Result := ws1 + '...';
        until false;
      end;
    iemtsRight:
      begin
        q := 1;
        repeat
          tw := IETextWidthW(ACanvas, Result);
          if (tw <= iMaxWidth) or (length(Result) < 2) then
            break;
          inc(q);
          ws1 := TrimLeft( Copy(sCaption, q, length(sCaption)));
          if ws1 = '' then
            break;
          Result := '...' + ws1;
        until false;
      end;
  end;
end;



function IEFileTimeToDateTime(ft: TFileTime): TDateTime;
var
  LocalFileTime: TFileTime;
  iDosDT: integer;
begin
  Result := 0.0;
  if ft.dwLowDateTime + ft.dwHighDateTime = 0 then
    EXIT;

  if not FileTimeToLocalFileTime(ft, LocalFileTime) then
    EXIT;

  if not FileTimeToDosDateTime(LocalFileTime, longRec(iDosDT).hi, longRec(iDosDT).lo) then
    EXIT;

  if iDosDT <> -1 then
    Result := FileDateToDateTime(iDosDT);
end;


function IELargeFileSize(nFileSizeHigh, nFileSizeLow: DWORD) : Int64;
begin
  Int64Rec(Result).Lo := nFileSizeLow;
  Int64Rec(Result).Hi := nFileSizeHigh;
end;



{!!
<FS>IEGetFileDetails

<FM>Declaration<FC>
function IEGetFileDetails(const sFilename: string;
                          out iFileSizeBytes: Int64;
                          out dtCreateDate: TDateTime;
                          out dtEditDate: TDateTime
                          ): boolean;

<FM>Description<FN>
Return the size, create date and last edit date of a file. Result is false if an error occured.

<FM>See Also<FN>
- <A IEGetFileSize>
!!}
function IEGetFileDetails(const sFilename: string;
                          out iFileSizeBytes: Int64;
                          out dtCreateDate: TDateTime;
                          out dtEditDate: TDateTime
                          ): boolean;
var
  Data: TWin32FindData;
  H: THandle;
  ErrorMode: word;
begin
  result := true;
  iFileSizeBytes := 0;
  dtCreateDate := 0;
  dtEditdate := 0;
  { turn off critical errors }
  ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
  try
    try
      H := FindFirstFile(PCHAR(sFilename), Data);
      if H <> INVALID_HANDLE_VALUE then
      try
        iFileSizeBytes := IELargeFileSize(Data.nFileSizeHigh, Data.nFileSizeLow);
        dtEditDate := IEFileTimeToDateTime(Data.ftLastWriteTime);
        try
          dtCreateDate := IEFileTimeToDateTime(Data.ftCreationTime);
        except
          dtCreateDate := dtEditDate;
        end;
      finally
        Windows.FindClose(H);
      end
      else
        Result := false;
    except
      result := false;
    end;
  finally
    { restore old error mode }
    SetErrorMode(ErrorMode);
  end;
end;

{!!
<FS>IEFileSetDate

<FM>Declaration<FC>
function FileSetDate(const sFilename: string; DateTime: TDateTime): boolean;

<FM>Description<FN>
Same as sysutils.FileSetDate but takes a TDateTime as a parameter.
!!}
function IEFileSetDate(const sFilename: string; DateTime: TDateTime): boolean;
var
  liHandle: INTEGER;
begin
  result := False;

  if DateTime <> 0 then
  try
    liHandle := FileOpen(sFileName, fmOpenReadWrite or fmShareDenyNone);
    if liHandle > 0 then
    begin
      result := FileSetDate(liHandle, DateTimeToFileDate(DateTime)) <> 0;
      FileClose(liHandle);
    end;

  except
    // ERROR
  end;
end;


//////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////



// convert a real value into a string with decimal places
function IEFloatToFormatString(Value: Extended;
                               iDecimalCount: Integer;
                               bStripZeros: boolean): string;
begin
  result := Format('%.' + inttostr( imax(0, iDecimalCount )) + 'f', [Value]);

  if bStripZeros and (pos('.', result) > 0) then
    while result[length(result)] = '0' do
      setlength(result, length(result) - 1);

  if result[length(result)] = '.' then
    setlength(result, length(result) - 1);
end;


//////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////




function IE2DPoint(X, Y: double): TIE2DPoint;
begin
  result.X := X;
  result.Y := Y;
end;


{$ifndef IEHASUINT64}
function UInt64(v : Pointer) : int64;
begin
  result := int64(DWORD(v));
end;

function UInt64(v : Integer) : int64;
begin
  result := int64(DWORD(v));
end;
{$endif}


{$ifndef IEHASNATIVEINT}
function Nativeint(v: Pointer): DWORD;
begin
  result := DWORD(v);
end;

function Nativeint(v: Char): DWORD;
begin
  result := DWORD(v);
end;
{$endif}



{$IfNDef Delphi6orNewer}
function Get8087CW: Word; // for D5
asm
  PUSH    0
  FNSTCW  [ESP].Word
  POP     EAX
end;
{$ENDIF}


{$ifdef IEVISION}
function IEVisionBGR8ToTRGB(visionBGR8: TIEVisionBGR8): TRGB;
begin
  result.b := visionBGR8.b;
  result.g := visionBGR8.g;
  result.r := visionBGR8.r;
end;

function IETRGBToVisionBGR8(rgb: TRGB): TIEVisionBGR8;
begin
  result.b := rgb.b;
  result.g := rgb.g;
  result.r := rgb.r;
end;

// from PixleFormat to IEVision channelFormat/channelCount
procedure IEVisionConvPixelFormat(PixelFormat: TIEPixelFormat; out channelFormat: TIEVisionChannelFormat; out channelCount: integer);
begin
  channelFormat := ievUINT8;
  channelCount :=  0;
  case PixelFormat of
    ie1g:
      begin
        channelFormat := ievUINT1;
        channelCount  := 1;
      end;
    ie8p:
      begin
        channelFormat := ievUINT8;
        channelCount  := 1;
      end;
    ie8g:
      begin
        channelFormat := ievUINT8;
        channelCount  := 1;
      end;
    ie16g:
      begin
        channelFormat := ievUINT16;
        channelCount  := 1;
      end;
    ie24RGB:
      begin
        channelFormat := ievUINT8;
        channelCount  := 3;
      end;
    ie32f:
      begin
        channelFormat := ievFLOAT32;
        channelCount  := 1;
      end;
    ieCMYK:
      begin
        channelFormat := ievUINT8;
        channelCount  := 4;
      end;
    ie48RGB:
      begin
        channelFormat := ievUINT16;
        channelCount  := 3;
      end;
    ieCIELab:
      begin
        channelFormat := ievUINT8;
        channelCount  := 3;
      end;
    ie32RGB:
      begin
        channelFormat := ievUINT8;
        channelCount  := 4;
      end;
  end;
end;

// from IEVision channelFormat/channelCount to PixleFormat 
function IEVisionConvPixelFormat(channelFormat: TIEVisionChannelFormat; channelCount: integer): TIEPixelFormat;
begin
  result := ienull; // invalid
  case channelFormat of
    ievUINT1:
      begin
        case channelCount of
          1: result := ie1g;
        end;
      end;
    ievUINT8:
      begin
        case channelCount of
          1: result := ie8g;
          3: result := ie24RGB;
          4: result := ie32RGB;
        end;
      end;
    ievUINT16:
      begin
        case channelCount of
          1: result := ie16g;
          3: result := ie48RGB;
        end;
      end;
    ievFLOAT32:
      begin
        case channelCount of
          1: result := ie32f;
        end;
      end;
  end;
end;
{$endif}




///////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////
// Swaps two values

procedure IESwap(var a: integer; var b: integer);
var
  t: integer;
begin
  t := a; a := b; b := t;
end;

procedure IESwap(var a: double; var b: double);
var
  t: double;
begin
  t := a; a := b; b := t;
end;

procedure IESwap(var a: boolean; var b: boolean);
var
  t: boolean;
begin
  t := a; a := b; b := t;
end;

procedure IESwap(var a: TIELayerMagnification; var b: TIELayerMagnification);
var
  t: TIELayerMagnification;
begin
  t := a; a := b; b := t;
end;

procedure IESwap(var a: TIERenderOperation; var b: TIERenderOperation);
var
  t: TIERenderOperation;
begin
  t := a; a := b; b := t;
end;

procedure IESwap(var a: pointer; var b: pointer);
var
  t: pointer;
begin
  t := a; a := b; b := t;
end;

procedure IESwap(var a: TResampleFilter; var b: TResampleFilter);
var
  t: TResampleFilter;
begin
  t := a; a := b; b := t;
end;

procedure IESwap(var a: AnsiString; var b: AnsiString);
var
  t: AnsiString;
begin
  t := a; a := b; b := t;
end;

{$IfDef UNICODE}
procedure IESwap(var a: UnicodeString; var b: UnicodeString);
var
  t: UnicodeString;
begin
  t := a; a := b; b := t;
end;
{$EndIf}

procedure IESwap(var a: TGuid; var b: TGuid);
var
  t: TGuid;
begin
  t := a; a := b; b := t;
end;


procedure IESwap(var a: TRGB; var b: TRGB);
var
  t: TRGB;
begin
  t := a; a := b; b := t;
end;

procedure IESwap(var a: TIEArrayOfTRGB; var b: TIEArrayOfTRGB);
var
  t: TIEArrayOfTRGB;
begin
  t := a; a := b; b := t;
end;

procedure IESwap(var a: TRect; var b: TRect);
var
  t: TRect;
begin
  t := a; a := b; b := t;
end;    

procedure IESwap(var a: TIEShape; var b: TIEShape);
var
  t: TIEShape;
begin
  t := a; a := b; b := t;
end;

procedure IESwap(var a: TColor; var b: TColor);
var
  t: TColor;
begin
  t := a; a := b; b := t;
end;

procedure IESwap(var a: TFont; var b: TFont);
var
  tmpCharset: TFontCharset;
  tmpColor: TColor;
  tmpHeight: Integer;
  tmpName: TFontName;
  tmpStyle: TFontStyles;
begin
  tmpCharset := a.Charset;
  a.Charset  := b.Charset;
  b.Charset  := tmpCharset;

  tmpColor   := a.Color;
  a.Color    := b.Color;
  b.Color    := tmpColor;

  tmpHeight  := a.Height;
  a.Height   := b.Height;
  b.Height   := tmpHeight;

  tmpName    := a.Name;
  a.Name     := b.Name;
  b.Name     := tmpName;

  tmpStyle   := a.Style;
  a.Style    := b.Style;
  b.Style    := tmpStyle;
end;

procedure IESwap(var a: TPoint; var b: TPoint);
var
  t: TPoint;
begin
  t := a; a := b; b := t;
end;


///////////////////////////////////////////////////////////////////////////////////////////////////////////
// timeout support

function IESetupTimeout(): dword;
begin
  result := GetTickCount();
end;

function IEIsTimeoutExpired(startTime: dword; timeout: dword): boolean;
var
  diff: dword;
  curr: dword;
begin
  curr := GetTickCount();
  if startTime > curr then
    // overflow
    diff := $FFFFFFFF - startTime + curr
  else
    diff := curr - startTime;
  result := diff >= timeout;
end;


///////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////

{!!
<FS>IERectangle

<FM>Declaration<FC>
function IERectangle(x, y, width, height: integer): <A TIERectangle>; overload;
function IERectangle(Rect: TRect): <A TIERectangle>; overload;

<FM>Description<FN>
Create a TIERectangle structure.
!!}
function IERectangle(x, y, width, height: integer): TIERectangle;
begin
  result.x      := x;
  result.y      := y;
  result.width  := width;
  result.height := height;
end;

function IERectangle(Rect: TRect): TIERectangle;
begin
  with Rect do
  begin
    result.x      := Left;
    result.y      := Top;
    result.width  := Right - Left;
    result.height := Bottom - Top;
  end;
end;


////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////
// TIEClientSocket


const

  WSADESCRIPTION_LEN = 256;
  WSASYS_STATUS_LEN  = 128;
  INVALID_SOCKET     = pointer(-1);
  SOCKET_ERROR       = -1;
  AF_INET            = 2;
  SOCK_STREAM        = 1;
  AF_UNSPEC          = 0;
  IPPROTO_TCP        = 6;
  TCP_NODELAY        = $0001;
  SD_BOTH            = 2;

type

  TWSAData = record
    wVersion: Word;
    wHighVersion: Word;
    szDescription: array[0..WSADESCRIPTION_LEN] of AnsiChar;
    szSystemStatus: array[0..WSASYS_STATUS_LEN] of AnsiChar;
    iMaxSockets: Word;
    iMaxUdpDg: Word;
    lpVendorInfo: PAnsiChar;
  end;

  SunB = packed record
    s_b1, s_b2, s_b3, s_b4: byte;
  end;

  SunW = packed record
    s_w1, s_w2: word;
  end;

  in_addr = record
    case integer of
      0: (S_un_b: SunB);
      1: (S_un_w: SunW);
      2: (S_addr: dword);
  end;

  TInAddr = in_addr;

  sockaddr_in = record
    case Integer of
      0: (sin_family: word;
          sin_port: word;
          sin_addr: TInAddr;
          sin_zero: array[0..7] of AnsiChar);
      1: (sa_family: word;
          sa_data: array[0..13] of AnsiChar)
  end;

  TSockAddr = sockaddr_in;
  PSOCKADDR = ^TSockAddr;

  paddrinfoA = ^addrinfoA;
  addrinfoA = packed record
    ai_flags: integer;
    ai_family: integer;
    ai_socktype: integer;
    ai_protocol: integer;
    ai_addrlen: TIESizeT;
    ai_canonname: PAnsiChar;
    ai_addr: PSOCKADDR;
    ai_next: paddrinfoA;
  end;

  TIE_WSAStartup = function(wVersionRequired: word; var WSData: TWSAData): Integer; stdcall;
  TIE_WSACleanup = function(): Integer; stdcall;
  TIE_recv = function(s: pointer; var Buf; len, flags: Integer): Integer; stdcall;
  TIE_send = function(s: pointer; var Buf; len, flags: Integer): Integer; stdcall;
  TIE_socket = function(af, Struct, protocol: Integer): pointer; stdcall;
  TIE_getaddrinfo = function(nodename: PAnsiChar; servname: PAnsiChar; hints: paddrinfoA; var res: paddrinfoA): integer; stdcall;
  TIE_freeaddrinfo = procedure(addr: paddrinfoA); stdcall;
  TIE_connect = function(s: pointer; var name: TSockAddr; namelen: Integer): Integer; stdcall;
  TIE_setsockopt = function(s: pointer; level, optname: Integer; optval: PAnsiChar; optlen: Integer): Integer; stdcall;
  TIE_shutdown = function(s: pointer; how: Integer): Integer; stdcall;
  TIE_closesocket = function(s: pointer): Integer; stdcall;

var
  IE_SockLibInitCS: TCriticalSection;
  IE_SockLib: THandle = 0;
  IE_SockLibCount: integer = 0;
  IE_WSAStartup: TIE_WSAStartup = nil;
  IE_WSACleanup: TIE_WSACleanup = nil;
  IE_recv: TIE_recv = nil;
  IE_send: TIE_send = nil;
  IE_socket: TIE_socket = nil;
  IE_getaddrinfo: TIE_getaddrinfo = nil;
  IE_freeaddrinfo: TIE_freeaddrinfo = nil;
  IE_connect: TIE_connect = nil;
  IE_setsockopt: TIE_setsockopt = nil;
  IE_shutdown: TIE_shutdown = nil;
  IE_closesocket: TIE_closesocket = nil;



function IEInitializeSocketLib: boolean;
begin
  IE_SockLibInitCS.Enter();
  result := true;
  try
    if IE_SockLibCount = 0 then
    begin
      result := false;
      IE_SockLib := LoadLibrary('Ws2_32.dll');
      if IE_SockLib<>0 then
      begin
        IE_WSAStartup := GetProcAddress(IE_SockLib, 'WSAStartup');
        IE_WSACleanup := GetProcAddress(IE_SockLib, 'WSACleanup');
        IE_recv := GetProcAddress(IE_SockLib, 'recv');
        IE_send := GetProcAddress(IE_SockLib, 'send');
        IE_socket := GetProcAddress(IE_SockLib, 'socket');
        IE_getaddrinfo := GetProcAddress(IE_SockLib, 'getaddrinfo');
        IE_freeaddrinfo := GetProcAddress(IE_SockLib, 'freeaddrinfo');
        IE_connect := GetProcAddress(IE_SockLib, 'connect');
        IE_setsockopt := GetProcAddress(IE_SockLib, 'setsockopt');
        IE_shutdown := GetProcAddress(IE_SockLib, 'shutdown');
        IE_closesocket := GetProcAddress(IE_SockLib, 'closesocket');
        result := assigned(@IE_WSAStartup) and assigned(@IE_WSACleanup) and assigned(@IE_recv) and
                  assigned(@IE_send) and assigned(@IE_socket) and assigned(@IE_getaddrinfo) and assigned(@IE_freeaddrinfo) and
                  assigned(@IE_connect) and assigned(@IE_setsockopt) and assigned(@IE_shutdown) and assigned(@IE_closesocket);
        if not result then
          FreeLibrary(IE_SockLib);
      end;
    end;
    if result then
      inc(IE_SockLibCount);
  finally
    IE_SockLibInitCS.Leave();
  end;
end;

procedure IEFinalizeSocketLib;
begin
  IE_SockLibInitCS.Enter();
  try
    dec(IE_SockLibCount);
    if IE_SockLibCount = 0 then
    begin
      FreeLibrary(IE_SockLib);
      IE_SockLib := 0;
    end;
  finally
    IE_SockLibInitCS.Leave();
  end;
end;

constructor TIEClientSocket.Create;
var
  versionRequired: word;
  WSData: TWSAData;
begin
  inherited;

  m_socket := INVALID_SOCKET;
  m_littleEndian := false;

  versionRequired := 2 or (2 shl 8);
  if not IEInitializeSocketLib() or (IE_WSAStartUp(versionRequired, WSData)<>0) then
    raise EIERFBError.Create('Failed to startup WinSock');
end;

destructor TIEClientSocket.Destroy;
begin
  IE_WSACleanUp();
  IEFinalizeSocketLib();
  inherited;
end;

procedure TIEClientSocket.ReceiveBuffer(buf: pointer; len: integer);
var
  r, tr: integer;
begin
  tr := 0;
  while tr < len do
  begin
    r := IE_recv(m_socket, pbyte(buf)^, len-tr, 0);
    if r = 0 then
      raise EIERFBError.Create('Connection closed')
    else
    if r = SOCKET_ERROR then
      raise EIERFBError.Create('Receive error');
    inc(tr, r);
    inc(pbyte(buf), r);
  end;
end;

function TIEClientSocket.ReceiveBufferSilent(buf: pointer; len: integer): Boolean;
var
  r, tr: integer;
begin
  result := true;
  tr := 0;
  while tr < len do
  begin
    r := IE_recv(m_socket, pbyte(buf)^, len-tr, 0);
    if (r = 0) or (r = SOCKET_ERROR) then
    begin
      result := false;
      break;
    end;
    inc(tr, r);
    inc(pbyte(buf), r);
  end;
end;

procedure TIEClientSocket.SendBuffer(buf: pointer; len: integer);
var
  s, ts: integer;
begin
  ts := 0;
  while ts < len do
  begin
    s := IE_send(m_socket, pbyte(buf)^, len-ts, 0);
    if s = SOCKET_ERROR then
      raise EIERFBError.Create('Send error');
    inc(ts, s);
    inc(pbyte(buf), s);
  end;
end;

function TIEClientSocket.ReceiveByte(): byte;
begin
  ReceiveBuffer(@result, 1);
end;

function TIEClientSocket.ReceiveByteSilent(var b: Byte): Boolean;
begin
  result := ReceiveBufferSilent(@b, 1);
end;

procedure TIEClientSocket.ReceivePad(len: integer);
begin
  while len>0 do
  begin
    ReceiveByte();
    dec(len);
  end;
end;

function TIEClientSocket.ReceiveWord(): word;
begin
  ReceiveBuffer(@result, 2);
  if not m_littleEndian then
    result := IESwapWord(result);
end;

function TIEClientSocket.ReceiveDWord(): dword;
begin
  ReceiveBuffer(@result, 4);
  if not m_littleEndian then
    result := IESwapDWord(result);
end;

procedure TIEClientSocket.SendByte(value: byte);
begin
  SendBuffer(@value, 1);
end;

procedure TIEClientSocket.SendPad(len: integer);
begin
  while len>0 do
  begin
    SendByte(0);
    dec(len);
  end;
end;

procedure TIEClientSocket.SendWord(value: word);
begin
  if not m_littleEndian then
    value := IESwapWord(value);
  SendBuffer(@value, 2);
end;

procedure TIEClientSocket.SendDWord(value: dword);
begin
  if not m_littleEndian then
    value := IESwapDWord(value);
  SendBuffer(@value, 4);
end;

procedure TIEClientSocket.Connect(const Address: string; Port: word);
var
  addr: paddrinfoA;
  hints: addrinfoA;
  PortStr: AnsiString;
  i: integer;
  dw: dword;
begin
  try
    m_socket := IE_socket(AF_INET, SOCK_STREAM, 0);
    if m_socket = INVALID_SOCKET then
      raise EIERFBError.Create('Failed to open socket');

    addr := nil;
    ZeroMemory(@hints, sizeof(addrinfoA));
    hints.ai_family := AF_UNSPEC;
    hints.ai_socktype := SOCK_STREAM;
    hints.ai_protocol := IPPROTO_TCP;
    PortStr := IEIntToStr(Port);
    if IE_getaddrinfo(PAnsiChar(AnsiString(Address)), PAnsiChar(PortStr), @hints, addr) <> 0 then
      raise EIERFBError.Create('Cannot resolve host name');
    i := IE_connect(m_socket, addr^.ai_addr^, addr^.ai_addrlen);
    IE_freeaddrinfo(addr);
    if i = SOCKET_ERROR then
      raise EIERFBError.Create('Connection error');

    dw := 1;
    IE_setsockopt(m_socket, IPPROTO_TCP, TCP_NODELAY, PAnsiChar(@dw), sizeof(BOOL));
  except
    if m_socket<>INVALID_SOCKET then
    begin
      IE_shutdown(m_socket, SD_BOTH);
      IE_closesocket(m_socket);
      m_socket := INVALID_SOCKET;
    end;
    raise;
  end;
end;

procedure TIEClientSocket.Disconnect();
begin
  if Connected then
  begin
    IE_shutdown(m_socket, SD_BOTH);
    IE_closesocket(m_socket);
    m_socket := INVALID_SOCKET;
  end;
end;

function TIEClientSocket.GetConnected: boolean;
begin
  result := m_socket <> INVALID_SOCKET;
end;

// TIEClientSocket
////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////


constructor TIEByteArray.Create(InitBlockSize: integer);
begin
  inherited Create;
  fBlockSize := InitBlockSize;
  fSize := 0;
  fRSize := fBlockSize;
  getmem(Data, fRSize);
end;

destructor TIEByteArray.Destroy;
begin
  freemem(Data);
  inherited;
end;

procedure TIEByteArray.AddByte(v: byte);
begin
  SetSize(fSize + 1);
  Data^[fSize - 1] := v;
end;

procedure TIEByteArray.Clear;
begin
  freemem(Data);
  fSize := 0;
  fRSize := fBlockSize;
  getmem(Data, fRSize);
end;

procedure TIEByteArray.SetSize(v: integer);
var
  tmp: pbytearray;
begin
  if v > fSize then
  begin
    // increase
    if v > fRSize then
    begin
      fRSize := v + fBlockSize;
      getmem(tmp, fRSize);
      CopyMemory(tmp, Data, fSize);
      freemem(Data);
      Data := tmp;
    end;
  end
  else
  begin
    // decrease
    if v < (fRSize - fBlockSize) then
    begin
      fRSize := v + fBlockSize;
      getmem(tmp, fRSize);
      CopyMemory(tmp, Data, v);
      freemem(Data);
      Data := tmp;
    end;
  end;
  fSize := v;
end;

// returns number of bytes written
function TIEByteArray.AppendFromStream(Stream: TStream; Count: integer): integer;
var
  l: integer;
begin
  l := fSize;
  SetSize(fSize + Count);
  result := Stream.Read(Data^[l], Count);
  if result < Count then
    SetSize(l + result);
end;

/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////



///////////////////////////////////////////////////////////////////////////////////////////////////////////
// Gestures support

var
  IEGesturesUser32Lib:     THandle = 0;



procedure IEInitialize_gestures();
begin
  IEGesturesUser32Lib := LoadLibrary('User32.dll');
  if IEGesturesUser32Lib <> 0 then
  begin
    IEGetGestureInfo         := GetProcAddress(IEGesturesUser32Lib, 'GetGestureInfo');
    IECloseGestureInfoHandle := GetProcAddress(IEGesturesUser32Lib, 'CloseGestureInfoHandle');
    IESetGestureConfig       := GetProcAddress(IEGesturesUser32Lib, 'SetGestureConfig');
    IEUnregisterTouchWindow  := GetProcAddress(IEGesturesUser32Lib, 'UnregisterTouchWindow');
    if @IEGetGestureInfo = nil then
      IEFinalize_gestures();
  end;
end;

procedure IEFinalize_gestures();
begin
  if IEGesturesUser32Lib <> 0 then
  begin
    FreeLibrary(IEGesturesUser32Lib);
    IEGesturesUser32Lib := 0;
  end;
end;

function IEHasGestures(): boolean;
begin
  result := IEGesturesUser32Lib <> 0;
end;

// Gestures support
///////////////////////////////////////////////////////////////////////////////////////////////////////////


procedure InitIECosineTab;
var
  i: integer;
begin
  for i := 0 to 255 do
    IECosineTab[i] := Round(64 - Cos(i * Pi / 255) * 64);
end;

procedure IEBezier2D4Controls(p0: TPoint; c0: TPoint; c1: TPoint; p1: TPoint; pResultArray: PPointArray; nSteps: integer);
var
  t, t_sq, t_cb, incr, r1, r2, r3, r4: double   ;
  i: integer      ;
begin
  incr := 1.0/nSteps;
  t := incr;
  for i := 0 to nSteps-1 do
  begin
     t_sq := t * t;
     t_cb := t * t_sq;
     r1   := 1 - 3*t + 3*t_sq -   t_cb;
     r2   :=     3*t - 6*t_sq + 3*t_cb;
     r3   :=           3*t_sq - 3*t_cb;
     r4   :=                      t_cb;
     pResultArray[i].x := round(r1*p0.x + r2*c0.x + r3*c1.x + r4*p1.x);
     pResultArray[i].y := round(r1*p0.y + r2*c0.y + r3*c1.y + r4*p1.y);
     t := t+incr;
  end;
end;

  
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///  GRADIENT

const
  GRADIENT_FILL_RECT_V = $00000001;
  GRADIENT_FILL_RECT_H = $00000000;

type
  Trivertex = packed record
    X, Y: DWORD;
    Red, Green, Blue, Alpha: Word;
  end;

  TGradientFill = function(DC: HDC; pVertex: Pointer; dwNumVertex: DWORD; pMesh: Pointer; dwNumMesh, dwMode: DWORD): LongBool; stdcall;

  TRGBRec = packed record
    case Integer of
      1: (RGBVal: LongInt);
      0: (Red, Green, Blue, None: Byte);
  end;

  TGradientRect = packed record
    UpperLeft: ULONG;
    LowerRight: ULONG;
  end;


var
  FhGradientFill: HMODULE;
  FGradientFill: TGradientFill;

function LoadGradLibrary: boolean;
begin
  result := True;
  if FhGradientFill = 0 then
  begin
    FhGradientFill := LoadLibrary('MSIMG32.DLL');
    if FhGradientFill > 0 then
      FGradientFill := GetProcAddress(FhGradientFill, 'GradientFill')
    else
      result := false; // MSIMG32 could not be loaded
  end;
end;

function IEDrawGradient(R: TRect; DC: HDC; ColorStart, ColorStop: TColor; bVertical: boolean): Boolean;
var
  Gr: TGradientRect;
  Vert: array[0..1] of Trivertex;
  StartColor, StopColor: TRGBRec;
begin
  result := LoadGradLibrary;
  if not result then
    exit;
  StartColor.RGBVal := ColorToRGB(ColorStart);
  StopColor.RGBVal := ColorToRGB(ColorStop);

  Gr.UpperLeft := 0;
  Gr.LowerRight := 1;

  Vert[0].x := r.TopLeft.x;
  Vert[0].y := r.TopLeft.y;
  Vert[0].Red := StartColor.Red shl 8;
  Vert[0].Green := StartColor.Green shl 8;
  Vert[0].Blue := StartColor.Blue shl 8;
  Vert[0].Alpha := $0000;

  Vert[1].x := r.BottomRight.x;
  Vert[1].y := r.BottomRight.y;
  Vert[1].Red := StopColor.Red shl 8;
  Vert[1].Green := StopColor.Green shl 8;
  Vert[1].Blue := StopColor.Blue shl 8;
  Vert[1].Alpha := $0000;

  if bVertical then
    Result := FGradientFill(DC, @Vert, 2, @Gr, 1, GRADIENT_FILL_RECT_V)
  else
    Result := FGradientFill(DC, @Vert, 2, @Gr, 1, GRADIENT_FILL_RECT_H);
end;

// Return the standard BitsPerSample and SamplesPerPixel for a PixelFormat
procedure IEPixelFormatToBPSAndSPP(PixelFormat: TIEPixelFormat; out iBitsPerSample: Integer; out iSamplesPerPixel: Integer);
begin
  case PixelFormat of

    ie1g:
      begin
        iBitsPerSample := 1;
        iSamplesPerPixel := 1;
      end;

    ie8p, ie8g:
      begin
        iBitsPerSample := 8;
        iSamplesPerPixel := 1;
      end;

    ie16g:
      begin
        iBitsPerSample := 16;
        iSamplesPerPixel := 1;
      end;

    else { ie24RGB }
      begin
        iBitsPerSample := 8;
        iSamplesPerPixel := 3;
      end;

  end;
end;

// Return the standard BitsPerSample and SamplesPerPixel for a BitCount
// bAllow32bit=False: 32 bit return the same as 24bit
procedure BitCountToBPSAndSPP(BitCount: Integer; bAllow32bit: Boolean; out iBitsPerSample: Integer; out iSamplesPerPixel: Integer);
begin
  case BitCount of
  
    1:
      begin
        iBitsPerSample   := 1;
        iSamplesPerPixel := 1;
      end;

    4:
      begin
        iBitsPerSample   := 4;
        iSamplesPerPixel := 1;
      end;

    8:
      begin
        iBitsPerSample   := 8;
        iSamplesPerPixel := 1;
      end;

    15:
      begin
        iBitsPerSample   := 5;
        iSamplesPerPixel := 3;
      end;

    32:
      if bAllow32bit then
      begin
        iBitsPerSample   := 8;
        iSamplesPerPixel := 4;
      end
      else
      begin
        iBitsPerSample := 8;
        iSamplesPerPixel := 3;
      end;

    else { 16, 24 }
      begin
        iBitsPerSample   := 8;
        iSamplesPerPixel := 3;
      end;
  end;
end;

function ProgressRec(Sender: TObject; OnProgress: TIEProgressEvent; var bAborting: Boolean) : TProgressRec;
begin
  Result.Sender := Sender;
  Result.fOnProgress := OnProgress;
  Result.Aborting := @bAborting;
end;

function ProgressRec(Sender: TObject; OnProgress: TIEProgressEvent; pAborting: PBoolean) : TProgressRec;
begin
  Result.Sender := Sender;
  Result.fOnProgress := OnProgress;
  Result.Aborting := pAborting;
end;


function NullProgressRec(var bAborting: Boolean; bResetAborting : Boolean = true) : TProgressRec;
begin
  if bResetAborting then  
    bAborting := False;
  Result.Sender := nil;
  Result.fOnProgress := nil;
  Result.Aborting := @bAborting;
end;

function NullProgressRec(pAborting: PBoolean; bResetAborting : Boolean = true) : TProgressRec;
begin
  if bResetAborting and ( pAborting <> nil ) then
    pAborting^ := False;
  Result.Sender := nil;         
  Result.fOnProgress := nil;
  Result.Aborting := pAborting;
end;


{$IfNdef Delphi6orNewer}
function RoundTo(const AValue: Double; ADigit: Integer): Double;
var
  LFactor: Double;
begin
  LFactor := IntPower(10, ADigit);
  Result := Round(AValue / LFactor) * LFactor;
end;
{$endif}

{$IfNdef Delphi6orNewer}
function Sign(const AValue: Double): Integer;
begin
  if AValue < 0 then
    Result := -1
  else
  if AValue > 0 then
    Result := 1
  else
    Result := 0;
end;
{$ENDIF}

procedure IESetStringA(var S: AnsiString; Buffer: PAnsiChar; Length: Integer);
begin
  SetLength(S, Length);
  CopyMemory(@S[1], Buffer, Length);
end;


{$IfNdef Delphi7orNewer}
function BoolToStr(B: Boolean): string;
const
  cSimpleBoolStrs: array [boolean] of String = ('0', '-1');
begin
  Result := cSimpleBoolStrs[B];
end;
{$endif}


function IECreateRect(Left, Top, Right, Bottom: Integer): TRect;
begin
{$IfNdef Delphi7orNewer}
  Result.Left   := Left;
  Result.Top    := Top;
  Result.Right  := Right;
  Result.Bottom := Bottom;
{$else}
  Result := Types.Rect(Left, Top, Right, Bottom);
{$endif}
end;



///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////

var
  ieImageEnInitializedMagik: AnsiString;
  ieImageEnInitialized:      integer; // 0=not inizialized >0 initialized n times
  ieImageEnInit_CS:          TCriticalSection;


// IEInitializeImageEn and IEFinalizeImageEn must be called in initialization/finalization section only of hyieutils
// or in constructor/descructors of objects, or in functions, but not in initialization/finalization section of other units.
// Attention to deadlocks (for example you cannot call IEInitializeImageEn in TImageEnIO creator).

procedure IEInitializeImageEn;
begin
  if ieImageEnInitializedMagik <> 'STATICINIT' then
  begin
    // static variables not still intialized, do it here
    ieImageEnInitializedMagik := 'STATICINIT';
    ieImageEnInitialized := 0;
    ieImageEnInit_CS := TCriticalSection.Create();
  end;
  ieImageEnInit_CS.Enter();
  try
    if ieImageEnInitialized = 0 then
    begin
      // initialize
      IEInitialize_iegdiplus();
      IEInitialize_hyiedefs();
      IEInitialize_hyieutils();
      IEInitialize_ievect();
      IEInitialize_imageenio();
      IEInitialize_iexBitmaps;
      IEInitialize_imageenproc();
      IEInitialize_imageenview();
      IEInitialize_tifccitt();
      IEInitialize_ietextc();
      IEInitialize_iepresetim();
      IEInitialize_gestures();
    end;
    inc(ieImageEnInitialized);
  finally
    ieImageEnInit_CS.Leave();
  end;
end;

procedure IEFinalizeImageEn;
var
  freecriticalsec: boolean;
begin
  if ieImageEnInitializedMagik<>'STATICINIT' then
    exit;
  freecriticalsec := false;
  ieImageEnInit_CS.Enter();
  try
    dec(ieImageEnInitialized);
    if ieImageEnInitialized = 0 then
    begin
      // finalize
      IEFinalize_gestures();
      IEFinalize_iepresetim();
      IEFinalize_ietextc();
      IEFinalize_tifccitt();
      IEFinalize_imageenview();
      IEFinalize_imageenproc();
      IEFinalize_imageenio();
      IEFinalize_iexBitmaps;
      IEFinalize_ievect();
      {$IFDEF IEINCLUDEJPEG2000}
      IEFinalize_iej2000();     // initialized in iej2000 reading/writing functions (not in IEInitializeImageEn)
      {$ENDIF}
      IEFinalize_hyieutils();
      IEFinalize_hyiedefs();
      IEFinalize_iegdiplus();
      {$IFDEF IEVISION}
      // note: initialization done in IEVisionAvailable() and IELibAvailable() instead of IEInitializeImageEn()
      IEFinalize_ielib();
      IEFinalize_ievision();
      {$ENDIF}
      {$IFDEF IEINCLUDEMISCPLUGINS}
      TIEMiscPluginsImageMagick.Finalize();
      {$ENDIF}
      IEGlobalSettings().DestroySingletonInstance();

      ieImageEnInitializedMagik := '';
      freecriticalsec := true;
    end;
  finally
    ieImageEnInit_CS.Leave();
    if freecriticalsec then
      FreeAndNil(ieImageEnInit_CS);
  end;
end;




procedure IEPrintLogWrite(const ss: String);
begin
  if iegPrintLogFileName <> '' then
  begin
    closefile(iegPrintLogFile);
    assignfile(iegPrintLogFile, string(iegPrintLogFileName));
    append(iegPrintLogFile);
    WriteLn(iegPrintLogFile, datetostr(date) + ' ' + timetostr(time) + ' : ' + ss);
    Flush(iegPrintLogFile);
  end;
end;


/////////////////////////////////////////////////////////////////////////////////////


procedure iedswap(var d1, d2: Double);
var
  v: Double;
begin
  v := d1;
  d1 := d2;
  d2 := v;
end;

procedure i64swap(var v1, v2: int64);
var
  v: int64;
begin
  v := v1;
  v1 := v2;
  v2 := v;
end;

/////////////////////////////////////////////////////////////////////////////////////

function Floor(X: Extended): Integer;
begin
  Result := Trunc(X);
  if Frac(X) < 0 then
    Dec(Result);
end;


function CreateCMYK(c, m, y, k: byte): TCMYK;
begin
  result.c := c;
  result.m := m;
  result.y := y;
  result.k := k;
end;

function CreateRGB(r, g, b: byte): TRGB;
begin
  result.r := r;
  result.g := g;
  result.b := b;
end;

function CreateRGB48(r, g, b: word): TRGB48;
begin
  result.r := r;
  result.g := g;
  result.b := b;
end;


function CreateRGBA(r, g, b, a: byte): TRGBA;
begin
  result.r := r;
  result.g := g;
  result.b := b;
  result.a := a;
end;

function CreateRGBFromInt(r, g, b: Integer): TRGB;
begin
  result.r := blimit(r);
  result.g := blimit(g);
  result.b := blimit(b);
end;


/////////////////////////////////////////////////////////////////////////////////////

function TRGB2TColor(rgb: TRGB): TColor;
begin
  with rgb do
    result := r or (g shl 8) or (b shl 16);
end;

/////////////////////////////////////////////////////////////////////////////////////

function RGB2TColor(r, g, b: Integer): TColor;
begin
  result := r or (g shl 8) or (b shl 16);
end;

/////////////////////////////////////////////////////////////////////////////////////

function TColor2TRGB(cl: TColor): TRGB;
var
  rgb: longint;
begin
  rgb := colortorgb(cl);
  result.r := $FF and rgb;
  result.g := ($FF00 and rgb) shr 8;
  result.b := ($FF0000 and rgb) shr 16;
end;

function TColor2TRGBA(cl: TColor; transparency: Integer): TRGBA;
var
  rgb: longint;
begin
  rgb := colortorgb(cl);
  result.r := $FF and rgb;
  result.g := ($FF00 and rgb) shr 8;
  result.b := ($FF0000 and rgb) shr 16;
  result.a := transparency;
end;

// gets alpha from TColor
// Cannot accept colors like clRed
function TColor2TRGBA(cl: TColor): TRGBA;
var
  rgb: longint;
begin
  rgb := colortorgb(cl);
  result.r := $FF and rgb;
  result.g := ($FF00 and rgb) shr 8;
  result.b := ($FF0000 and rgb) shr 16;
  result.a := ($FF000000 and rgb) shr 24;
end;


function IEApplyAlphaToColor(rgb: TRGB; Alpha: Integer): TRGB;
begin
  Result := rgb;

  if (Result.r = 255) and (Result.g = 255) and (Result.b = 255) then
  begin
    // All white
    Result.r := Alpha;
    Result.g := Alpha;
    Result.b := Alpha;
  end
  else
  begin
    Result.r := Trunc( Alpha / 255 * Result.r ) + ( 255 - Alpha );
    Result.g := Trunc( Alpha / 255 * Result.g ) + ( 255 - Alpha );
    Result.b := Trunc( Alpha / 255 * Result.b ) + ( 255 - Alpha );
  end;
end;

function IEApplyAlphaToColor(Color: TColor; Alpha: Integer): TColor;
begin
  Result := TRGB2TColor( IEApplyAlphaToColor( TColor2TRGB( Color ), Alpha ));
end;


/////////////////////////////////////////////////////////////////////////////////////

function dmin(v1, v2: Double): Double;
begin
  if v1 < v2 then
    dmin := v1
  else
    dmin := v2;
end;

function dmax(v1, v2: Double): Double;
begin
  if v1 > v2 then
    dmax := v1
  else
    dmax := v2;
end;

function dwmax(v1, v2: DWord): DWord;
begin
  if v1 > v2 then
    result := v1
  else
    result := v2;
end;

function imax(v1, v2: Integer): Integer;
{$ifdef IEUSEASM}
asm
  cmp  edx,eax
  jng  @1
  mov  eax,edx
@1:
end;
{$else}
begin
  if v1 > v2 then
    result := v1
  else
    result := v2;
end;
{$endif}

function imin(v1, v2: Integer): Integer;
{$ifdef IEUSEASM}
asm
  cmp  eax,edx
  jng  @1
  mov  eax,edx
@1:
end;
{$else}
begin
  if v1 < v2 then
    result := v1
  else
    result := v2;
end;
{$endif}


{$ifdef IEHASUINT64}
function u64min(v1, v2: uint64): uint64;
begin
  if v1 < v2 then
    result := v1
  else
    result := v2;
end;
{$endif}

function i64min(v1, v2: int64): int64;
begin
  if v1 < v2 then
    result := v1
  else
    result := v2;
end;

function i64max(v1, v2: int64): int64;
begin
  if v1 > v2 then
    result := v1
  else
    result := v2;
end;


// vv=eax       result=eax
// min=edx
// max=ecx
function ilimit(vv, min, max: Integer): Integer;
{$ifdef IEUSEASM}
asm
  cmp eax,edx
  jg @1		// vv>min
  mov eax,edx
  ret
  @1:
  cmp eax,ecx
  jl @2		// vv<min
  mov eax,ecx
  ret
@2:
end;
{$else}
begin
  if vv < min then
    result := min
  else
  if vv > max then
    result := max
  else
    result := vv;
end;
{$endif}


// limit 0 between 255
function blimit(vv: Integer): Integer;
{$ifdef IEUSEASM}
asm
  OR EAX, EAX
  JNS @@plus
  XOR EAX, EAX
  RET

  @@plus:
  CMP EAX, 255
  JBE @@END
  MOV EAX, 255
@@END:
end;
{$else}
begin
  if vv < 0 then
    result := 0
  else
  if vv > 255 then
    result := 255
  else
    result := vv;
end;
{$endif}

function wlimit(vv: Integer): word;
begin
  if vv < 0 then
    result := 0
  else
  if vv>65535 then
    result := 65535
  else
    result := vv;
end;

/////////////////////////////////////////////////////////////////////////////////////

{$ifdef IEUSEASM}
procedure iswap(var B1, B2: LongInt); assembler;
asm
  push EBX
  mov  ecx, [EAX];
  mov  ebx, [EDX];
  mov  [EDX], ecx
  mov  [EAX], ebx
  pop EBX
end;
{$else}
procedure iswap(var B1, B2: LongInt);
var
  temp: LongInt;
begin
  temp := B1;
  B1 := B2;
  B2 := temp;
end;
{$endif}

{$ifdef IEUSEASM}
procedure dwswap(var B1, B2: dword); assembler;
asm
  push EBX
  mov  ecx, [EAX];
  mov  ebx, [EDX];
  mov  [EDX], ecx
  mov  [EAX], ebx
  pop EBX
end;
{$else}
procedure dwswap(var B1, B2: dword);
var
  temp: dword;
begin
  temp := B1;
  B1 := B2;
  B2 := temp;
end;
{$endif}

procedure dswap(var v1, v2: Double);
var
  t: Double;
begin
  t := v1;
  v1 := v2;
  v2 := t;
end;

function EqualRGB(rgb1, rgb2: TRGB): Boolean;
begin
  result := (rgb1.r = rgb2.r) and (rgb1.g = rgb2.g) and (rgb1.b = rgb2.b);
end;


function IEAverageColor(c1, c2 : TColor): TColor;
begin
  Result := TRGB2TCOLOR( IEAverageColor( TColor2TRGB( c1 ), TColor2TRGB( c2 ) ));
end;

function IEAverageColor(rgb1, rgb2 : TRGB): TRGB;
begin
  Result :=  CreateRGB( ( rgb1.r + rgb2.r ) div 2,
                        ( rgb1.g + rgb2.g ) div 2,
                        ( rgb1.b + rgb2.b ) div 2 );
end;


{$ifdef IEUSEASM}
procedure bswap(var B1, B2: Byte); assembler;
asm
  mov  cl, Byte Ptr [EAX];
  mov  ch, Byte Ptr [EDX];
  mov  Byte Ptr [EDX], cl
  mov  Byte Ptr [EAX], ch
end;
{$else}
procedure bswap(var B1, B2: byte);
var
  temp: byte;
begin
  temp := B1;
  B1 := B2;
  B2 := temp;
end;
{$endif}

// order two coordinates, putting the first as top-left
procedure OrdCor(var x1, y1, x2, y2: Integer);
begin
  if x1 > x2 then
    iswap(x1, x2);
  if y1 > y2 then
    iswap(y1, y2);
end;



//////////////////////////////////////////////////////////////////////////////////////////////



// Hue, Sat, Lum from 0 to 1
procedure ColorToHSL(cl: TColor; var Hue, Sat, Lum: Double);
var
  RGB: TRGB;
begin
  RGB := TColor2TRGB( cl );
  RGB2HSL( RGB, Hue, Sat, Lum );
end;

// Hue, Sat, Lum from 0 to 1
procedure RGB2HSL(px: TRGB; var Hue, Sat, Lum: Double);
var
  delta, r, g, b, cmax, cmin: Double;
begin
  r := px.r / 255;
  g := px.g / 255;
  b := px.b / 255;
  cmax := dmax(r, dmax(g, b));
  cmin := dmin(r, dmin(g, b));
  Lum := (cmax + cmin) / 2;
  if cmax = cmin then
  begin
    Sat := 0;
    Hue := 0;
  end
  else
  begin
    if Lum < 0.5 then
      Sat := (cmax - cmin) / (cmax + cmin)
    else
      Sat := (cmax - cmin) / (2 - cmax - cmin);
    delta := cmax - cmin;
    if r = cmax then
      Hue := (g - b) / delta
    else
    if g = cmax then
      Hue := 2 + (b - r) / delta
    else
      Hue := 4 + (r - g) / delta;
    Hue := Hue / 6;
    if Hue < 0 then
      Hue := Hue + 1;
  end;
end;


// Hue, Sat, Lum: 0..1
function HSLToColor(Hue, Sat, Lum: Double) : TColor;
var
  RGB: TRGB;
begin
  HSL2RGB( RGB, Hue, Sat, Lum );
  Result := TRGB2TColor( RGB );
end;


// Hue, Sat, Lum: 0..1
procedure HSL2RGB(var px: TRGB; Hue, Sat, Lum: Double);

  function HueToRGB(m1, m2, h: Double): Double;
  const
    C1 = 2 / 3;
  begin
    if h < 0 then
      h := h + 1
    else
    if h > 1 then
      h := h - 1;
    if 6 * h < 1 then
      result := (m1 + (m2 - m1) * h * 6)
    else
    if 2 * h < 1 then
      result := m2
    else
    if 3 * h < 2 then
      result := (m1 + (m2 - m1) * (C1 - h) * 6)
    else
      result := m1;
  end;

const
  C1 = 1 / 3;
var
  r, g, b: Double;
  m1, m2: Double;
begin
  // check limits
  if Hue < 0 then
    Hue := 1 + Hue
  else
  if Hue > 1 then
    Hue := Hue - 1;
  if Sat < 0 then
    Sat := 0
  else
  if Sat > 1 then
    Sat := 1;
  if Lum < 0 then
    Lum := 0
  else
  if Lum > 1 then
    Lum := 1;
  //
  if Sat = 0 then
  begin
    r := Lum;
    g := Lum;
    b := Lum;
  end
  else
  begin
    if Lum <= 0.5 then
      m2 := Lum * (1 + Sat)
    else
      m2 := Lum + Sat - Lum * Sat;
    m1 := 2 * Lum - m2;
    r := HueToRGB(m1, m2, Hue + C1);
    g := HueToRGB(m1, m2, Hue);
    b := HueToRGB(m1, m2, Hue - C1);
  end;
  px.r := blimit(round(r * 255));
  px.g := blimit(round(g * 255));
  px.b := blimit(round(b * 255));
end;

// HSV to RGB.
//    H = 0 to 359 (corresponding to 0..359 degrees around hexcone)
//    S = 0 (shade of gray) to 99 (pure color)
//    V = 0 (black) to 99 {white)
//
//    Based on C Code in "Computer Graphics -- Principles and Practice"
//    Foley et al, 1996, p. 594.  Floating point fractions, 0..1, replaced with
//    integer values, 0..99.

procedure HSV2RGB(var px: TRGB; H, S, V: Integer);
const
  divisor: Integer = 99 * 60;
var
  f: Integer;
  hTemp: Integer;
  p, q, t: Integer;
  VS: Integer;
begin
  // check limits (changed at 2.1.1)
  if H < 0 then
    H := 360 + H
  else
  if H > 359 then
    H := H - 360;
  if S < 0 then
    S := 0
  else
  if S > 99 then
    S := 99;
  if V < 0 then
    V := 0
  else
  if V > 99 then
    V := 99;
  //
  if S = 0 then
  begin
    px.r := v;
    px.g := v;
    px.b := v;
  end
  else
  begin
    if H = 360 then
      hTemp := 0
    else
      hTemp := H;
    f := hTemp mod 60;
    hTemp := hTemp div 60;
    VS := V * S;
    p := V - VS div 99;
    q := V - (VS * f) div divisor;
    t := V - (VS * (60 - f)) div divisor;
    with px do
    begin
      case hTemp of
        0:
          begin
            R := V;
            G := t;
            B := p
          end;
        1:
          begin
            R := q;
            G := V;
            B := p
          end;
        2:
          begin
            R := p;
            G := V;
            B := t
          end;
        3:
          begin
            R := p;
            G := q;
            B := V
          end;
        4:
          begin
            R := t;
            G := p;
            B := V
          end;
        5:
          begin
            R := V;
            G := p;
            B := q
          end;
      end
    end
  end;
  px.r := round(px.r / 99 * 255);
  px.g := round(px.g / 99 * 255);
  px.b := round(px.b / 99 * 255);
end;


function HSVToColor(h, s, v: Integer): TColor;
var
  RGB: TRGB;
begin
  HSV2RGB( RGB, h, s, v );
  Result := TRGB2TColor( RGB );
end;

// RGB, each 0 to 255, to HSV.
//   H = 0 to 359 (corresponding to 0..359 degrees around hexcone)
//   S = 0 (shade of gray) to 99 (pure color)
//   V = 0 (black) to 99 {white)
//
//   Based on C Code in "Computer Graphics -- Principles and Practice"
//   Foley et al, 1996, p. 592.  Floating point fractions, 0..1, replaced with
//   integer values, 0..99.

procedure RGB2HSV(RGB: TRGB; var h, s, v: Integer);

  procedure MinMaxInt(const i, j, k: Integer; var min, max: Integer);
  begin
    if i > j then
    begin
      if i > k then
        max := i
      else
        max := k;
      if j < k then
        min := j
      else
        min := k
    end
    else
    begin
      if j > k then
        max := j
      else
        max := k;
      if i < k then
        min := i
      else
        min := k
    end;
  end;

var
  Delta: Integer;
  MinValue: Integer;
  r, g, b: Integer;
begin
  r := round(RGB.r / 255 * 99);
  g := round(RGB.g / 255 * 99);
  b := round(RGB.b / 255 * 99);
  MinMaxInt(R, G, B, MinValue, V);
  Delta := V - MinValue;
  if V = 0 then
    S := 0
  else
    S := (99 * Delta) div V;
  if S = 0 then
    H := 0
  else
  begin
    if R = V then
      h := (60 * (G - B)) div Delta
    else
    if G = V then
      h := 120 + (60 * (B - R)) div Delta
    else
    if B = V then
      h := 240 + (60 * (R - G)) div Delta;
    if H < 0 then
      H := H + 360;
  end;
end;


procedure ColorToHSV(cl: TColor; var h, s, v: Integer);
var
  RGB: TRGB;
begin
  RGB := TColor2TRGB( cl );
  RGB2HSV( RGB, h, s, v );
end;


// HTML Color
function ColorToHex(Color : TColor): string;
begin
  Result := '#' +
            { red value }
            IntToHex( GetRValue( Color ), 2 ) +
            { green value }
            IntToHex( GetGValue( Color ), 2 ) +
            { blue value }
            IntToHex( GetBValue( Color ), 2 );
end;



procedure YUV2RGB(y, u, v: Integer; var RGB: TRGB);
begin
  with RGB do
  begin
    b := blimit(round(1.164 * (y - 16) + 2.018 * (u - 128)));
    g := blimit(round(1.164 * (y - 16) - 0.813 * (v - 128) - 0.391 * (u - 128)));
    r := blimit(round(1.164 * (y - 16) + 1.596 * (v - 128)));
  end;
end;



/////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////
// Thanks to Roy Klever

procedure IERGBtoHSB(const cRed, cGreen, cBlue: byte; var H, S, B: word);

  procedure MinMaxByte(const i, j, k: byte; var min: Integer; var max: word);
  begin
    if i > j then
    begin
      if i > k then
        max := i
      else
        max := k;
      if j < k then
        min := j
      else
        min := k
    end
    else
    begin
      if j > k then
        max := j
      else
        max := k;
      if i < k then
        min := i
      else
        min := k
    end;
  end;

var
  Delta: Integer;
  MinValue: Integer;
  tmpH: Integer;
begin
  tmpH := 0;
  MinMaxByte(cRed, cGreen, cBlue, MinValue, B);
  Delta := B - MinValue;
  if B = 0 then
    S := 0
  else
    S := (255 * Delta) div B;
  if S = 0 then
    tmpH := 0
  else
  begin
    if cRed = B then
      tmpH := (60 * (cGreen - cBlue)) div Delta
    else
    if cGreen = B then
      tmpH := 120 + (60 * (cBlue - cRed)) div Delta
    else
    if cBlue = B then
      tmpH := 240 + (60 * (cRed - cGreen)) div Delta;
    if tmpH < 0 then
      tmpH := tmpH + 360;
  end;
  H := tmpH;
end;

procedure IEHSBtoRGB(const H, S, B: word; var cRed, cGreen, cBlue: byte);
const
  divisor: Integer = 255 * 60;
var
  f: Integer;
  hTemp: Integer;
  p, q, t: Integer;
  VS: Integer;
begin
  if s = 0 then
  begin
    cRed := B;
    cGreen := B;
    cBlue := B;
  end
  else
  begin
    if H = 360 then
      hTemp := 0
    else
      hTemp := H;
    f := hTemp mod 60;
    hTemp := hTemp div 60;
    VS := B * S;
    p := B - VS div 255;
    q := B - (VS * f) div divisor;
    t := B - (VS * (60 - f)) div divisor;

    case hTemp of
      0:
        begin
          cRed := B;
          cGreen := t;
          cBlue := p
        end;
      1:
        begin
          cRed := q;
          cGreen := B;
          cBlue := p
        end;
      2:
        begin
          cRed := p;
          cGreen := B;
          cBlue := t
        end;
      3:
        begin
          cRed := p;
          cGreen := q;
          cBlue := B
        end;
      4:
        begin
          cRed := t;
          cGreen := p;
          cBlue := B
        end;
      5:
        begin
          cRed := B;
          cGreen := p;
          cBlue := q
        end;
    end;
  end;
end;

//////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////


procedure IEInitialize_hyieutils;
begin
  begin
    IEGlobalSettings(); // just to create global settings object now
    IESetDefaultTranslationWords();
    mscms := 0;
    InitIECosineTab();
    {$ifdef IERFBPROTOCOL}
    IE_SockLibInitCS := TCriticalSection.Create();
    {$endif}
  end;
end;

procedure IEFinalize_hyieutils;
begin
  {$ifdef IERFBPROTOCOL}
  FreeAndNil(IE_SockLibInitCS);
  {$endif}
  if assigned(IEGlobalSettings().DefaultDialogFont) then
  begin
    IEGlobalSettings().DefaultDialogFont.Free();
    IEGlobalSettings().DefaultDialogFont := nil;
  end;
  if mscms <> 0 then
    FreeLibrary(mscms);
end;



initialization
  FhGradientFill := 0;
  IEInitializeImageEn();

finalization
  IEFinalizeImageEn();
  try
    if FhGradientFill > 0 then
      FreeLibrary(fhGradientFill);
  except
  end;


end.