(* 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 1062
Doc revision 1004
*)

unit imageenproc;

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


{$R-}
{$Q-}


{$I ie.inc}


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Contnrs, Forms, ieview, ExtCtrls, hyiedefs, iexBitmaps, iefft,
  iexTransitions, hyieutils;

type

{!!
<FS>TGraphFilter

<FM>Declaration<FC>
}
  TGraphFilter = record
    Values: array[0..2, 0..2] of integer;
    Divisor: Integer;
  end;
  PIEGraphFilter = ^TGraphFilter;

  // filter exception
  EFilterInvalid = class(Exception);
{!!}


{!!
<FS>THistogramItem

<FM>Declaration<FC>
}
  THistogramItem = record
    R:    DWord;
    G:    DWord;
    B:    DWord;
    Gray: DWord;
    Hue:  DWord;
  end;
{!!}


{!!
<FS>TIEHistogramContent

<FM>Declaration<FC>
}
  TIEHistogramContent = set of (iehcRed, iehcGreen, iehcBlue, iehcGray, iehcHue);
{!!}



{!!
<FS>PHistogramItem

<FM>Declaration<FC>
}
 PHistogramItem = ^THistogramItem;
{!!}


{!!
<FS>THistogram

<FM>Declaration<FC>
THistogram = array[0..255] of <A THistogramItem>;
!!}
  THistogram = array[0..255] of THistogramItem;

  PHistogram = ^THistogram;


{!!
<FS>TIEHistogram

<FM>Declaration<FC>
TIEHistogram = array of <A THistogramItem>;
!!}
  TIEHistogram = array of THistogramItem;


{!!
<FS>TPreviewEffects

<FM>Declaration<FC>
  TPreviewEffects = set of (peAll, peContrast, peHSV, peHSL, peRGB, peUserFilt, peEqualize, peBumpMap, peLens, peWave, peMorph, peRotate, peFFT, peGamma, peSharpen, peResize, peSoftShadow, peAutoEnhance, peCrop);

<FM>Description<FN>
Specify which tabs are shown in the Image Processing Dialog  (displayed by calling <A TImageEnProc.DoPreviews>).

<TABLE>
<R> <H>Value</H> <H>Description</H> <H>Method Used</H> </R>
<R> <C><FC>peAll<FN></C> <C>All tabs will be shown</C> <C>-</C> </R>
<R> <C><FC>peContrast<FN></C> <C>Adjust contrast</C> <C><A TImageEnProc.Contrast>, <A TImageEnProc.IntensityRGBAll></C> </R>
<R> <C><FC>peHSV<FN></C> <C>Adjust the Hue/Saturation/Value</C> <C><A TImageEnProc.HSVvar></C> </R>
<R> <C><FC>peHSL<FN></C> <C>Adjust the Hue/Saturation/Luminance</C> <C><A TImageEnProc.HSLvar></C> </R>
<R> <C><FC>peRGB<FN></C> <C>Adjust Red/Green/Blue values</C> <C><A TImageEnProc.IntensityRGBAll></C> </R>
<R> <C><FC>peUserFilt<FN></C> <C>Apply a 3x3 filter</C> <C><A TImageEnProc.ApplyFilter></C> </R>
<R> <C><FC>peEqualize<FN></C> <C>Equalize the color histogram</C> <C><A TImageEnProc.Threshold>, <A TImageEnProc.HistEqualize>, <A TImageEnProc.HistAutoEqualize></C> </R>
<R> <C><FC>peBumpMap<FN></C> <C>Apply Bump map effect</C> <C><A TImageEnProc.BumpMapping></C> </R>
<R> <C><FC>peLens<FN></C> <C>Apply Lens effect</C> <C><A TImageEnProc.Lens></C> </R>
<R> <C><FC>peWave<FN></C> <C>Apply Wave effect</C> <C><A TImageEnProc.Wave></C> </R>
<R> <C><FC>peMorph<FN></C> <C>Set the minimum of maximum pixel values</C> <C><A TImageEnProc.Minimum>, <A TImageEnProc.Maximum></C> </R>
<R> <C><FC>peRotate<FN></C> <C>Rotate the image</C> <C><A TImageEnProc.Rotate>, <A TImageEnProc.Flip></C> </R>
<R> <C><FC>peFFT<FN></C> <C>Apply a Fourier Analysis</C> <C><A TImageEnProc.FTCreateImage></C> </R>
<R> <C><FC>peGamma<FN></C> <C>Perform gamma correction</C> <C><A TImageEnProc.GammaCorrect></C> </R>
<R> <C><FC>peSharpen<FN></C> <C>Apply a sharpening filter</C> <C><A TImageEnProc.Sharpen></C> </R>
<R> <C><FC>peResize<FN></C> <C>Change the dimensions of the image</C> <C><A TImageEnProc.Resample></C> </R>
<R> <C><FC>peSoftShadow<FN></C> <C>Apply a soft-shadow</C> <C><A TImageEnProc.AddSoftShadow></C> </R>
<R> <C><FC>peAutoEnhance<FN></C> <C>Automatic color enhancement</C> <C><A TImageEnProc.AutoImageEnhance1>, <A TImageEnProc.AutoImageEnhance2></C> </R>
<R> <C><FC>peCrop<FN></C> <C>Crop or allow border to an image</C> <C><A TImageEnProc.Crop>, <A TImageEnProc.ImageResize></C> </R>
</TABLE>
!!}
  TPreviewEffects = set of (peAll, peContrast, peHSV, peHSL, peRGB, peUserFilt, peEqualize, peBumpMap, peLens, peWave, peMorph, peRotate, peFFT, peGamma, peSharpen, peResize, peSoftShadow, peAutoEnhance, peCrop);

{!!
<FS>TPRPreviewsParamsItems

<FM>Declaration<FC>
TPRPreviewsParamsItems = (prppDefaultLockPreview, prppShowResetButton, prppHardReset, prppResetSelectedTab);

<FM>Description<FN>
Configure features of the Image Processing Dialog (displayed by calling <A TImageEnProc.DoPreviews>).

<TABLE>
<R> <H>Value</H> <H>Description</H> </R>
<R> <C><FC>prppDefaultLockPreview<FN></C> <C>Enable the "Lock preview" checkbox when the dialog is shown (i.e. preview is shown by default)</C> </R>
<R> <C><FC>prppShowResetButton<FN></C> <C>Show a "Reset" button, which resets parameters to previous values</C> </R>
<R> <C><FC>prppHardReset<FN></C> <C>Allow Reset button to reset to default values instead of previous values</C> </R>
<R> <C><FC>prppResetSelectedTab<FN></C> <C>The Reset button will reset only the selected tab instead of all tabs</C> </R>
</TABLE>

<FM>Example<FC>
// Show preview by default
ImageEnView1.Proc.PreviewsParams := ImageEnView1.Proc.PreviewsParams + [ prppDefaultLockPreview ];
!!}
  TPRPreviewsParamsItems = (prppDefaultLockPreview, prppShowResetButton, prppHardReset, prppResetSelectedTab);


{!!
<FS>TPRPreviewsParams

<FM>Declaration<FC>
TPRPreviewsParams = set of <A TPRPreviewsParamsItems>;

<FM>Description<FN>
Configure features of the Image Processing Dialog (displayed by calling <A TImageEnProc.DoPreviews>).

<TABLE>
<R> <H>Value</H> <H>Description</H> </R>
<R> <C><FC>prppDefaultLockPreview<FN></C> <C>Enable the "Lock preview" checkbox when the dialog is shown (i.e. preview is shown by default)</C> </R>
<R> <C><FC>prppShowResetButton<FN></C> <C>Show a "Reset" button, which resets parameters to previous values</C> </R>
<R> <C><FC>prppHardReset<FN></C> <C>Allow Reset button to reset to default values instead of previous values</C> </R>
<R> <C><FC>prppResetSelectedTab<FN></C> <C>The Reset button will reset only the selected tab instead of all tabs</C> </R>
</TABLE>

<FM>Example<FC>
// Show preview by default
ImageEnView1.Proc.PreviewsParams := ImageEnView1.Proc.PreviewsParams + [ prppDefaultLockPreview ];
!!}
  TPRPreviewsParams = set of TPRPreviewsParamsItems;


{!!
<FS>TIECopyPasteType

<FM>Declaration<FC>
TIECopyPasteType = (iecpAuto, iecpFullImage, iecpSelection, iecpLayer);

<FM>Description<FN>
Specifies the source for cut and copy operations, or the destination for paste operations.

When the TImageEnProc is attached to a:
<TABLE>
<R> <H>Class</H> <H>Description</H> </R>
<R> <C><FC>TIEBitmap<FN></C> <C>Only iecpFullImage is relevant (iecpAuto will have the same effect as iecpFullImage. iecpSelection and iecpLayer will always fail)</C> </R>
<R> <C><FC>TImageEnView/TImageEnVect<FN></C> <C>iecpAuto, iecpFullImage, iecpSelection and iecpLayer are all available</C> </R>
<R> <C><FC>TImageEnMView/TImageEnFolderMView<FN></C> <C>Only iecpFullImage is relevant (iecpAuto will have the same effect as iecpFullImage. iecpSelection and iecpLayer will always fail)</C> </R>
</TABLE>

Used by:
- <A TImageEnProc.CanCutToClipboard>
- <A TImageEnProc.CutToClipboard>
- <A TImageEnProc.CanCopyToClipboard>
- <A TImageEnProc.CopyToClipboard>
- <A TImageEnProc.CanPasteFromClipboard>
- <A TImageEnProc.PasteFromClipboard>

!!}
  TIECopyPasteType = (iecpAuto, iecpFullImage, iecpSelection, iecpLayer);


////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// TIPDialogParams

{!!
<FS>TIPDialogParams

<FM>Description<FN>
Provides read/write access to the parameters of the Image Processing Dialog (displayed by calling <A TImageEnProc.DoPreviews>).

<FM>Fields<FN>
<TABLE2>
<R> <C_IMG_PROPERTY> <C>DialogWidth: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>DialogHeight: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>CONTRAST_Contrast: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>CONTRAST_Brightness: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>HSV_H: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>HSV_S: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>HSV_V: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>HSL_H: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>HSL_S: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>HSL_L: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>RGB_R: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>RGB_G: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>RGB_B: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>USERFILTER_Values: TGraphFilter;</C> </R>
<R> <C_IMG_PROPERTY> <C>EQUALIZATION_ThresholdDown: TRGB;</C> </R>
<R> <C_IMG_PROPERTY> <C>EQUALIZATION_ThresholdUp: TRGB;</C> </R>
<R> <C_IMG_PROPERTY> <C>EQUALIZATION_EqDown: TRGB;</C> </R>
<R> <C_IMG_PROPERTY> <C>EQUALIZATION_EqUp: TRGB;</C> </R>
<R> <C_IMG_PROPERTY> <C>EQUALIZATION_EqualizeButton: Boolean;</C> </R>
<R> <C_IMG_PROPERTY> <C>BUMPMAP_Left: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>BUMPMAP_Top: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>BUMPMAP_Width: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>BUMPMAP_Height: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>BUMPMAP_Col: TRGB;</C> </R>
<R> <C_IMG_PROPERTY> <C>BUMPMAP_Src: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>BUMPMAP_Auto: Boolean;</C> </R>
<R> <C_IMG_PROPERTY> <C>LENS_Left: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>LENS_Top: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>LENS_Width: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>LENS_Height: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>LENS_Ref: Double;</C> </R>
<R> <C_IMG_PROPERTY> <C>LENS_Auto: Boolean;</C> </R>
<R> <C_IMG_PROPERTY> <C>WAVE_Amplitude: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>WAVE_WaveLength: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>WAVE_Phase: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>WAVE_Reflect: Boolean;</C> </R>
<R> <C_IMG_PROPERTY> <C>MORPH_Filter: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>MORPH_WinSize: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>ROTATE_Angle: Double;</C> </R>
<R> <C_IMG_PROPERTY> <C>FLIP_Horz: Boolean;</C> </R>
<R> <C_IMG_PROPERTY> <C>FLIP_Vert: Boolean;</C> </R>
<R> <C_IMG_PROPERTY> <C>GAMMACORRECTION_Value: Double;</C> </R>
<R> <C_IMG_PROPERTY> <C>SHARPEN_Sharpen: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>SHARPEN_Size: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>FFT_Left: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>FFT_Top: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>FFT_Right: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>FFT_Bottom: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>FFT_GrayScale: Boolean;</C> </R>
<R> <C_IMG_PROPERTY> <C>FFT_Selection: TMemoryStream;</C> </R>
<R> <C_IMG_PROPERTY> <C>Resize_Percent : Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>Shadow_Radius : Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>Shadow_Offset : Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>AutoEnhance1_Slope: Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>AutoEnhance1_Range : Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>AutoEnhance3_Gamma : Double;</C> </R>
<R> <C_IMG_PROPERTY> <C>AutoEnhance3_Saturation : Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>Crop_Left : Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>Crop_Top : Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>Crop_Right : Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>Crop_Bottom : Integer;</C> </R>
<R> <C_IMG_PROPERTY> <C>BackgroundColor : TColor;</C> </R>
</TABLE>

<FM>Methods<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TIPDialogParams.SaveToFile></C> </R>
<R> <C_IMG_METHOD> <C><A TIPDialogParams.LoadFromFile></C> </R>
<R> <C_IMG_METHOD> <C><A TIPDialogParams.SaveToStream></C> </R>
<R> <C_IMG_METHOD> <C><A TIPDialogParams.LoadFromStream></C> </R>
<R> <C_IMG_METHOD> <C><A TIPDialogParams.SetProperty></C> </R>
<R> <C_IMG_METHOD> <C><A TIPDialogParams.GetProperty></C> </R>
<R> <C_IMG_METHOD> <C><A TIPDialogParams.SetDefaultParams></C> </R>
</TABLE>

!!}
  {$ifdef IEINCLUDEDIALOGIP}
  TIPDialogParams = class
  private
    fFFT_Left: Integer;
    fFFT_Top: Integer;
    fFFT_Right: Integer;
    fFFT_Bottom: Integer;
    procedure SetFFT_Left(v: Integer);
    procedure SetFFT_Top(v: Integer);
    procedure SetFFT_Right(v: Integer);
    procedure SetFFT_Bottom(v: Integer);
  public
    DialogWidth: Integer;
    DialogHeight: Integer;
    CONTRAST_Contrast: Integer;
    CONTRAST_Brightness: Integer;
    HSV_H: Integer;
    HSV_S: Integer;
    HSV_V: Integer;
    HSL_H: Integer;
    HSL_S: Integer;
    HSL_L: Integer;
    RGB_R: Integer;
    RGB_G: Integer;
    RGB_B: Integer;
    USERFILTER_Values: TGraphFilter;
    EQUALIZATION_ThresholdDown: TRGB;
    EQUALIZATION_ThresholdUp: TRGB;
    EQUALIZATION_EqDown: TRGB;
    EQUALIZATION_EqUp: TRGB;
    EQUALIZATION_EqualizeButton: Boolean;
    BUMPMAP_Left: Integer;
    BUMPMAP_Top: Integer;
    BUMPMAP_Width: Integer;
    BUMPMAP_Height: Integer;
    BUMPMAP_Col: TRGB;
    BUMPMAP_Src: Integer;
    BUMPMAP_Auto: Boolean;
    LENS_Left: Integer;
    LENS_Top: Integer;
    LENS_Width: Integer;
    LENS_Height: Integer;
    LENS_Ref: Double;
    LENS_Auto: Boolean;
    WAVE_Amplitude: Integer;
    WAVE_WaveLength: Integer;
    WAVE_Phase: Integer;
    WAVE_Reflect: Boolean;
    MORPH_Filter: Integer;
    MORPH_WinSize: Integer;
    ROTATE_Angle: Double;
    FLIP_Horz : Boolean;
    FLIP_Vert : Boolean;
    GAMMACORRECTION_Value: Double;
    SHARPEN_Sharpen: Integer;
    SHARPEN_Size: Integer;
    FFT_GrayScale: Boolean;
    FFT_Selection: TMemoryStream;
    Resize_Percent : Integer;
    Shadow_Radius : Integer;
    Shadow_Offset : Integer;
    AutoEnhance1_Slope : Integer;
    AutoEnhance1_Range : Integer;
    AutoEnhance3_Gamma: Double;
    AutoEnhance3_Saturation : Integer;
    Crop_Left    : Integer;
    Crop_Top     : Integer;
    Crop_Right   : Integer;
    Crop_Bottom  : Integer;
    BackgroundColor : TColor;

    property FFT_Left: Integer read fFFT_Left write SetFFT_Left;
    property FFT_Top: Integer read fFFT_Top write SetFFT_Top;
    property FFT_Right: Integer read fFFT_Right write SetFFT_Right;
    property FFT_Bottom: Integer read fFFT_Bottom write SetFFT_Bottom;
    constructor Create;
    destructor Destroy; override;
    procedure SaveToFile(const FileName: String);
    procedure LoadFromFile(const FileName: String);
    procedure SaveToStream(Stream: TStream);
    procedure LoadFromStream(Stream: TStream);
    procedure SetProperty(Prop, Value: String);
    function GetProperty(const Prop: String): String;
    procedure SetDefaultParams;
  end;
  {$endif}

// TIPDialogParams
////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////


{!!
<FS>TIEEncryptionAlgorithm

<FM>Declaration<FC>
}
  TIEEncryptionAlgorithm = (ieeaTEA,    // simple TEA algorithm
                            ieeaTEA2);  // TEA algorithm with pseudorandom key
{!!}


{!!
<FS>TIEFilterPresets

<FM>Declaration<FC>
}
  TIEFilterPresets = integer;
{!!}

{!!
<FS>TIEPreviewEvent

<FM>Declaration<FC>
}
  TIEPreviewEvent = procedure(Sender: TObject; PreviewForm: TForm) of object;
{!!}

{!!
<FS>TIEChannel

<FM>Declaration<FC>
}
  TIEChannel = (iecRed, iecGreen, iecBlue);
{!!}


{!!
<FS>TIEChannels

<FM>Declaration<FC>
TIEChannels = set of <A TIEChannel>;

<FM>Description<FN>
TIEChannels = set of (iecRed, iecGreen, iecBlue);
!!}
  TIEChannels = set of TIEChannel;

{!!
<FS>TIEUndoSource

<FM>Declaration<FC>
TIEUndoSource = (ieuUnknown, ieuImage, ieuSelection, ieuObject, ieuLayer, ieuFullLayer, ieuObjectsAndLayers);

<FM>Description<FN>
<TABLE>
<R> <H>Value</H> <H>Description</H> </R>
<R> <C><FC>ieuUnknown<FN></C> <C>Unexpected source</C> </R>
<R> <C><FC>ieuImage<FN></C> <C>The bitmap (e.g. of the current layer)</C> </R>
<R> <C><FC>ieuSelection<FN></C> <C>The selection that has been made (Note: not the content of the selection)</C> </R>
<R> <C><FC>ieuObject<FN></C> <C>The current <A TImageEnVect> object</C> </R>
<R> <C><FC>ieuLayer<FN></C> <C>The properties of all layers (but not the image content)</C> </R>
<R> <C><FC>ieuFullLayer<FN></C> <C>The properties of all layers, and the image content of the current layer</C> </R>
<R> <C><FC>ieuObjectsAndLayers<FN></C> <C>Everything, i.e. the image and all layers and objects</C> </R>
</TABLE>
!!}
  TIEUndoSource = (ieuUnknown, ieuImage, ieuSelection, ieuObject, ieuLayer, ieuFullLayer, ieuObjectsAndLayers);

{!!
<FS>TIEMedFilType

<FM>Declaration<FC>
TIEMedFilType = (mfMedianFilter, mfSharpen, mfEdgeExtract);

<FM>Description<FN>
The effect of <A TImageEnProc.MedianFilter>:
<TABLE>
<R> <C><FC>mfMedianFilter<FN></C> <C>Substitute median if central point differs from median by a threshold amount</C> </R>
<R> <C><FC>mfSharpen<FN></C> <C>High pass sharpening</C> </R>
<R> <C><FC>mfEdgeExtract<FN></C> <C>Edge extraction</C> </R>
</TABLE>

!!}
  TIEMedFilType = (mfMedianFilter, mfSharpen, mfEdgeExtract);

{!!
<FS>TIESaveUndoEvent

<FM>Declaration<FC>
TIESaveUndoEvent = procedure(Sender : TObject; Source : <A TIEUndoSource>) of object;
!!}
  TIESaveUndoEvent = procedure(Sender: TObject; Source: TIEUndoSource) of object;


{!!
<FS>TIEOnUndoRedoEvent

<FM>Declaration<FC>
TIEOnUndoRedoEvent = procedure(Sender : TObject; bIsUndo : Boolean; Source : <A TIEUndoSource>; Bitmap : <A TIEBitmap>; iIndex : Integer; var bHandled : Boolean) of object;
!!}
  TIEOnUndoRedoEvent = procedure(Sender : TObject; bIsUndo : Boolean; Source : TIEUndoSource; UndoObj : TObject; iIndex : Integer; var bHandled : Boolean) of object;

{!!
<FS>TIEDeinterlaceMode

<FM>Declaration<FC>
TIEDeinterlaceMode = (iedDiscard, iedIntelliMerge);

<FM>Description<FN>
<FC>iedDiscard<FN> just discards one row every two.
<FC>iedIntelliMerge<FN> merges only if the two fields are similar (less movement).
!!}
  TIEDeinterlaceMode = (iedDiscard, iedIntelliMerge);

{!!
<FS>TIEThreshMode

<FM>Declaration<FC>
}
TIEThreshMode = (ietMean, ietMedian, ietMeanMinMax);
{!!}

{!!
<FS>TIECmpMode

<FM>Declaration<FC>
}
TIECmpMode = (
  iecmpRMSE,        // Root Mean Square error
  iecmpHamming,     // Hamming distance
  iecmpCovariance   // Covariance
);
{!!}


  TIEUndoStore = class
  private
    fObjectList: TList;       // list of undo objects
    fInfoList: TObjectList;   // List of undo details

    function GetCaptions(index: Integer): String;
    procedure SetCaptions(index: Integer; const Value: String);
    function GetMViewIndexes(index: Integer): Integer;
    procedure SetMViewIndexes(index: Integer; const Value: Integer);
    function GetUndoObjects(index: Integer): TObject;
    {$IFDEF IEUseLegacyUndoFunctionality}
    procedure SetUndoObjects(index: Integer; obj: TObject);
    {$ENDIF}
    function GetUndoSources(index: Integer): TIEUndoSource;
    function GetUndoOperations(index: Integer): Integer;
    procedure SetUndoOperations(index: Integer; const Value: Integer);
    function GetLayerIndexes(index: Integer): Integer;
    procedure SetLayerIndexes(index: Integer; const Value: Integer);
  public
    constructor Create();
    destructor Destroy(); override;

    procedure ClearAll();
    procedure ClearAt(idx: Integer; bFreeUndoImg: Boolean = true);
    function Count(): integer;
    procedure Add(Obj: TObject; Source: TIEUndoSource; Operation: Integer; MViewIndex: Integer);

    // Display caption
    property Captions[index: Integer]: String read GetCaptions write SetCaptions;

    // The undo image
    property UndoObjects[index: Integer]: TObject read GetUndoObjects
      {$IFDEF IEUseLegacyUndoFunctionality} write SetUndoObjects {$ENDIF};

    // The type of undo, e.g. image, layer, IEVect object, etc.
    property UndoSources[index: Integer]: TIEUndoSource read GetUndoSources;

    // An ID indicating the type of operation that was done, e.g. Rotate
    property UndoOperations[index: Integer]: Integer read GetUndoOperations write SetUndoOperations;

    // Relevant Index in a TImageEnMView for this undo image
    property MViewIndexes[index: Integer]: Integer read GetMViewIndexes write SetMViewIndexes;

    // Relevant Layer in a TImageEnView for this undo image
    property LayerIndexes[index: Integer]: Integer read GetLayerIndexes write SetLayerIndexes;
  end;

{!!
<FS>TIEPaletteType

<FM>Declaration<FC>
TIEPaletteType = (ieptMedianCut, ieptFixedBW, ieptFixedHalftone8, ieptFixedHalftone27, ieptFixedHalftone64,
                  ieptFixedHalftone125, ieptFixedWebPalette, ieptFixedHalftone252,
                  ieptFixedHalftone256, ieptFixedGray4, ieptFixedGray16, ieptFixedGray256);

<FM>Description<FN>
<TABLE>
<R> <H>Value</H> <H>Description</H> </R>
<R> <C><FC>ieptMedianCut<FN></C> <C>An optimal palette generated using a median-cut algorithm. Derived from the colors in an image.</C> </R>
<R> <C><FC>ieptFixedBW<FN></C> <C>A black and white palette.</C> </R>
<R> <C><FC>ieptFixedHalftone8<FN></C> <C>A palette that has its 8-color on-off primaries and the 16 system colors added. With duplicates removed, 16 colors are available.</C> </R>
<R> <C><FC>ieptFixedHalftone27<FN></C> <C>A palette that has 3 intensity levels of each primary: 27-color on-off primaries and the 16 system colors added. With duplicates removed, 35 colors are available.</C> </R>
<R> <C><FC>ieptFixedHalftone64<FN></C> <C>A palette that has 4 intensity levels of each primary: 64-color on-off primaries and the 16 system colors added. With duplicates removed, 72 colors are available.</C> </R>
<R> <C><FC>ieptFixedHalftone125<FN></C> <C>A palette that has 5 intensity levels of each primary: 125-color on-off primaries and the 16 system colors added. With duplicates removed, 133 colors are available.</C> </R>
<R> <C><FC>ieptFixedWebPalette<FN></C> <C>A palette that has 6 intensity levels of each primary: 216-color on-off primaries and the 16 system colors added. With duplicates removed, 224 colors are available.</C> </R>
<R> <C><FC>ieptFixedHalftone252<FN></C> <C>A palette that has its 252-color on-off primaries and the 16 system colors added. With duplicates removed, 256 colors are available.</C> </R>
<R> <C><FC>ieptFixedHalftone256<FN></C> <C>A palette that has its 256-color on-off primaries and the 16 system colors added. With duplicates removed, 256 colors are available.</C> </R>
<R> <C><FC>ieptFixedGray4<FN></C> <C>A palette that has 4 shades of gray.</C> </R>
<R> <C><FC>ieptFixedGray16<FN></C> <C>A palette that has 16 shades of gray.</C> </R>
<R> <C><FC>ieptFixedGray256<FN></C> <C>A palette that has 256 shades of gray.</C> </R>
</TABLE>
!!}
TIEPaletteType = (ieptMedianCut, ieptFixedBW, ieptFixedHalftone8, ieptFixedHalftone27, ieptFixedHalftone64,
                  ieptFixedHalftone125, ieptFixedWebPalette, ieptFixedHalftone252,
                  ieptFixedHalftone256, ieptFixedGray4, ieptFixedGray16, ieptFixedGray256);



{!!
<FS>TIEDitherType

<FM>Declaration<FC>
TIEDitherType =  (iedtSolid, iedtOrdered4x4, iedtOrdered8x8, iedtOrdered16x16, iedtSpiral4x4,
                  iedtSpiral8x8, iedtDualSpiral4x4, iedtDualSpiral8x8, iedtErrorDiffusion);

<FM>Description<FN>
<TABLE>
<R> <H>Value</H> <H>Description</H> </R>
<R> <C><FC>iedtSolid<FN></C> <C>A solid color algorithm without dither.</C> </R>
<R> <C><FC>iedtOrdered4x4<FN></C> <C>A 4x4 ordered dither algorithm.</C> </R>
<R> <C><FC>iedtOrdered8x8<FN></C> <C>An 8x8 ordered dither algorithm.</C> </R>
<R> <C><FC>iedtOrdered16x16<FN></C> <C>A 16x16 ordered dither algorithm.</C> </R>
<R> <C><FC>iedtSpiral4x4<FN></C> <C>A 4x4 spiral dither algorithm.</C> </R>
<R> <C><FC>iedtSpiral8x8<FN></C> <C>An 8x8 spiral dither algorithm.</C> </R>
<R> <C><FC>iedtDualSpiral4x4<FN></C> <C>A 4x4 dual spiral dither algorithm.</C> </R>
<R> <C><FC>iedtDualSpiral8x8<FN></C> <C>An 8x8 dual spiral dither algorithm.</C> </R>
<R> <C><FC>iedtErrorDiffusion<FN></C> <C>An error diffusion algorithm.</C> </R>
</TABLE>
!!}
TIEDitherType =  (iedtSolid, iedtOrdered4x4, iedtOrdered8x8, iedtOrdered16x16, iedtSpiral4x4,
                  iedtSpiral8x8, iedtDualSpiral4x4, iedtDualSpiral8x8, iedtErrorDiffusion);



{!!
<FS>TIECropAlgorithm

<FM>Declaration<FC>
TIECropAlgorithm =  (iecaSkewedDocument, iecaAngledPhoto);

<FM>Description<FN>
<TABLE>
<R> <H>Value</H> <H>Description</H> </R>
<R> <C><FC>iecaSkewedDocument<FN></C> <C>Works best with documents requiring rotation due to scanning skew (not lined up correctly when scanning) or a previous rotation</C> </R>
<R> <C><FC>iecaAngledPhoto<FN></C> <C>Works best with photos requiring rotation due camera skew (the camera is not quite horizontal)</C> </R>
</TABLE>
!!}
TIECropAlgorithm =  (iecaSkewedDocument, iecaAngledPhoto);

{!!
<FS>TImageEnProc

<FM>Description<FN>
TImageEnProc provides image processing and analysis functionality to the <A TImageEnView>, <A TImageEnDBView>, <A TIEBitmap>, TImage or TBitmap component. It also handles clipboard operations, undo/redo and encryption.

Note: <A TImageEnView> already encapsulates TImageEnProc (as <A TImageEnView.Proc>), so you don't generally need to add a TImageEnProc component to a form.

<FM>Examples<FC>
// Rotate an image in a TImageEnView 90° clockwise
ImageEnView1.Proc.Rotate(270);

// Reduce the size of an image in a TImageEnView to half its size (so when saved it will be much smaller on disk)
ImageEnView1.Proc.Resample(ImageEnView1.IEBitmap.Width div 2, -1, rfLanczos3);

// Prompt the user to perform image modification effects on an image in a TImage
ImageEnView1.Proc.AttachedBitmap := Image1.Picture.Bitmap;
ImageEnView1.Proc.DoPreviews([peAll]);

// Load an image with a TIEBitmap, make it negative then save it
iebmp := TIEBitmap.Create;
ImageEnProc := TImageEnProc.create(nil);
ImageEnProc.AttachedIEBitmap := iebmp;
iebmp.Read('animage.tif');
ImageEnProc.Negative;
iebmp.Write('output.tif');
ImageEnProc.Free;
iebmp.Free;

<FM>Methods and Properties<FN>
<FI>Connected component<FN>
<TABLE2>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.AttachedBitmap></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.AttachedIEBitmap></C> </R>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.AttachedImageEn></C> </R>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.AttachedTImage></C> </R>
</TABLE>

<FI>Dialogs<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.DoPreviews></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.IPDialogParams></C> </R>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.PreviewFont></C> </R>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.PreviewFontEnabled></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.PreviewsLog></C> </R>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.PreviewsParams></C> </R>
</TABLE>

<FI>Shadows<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AddInnerShadow></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AddSoftShadow> (and Glow)</C> </R>
</TABLE>

<FI>Fourier Analysis (FFT)<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.FTClearZone></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.FTConvertFrom></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.FTCreateImage></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.FTDisplayFrom></C> </R>
</TABLE>

<FI>Paint<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.CastColor></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearSel></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Clear></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Fill></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.PaintMark></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.PaintPenMarker></C> </R>
</TABLE>

<FI>Alpha Channel<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.CastAlpha></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.FeatherAlphaEdges></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.SetTransparentColors></C> </R>
</TABLE>

<FI>Chroma Key<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GuessChromaKeyColor></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.RemoveChromaKey></C> </R>
</TABLE>

<FI>Analysis<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.CalcAverageRGB></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.CalcDensityHistogram></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.CalcImageNumColors></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.CalcImagePalette></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.CalcOrientation></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.CalcStdDev></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.CompareWith></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.CompareHistogramWith></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ComputeImageEquality></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GetDominantColor></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GetHistogram></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GetHSVChannelAll></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GetHSVChannel></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GetRGBChannelAll></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GetRGBChannel></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.SeparateObjects></C> </R>
</TABLE>

<FI>Custom Image Analysis<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.BeginImageAnalysis></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.EndImageAnalysis></C> </R>
</TABLE>

<FI>Custom Image Processing<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.BeginImageProcessing></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.EndImageProcessing></C> </R>
</TABLE>

<FI>Automatic Image Enhancement<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AdjustGainOffset></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AutoImageEnhance1></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AutoImageEnhance2></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AutoImageEnhance3></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AutoSharp></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.HistAutoEqualize></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WhiteBalance_AutoWhite></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WhiteBalance_GrayWorld></C> </R>
</TABLE>

<FI>Color Adjustment<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AdjustBrightnessContrastSaturation></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AdjustLumSatHistogram></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AdjustSaturation></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AdjustTemperature></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AdjustTint></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.CastColorRange></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Closing></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Colorize></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Contrast></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Contrast2></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Contrast3></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ConvertTo24Bit></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ConvertToBW_FloydSteinberg></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ConvertToBWLocalThreshold></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ConvertToBWOrdered></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ConvertToBWThreshold></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ConvertToGray></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ConvertToPalette></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ConvertToSepia></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ConvertTo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.DisposeChannels></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Deinterlace></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.EdgeDetect_ShenCastan></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.EdgeDetect_Sobel></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GammaCorrect></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.HistEqualize></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.HSLvar></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.HSVvar></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.IntensityRGBAll></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Intensity></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.MapGrayToColor></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Maximum></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.MedianFilter></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.MatchHSVRange></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Minimum></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Negative></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Opening></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Random></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Threshold></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Threshold2></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WallisFilter></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WhiteBalance_coef></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WhiteBalance_WhiteAt></C> </R>
</TABLE>

<FI>Pixel Adjustment<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ApplyFilterPreset></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ApplyFilter></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Blur></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.BumpMapping>     </C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Convolve>  </C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.FiltersInitialDir>  </C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Lens>      </C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Merge></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.MotionBlur>   </C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.RemoveRedEyes>   </C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Pixelize></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.PencilSketch></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Sharpen>    </C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.SymmetricNearestNeighbour></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.UnsharpMask>   </C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Wave></C> </R>
</TABLE>

<FI>Noise<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.RemoveIsolatedPixels></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.RemoveNoise></C> </R>
</TABLE>

<FI>Clipboard<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C> <A TImageEnProc.CanCutToClipboard> </C> </R>
<R> <C_IMG_METHOD> <C> <A TImageEnProc.CutToClipboard> </C> </R>
<R> <C_IMG_METHOD> <C> <A TImageEnProc.CanCopyToClipboard> </C> </R>
<R> <C_IMG_METHOD> <C> <A TImageEnProc.CopyToClipboard> </C> </R>
<R> <C_IMG_METHOD> <C> <A TImageEnProc.CanPasteFromClipboard> </C> </R>
<R> <C_IMG_METHOD> <C> <A TImageEnProc.PasteFromClipboard> </C> </R>
<R> <C_IMG_METHOD> <C> <A TImageEnProc.PointPasteFromClip> </C> </R>
</TABLE>

<FI>Steganography<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearHiddenText></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GetHiddenDataSpace></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ReadHiddenData></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ReadHiddenText></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WriteHiddenData></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WriteHiddenText></C> </R>
</TABLE>

<FI>Encryption<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Decrypt></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Encrypt></C> </R>
</TABLE>

<FI>Geometric (Rotate, resize, crop, etc)<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AutoCrop></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AutoCrop2></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.CropTransparentBorder></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.CropSel></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Crop></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Flip></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ImageResize></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.MakeTile></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.PerspectiveDraw></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ProjectDraw></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.RadialStretch></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Reflection></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Resample></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ResampleTo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.RotateAndCrop></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Rotate></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.RoundImage></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ShiftChannel></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.SkewDetectionFine></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.SkewDetection></C> </R>
</TABLE>

<FI>Undo<FN>
<TABLE2>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.AutoUndo></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.CanUndo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearAllUndo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearUndoAt></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearUndo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GetUndoInfo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.SaveUndo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Undo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.UndoAt></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.UndoCaptions></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.UndoCount></C> </R>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.UndoLimit></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.UndoLocation></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.UndoRect></C> </R>
</TABLE>

<FI>Redo<FN>
<TABLE2>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.CanRedo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearAllRedo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearRedo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearRedoAt></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GetRedoInfo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Redo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.RedoAt></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.RedoCaptions></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.RedoCount></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.SaveRedo></C> </R>
</TABLE>

<FI>Transitions<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.PrepareTransitionBitmaps></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.PrepareTransitionBitmapsEx></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.CreateTransitionBitmap></C> </R>
</TABLE>

<FI>Others<FN>
<TABLE2>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.AutoConvertFormat></C> </R>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.Background></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.CheckLegacyBitmap></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Create></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.CreateFromBitmap></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GetReSel></C> </R>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.ImageEnVersion></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.TextOut></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Update></C> </R>
</TABLE>

<FM>Events<FN>
<TABLE2>
<R> <C_IMG_EVENT> <C><A TImageEnProc.OnFinishWork></C> </R>
<R> <C_IMG_EVENT> <C><A TImageEnProc.OnPreview></C> </R>
<R> <C_IMG_EVENT> <C><A TImageEnProc.OnProgress></C> </R>
<R> <C_IMG_EVENT> <C><A TImageEnProc.OnSaveUndo></C> </R>
</TABLE>
!!}
  {$ifdef IEHASPLATFORMATTRIBUTE}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
  {$endif}
  TImageEnProc = class(TComponent)
  private
    { Private declarations }
    fAutoUndo: Boolean;
    fImageEnView: TIEView; // refers to TIEView (fbitmap=fimageenview.bitmap)
    fImageEnViewBitmapChangeHandle: Pointer; // bitmap change handle (nil=none)
    fBackground: TColor; // valid only if fImageEnview=nil
    fPreviewsParams: TPRPreviewsParams;
    fPreviewFont: TFont;
    fPreviewFontEnabled: Boolean;
    fOnPreview: TIEPreviewEvent;
    fTImage: TImage; // riferimento a TImage
    fFiltersInitialDir: String;
    fIEBitmap: TIEBitmap; // encapsulates fBitmap if SetBitmap, SetAttachedBitmap, SetAttachedImageEn, SetTImage are called
    fIEBitmapCreated: Boolean; // true if fIEBitmap is created by TImageEnIO
    fTransitionFullBitmap : TIEBitmap; // Used when creating PanZoom transition Bitmaps
    {$ifdef IEINCLUDEDIALOGIP}
    fIPDialogParams: TIPDialogParams;
    fPreviewsLog: TStringList;
    {$endif}
    fAutoConvertFormat: Boolean; // if true functions that call MakeConsistentBitmap will convert the pixelformat to the requested one
    fTransition: TIETransitionEffects;            // effect engine

    procedure SetAttachedBitmap(atBitmap: TBitmap);
    procedure SetAttachedImageEn(atImageEn: TIEView);
    function GetReBackground: TColor;
    procedure SetReBackground(v: TColor);
    procedure SetPreviewFont(f: TFont);
    procedure SetPreviewFontEnabled(Value: Boolean);
    procedure SetTImage(v: TImage);
    procedure SetPRPreviewParams(v: TPRPreviewsParams);
    function GetPRPreviewParams: TPRPreviewsParams;
    procedure SetUndoCaptions(index: Integer; const Value: String);
    procedure SetUndoLimit(v: Integer);
    function GetImageEnVersion: String;
    procedure SetImageEnVersion(Value: String);
    procedure GuessChromaKeyColorEx(out KeyColor : TRGB; bGetTolerance : Boolean; out Tolerance: Double);
    procedure CheckHaveValidBitmap();

    function CopyToClipboard_Image(IncludeImageEnFormat: Boolean; ClearImage: Boolean): Boolean;
    function CopyToClipboard_Selection(IncludeImageEnFormat: Boolean; CutImage: Boolean; CutAlpha: Boolean = false): Boolean;
    function CopyToClipboard_Layer(CutLayer: Boolean): Boolean;

    function PasteFromClipboard_Image(): Boolean;
    function PasteFromClipboard_Selection(MergeAlpha: Boolean = True; MaintainAspectRatio: Boolean = False; CanStretch: Boolean = False): Boolean;

  protected
    { Protected declarations }
    fUndoList: TIEUndoStore;
    fRedoList: TIEUndoStore;
    fUndoLocation: TIELocation;
    fUndoLimit: Integer;
    fBitmap: TBitmap; // working bitmap (if fImageEnView is <>nil then fBitmap=FImageEnView.bitmap)
    fOnProgress: TIEProgressEvent;
    fOnFinishWork: TNotifyEvent;
    fOnSaveUndo: TIESaveUndoEvent;

    function GetCanUndo: Boolean; virtual;
    function GetCanRedo: Boolean; virtual;
    function GetUndoCount: Integer; virtual;
    function GetRedoCount: Integer; virtual;
    function GetRedoCaptions(index: Integer): String; virtual;
    function GetUndoCaptions(index: Integer): String; virtual;
 
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure OnBitmapChange(Sender: TObject; destroying: Boolean);
    procedure SetIEBitmap(bmp: TIEBitmap);
    procedure SetAttachedIEBitmap(bmp: TIEBitmap);
    function MakeConsistentBitmap(allowedFormats: TIEPixelFormatSet; ExceptionOnInvalidBitmap: Boolean = true): Boolean;
    procedure DoFinishWork; virtual;
    function GetDPIX: Integer;
    function GetDPIY: Integer;

  public
    { Public declarations } 
    fMViewIndex : Integer; // The index of the current bitmap if this is attached to a TImageEnMView
    fOnUndoRedoEvent : TIEOnUndoRedoEvent; // Custom handling of undo by TImageEnMView

    constructor Create(Owner: TComponent); overload; override;
    constructor CreateFromBitmap(Bitmap: TIEBitmap); overload;
    constructor CreateFromBitmap(Bitmap: TBitmap); overload;
    destructor Destroy; override;
    property AttachedBitmap: TBitmap read fBitmap write SetAttachedBitmap;
    property AttachedIEBitmap: TIEBitmap read fIEBitmap write SetAttachedIEBitmap;
    procedure Update;

    function PasteFromClipboard_Layer(): Integer;

{!!
<FS>TImageEnProc.FiltersInitialDir

<FM>Declaration<FC>
property FiltersInitialDir: String;

<FM>Description<FN>
FiltersInitialDir contains the initial directory in the previews dialog for the 'user filters' effect.
!!}
    property FiltersInitialDir: String read fFiltersInitialDir write fFiltersInitialDir;

    // Image processing
    procedure CheckLegacyBitmap(PixelFormat: TIEPixelFormat);
    function BeginImageProcessing(allowedFormats: TIEPixelFormatSet; var x1, y1, x2, y2: Integer; const OpName: String; var ProcBitmap: TIEBitmap; var mask: TIEMask; OpID: Integer = 0; ExtractROI: Boolean = true): Boolean;
    procedure EndImageProcessing(ProcBitmap: TIEBitmap; mask: TIEMask);
    function BeginImageAnalysis(allowedFormats: TIEPixelFormatSet; var x1, y1, x2, y2: Integer; var ProcBitmap: TIEBitmap; var mask: TIEMask): Boolean;
    procedure EndImageAnalysis(ProcBitmap: TIEBitmap);
    procedure Negative;
    procedure HSLvar(oHue, oSat, oLum: Integer);
    procedure HSVvar(oHue, oSat, oVal: Integer);
    procedure IntensityRGBAll(r, g, b: Integer);
    procedure Intensity(LoLimit, HiLimit, Change: Integer; UseAverageRGB: Boolean; DoRed, DoGreen, DoBlue: Boolean);
    procedure Contrast(vv: Double = 2);
    procedure ApplyFilter(filter: TGraphFilter);
    procedure ApplyFilterPreset(filter: TIEFilterPresets);
    procedure Convolve(Kernel: array of double; KernelWidth, KernelHeight: Integer; Factor: Double);
    procedure ConvertToGray;
    procedure ConvertToSepia(Depth : Integer = 20);
    procedure CastColorRange(BeginColor, EndColor, CastColor: TRGB);
    function MatchHSVRange(HueBegin, HueEnd, SatBegin, SatEnd, ValBegin, ValEnd: Integer; ColorizeMatched: Boolean; MatchColor: TRGB; ColorizeNonMatched: Boolean; NonMatchColor: TRGB): Integer;
    procedure CastColor(x, y: Integer; newColor: TRGB; tolerance: Integer);
    procedure CastAlpha(x, y: Integer; newAlpha: Integer; tolerance: Integer);
    procedure FeatherAlphaEdges(iFeatherDepth : Integer);
    procedure Flip(dir: TFlipDir);
    procedure RemoveRedEyes;
    procedure ConvertToBW_FloydSteinberg;
    procedure ConvertToBWLocalThreshold(WinSize: Integer = 4; Mode: TIEThreshMode = ietMean; Offset: Integer = 4);

    procedure ImageResize(newWidth, newHeight: Integer; HorizAlign: TIEHAlign = iehLeft; VertAlign: TIEVAlign = ievTop; FillAlpha: Integer = 255); overload;
    procedure ImageResize(AddLeft, AddTop, AddRight, AddBottom: integer; FillAlpha: Integer = 255); overload;
    procedure Resample(NewWidth, NewHeight: Integer; FilterType: TResampleFilter = rfNone; bMaintainAspectRatio : Boolean = False); overload;
    procedure Resample(ScaleBy: Double; FilterType: TResampleFilter = rfNone); overload;

    procedure Rotate(Angle: Double; AntiAliasMode: TIEAntialiasMode = ierFast; BackgroundColor: TColor = -1); {$ifdef IEIncludeDeprecatedInV4} overload; {$endif}
    procedure RotateAndCrop(Angle: Double; AntiAliasMode: TIEAntialiasMode = ierFast; Rate: Double = 1.3; CropAlgorithm: TIECropAlgorithm = iecaSkewedDocument); {$ifdef IEIncludeDeprecatedInV4} overload; {$endif}

    {$ifdef IEIncludeDeprecatedInV4}
    // Deprecated in 5.0.0
    procedure Rotate(Angle: Double; AntiAlias: Boolean; AntiAliasMode: TIEAntialiasMode = ierFast; BackgroundColor: TColor = -1); overload; {$ifdef IEWarningForDeprecated} deprecated {$ifdef IESupportDeprecatedDescription} 'Remove AntiAlias parameter - http://imageen.com/help/Compatibility.html' {$endif}; {$endif}
    procedure RotateAndCrop(Angle: Double; AntiAlias: Boolean; AntiAliasMode: TIEAntialiasMode = ierFast; Rate: Double = 1.3); overload; {$ifdef IEWarningForDeprecated} deprecated {$ifdef IESupportDeprecatedDescription} 'Remove AntiAlias parameter - http://imageen.com/help/Compatibility.html' {$endif}; {$endif}
    {$endif}

    procedure ConvertToBWThreshold(Threshold: Integer = -1);
    procedure EdgeDetect_ShenCastan(Ratio: Double = 0.99; Smooth: Double = 0.9; WindowSize: Integer = 7; ThinFactor: Integer = 0; DoHysteresis: Boolean = true);
    procedure EdgeDetect_Sobel;
    procedure RemoveIsolatedPixels(NoiseColor: Integer = 1; PixelsCount: Integer = 2);
    procedure RemoveNoise(Iterations: Integer = 2; InvertImage: Boolean = false);
    procedure PaintMark(Frequency: Integer; Color: TRGB);
    procedure GammaCorrect(Gamma: Double; Channel: TIEChannels = [iecRed, iecGreen, iecBlue]);
    procedure PaintPenMarker(x, y: Integer; Width: Integer = 20; Color: TColor = clYellow; BackgroundColor: TColor = clWhite; Tolerance: Integer = 10);
    procedure ConvertToPalette(NumColors: Integer; Palette: pointer; DitherMethod: TIEDitherMethod = ieOrdered);
    procedure ConvertTo(NumColors: Integer; DitherMethod: TIEDitherMethod = ieOrdered); overload;
    {$IFDEF IEINCLUDEWIC}
    function ConvertTo(PixelFormat: TIEPixelFormat; PaletteType: TIEPaletteType = ieptMedianCut; DitherType: TIEDitherType = iedtSolid; CheckParametersOnly: boolean = false): boolean; overload;
    function ConvertTo(PixelFormat: TIEPixelFormat; Palette: array of TRGB; DitherType: TIEDitherType = iedtSolid; CheckParametersOnly: boolean = false): boolean; overload;
    {$ENDIF}
    {$IFDEF IEINCLUDEDIALOGIP}
    function DoPreviews(pe: TPreviewEffects = [peAll]; IsResizeable: Boolean = True; FormWidth: Integer = -1; FormHeight: Integer = -1; FormLeft: Integer = -1; FormTop: Integer = -1): Boolean;

{!!
<FS>TImageEnProc.IPDialogParams

<FM>Declaration<FC>
property IPDialogParams: <A TIPDialogParams>;

<FM>Description<FN>
This property contains <A TIPDialogParams> object which provides read/write access to the parameters of the Image Processing Dialog  (displayed by calling <A TImageEnProc.DoPreviews>).

<FM>Example<FC>
// Set default brightness in "Contrast" tab
ImageEnView1.Proc.IPDialogParams.CONTRAST_Brightness := 20;
ImageEnView1.Proc.DoPreviews;

// Make parameters persistent (saved between sessions)
if FileExists(AppSettingsFolder + 'Previews.dat') then
  ImageEnView1.Proc.IPDialogParams.LoadFromFile(AppSettingsFolder + 'Previews.dat');
If ImageEnView1.Proc.DoPreviews then
  ImageEnView1.Proc.IPDialogParams.SaveToFile(AppSettingsFolder + 'Previews.dat');
!!}
    property IPDialogParams: TIPDialogParams read fIPDialogParams;

{!!
<FS>TImageEnProc.PreviewsLog

<FM>Declaration<FC>
property PreviewsLog: TStringList;

<FM>Description<FN>
Returns a log of operations performed in the Image Processing Dialog (<A TImageEnProc.DoPreviews>).

<FM>Example<FC>
ImageEnView1.Proc.DoPreviews;
Memo1.Lines.Assign( ImageEnView1.Proc.PreviewsLog );
!!}
    property PreviewsLog: TStringList read fPreviewsLog;
    {$ENDIF}

    procedure AddSoftShadow(radius: Double=4; OffSetX: Integer=4; OffSetY: Integer=4; AdaptSize: Boolean = true; ShadowColor: TColor = clBlack; Intensity: Integer = 100);
    procedure AddInnerShadow(radius: Double=4; OffSetX: Integer = 0; OffSetY: Integer = 0; ShadowColor: TColor = clBlack);
    procedure MedianFilter(WindowX: Integer = 5; WindowY: Integer = 5; Brightness: Integer = 50; Contrast: Integer = 50; Multiplier: Integer = 1; Threshold: Integer = 50; MedianOp: TIEMedFilType = mfMedianFilter);
    procedure WallisFilter(WinWidth: Integer = 2; WinHeight: Integer = 2; Mean: Integer = 50; StDev: Integer = 50; InGain: Integer = 50; Edge: Integer = 10; Limit: Integer = 50; Thresholding: Boolean = false);
    procedure Sharpen(Intensity: Integer = 10; Neighbourhood: Integer = 4);
    procedure UnsharpMask(Radius: Double = 4.0; Amount: Double = 1.0; Threshold: Double = 0.05);
    procedure SymmetricNearestNeighbour(Radius: Integer = 6);
    procedure Pixelize(Amount: Double = 0.02);
    procedure PencilSketch(GrayScale: boolean = true; LevelSteps: integer = 2; MaxTextures: integer = MAXINT; EdgeBlurAmount: integer = 4; EdgeAmount: double = 0.5; LineThickness: double = 1; DarkeningFactor: double = 0.1; LineAlpha: double = 0.1; LineDensity: double = 0.5; Lightness: double = 4; AntialiasedLines: boolean = false);
    procedure Clear;
    procedure ClearSel;
    procedure Merge(SrcBitmap: TBitmap; pcf: Integer = 50); overload;
    procedure Merge(SrcBitmap: TIEBitmap; pcf: Integer = 50); overload;
    procedure Merge(SrcBitmap: TIEBitmap; Mask: TIEBitmap); overload;
    {$ifdef IEIncludeDeprecatedInV6}
    // Deprecated in 6.2.0 (2015-06-27)
    procedure MergeIEBitmap(DBitmap: TIEBitmap; pcf: Integer = 50); {$ifdef IEWarningForDeprecated} deprecated {$ifdef IESupportDeprecatedDescription} 'Use Merge instead - http://imageen.com/help/Compatibility.html' {$endif}; {$endif}
    {$endif}
    procedure Threshold(DownLimit, UpLimit, DownVal, UpVal: TRGB);
    procedure Threshold2(LoThreshold, HiThreshold: Integer; Red, Green, Blue: Boolean);
    procedure HistEqualize(LoThresh, HiThresh: TRGB);
    procedure HistAutoEqualize;
    procedure CropSel(TransparencyOnly: Boolean = False);
    procedure BumpMapping(LightX, LightY, LampX, LampY, pcf: Integer; Color: TRGB);
    procedure Lens(cx, cy, Width, Height: Integer; Refraction: Double);
    procedure Wave(amplitude, wavelength, phase: Integer; reflective: Boolean);
    procedure ConvertToBWOrdered;
    procedure ConvertTo24Bit;
    function WriteHiddenText(text: AnsiString): Integer;
    function WriteHiddenData(data: PAnsiChar; count: Integer): Integer;
    procedure Maximum(WindowSize: Integer);
    procedure Minimum(WindowSize: Integer);
    procedure Opening(WindowSize: Integer);
    procedure Closing(WindowSize: Integer);
    procedure Fill(FillColor: TRGB); overload;
    procedure Fill(FillColor: TColor); overload;
    procedure Blur(radius: Double);
    procedure MotionBlur(angle: Double; radius: Integer=8; sigma: Integer=7);
    procedure Random(mean: Double = 0.5; stdDev: Double = 0.123);
    procedure SetTransparentColors(MinColor, MaxColor: TRGB; Alpha: Integer = 0);
    procedure RemoveChromaKey(KeyPixelX, KeyPixelY: integer; Tolerance: double; Saturation: integer; FeatherEdges: Integer;
                              HueReduction : Integer = 0; RemoveNoise: boolean = False); overload;
    procedure RemoveChromaKey(KeyColorRGB: TRGB; Tolerance: double; Saturation: integer; FeatherEdges: Integer;
                              HueReduction : Integer = 0; RemoveNoise: boolean = False); overload;
    function GuessChromaKeyColor : TRGB; overload;
    function GuessChromaKeyColor(out Tolerance: Double) : TRGB; overload;
    procedure ResampleTo(Target: TIEBitmap; TargetWidth, TargetHeight: Integer; FilterType: TResampleFilter; bMaintainAspectRatio : Boolean = False);
    procedure RoundImage(RoundWidth, RoundHeight: Integer);
    procedure RadialStretch(ARed, BRed, CRed, DRed, AGreen, BGreen, CGreen, DGreen, ABlue, BBlue, CBlue, DBlue: Double);
    procedure Crop(x1, y1, x2, y2: Integer); overload;
    procedure Crop(Rect: TRect); overload;
    procedure Crop(Rectangle: TRect; Rotation: double; AntialiasMode: TIEAntialiasMode = ierFast); overload;
    procedure Crop(Quadrilater: array of TIE2DPoint); overload;
    procedure CropTransparentBorder;
    function AutoCrop(Tolerance: Integer; Background: TRGB; DoCrop: Boolean = True): TRect; overload;
    function AutoCrop(Tolerance: Integer; Background: TColor; DoCrop: Boolean = True): TRect; overload;
    function AutoCrop2(BorderRate: Double = 6; DoCrop: Boolean = True): TRect;
    procedure MakeTile(columns: Integer = 2; rows: Integer = 2);
    procedure ShiftChannel(offsetX, offsetY: Integer; channel: TIEChannel; fillValue: Integer);
    procedure DisposeChannels(newDispo: String);
    procedure Deinterlace(mode: TIEDeinterlaceMode);
    procedure Encrypt(Passkey: array of byte; Algorithm: TIEEncryptionAlgorithm = ieeaTEA); overload;
    procedure Encrypt(Passkey: AnsiString; Algorithm: TIEEncryptionAlgorithm = ieeaTEA); overload;
    procedure Decrypt(Passkey: array of byte; Algorithm: TIEEncryptionAlgorithm = ieeaTEA); overload;
    procedure Decrypt(Passkey: AnsiString; Algorithm: TIEEncryptionAlgorithm = ieeaTEA); overload;
    procedure Reflection(minAlpha: Integer = 0; maxAlpha: Integer = 200; percentage: Integer = 100);
    procedure PerspectiveDraw(Source: TIEBitmap; x0, y0, x1, y1, x2, y2, x3, y3: Integer; alphaMin: Integer = -1; alphaMax: Integer = -1; mergeAlpha: Boolean = false);
    function ProjectDraw(Source: TIEBitmap; centerDestX: Integer; centerDestY: Integer; destWidth: Integer; destHeight: Integer;
                         depth: Double; translateX: Integer; translateY: Integer; rotateX: Double; rotateY: Double;
                         specularAlphaMin: Integer = -1; specularAlphaMax: Integer = -1; mergeAlpha: Boolean = false): TIEQuadCoords; overload;
    function ProjectDraw(Source: TIEBitmap; centerDestX: Integer; centerDestY: Integer; scale: Double; depth: Double;
                         translateX: Integer; translateY: Integer; rotateX: Double; rotateY: Double;
                         specularAlphaMin: Integer = -1; specularAlphaMax: Integer = -1; mergeAlpha: Boolean = false): TIEQuadCoords; overload;
    procedure MapGrayToColor(map: array of TRGB);
    // Image adjust
    procedure WhiteBalance_coef(Red, Green, Blue: Double);
    procedure WhiteBalance_GrayWorld;
    procedure WhiteBalance_WhiteAt(WhiteX, WhiteY: Integer);
    procedure WhiteBalance_AutoWhite;
    procedure AdjustGainOffset;
    procedure AutoImageEnhance1(SubsampledSize: Integer = 60; Slope: Integer = 20; Cut: Integer = 25; Neighbour: Integer = 2);
    procedure AutoImageEnhance2(ScaleCount: Integer = 3; ScaleCurve: Integer = 2; Variance: Double = 1.8; ScaleHigh: Integer = 200; Luminance: Boolean = True);
    procedure AutoImageEnhance3(Gamma: Double = 0.35; Saturation: Integer=80);
    procedure AutoSharp(Intensity: Integer=68; rate: Double = 0.035);
    procedure Colorize(hue: Integer; saturation: Integer; luminosity: Double);
    procedure AdjustBrightnessContrastSaturation(Brightness, Contrast, Saturation: Integer);
    procedure Contrast2(Amount: Double);
    procedure AdjustSaturation(Amount: Integer);
    procedure AdjustTemperature(temperature: Integer);
    procedure AdjustTint(Amount: Integer); overload;
    procedure AdjustTint(Amount: Integer; FixedColorStart: TRGB; FixedColorEnd: TRGB); overload;
    procedure AdjustTint(Amount: Integer; FixedColorPos: TPoint); overload;
    procedure AdjustLumSatHistogram(Saturation, Luminance: Double);
    procedure Contrast3(Change, Midpoint: Integer; DoRed, DoGreen, DoBlue: Boolean);
    // Image analysis
    function CalcOrientation: Integer;
    procedure GetHistogram(Hist: pointer; Content: TIEHistogramContent = [iehcRed, iehcGreen, iehcBlue, iehcGray]); overload;
    function GetHistogram(Content: TIEHistogramContent = [iehcRed, iehcGreen, iehcBlue, iehcGray]): TIEHistogram; overload;
    procedure CalcImagePalette(var Palette: array of TRGB; MaxCol: Integer = 256);
    function CalcImageNumColors(): Integer;
    function GetHSVChannel(ch: Integer): TIEBitmap;
    procedure GetHSVChannelAll(BitmapH, BitmapS, BitmapV: TIEBitmap);
    {$ifdef IEIncludeDeprecatedInV5}
    // Deprecated in 5.2.0
    function GetRGBChannel(ch: Integer): TIEBitmap; overload; {$ifdef IEWarningForDeprecated} deprecated {$ifdef IESupportDeprecatedDescription} 'Check parameters - http://imageen.com/help/Compatibility.html' {$endif}; {$endif}
    {$endif}
    function GetRGBChannel(ch: TIEChannel): TIEBitmap; {$ifdef IEIncludeDeprecatedInV5} overload; {$endif}
    procedure GetRGBChannelAll(BitmapR, BitmapG, BitmapB: TIEBitmap);
    function ReadHiddenText: AnsiString;
    function ReadHiddenData(data: PAnsiChar; maxlen: Integer): Integer;
    function GetHiddenDataSpace: Integer;
    procedure ClearHiddenText;
    {$ifdef IEINCLUDEFFT}
    function FTCreateImage(ImageType: TIEFtImageType; NewWidth: Integer = -1; NewHeight: Integer = -1): TIEFtImage;
    procedure FTConvertFrom(ft: TIEftImage);
    procedure FTDisplayFrom(ft: TIEftImage);
    procedure FTClearZone(tx1, ty1, tx2, ty2: Integer; GrayScale: Boolean);
    {$endif}
    function SkewDetection(ResampleWidth: Integer = 0; AngleRange: Integer = 30; Precision: Double = 0.1; EdgeDetect: Boolean = false): Double;
    function SkewDetectionFine(StartingAngle: Double = 0; resolution: Double = 0.1; range: Integer = 10; maxQuality: Boolean = True): Double;
    procedure CalcDensityHistogram(VertHist, HorizHist: pointer; norm_vert, norm_horiz: Integer);
    function ComputeImageEquality(SecondImage: TIEBitmap; var psnr_min, psnr_max: Double; var mse_min, mse_max: Double; var rmse_min, rmse_max: Double; var pae_min, pae_max: Double; var mae_min, mae_max: Double): Boolean;
    function CompareWith(SecondImage: TIEBitmap; DiffBitmap: TIEBitmap): Double;
    function CompareHistogramWith(SecondImage: TIEBitmap; Mode: TIECmpMode; GrayScale: Boolean): Double;
    function GetDominantColor(var Color: TRGB): Double;
    function SeparateObjects(Quality: Integer=4; MergeCommonAreas: Boolean = True): TList; overload;
    function SeparateObjects(Quality: Integer; MergeCommonAreas: Boolean; BackgroundColorBegin, BackgroundColorEnd: TRGB): TList; overload;
    function CalcAverageRGB(iSampleCount : Integer = 0): TRGB;
    function CalcStdDev(): Double;

    // Undo
    procedure SaveUndo(Source: TIEUndoSource = ieuImage; ClearRedo: Boolean = false); overload; virtual;
    procedure SaveUndo(const Caption: String; Source: TIEUndoSource = ieuImage; ClearRedo: Boolean = false; Operation: Integer = 0); overload; virtual;
    {$ifdef IEIncludeDeprecatedInV6}
    // Deprecated in 6.2.2
    procedure SaveUndoCaptioned(const Caption: String; Source: TIEUndoSource = ieuImage); {$ifdef IEWarningForDeprecated} deprecated {$ifdef IESupportDeprecatedDescription} 'Use SaveUndo instead - http://imageen.com/help/Compatibility.html' {$endif}; {$endif}
    {$endif}

    procedure ClearUndo; virtual;
    procedure ClearUndoAt(Position: Integer);
    procedure ClearAllUndo; virtual;
    procedure Undo(AutoRedo: Boolean = False); virtual;
    procedure UndoRect(x1, y1, x2, y2: Integer);
    procedure UndoAt(Position: Integer; AutoRedo: Boolean = False); virtual;
    property CanUndo: Boolean read GetCanUndo;
    property CanRedo: Boolean read GetCanRedo;

{!!
<FS>TImageEnProc.UndoLocation

<FM>Declaration<FC>
property UndoLocation: <A TIELocation>;

<FM>Description<FN>
Specifies where ImageEn saves "Undo" images.

Default: ieFile

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.UndoLimit></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Undo></C> </R>
</TABLE>

!!}
    property UndoLocation: TIELocation read fUndoLocation write fUndoLocation;

    property UndoCount: Integer read GetUndoCount;
    property UndoCaptions[index: Integer]: String read GetUndoCaptions write SetUndoCaptions;
    procedure GetUndoInfo(const index: Integer; Out UndoSource : TIEUndoSource; out UndoOperation: Integer);

    // Redo
    procedure SaveRedo(Source: TIEUndoSource = ieuImage); overload; virtual;
    procedure SaveRedo(const Caption: String; Source: TIEUndoSource = ieuImage); overload; virtual;
    {$ifdef IEIncludeDeprecatedInV6}
    // Deprecated in 6.2.2
    procedure SaveRedoCaptioned(const Caption: String; Source: TIEUndoSource = ieuImage); {$ifdef IEWarningForDeprecated} deprecated {$ifdef IESupportDeprecatedDescription} 'Use SaveRedo instead - http://imageen.com/help/Compatibility.html' {$endif}; {$endif}
    {$endif}

    property RedoCaptions[index: Integer]: String read GetRedoCaptions;
    property RedoCount: Integer read GetRedoCount;
    procedure ClearAllRedo; virtual;
    procedure ClearRedo; virtual;
    procedure ClearRedoAt(Position: Integer); virtual;
    procedure Redo(AutoUndo: Boolean = False); virtual;
    procedure RedoAt(Position: Integer; AutoUndo: Boolean = False); virtual;
    procedure GetRedoInfo(const index: Integer; Out RedoSource : TIEUndoSource; out RedoOperation: Integer); virtual;

    // Cut/Copy/Paste
    function CanCutToClipboard(Source: TIECopyPasteType = iecpAuto): Boolean;
    function CutToClipboard(Source: TIECopyPasteType = iecpAuto; CutAlpha: Boolean = false): Boolean;
    function CanCopyToClipboard(Source: TIECopyPasteType = iecpAuto): Boolean;
    function CopyToClipboard(Source: TIECopyPasteType = iecpAuto): Boolean; {$ifdef IEIncludeDeprecatedInV6} overload;{$endif}
    function CanPasteFromClipboard(Dest: TIECopyPasteType = iecpAuto; InclImagesAsLayers: Boolean = True): Boolean;
    function PasteFromClipboard(Dest: TIECopyPasteType = iecpAuto; MergeAlpha: Boolean = True; MaintainAspectRatio: Boolean = True; CanStretch: Boolean = True): Boolean;
    function PointPasteFromClip(XDest, YDest: Integer; MergeAlpha: Boolean = True): Boolean;

    // Older Methods
    {$ifdef IEIncludeDeprecatedInV6}
    // Deprecated in 6.2.0 (2015-05-20)
    procedure SelPasteFromClipStretch(MergeAlpha: Boolean = True); {$ifdef IEWarningForDeprecated} deprecated {$ifdef IESupportDeprecatedDescription} 'Use SelPasteFromClip instead - http://imageen.com/help/Compatibility.html' {$endif}; {$endif}

    // Deprecated in 7.0.0 (2017-02-02)
    function CopyToClipboard(IncludeImageEnFormat: Boolean): Boolean; overload; {$ifdef IEWarningForDeprecated} deprecated {$ifdef IESupportDeprecatedDescription} 'Check parameters - http://imageen.com/help/Compatibility.html' {$endif}; {$endif}
    function SelCopyToClip(IncludeImageEnFormat: Boolean = True): Boolean; {$ifdef IEWarningForDeprecated} deprecated {$ifdef IESupportDeprecatedDescription} 'Use CopyToClipboard(iecpSelection) instead - http://imageen.com/help/Compatibility.html' {$endif}; {$endif}
    function SelCutToClip(IncludeImageEnFormat: Boolean = true; CutAlpha: Boolean = false): Boolean; {$ifdef IEWarningForDeprecated} deprecated {$ifdef IESupportDeprecatedDescription} 'Use CutToClipboard(iecpSelection) instead - http://imageen.com/help/Compatibility.html' {$endif}; {$endif}
    function IsClipboardAvailable(): Boolean; {$ifdef IEWarningForDeprecated} deprecated {$ifdef IESupportDeprecatedDescription} 'Use CanPasteFromClipboard(iecAuto) instead - http://imageen.com/help/Compatibility.html' {$endif}; {$endif}
    function SelPasteFromClip(MergeAlpha: Boolean = True; MaintainAspectRatio: Boolean = false; CanStretch: Boolean = False): Boolean;  {$ifdef IEWarningForDeprecated} deprecated {$ifdef IESupportDeprecatedDescription} 'Use PasteFromClipboard(iecpSelection) instead - http://imageen.com/help/Compatibility.html' {$endif}; {$endif}
    {$endif}

    // selection area
    function GetReSel(var fSX1, fSY1, fSX2, fSY2: Integer; var PolySel: PPointArray; var PolySelCount: Integer; var mask: TIEMask): Boolean; dynamic;

    // Transitions
    procedure PrepareTransitionBitmaps(StartBitmap, EndBitmap : TBitmap; Effect : TIETransitionType;
                                       iWidth : Integer = -1; iHeight : Integer = -1;
                                       BackgroundColor : TColor = -1; ResamplingFilter: TResampleFilter = rfFastLinear);
    procedure PrepareTransitionBitmapsEx(StartBitmap, EndBitmap : TBitmap; Effect : TIETransitionType;
                                         StartRect, EndRect : TRect; RectMaintainAspectRatio : Boolean = True;
                                         iWidth : Integer = -1; iHeight : Integer = -1; bStretchSmall : Boolean = False;
                                         BackgroundColor : TColor = -1; ResamplingFilter: TResampleFilter = rfFastLinear;
                                         Smoothing: Integer = 96; Timing : TIETransitionTiming = iettLinear);
    procedure CreateTransitionBitmap(TransitionProgress : Single; DestBitmap : TBitmap);

    procedure TextOut_Legacy(X, Y : Integer; const Text : String; AFont : TFont = nil; Angle : Integer = 0;
                             bAntiAlias : Boolean = true; bAutoEnlarge : Boolean = False); overload;
    procedure TextOut(X, Y : Integer; const Text : String; AFont : TFont = nil; Angle : Integer = 0;
                      bAntiAlias : Boolean = true; bAutoEnlarge : Boolean = False); overload;
    procedure TextOut(X, Y : Integer; const Text : String; const sFontName : String; iFontSize : Integer; cFontColor : TColor; Style : TFontStyles; Angle : Integer = 0;
                      bAntiAlias : Boolean = true; bAutoEnlarge : Boolean = False); overload;
    procedure TextOut(Rect: TRect; const Text : String; AFont : TFont = nil; Angle : Integer = 0); overload;
    procedure TextOut(Rect: TRect; const Text : String; const sFontName : String; iFontSize : Integer; cFontColor : TColor; Style : TFontStyles; Angle : Integer = 0); overload;

  published
    { Published declarations }
    property AttachedImageEn: TIEView read fImageEnView write SetAttachedImageEn;

{!!
<FS>TImageEnProc.AutoUndo

<FM>Declaration<FC>
property AutoUndo: Boolean;

<FM>Description<FN>
When true, all image processing and load operations will automatically call <A TImageEnProc.SaveUndo> and <A TImageEnProc.ClearAllRedo>.

Default: True

<IMG help_images\undoredo.gif> 

<FM>Example<FC>
This code:

ImageEnView1.Proc.AutoUndo := true;
ImageEnView1.Proc.Negative;
ImageEnView1.Proc.ConvertToGray;

Is equivalent to:

ImageEnView1.Proc.AutoUndo := false;
ImageEnView1.Proc.SaveUndo;
ImageEnView1.Proc.Negative;
ImageEnView1.Proc.SaveUndo;
ImageEnView1.Proc.ConvertToGray;
ImageEnView1.Proc.ClearAllRedo;

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.SaveUndo></C> </R>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.UndoLimit></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Undo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearAllRedo></C> </R>
</TABLE>

!!}
    property AutoUndo: Boolean read fAutoUndo write fAutoUndo default true;

    property Background: TColor read GetReBackground write SetReBackground default clBlack;

{!!
<FS>TImageEnProc.OnProgress

<FM>Declaration<FC>
property OnProgress: <A TIEProgressEvent>;

<FM>Description<FN>
Occurs whenever image processing operations are executed. If you are using it to update a progress bar then you should reset it in the <A TImageEnProc.OnFinishWork> event.

To access processing progress for the <A TImageEnView.Proc> class of a TImageEnView, use the <A TImageEnView.OnProgress> event.

<FM>Example<FC>
// Show progress display during processing operations
procedure TMainForm.ImageEnProc1Progress(Sender: TObject; per: Integer);
begin
  ProgressBar1.Position := per;
  ProgressBar1.Visible := True;
end;

// Hide the progress bar
procedure TMainForm.ImageEnProc1FinishWork(Sender: TObject);
begin
  ProgressBar1.Visible := False;
end;

!!}
    property OnProgress: TIEProgressEvent read fOnProgress write fOnProgress;

    property PreviewsParams: TPRPreviewsParams read GetPRPreviewParams write SetPRPreviewParams;
    property PreviewFont: TFont read fPreviewFont write SetPreviewFont;
    property PreviewFontEnabled: Boolean read fPreviewFontEnabled write SetPreviewFontEnabled default false;
    property AttachedTImage: TImage read fTImage write SetTImage;

{!!
<FS>TImageEnProc.OnPreview

<FM>Declaration<FC>
property OnPreview: <A TIEPreviewEvent>;

<FM>Description<FN>
Occurs before the Image Processing Dialog form is displayed (i.e. after calling <A TImageEnProc.DoPreviews>).

<FM>Example 1<FC>
procedure TForm1.ImageEnProc1Preview(Sender: TObject; PreviewForm: TForm);
begin
  (PreviewForm as TfPreviews).PageControl1.MultiLine := True;
end;

<FM>Example 2<FC>
// Customizing the Preview dialog of a TImageEnView
uses
  Previews;

procedure TMyForm.FormCreate(Sender: TObject);
begin
  ImageEnView1.Proc.OnPreview := ProcPreview;
end;

procedure TMyForm.ProcPreview(Sender: TObject; PreviewForm: TForm);
begin
  with TfPreviews(PreviewForm) do
  begin
    // Red dialog
    Color := clRed;

    // Caption of OK button
    OkButton.Caption := 'Yeah baby';

    // Replace cancel button with custom control
    CancelButton.Visible := False;
    With TMyAnimatedButton.Create( PreviewForm ) do
    begin
      Parent := PreviewForm;
      Left := CancelButton.Left;
      Top := CancelButton.Top + CancelButton.Height + 8;
      Width := CancelButton.Width;
      Height := CancelButton.Height;
      Anchors := [akTop, akRight];
      Caption := 'My Cancel';
      ModalResult := 2;
    end;
  end;
end;
!!}
    property OnPreview: TIEPreviewEvent read fOnPreview write fOnPreview;

    property UndoLimit: Integer read fUndoLimit write SetUndoLimit default 1;

{!!
<FS>TImageEnProc.OnFinishWork

<FM>Declaration<FC>
property OnFinishWork: TNotifyEvent;

<FM>Description<FN>
Occurs whenever an image processing task terminates. This event is called after the last call to <A TImageEnProc.OnProgress>, so is useful to reset the progress bar.

<FM>Example<FC>
// Show progress display during processing operations
procedure TMDIChild.ImageEnView1Progress(Sender: TObject; per: Integer);
begin
  ProgressBar1.Position := per;
  ProgressBar1.Visible := True;
end;

// Hide the progress bar
procedure TMDIChild.ImageEnView1FinishWork(Sender: TObject);
begin
  ProgressBar1.Visible := False;
end;

<FM>See Also<FN>
- <L TImageEnProc.OnProgress>TImageEnProc.OnProgress</L>
- <L TImageEnView.OnFinishWork>TImageEnView.OnFinishWork</L>
!!}
    property OnFinishWork: TNotifyEvent read fOnFinishWork write fOnFinishWork;

{!!
<FS>TImageEnProc.AutoConvertFormat

<FM>Declaration<FC>
property AutoConvertFormat: Boolean;

<FM>Description<FN>
When true, all image processing functions automatically convert the source pixel format as required. For example, The <A TImageEnProc.Contrast> method requires a RGB24 pixel format. If your image is black & white or any other format, it is converted automatically to RGB24.
If AutoConvertFormat = False and you call <A TImageEnProc.Contrast> with a black & white image, then the method will fail.

Default: True
!!}
    property AutoConvertFormat: Boolean read fAutoConvertFormat write fAutoConvertFormat default true;

{!!
<FS>TImageEnProc.OnSaveUndo

<FM>Declaration<FC>
property OnSaveUndo: <A TIESaveUndoEvent>;

<FM>Description<FN>
Occurs after <A TImageEnProc.SaveUndo> is called automatically or by code. Source is the same parameter used when calling SaveUndo.
!!}
    property OnSaveUndo: TIESaveUndoEvent read fOnSaveUndo write fOnSaveUndo;

    property ImageEnVersion: String read GetImageEnVersion write SetImageEnVersion stored false;
  end;


type
  TIEProjectBitmapOp = (ieovoCALCRECTONLY, // calculate outCoords, without drawings
                        ieovoDRAWONLY,     // assume outCoords already calculated, perform drawings
                        ieovoFULLOP        // calculate and draw
                        );


const
{$ifdef IEIncludeDeprecatedInV5}
  // Deprecated in 6.0.0 (11/3/2015)
  // DEPRECATED: Use ppeColorAdjustments, ppeEditingFunctions, ppeSpecialEffects
  ppeColorAdjust = [peContrast, peHSV, peHSL, peRGB, peEqualize, peFFT, peGamma, peSharpen, peAutoEnhance];
  ppeEffects = [peUserFilt, peBumpMap, peLens, peWave, peMorph, peRotate, peResize, peSoftShadow, peCrop];
{$endif}

{!!
<FS>ppeColorAdjustments

<FM>Declaration<FC>
  ppeColorAdjustments = [peContrast, peHSV, peHSL, peRGB, peEqualize, peFFT, peGamma, peAutoEnhance];

<FM>Description<FN>
A set of <A TPreviewEffects> that adjust the color of the image.

<FM>Examples<FC>
// Prompt to perform color adjustment effects
ImageEnView1.Proc.DoPreviews( ppeColorAdjustments );

<IMG help_images\AdjustColors.gif>
!!}
  ppeColorAdjustments = [peContrast, peHSV, peHSL, peRGB, peEqualize, peFFT, peGamma, peAutoEnhance];


{!!
<FS>ppeEditingFunctions

<FM>Declaration<FC>
  ppeEditingFunctions = [peRotate, peResize, peSharpen, peCrop];

<FM>Description<FN>
A set of <A TPreviewEffects> for editing the image.

<FM>Examples<FC>
// Prompt to edit the image
ImageEnView1.Proc.DoPreviews( ppeEditingFunctions );

<IMG help_images\CropEffect.jpg>
!!}
  ppeEditingFunctions = [peRotate, peResize, peSharpen, peCrop];

{!!
<FS>ppeSpecialEffects

<FM>Declaration<FC>
  ppeSpecialEffects = [peUserFilt, peBumpMap, peLens, peWave, peMorph, peSoftShadow];

<FM>Description<FN>
A set of <A TPreviewEffects> that perform effects upon the image.

<FM>Examples<FC>
// Prompt to perform special effects
ImageEnView1.Proc.DoPreviews( ppeSpecialEffects );

<IMG help_images\ImageEffects.gif>
!!}
  ppeSpecialEffects = [peUserFilt, peBumpMap, peLens, peWave, peMorph, peSoftShadow];

  // Filter presets
  fpNone      = 0;
  fpBlur      = 1;
  fpEdge      = 2;
  fpEmboss    = 3;
  fpHighPass1 = 4;
  fpHighPass2 = 5;
  fpHighPass3 = 6;
  fpLowPass1  = 7;
  fpLowPass2  = 8;

  BWORDERPATTERN: array[0..7, 0..7] of integer = (
    (0, 32, 8, 40, 2, 34, 10, 42),
    (48, 16, 56, 24, 50, 18, 58, 26),
    (12, 44, 4, 36, 14, 46, 6, 38),
    (60, 28, 52, 20, 62, 30, 54, 22),
    (3, 35, 11, 43, 1, 33, 9, 41),
    (51, 19, 59, 27, 49, 17, 57, 25),
    (15, 47, 7, 39, 13, 45, 5, 37),
    (63, 31, 55, 23, 61, 29, 53, 21));

  IERawClipFormat_Name        : AnsiString = 'IMAGEEN RAW FORMAT';
  IELayerClipboardFormat_Name : AnsiString = 'IMAGEEN LAYER FORMAT';


procedure IEInitialize_imageenproc;
procedure IEFinalize_imageenproc;

procedure _GetMediaContrastRGB(bitmap: TIEBitmap; var mR, mG, mB: Integer);
procedure _HSLvar(bitmap: TIEBitmap; oHue, oSat, oLum: Integer; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _HSVvar(bitmap: TIEBitmap; oHue, oSat, oVal: Integer; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _IntensityRGBAll(bitmap: TIEBitmap; r, g, b: Integer; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _ContrastRGB(bitmap: TIEBitmap; vv: Double; mR, mG, mB: Integer; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _ApplyFilter(bitmap: TIEBitmap; filter: TGraphFilter; fSelx1, fSely1, fSelx2, fSely2: Integer; var Progress: TProgressRec);
procedure _CastColorRange(bitmap: TIEBitmap; BeginColor, EndColor, CastColor: TRGB; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _Rot90oEx(bakbmp: TIEBitmap; newbitmap: TIEBitmap);
procedure _Rot90oEx8(bakbmp: TIEBitmap; newbitmap: TIEBitmap);
procedure _Rot90Ex(bakbmp: TIEBitmap; newbitmap: TIEBitmap);
procedure _Rot90Ex8(bakbmp: TIEBitmap; newbitmap: TIEBitmap);
procedure _Negative(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _Sharpen(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; Intensity: Integer; Neighbourhood: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _SetTransparentColors(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; MinColor, MaxColor: TRGB; alpha: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _ConvertToGray(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _Merge(DestBitmap: TIEBitmap; SrcBitmap: TIEBitmap; pcf: Integer; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IEApplyThreshold(bitmap: TIEBitmap; DownLimit, UpLimit, DownVal, UpVal: TRGB; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IEHistEqualize(bitmap: TIEBitmap; LoThresh, HiThresh: TRGB; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
function IEGetHistogram(Bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; mask: TIEMask; content: TIEHistogramContent): TIEHistogram;
procedure _HistAutoEqualize(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
//procedure _Resample(Src, Dst: TBitmap; FilterType: TResampleFilter; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _ResampleEx(SrcImg, DstImg: TIEBaseBitmap; SrcAlpha: TIEBitmap; FilterType: TResampleFilter; fOnProgress: TIEProgressEvent; Sender: TObject);
function IEGetImageNumColors(bitmap: TIEBitmap; x1, y1, x2, y2: Integer): Integer;
//procedure _ConvertTo(Bitmap: TBitmap; NumColors: Integer; OutPalette: PRGBROW; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _ConvertToEx(Bitmap: TIEBitmap; NumColors: Integer; OutPalette: PRGBROW; fOnProgress: TIEProgressEvent; Sender: TObject);
//procedure _Negative1Bit(Bitmap: TBitmap);
procedure _Negative1BitEx(Bitmap: TIEBitmap);
function _GetHSVChannel(bitmap: TIEBitmap; ch: Integer; fOnProgress: TIEProgressEvent; Sender: TObject): TIEBitmap;
procedure _GetHSVChannelAll(bitmap: TIEBitmap; BitmapH, BitmapS, BitmapV: TIEBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
function _GetRGBChannel(bitmap: TIEBitmap; ch: Integer; fOnProgress: TIEProgressEvent; Sender: TObject): TIEBitmap;
procedure _GetRGBChannelAll(bitmap: TIEBitmap; BitmapR, BitmapG, BitmapB: TIEBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
function _RGBToGray(const rgb: TRGB): Integer;
function _GetSimilColor(const ColorMap: array of TRGB; nc: Integer; Col: TRGB): Integer;
procedure _RGB2BGR(var ColorMap: array of TRGB; nc: Integer);
procedure _BGR2RGB(buff: PRGB; width: Integer);
procedure _BGR2RGB48(buff: PRGB48; width: Integer);
procedure IECopyBits_large(Dest, Source: pbyte; DestStart, SourceStart, Len: Integer; SourceRowLen: Integer);
procedure IECopyBits_small(Dest, Source: pbyte; DestStart, SourceStart, Len: Integer; SourceRowLen: Integer);
procedure _CopyBitmapRect(Source, Dest: TBitmap; x1, y1, x2, y2: Integer);
//function _ConvertTo1bit(Bitmap: TBitmap; var BackCol, ForeCol: TRGB): TBitmap;
function _ConvertTo1bitEx(Bitmap: TIEBitmap; var BackCol, ForeCol: TRGB): TIEBitmap;
procedure _Conv1to24(var SrcBitmap, DstBitmap: TBitmap; var Progress: TProgressRec);
procedure _CopyPolygonBitmap(Dest: TBitmap; Source: TBitmap; x1, y1: Integer; SelPoly: PPointArray; SelPolyCount: Integer);
function _BitmapCompareX(Bitmap1, Bitmap2: TBitmap): Boolean;
function _BitmapCompareXEx(Bitmap1, Bitmap2: TIEBitmap): Boolean;
//procedure _ClearSel(fBitmap: TBitmap; SelPoly: PPointArray; SelPolyCount: Integer; Background: TColor);
//procedure _ClearSelMask(fBitmap: TBitmap; mask: TIEMask; Background: TColor);
procedure _ClearSelMaskEx(fIEBitmap: TIEBitmap; mask: TIEMask; Background: TColor);
//procedure _CopyBitmapPoly(Source: TBitmap; Dest: TBitmap; sx1, sy1, sx2, sy2: Integer; SelPoly: PPointArray; SelPolyCount: Integer);
procedure _ConvertToBWOrdered(bitmap: TIEBitmap; var Progress: TProgressRec);
procedure _ConvertToBWThreshold(bitmap: TIEBitmap; Threshold: Integer; var Progress: TProgressRec);
procedure _ConvertToBWThresholdEx(origbitmap, destbitmap: TIEBitmap; Threshold: Integer; var Progress: TProgressRec);
procedure _BumpMapping(Bitmap: TIEBitmap; LightX, LightY, LAmpX, LAmpY, pcf: Integer; Color: TRGB; fselx1, fsely1, fselx2, fsely2: Integer; var Progress: TProgressRec);
procedure _lens(Bitmap: TIEBitmap; xx, yy: Integer; width, height: Integer; refraction: Double; var Progress: TProgressRec);
procedure IEAdjustTemperature(bitmap: TIEBitmap; x1, y1, x2, y2: Integer; temperature: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);

procedure _rotate1bit(fBitmap: TBitmap; angle: Double; background: Integer; var Progress: TProgressRec);
procedure _rotate1bitEx(fBitmap: TIEBitmap; angle: Double; background: Integer; var Progress: TProgressRec);
procedure _rotate8bit(fBitmap: TIEBitmap; angle: Double; background: Integer);
procedure IEGRotate(src: TIEBitmap; angle: Double; Background: TColor; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IEGRotateTo(src, dst: TIEBitmap; angle: Double; Background: TColor; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _RotateEx(fBitmap: TIEBitmap; fangle: Double; antialias: Boolean; Background: TRGB; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _RotateEx8(fBitmap: TIEBitmap; fangle: Double; antialias: Boolean; Background: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IEQRotate(src: TIEBitmap; angle: Double; Background: TColor; Filter: TIEAntialiasMode; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IEQRotateTo(src: TIEBitmap; dst: TIEBitmap; angle: Double; Background: TColor; Filter: TIEAntialiasMode; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IEQRotateTo24(src: TIEBitmap; dst: TIEBitmap; angle: Double; Background: TColor; Filter: TIEAntialiasMode; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IEQRotate8(src: TIEBitmap; angle: Double; Background: Integer; Filter: TIEAntialiasMode);
procedure IEQRotateTo8(src: TIEBitmap; dst: TIEBitmap; angle: Double; Background: Integer; Filter: TIEAntialiasMode);

function _GetPixelbw(row: pbyte; pix: Integer): Integer;
procedure _SetPixelbw(row: pbyte; pix: Integer; vv: Integer);
procedure IEWave(Bitmap: TIEBitmap; amplitude, wavelength, phase: Integer; reflective: Boolean; var Progress: TProgressRec);
function _CreateWinPalette(var ColorMap: array of TRGB; NCol: Integer): HPalette;
function _CopyDIB2Bitmap(hbi: THandle; fBitmap: TBitmap; xbits: pbyte; unlck: Boolean): Integer;
function _CopyDIB2BitmapEx(hbi: THandle; fBitmap: TIEBaseBitmap; xbits: pbyte; unlck: Boolean): Integer;
//function _CopyBitmaptoDIB(fBitmap: TBitmap; x1, y1, x2, y2: Integer): THandle;
function _CopyBitmaptoDIBEx(fBitmap: TIEBaseBitmap; x1, y1, x2, y2: Integer; dpix, dpiy: Integer): THandle;
//function _IECopyDIB2Bitmap2(hbi: THandle; fBitmap: TBitmap; xbits: Pbyte; unlck: Boolean): Integer;
function _IECopyDIB2Bitmap2Ex(hbi: THandle; fBitmap: TIEDibBitmap; xbits: pbyte; unlck: Boolean): Integer;
procedure IEDIBGamma(hbi: THandle; gamma: Double);
procedure _CopyIYU1ToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
procedure _CopyIYU2ToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
procedure _CopyUYVYToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
procedure _CopyYUY2ToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
procedure _CopyNV12ToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
procedure _CopyYVYUToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
procedure _CopyY41PToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
procedure _CopyY211ToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
procedure _CopyCLJRToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
procedure _CopyYVU9ToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
procedure _CopyYV12ToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
procedure _CopyI420ToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
procedure _CopyPolygonToPoint(Source: TBitmap; Polygon: PPointArray; PolygonLen: Integer; Dest: TBitmap; const Position: TPoint);
procedure _CopyPointToPolygon(Source: TBitmap; Polygon: PPointArray; PolygonLen: Integer; Dest: TBitmap; const Position: TPoint);
procedure _CopyBGR_RGB(dst: PRGB; src: PRGB; width: Integer);
procedure _CopyBGR_RGB48(dst: PRGB48; src: PRGB48; width: Integer);
function _CopyBitmaptoClipboardEx(Source: TIEBitmap; InitClipboard: Boolean; IncludeImageEnFormat: Boolean; X1, Y1, X2, Y2: Integer; SelPoly: PPointArray; SelPolyCount: Integer; Mask: TIEMask; FillColor: TColor; DpiX, DpiY: Integer): Boolean;
procedure IEMorphFilter(bitmap: TIEBitmap; WindowSize: Integer; op: Integer; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IEMorphFilter_ie1g(bitmap: TIEBitmap; WindowSize: Integer; op: Integer; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IEMorphFilter_ie24RGB(bitmap: TIEBitmap; WindowSize: Integer; op: Integer; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IEmorph1bit(Bitmap: TIEBitmap; nIter: Integer; opType: Integer; size: Integer; invertFlag: Boolean; fOnProgress: TIEProgressEvent; Sender: TObject);
function IEMakeMagicWandPoints(fBitmap: TIEBitmap; x, y: Integer; maxfilter: Boolean; tolerance: Integer): TIEArrayOfTPoint;
procedure _MakeMagicWandPointsEx(fBitmap: TIEBitmap; x, y: Integer; maxfilter: Boolean; tolerance: Integer; mask: TIEMask; selintensity: Integer);
procedure _MakeMagicWandPointsEx2(fBitmap: TIEBitmap; x, y: Integer; tolerance: Integer; mask: TIEMask; selintensity: Integer);
procedure _IEBmpStretch(origBmp, destBmp: TBitmap);
procedure _IEBmpStretchEx(origBmp, destBmp: TIEBaseBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
function _ConvertXBitsToYBits(var Input, Output: TBYTEROW; Xbits, Ybits, Width: Word; Palette: array of TRGB; Quantizer: TObject): Integer;
//procedure _SubResample1bitFiltered(src: TBitmap; sx1, sy1, sx2, sy2: Integer; dst: TBitmap);
procedure _SubResample1bitFilteredEx(src: TIEBaseBitmap; sx1, sy1, sx2, sy2: Integer; dst: TIEBitmap);
//function _SubResample1bitFilteredDIB(src: Pbyte; sxx, syy: Integer; sx1, sy1, sx2, sy2: Integer; dxx, dyy: Integer): Pbyte;
procedure _IEAdjustResampleDimensions(var iTargetWidth, iTargetHeight: Integer; iBitmapWidth, iBitmapHeight : Integer; bMaintainAspectRatio: Boolean);
procedure _IEResampleIEBitmap(source, dest: TIEBitmap; FilterType: TResampleFilter; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _IEResampleIEBitmap2(sourceANDdest: TIEBitmap; FilterType: TResampleFilter; NewWidth, NewHeight: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _Resampleie8g(Src, Dst: TIEBitmap; FilterType: TResampleFilter);
//procedure _Resample1bit(Src, Dst: TBitmap; FilterType: TResampleFilter);
procedure _Resample1bitEx(Src, Dst: TIEBitmap; FilterType: TResampleFilter);
function _iehough(image: TIEBitmap; var Progress: TProgressRec; anglerange: Integer; Precision: Double): Double;
procedure _Fill(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; FillColor: TRGB; fOnProgress: TIEProgressEvent; Sender: TObject);
//procedure _ResampleLinear(Src, Dst: TBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _ResampleLinearEx(Src, Dst: TIEBaseBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
//procedure _ResampleLinear1Bit(Src, Dst: TBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _ResampleLinear1BitEx(Src, Dst: TIEBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _ResampleLinear8g(Src, Dst: TIEBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _ResampleLinear16g(Src, Dst: TIEBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _IEEdgeDetect_ShenCastan(SrcBitmap, DstBitmap: TIEBitmap; Ratio: Double; Smooth: Double; WindowSize: Integer; ThinFactor: Integer; DoHysteresis: Boolean; var Progress: TProgressRec);
procedure _CalcDensityHistogram(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject; VertHist, HorizHist: pintegerarray; norm_vert, norm_horiz: Integer);
procedure _FlipEx(bmp: TIEBitmap; dir: TFlipDir);
procedure IERemoveIsolatedPixels1Bit(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; NoiseColor: Boolean; IsolationMax: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _kf_kfill(bitmap: TIEBitmap; RetainConnectivity: Boolean; RetainEndpoints: Boolean; MaxIterations: Integer; WindowSize: Integer; InvertImage: Boolean);
procedure _IEComputeDiff(x, y: TIEBitmap; var psnr_min, psnr_max: Double; var mse_min, mse_max: Double;
  var rmse_min, rmse_max: Double; var pae_min, pae_max: Double;
  var mae_min, mae_max: Double; var equal: Boolean);
procedure _IEGammaCorrect_RGB8(ABitmap: TIEBitmap; AGamma: Double; AChannel: TIEChannels; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _NegativeBuffer(buf: pbyte; WidthBytes: Integer);
procedure _ConvRow1To24(spx, dpx: pbyte; Width: Integer);
procedure _IEGBlur(Bitmap: TIEBitmap; radius: Double; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _IEGBlurRect8(Bitmap: TIEBitmap; x1, y1, x2, y2: Integer; radius: Double);



{!!
<FS>IESoftShadowSize

<FM>Declaration<FC>
function IESoftShadowSize(Radius: Double; OffSetX: Integer; OffSetY: Integer) : Integer;

<FM>Description<FN>
If you call <A TImageEnProc.AddSoftShadow> with <FC>AdaptSize<FN> enabled then the dimensions of your image will be enlarged so the content does not change to fit the shadow.

This function returns the number of pixels that will be added in height and width by calling <A TImageEnProc.AddSoftShadow>.

Note: Regardless of your values for OffSetX/OffSetY AddSoftShadow always increases the width and height by the same value

<FM>Example<FC>
Var
  iSoftShadowSize: Integer;
Begin
  iSoftShadowSize := IESoftShadowSize(ImageEnView1.Proc.SoftShadow.Radius, ImageEnView1.Proc.SoftShadow.OffsetX, ImageEnView1.Proc.SoftShadow.OffsetY);
  ShowMessage(Format('Adding a soft shadow will enlarge the image to %d x %d', 
                     [ImageEnView1.IEBitmap.Width + iShadowSize,
                      ImageEnView1.IEBitmap.Height + iShadowSize]);
End;
!!}

function IESoftShadowSize(Radius: Double; OffSetX: Integer; OffSetY: Integer) : Integer;
procedure _IEAddSoftShadow(bitmap: TIEBitmap; radius: Double; OffSetX: Integer; OffSetY: Integer; Intensity: Integer; AdaptBitmap: Boolean; ShadowColor: TRGB; fOnProgress: TIEProgressEvent; Sender: TObject);
function _IEAddSoftShadowRect(bitmap: TIEBitmap; radius: Double; OffSetX: Integer; OffSetY: Integer; Intensity: Integer; ShadowColor: TRGB; x1, y1, x2, y2: Integer): Integer;
procedure _IEAddInnerShadow(bitmap: TIEBitmap; radius: Double; OffSetX: Integer; OffSetY: Integer; ShadowColor: TRGB; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _IEQResampleBytes(SrcImg, DstImg: TIEBaseBitmap; SrcAlpha: TIEBitmap; filter: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _IEQResampleWords(SrcImg, DstImg: TIEBaseBitmap; filter: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _IEMedianFilter(image: TIEBitmap; WindowX, WindowY: Integer; Brightness, Contrast, Multiplier, Threshold: Integer; MedianOp: TIEMedFilType; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _IEWallisFilter(image: TIEBitmap; WinWidth, WinHeight: Integer; Mean, StDev, InGain, Edge, Limit: Integer; Thresholding: Boolean; fOnProgress: TIEProgressEvent; Sender: TObject);
function _IECalcVertOrientationFitness(bitmap: TIEBitmap): Integer;
//procedure _IEAddSoftShadowRect2(bitmap: TIEBitmap; size: Integer; Intensity: Double; OffsetX, OffsetY: Integer; rx1, ry1, rx2, ry2: Integer);
procedure _IESetAlpha0Color(bitmap: TIEBitmap; cl: TRGB);
procedure _Conv1to24Ex(var SrcBitmap, DstBitmap: TIEBitmap; var Progress: TProgressRec);
procedure _IERemoveRedEyes(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IEFields_warp(source: TIEBitmap; asource_lines: PIELineArray; adest_lines: PIELineArray; num_lines: Integer; num_frames: Integer; outimages: TList);
procedure _IERoundImage(ProcBitmap: TIEBitmap; RoundWidth, RoundHeight: Integer; fOnProgress: TIEProgressEvent; self: TObject);
function _IESkewDetectionFine(Bitmap: TIEBitmap; StartingAngle: Double; resolution: Double; range: Integer; maxQuality: Boolean; fOnProgress: TIEProgressEvent; Sender: TObject): Double;
procedure _IERadialStretch(bitmap: TIEBitmap; ARed, BRed, CRed, DRed, AGreen, BGreen, CGreen, DGreen, ABlue, BBlue, CBlue, DBlue: Double; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _IEfsdither(bitmap: TIEBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IEColorFloydSteinberg(srcBitmap: TIEBitmap; dstBitmap: TIEBitmap; colorCount: Integer);
function _IESkewDetection(Bitmap: TIEBitmap; ResampleWidth: Integer; AngleRange: Integer; Precision: Double; EdgeDetect: Boolean; fOnProgress: TIEProgressEvent; Sender: TObject): Double;
procedure _ResampleProject1Bit(OrigBmp, DestBmp: TIEBaseBitmap; Negative: Boolean; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure _ResampleProject24Bit(OrigBmp, DestBmp: TIEBaseBitmap; Negative: Boolean; fOnProgress: TIEProgressEvent; Sender: TObject);
//procedure _ResampleProject(origBmp, DestBmp: TIEBaseBitmap; Negative: Boolean; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IEWhiteBalance_grayworld(bitmap: TIEBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IEWhiteBalance_2(bitmap: TIEBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IEWhiteBalance_3(bitmap: TIEBitmap; white_x, white_y: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IEGetAverageValues(bitmap: TIEBitmap; var avg: TIEArrayOfDouble); overload;
procedure IEGetAverageValues(bitmap: TIEBitmap; mask: TIEMask; x1, y1, x2, y2: Integer; var avg: TIEArrayOfDouble); overload;
procedure IEApplyCoefficients(bitmap: TIEBitmap; var coeff: array of double; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IEAdjustGainOffset(bitmap: TIEBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IECastColor(Bitmap: TIEBitmap; x, y: Integer; newColor: TRGB; tolerance: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IECastAlpha(Bitmap: TIEBitmap; x, y: Integer; newAlpha: Integer; tolerance: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
procedure IEPatternSearch(InputBitmap: TIEBitmap; pattern: TIEBitmap; var FoundRect: TRect; precision: Double; scaleSteps: Integer);
procedure IEACE(OrigBitmap: TIEBitmap; subwidth: Integer; Slope: Integer; Cut: Integer; Neighbour: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
procedure IELLLUT( SubOriginal, SubFiltered: TIEBitmap; Bitmap: TIEBitmap; Neighbour: Integer; OnProgress: TIEProgressEvent; Sender: TObject; ProgressOffset: Integer; ProgressMultiplier: Double);
procedure IEAutoSharp(bitmap: TIEBitmap; Intensity: Integer; rate: Double; OnProgress: TIEProgressEvent; Sender: TObject);
procedure IERetinex(bitmap: TIEBitmap; ScaleCount: Integer; ScaleCurve: Integer; Variance: single; ScaleHigh: Integer; Luma: Boolean; OnProgress: TIEProgressEvent; Sender: TObject);
procedure IEChangeYCbCrCoefficients(Bitmap: TIEBitmap; srcLumaRed, srcLumaGreen, srcLumaBlue, dstLumaRed, dstLumaGreen, dstLumaBlue: Double);
procedure IEAdjustBrightnessContrastSaturation(Bitmap: TIEBitmap; b, c, s: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
procedure IEContrast2(src: TIEBitmap; z: single; OnProgress: TIEProgressEvent; Sender: TObject);
procedure IEAdjustSaturation(Src: TIEBitmap; Amount: Integer; pr: TProgressRec);
procedure IEAdjustTint(Src: TIEBitmap; Amount: Integer; UseFixedColor: Boolean; FixedColorStart: TRGB; FixedColorEnd: TRGB; OnProgress: TIEProgressEvent; Sender: TObject);
procedure IEAutoSBHist(src: TIEBitmap; z1, z2: single; OnProgress: TIEProgressEvent; Sender: TObject);
procedure IESobel(bitmap: TIEBitmap; OnProgress: TIEProgressEvent; Sender: TObject);
function IEAutoCrop2(bitmap: TIEBitmap; BorderRate: Double): TRect;
procedure IEDisposeChannels(Bitmap: TIEBitmap; newDispo: String; OnProgress: TIEProgressEvent; Sender: TObject);
procedure IELuminanceEnhancement(Bitmap: TIEBitmap; Gamma: Double; Saturation: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
function IEGetVisibleArea(Bitmap: TIEBitmap; OnProgress: TIEProgressEvent; Sender: TObject): TRect;
function IECompareImagesHistogram(bitmap1, bitmap2: TIEBitmap; Mode: TIECmpMode; GrayScale: Boolean): Double;
procedure IEReflectionEffect(bitmap: TIEBitmap; minAlpha, maxAlpha: Integer; percentage: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
procedure IEPerspectiveTransform(SrcBitmap, DstBitmap: TIEBitmap; xx0, yy0, xx1, yy1, xx2, yy2, xx3, yy3 : Integer; alphaMin : Integer = -1; alphaMax : Integer = -1; mergeAlpha : Boolean = false; alpha : Integer = 255);
procedure IEProjectBitmap1(Bitmap: TIEBitmap; DstBitmap: TIEBitmap; centerDstX, centerDstY: Integer; destWidth, destHeight: Integer; translateX, translateY: Integer; depth: Double; rotateX, rotateY: Double; specularAlphaMin, specularAlphaMax: Integer; var outCoords: TIEQuadCoords; op: TIEProjectBitmapOp; mergeAlpha: Boolean; alpha: Integer);
procedure IEProjectBitmap2(Bitmap: TIEBitmap; DstBitmap: TIEBitmap; centerDstX, centerDstY: Integer; dstWidth, dstHeight: Integer; translateX, translateY: Integer; depth: Double; rotateX, rotateY: Double; specularAlphaMin, specularAlphaMax: Integer; var outCoords: TIEQuadCoords; op: TIEProjectBitmapOp; mergeAlpha: Boolean; alpha: Integer);
procedure IEMotionBlur(bitmap: TIEBitmap; angle: Double; radius: Integer; sigma: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
procedure IERandom(bitmap: TIEBitmap; mean: Double; stdDev: Double; x1, y1, x2, y2: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
procedure IEMapGrayToColor(Bitmap: TIEBitmap; map: array of TRGB; x1, y1, x2, y2: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
procedure IEConvolve(bitmap: TIEBitmap; kernel: array of double; kernelWidth, kernelHeight: Integer; factor: Double; x1, y1, x2, y2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
function IEAverageRGB(bitmap: TIEBitmap; mask: TIEMask; x1, y1, x2, y2: Integer): TRGB;
function IECompareHistograms(h1, h2: TIEHistogram; Mode: TIECmpMode; channel: Integer): Double;
procedure IEGetStandardDeviation(bitmap: TIEBitmap; mask: TIEMask; x1, y1, x2, y2: Integer; var stddev: TIEArrayOfDouble); overload;
function IEGetStandardDeviation(bitmap: TIEBitmap; mask: TIEMask; x1, y1, x2, y2: Integer): Double; overload;
procedure _IEGetHistogram(Bitmap: TIEBitmap; hist: pintegerarray);
procedure IECrop(Bitmap: TIEBitmap; Rectangle: TRect; Rotation: double; AntialiasMode: TIEAntialiasMode);
procedure IEPerspectiveCrop(Bitmap: TIEBitmap; quad: array of TIE2DPoint);
procedure IESymmetricNearestNeighbourOpt(Bitmap: TIEBitmap; Radius: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
procedure IEPixelize(Bitmap: TIEBitmap; Mask: TIEMask; Amount: double; x1, y1, x2, y2: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
procedure IEPencilSketch(Bitmap: TIEBitmap; grayScale: boolean = true; levelSteps: integer = 2; maxTextures: integer = MAXINT; edgeBlurAmount: integer = 4; edgeAmount: double = 0.5; lineThickness: double = 1; darkeningFactor: double = 0.1; lineAlpha: double = 0.1; lineDensity: double = 0.5; lightness: double = 4; antialiasedLines: boolean = false; onProgress: TIEProgressEvent = nil; sender: TObject = nil);

type
TIEPrecalcTransform = record
  rotateX, rotateY: Double; // in degrees
  dst_x1, dst_y1, dst_x2, dst_y2: Integer;
  destX, destY: Integer;
  width: Integer;
  height: Integer;
  src: pword;
end;
PIEPrecalcTransform = ^TIEPrecalcTransform;


function IEVectorize(bitmap: TIEMask; x1, y1, x2, y2: Integer; SCALE: Integer=4): TList;
function IESeparateObjects(Bitmap: TIEBitmap; MergeCommonAreas: Boolean; Quality: Integer; UseBackgroundColor: Boolean; BackgroundColorBegin, BackgroundColorEnd: TRGB): TList;

procedure IETEAEncipher64(v, w, k: pdwordarray);
procedure IETEADecipher64(v, w, k: pdwordarray);
procedure IEEncipherBitmap_TEA(Bitmap: TIEBitmap; key: pdwordarray; OnProgress: TIEProgressEvent; Sender: TObject);
procedure IEDecipherBitmap_TEA(Bitmap: TIEBitmap; key: pdwordarray; OnProgress: TIEProgressEvent; Sender: TObject);

function IEGraphFilterToString(filter: TGraphFilter): String;

procedure IELocalBinarize(InBitmap, OutBitmap: TIEBitmap; WinSize: Integer; Mode: TIEThreshMode; Offset: Integer; OnProgress: TIEProgressEvent; Sender: TObject);


{!!
<FS>IECloneBitmap

<FM>Declaration<FC>
function IECloneBitmap(Source: TBitmap): TBitmap;

<FM>Description<FN>
Creates a new TBitmap object that is a copy of the Source bitmap.

<FM>Example<FC>
Var
  mybmp: TBitmap;
Begin
...
  mybmp := IECloneBitmap( ImageEnView1.Bitmap );
...
  mybmp.free;
End;
!!}
function IECloneBitmap(Source: TBitmap): TBitmap;

{!!
<FS>IECopyBitmap

<FM>Declaration<FC>
procedure IECopyBitmap(Source, Dest: TBitmap);

<FM>Description<FN>
Copies Source bitmap to Dest bitmap.

<FM>Example<FC>
IECopyBitmap( ImageEnView1.Bitmap , ImageEnView2.Bitmap );
!!}
procedure IECopyBitmap(Source, Dest: TBitmap);

function IECompareImages(image1, image2: TIEBitmap; diffmap: TIEBitmap): Double;
procedure IEGetLuminosityDiff(image1, image2: TIEBitmap; var Red, Green, Blue: Integer);
procedure IEAdjustColors(templateimage, targetimage: TIEBitmap);

procedure IEShift(Bitmap: TIEBitmap; offsetx, offsety: Integer; channel: Integer; FillValue: Integer; OnProgress: TIEProgressEvent; Sender: TObject);



{!!
<FS>LoadFilterFromFile

<FM>Declaration<FC>
function LoadFilterFromFile(const FileName: String): <A TGraphFilter>;

<FM>Description<FN>
Loads a filter from a file.

<FM>Example<FC>
var
  Filter: TGraphFilter;
Begin
  Filter := LoadFilterFromFile('D:\myfilter.flt')
  ImageEnView1.Proc.ApplyFilter( Filter );
End;
!!}
function LoadFilterFromFile(const FileName: String): TGraphFilter;

{!!
<FS>SaveFilterToFile

<FM>Declaration<FC>
procedure SaveFilterToFile(const FileName: String; const filt: <A TGraphFilter>);

<FM>Description<FN>
Saves a filter to a file.
!!}
procedure SaveFilterToFile(const FileName: String; const filt: TGraphFilter);

{!!
<FS>IEAddNewFilter

<FM>Declaration<FC>
function IEAddNewFilter( const filter: <A TGraphFilter> ; const name: String): Integer;

<FM>Description<FN>
Creates a new public filter (3x3 convolution matrix). You can apply filters to an image using <A TImageEnProc.ApplyFilter> or the <L TImageEnProc.DoPreviews>Image Processing Dialog</L>.

<FM>Example<FC>
Const
  Myfilter: TgraphFilter =
   (Values: ((-1, 0, 1),
             (-1, 1, 1),
             (-1, 0, 1));
    Divisor: 1);
..
IEAddNewFilter( MyFilter, 'My Filter');
..
ImageEnView.Proc.DoPreviews();  // This filter will be displayed on the "User Filters" tab
!!}
function IEAddNewFilter( const filter: TGraphFilter ; const name: String): Integer;

function IEGetFilter( index: Integer ): PIEGraphFilter;
function IEGetFilterName( index: Integer ): String;
function IEGetFiltersCount: Integer;


var
  C1TO24: array[0..255, 0..7] of TRGB; // to convert 1bit to 24bit
  IERawClipFormat: Integer;
  IELayerClipboardFormat: Integer;


resourcestring
{$IFDEF IEUseLegacyUndoCaptions}
  IERS_CONVOLVE = 'Convolve';
  IERS_APPLYFILTER = 'ApplyFilter';
  IERS_HSLVAR = 'HSLvar %d, %d, %d';
  IERS_HSVVAR = 'HSVvar %d, %d, %d';
  IERS_CONVERTTOGRAY = 'ConvertToGray';
  IERS_CONVERTTOSEPIA = 'ConvertToSepia';
  IERS_MERGE = 'Merge %d';
  IERS_MERGEWITHMASK = 'MergeWithMask';
  IERS_THRESHOLD = 'Threshold';
  IERS_THRESHOLD2 = 'Threshold2';
  IERS_HISTAUTOEQUALIZE = 'HistAutoEqualize';
  IERS_HISTEQUALIZE = 'HistEqualize';
  IERS_CONTRAST = 'Contrast %f';
  IERS_INTENSITYRGBALL = 'IntensityRGBAll %d, %d, %d';
  IERS_NEGATIVE = 'Negative';
  IERS_CASTCOLORRANGE = 'CastColorRange';
  IERS_MATCHHSVRANGE = 'MatchHSVRange';
  IERS_BUMPMAPPING = 'BumpMapping';
  IERS_LENS = 'Lens';
  IERS_WAVE = 'Wave';
  IERS_MAXIMUM = 'Maximum %d';
  IERS_MINIMUM = 'Minimum %d';
  IERS_OPENING = 'Opening %d';
  IERS_CLOSING = 'Closing %d';
  IERS_FILL = 'Fill (%d, %d, %d)';
  IERS_REMOVEISOLATEDPIXELS = 'RemoveIsolatedPixels %d, %d';
  IERS_PAINTMARK = 'PaintMark %d, (%d, %d, %d)';
  IERS_GAMMACORRECT = 'GammaCorrect';
  IERS_BLUR = 'Blur %f';
  IERS_SETTRANSPARENTCOLORS = 'SetTransparentColors';
  IERS_MEDIANFILTER = 'MedianFilter';
  IERS_WALLISFILTER = 'WallisFilter';
  IERS_SHARPEN = 'Sharpen %d, %d';
  IERS_UNSHARPMASK = 'UnsharpMask %f, %f, %f';
  IERS_REMOVEREDEYES = 'RemoveRedEyes';
  IERS_ROUNDIMAGE = 'RoundImage %d, %d';
  IERS_RADIALSTRETCH = 'RadialStretch';
  IERS_WHITEBALANCE_COEF = 'WhiteBalance_coef %f, %f, %f';
  IERS_WHITEBALANCE_GRAYWORLD = 'WhiteBalance_GrayWorld';
  IERS_WHITEBALANCE_WHITEAT = 'WhiteBalance_WhiteAt %d, %d';
  IERS_WHITEBALANCE_AUTOWHITE = 'WhiteBalance_AutoWhite';
  IERS_ADJUSTGAINOFFSET = 'AdjustGainOffset';
  IERS_CASTCOLOR = 'CastColor';
  IERS_CASTALPHA = 'CastAlpha %d, %d, %d, %d';
  IERS_FEATHERALPHAEDGES = 'FeatherEdges %d';
  IERS_COLORIZE = 'Colorize %d, %d, %f';
  IERS_AUTOIMAGEENHANCE1 = 'AutoImageEnhance1 %d, %d, %d, %d';
  IERS_AUTOSHARP = 'AutoSharp %d, %f';
  IERS_AUTOIMAGEENHANCE2 = 'AutoImageEnhance2';
  IERS_SHIFTCHANNEL = 'ShiftChannel %d, %d, %d, %d';
  IERS_ADJUSTBRIGHTNESSCONTRASTSATURATION = 'AdjustBrightnessContrastSaturation %d, %d, %d';
  IERS_CONTRAST2 = 'Contrast2 %f';
  IERS_ADJUSTSATURATION = 'AdjustSaturation %d';
  IERS_ADJUSTTINT = 'AdjustTint %d';
  IERS_ADJUSTLUMSATHISTOGRAM = 'AdjustLumSatHistogram %f, %f';
  IERS_DISPOSECHANNELS = 'DisposeChannels %s';
  IERS_INTENSITY = 'Intensity';
  IERS_CONTRAST3 = 'Contrast3';
  IERS_AUTOIMAGEENHANCE3 = 'AutoImageEnhance3 %f, %d';
  IERS_REFLECTION = 'Reflection %d, %d, %d';
  IERS_PERSPECTIVEDRAW = 'PerspectiveDraw';
  IERS_PROJECTDRAW = 'ProjectDraw';
  IERS_ADJUSTTEMPERATURE = 'AdjustTemperature';
  IERS_MOTIONBLUR = 'MotionBlur %f, %d, %d';
  IERS_RANDOM = 'Random %f, %f';
  IERS_MAPGRAYTOCOLOR = 'MapGrayToColor';
  IERS_FTCLEARZONE = 'FTClearZone';
  IERS_RESAMPLE = 'Resample %d, %d';
  IERS_RESIZE = 'ImageResize %d, %d';
  IERS_PASTEFROMCLIPBOARD = 'PasteFromClipboard';
  IERS_POINTPASTEFROMCLIP = 'PointPasteFromClip %d, %d';
  IERS_SELPASTEFROMCLIPSTRETCH = 'SelPasteFromClipStretch';
  IERS_SELPASTEFROMCLIP = 'SelPasteFromClip';
  IERS_FLIP = 'Flip %s';
  IERS_SELCUTTOCLIP = 'SelCutToClip';
  IERS_CLEAR = 'Clear';
  IERS_CLEARSEL = 'ClearSel';
  IERS_CROPSEL = 'CropSel';
  IERS_CONVERTTO = 'ConvertTo %d';
  IERS_CONVERTTO2 = 'ConvertTo2 %d %d %d';
  IERS_CONVERTTO3 = 'ConvertTo2 %d %d';
  IERS_CONVERTTOPALETTE = 'ConvertToPalette';
  IERS_CONVERTTOBWORDERED = 'ConvertToBWOrdered';
  IERS_CONVERTTOBWTHRESHOLD = 'ConvertToBWThreshold %d';
  IERS_CONVERTTO24BIT = 'ConvertTo24Bit';
  IERS_ROTATE = 'Rotate %f';
  IERS_WRITEHIDDENDATA = 'WriteHiddenData';
  IERS_EDGEDETECT = 'EdgeDetect';
  IERS_REMOVENOISE = 'RemoveNoise';
  IERS_ADDSOFTSHADOW = 'AddSoftShadow';
  IERS_ADDINNERSHADOW = 'AddInnerShadow';
  IERS_CONVERTTOBW_FLOYDSTEINBERG = 'ConvertToBW_FloydSteinberg';
  IERS_CROP = 'Crop %d, %d, %d, %d';
  IERS_CROPROT = 'Crop %d, %d, %d, %d, %f';
  IERS_CROPQUAD = 'Crop (%f, %f), (%f, %f), (%f, %f), (%f, %f)';
  IERS_MAKETILE = 'MakeTile %d, %d';
  IERS_ROTATEANDCROP = 'RotateAndCrop';
  IERS_DEINTERLACE = 'Deinterlace';
  IERS_EDGEDETECT_SOBEL = 'EdgeDetect_Sobel';
  IERS_ENCRYPT = 'Encrypt';
  IERS_DECRYPT = 'Decrypt';
  IERS_CONVERTTOBWLOCALTHRESHOLD = 'ConvertToBWLocalThreshold';
  IERS_TEXTOUT = 'TextOut';
  IERS_REMOVECHROMAKEY = 'RemoveChromaKey';
  IERS_SYMMETRICNEARESTNEIGHBOUR = 'SymmetricNearestNeighbour %d';
  IERS_PIXELIZE = 'Pixelize %f';
  IERS_PENCILSKETCH = 'PencilSketch';
{$ENDIF}
  IERS_FLT_NONE = 'None';
  IERS_FLT_BLUR = 'Blur';
  IERS_FLT_EDGES = 'Edges';
  IERS_FLT_EMBOSS = 'Emboss';
  IERS_FLT_HIGH_PASS_1 = 'High Pass 1';
  IERS_FLT_HIGH_PASS_2 = 'High Pass 2';
  IERS_FLT_HIGH_PASS_3 = 'High Pass 3';
  IERS_FLT_LOW_PASS_1 = 'Low Pass 1';
  IERS_FLT_LOW_PASS_2 = 'Low Pass 2';

{!!
<FS>Undo Operation Consts

<FM>Declaration<FC>
}
const
  IEOP_CUSTOM                             = 0 ;
  IEOP_ADDINNERSHADOW                     = 1 ;
  IEOP_ADDSOFTSHADOW                      = 2 ;
  IEOP_ADJUSTBRIGHTNESSCONTRASTSATURATION = 3 ;
  IEOP_ADJUSTGAINOFFSET                   = 4 ;
  IEOP_ADJUSTLUMSATHISTOGRAM              = 5 ;
  IEOP_ADJUSTSATURATION                   = 6 ;
  IEOP_ADJUSTTEMPERATURE                  = 7 ;
  IEOP_ADJUSTTINT                         = 8 ;
  IEOP_APPLYFILTER                        = 9 ;
  IEOP_AUTOIMAGEENHANCE1                  = 10;
  IEOP_AUTOIMAGEENHANCE2                  = 11;
  IEOP_AUTOIMAGEENHANCE3                  = 12;
  IEOP_AUTOSHARP                          = 13;
  IEOP_BLUR                               = 14;
  IEOP_BUMPMAPPING                        = 15;
  IEOP_CASTALPHA                          = 16;
  IEOP_CASTCOLOR                          = 17;
  IEOP_CASTCOLORRANGE                     = 18;
  IEOP_CLEAR                              = 19;
  IEOP_CLEARSEL                           = 20;
  IEOP_CLOSING                            = 21;
  IEOP_COLORIZE                           = 22;
  IEOP_CONTRAST                           = 23;
  IEOP_CONTRAST2                          = 24;
  IEOP_CONTRAST3                          = 25;
  IEOP_CONVERTTO                          = 26;
  IEOP_CONVERTTO2                         = 27;
  IEOP_CONVERTTO24BIT                     = 28;
  IEOP_CONVERTTO3                         = 29;
  IEOP_CONVERTTOBW_FLOYDSTEINBERG         = 30;
  IEOP_CONVERTTOBWLOCALTHRESHOLD          = 31;
  IEOP_CONVERTTOBWORDERED                 = 32;
  IEOP_CONVERTTOBWTHRESHOLD               = 33;
  IEOP_CONVERTTOGRAY                      = 34;
  IEOP_CONVERTTOPALETTE                   = 35;
  IEOP_CONVERTTOSEPIA                     = 36;
  IEOP_CONVOLVE                           = 37;
  IEOP_CROP                               = 38;
  IEOP_CROPSEL                            = 39;
  IEOP_DECRYPT                            = 40;
  IEOP_DEINTERLACE                        = 41;
  IEOP_DISPOSECHANNELS                    = 42;
  IEOP_EDGEDETECT                         = 43;
  IEOP_EDGEDETECT_SOBEL                   = 44;
  IEOP_ENCRYPT                            = 45;
  IEOP_FEATHERALPHAEDGES                  = 46;
  IEOP_FILL                               = 47;
  IEOP_FLIPHORZ                           = 48;
  IEOP_FLIPVERT                           = 49;
  IEOP_FTCLEARZONE                        = 50;
  IEOP_GAMMACORRECT                       = 51;
  IEOP_HISTAUTOEQUALIZE                   = 52;
  IEOP_HISTEQUALIZE                       = 53;
  IEOP_HSLVAR                             = 54;
  IEOP_HSVVAR                             = 55;
  IEOP_INTENSITY                          = 56;
  IEOP_INTENSITYRGBALL                    = 57;
  IEOP_LENS                               = 58;
  IEOP_MAKETILE                           = 59;
  IEOP_MAPGRAYTOCOLOR                     = 60;
  IEOP_MATCHHSVRANGE                      = 61;
  IEOP_MAXIMUM                            = 62;
  IEOP_MEDIANFILTER                       = 63;
  IEOP_MERGE                              = 64;
  IEOP_MERGEWITHMASK                      = 65;
  IEOP_MINIMUM                            = 66;
  IEOP_MOTIONBLUR                         = 67;
  IEOP_NEGATIVE                           = 68;
  IEOP_OPENING                            = 69;
  IEOP_PAINTMARK                          = 70;
  IEOP_PASTEFROMCLIPBOARD                 = 71;
  IEOP_PERSPECTIVEDRAW                    = 72;
  IEOP_POINTPASTEFROMCLIP                 = 73;
  IEOP_PROJECTDRAW                        = 74;
  IEOP_RADIALSTRETCH                      = 75;
  IEOP_RANDOM                             = 76;
  IEOP_REFLECTION                         = 77;
  IEOP_REMOVECHROMAKEY                    = 78;
  IEOP_REMOVEISOLATEDPIXELS               = 79;
  IEOP_REMOVENOISE                        = 80;
  IEOP_REMOVEREDEYES                      = 81;
  IEOP_RESAMPLE                           = 82;
  IEOP_RESIZE                             = 83;
  IEOP_ROTATE                             = 84;
  IEOP_ROTATEANDCROP                      = 85;
  IEOP_ROUNDIMAGE                         = 86;
  IEOP_SELCUTTOCLIP                       = 87;
  IEOP_SELPASTEFROMCLIP                   = 88;
  IEOP_SELPASTEFROMCLIPSTRETCH            = 89;
  IEOP_SETTRANSPARENTCOLORS               = 90;
  IEOP_SHARPEN                            = 91;
  IEOP_SHIFTCHANNEL                       = 92;
  IEOP_TEXTOUT                            = 93;
  IEOP_THRESHOLD                          = 94;
  IEOP_THRESHOLD2                         = 95;
  IEOP_UNSHARPMASK                        = 100;
  IEOP_WALLISFILTER                       = 101;
  IEOP_WAVE                               = 102;
  IEOP_WHITEBALANCE_AUTOWHITE             = 103;
  IEOP_WHITEBALANCE_COEF                  = 104;
  IEOP_WHITEBALANCE_GRAYWORLD             = 105;
  IEOP_WHITEBALANCE_WHITEAT               = 106;
  IEOP_WRITEHIDDENDATA                    = 107;
  IEOP_SYMMETRICNEARESTNEIGHBOUR          = 108;
  IEOP_PIXELIZE                           = 109;
  IEOP_PENCILSKETCH                       = 110;
  IEOP_CUTTOCLIPBOARD                     = 111;
  IEOP_CUTLAYERTOCLIPBOARD                = 112;
  IEOP_PASTELAYERFROMCLIPBOARD            = 113;
  IEOP_ADDIMAGELAYER                      = 114;
  IEOP_ADDSHAPELAYER                      = 115;
  IEOP_ADDLINELAYER                       = 116;
  IEOP_ADDPOLYLINELAYER                   = 117;
  IEOP_ADDTEXTLAYER                       = 118;
  IEOP_MOVELAYER                          = 119;
  IEOP_RESIZELAYER                        = 120;
  IEOP_ROTATELAYER                        = 121;
  IEOP_REMOVELAYER                        = 122;
  IEOP_MERGELAYERS                        = 123;
  IEOP_ARRANGELAYERS                      = 124;
  IEOP_LAYERPROPS                         = 125;

  IEOP_OTHER                              = 999;
{!!}

const
  // Property strings for TIPDialogParams.GetProperty/SetProperty
  // MUST BE UPPERCASE!!!
  IPP_DIALOGWIDTH                 = 'DIALOGWIDTH';
  IPP_DIALOGHEIGHT                = 'DIALOGHEIGHT';
  IPP_CONTRAST_CONTRAST           = 'CONTRAST_CONTRAST';
  IPP_CONTRAST_BRIGHTNESS         = 'CONTRAST_BRIGHTNESS';
  IPP_HSV_H                       = 'HSV_H';
  IPP_HSV_S                       = 'HSV_S';
  IPP_HSV_V                       = 'HSV_V';
  IPP_HSL_H                       = 'HSL_H';
  IPP_HSL_S                       = 'HSL_S';
  IPP_HSL_L                       = 'HSL_L';
  IPP_RGB_R                       = 'RGB_R';
  IPP_RGB_G                       = 'RGB_G';
  IPP_RGB_B                       = 'RGB_B';      
  IPP_USERFILTER_VALUES_PREFIX    = 'USERFILTER_VALUES';
  IPP_USERFILTER_VALUES00         = IPP_USERFILTER_VALUES_PREFIX + '00';
  IPP_USERFILTER_VALUES01         = IPP_USERFILTER_VALUES_PREFIX + '01';
  IPP_USERFILTER_VALUES02         = IPP_USERFILTER_VALUES_PREFIX + '02';
  IPP_USERFILTER_VALUES10         = IPP_USERFILTER_VALUES_PREFIX + '10';
  IPP_USERFILTER_VALUES11         = IPP_USERFILTER_VALUES_PREFIX + '11';
  IPP_USERFILTER_VALUES12         = IPP_USERFILTER_VALUES_PREFIX + '12';
  IPP_USERFILTER_VALUES20         = IPP_USERFILTER_VALUES_PREFIX + '20';
  IPP_USERFILTER_VALUES21         = IPP_USERFILTER_VALUES_PREFIX + '21';
  IPP_USERFILTER_VALUES22         = IPP_USERFILTER_VALUES_PREFIX + '22';
  IPP_USERFILTER_DIVISOR          = 'USERFILTER_DIVISOR';
  IPP_EQUALIZATION_THRESHOLDDOWN  = 'EQUALIZATION_THRESHOLDDOWN';
  IPP_EQUALIZATION_THRESHOLDUP    = 'EQUALIZATION_THRESHOLDUP';
  IPP_EQUALIZATION_EQDOWN         = 'EQUALIZATION_EQDOWN';
  IPP_EQUALIZATION_EQUP           = 'EQUALIZATION_EQUP';
  IPP_EQUALIZATION_EQUALIZEBUTTON = 'EQUALIZATION_EQUALIZEBUTTON';
  IPP_BUMPMAP_LEFT                = 'BUMPMAP_LEFT';
  IPP_BUMPMAP_TOP                 = 'BUMPMAP_TOP';
  IPP_BUMPMAP_WIDTH               = 'BUMPMAP_WIDTH';
  IPP_BUMPMAP_HEIGHT              = 'BUMPMAP_HEIGHT';
  IPP_BUMPMAP_COL                 = 'BUMPMAP_COL';
  IPP_BUMPMAP_SRC                 = 'BUMPMAP_SRC';
  IPP_BUMPMAP_AUTO                = 'BUMPMAP_AUTO';
  IPP_LENS_LEFT                   = 'LENS_LEFT';
  IPP_LENS_TOP                    = 'LENS_TOP';
  IPP_LENS_WIDTH                  = 'LENS_WIDTH';
  IPP_LENS_HEIGHT                 = 'LENS_HEIGHT';
  IPP_LENS_REF                    = 'LENS_REF';
  IPP_LENS_AUTO                   = 'LENS_AUTO';
  IPP_WAVE_AMPLITUDE              = 'WAVE_AMPLITUDE';
  IPP_WAVE_WAVELENGTH             = 'WAVE_WAVELENGTH';
  IPP_WAVE_PHASE                  = 'WAVE_PHASE';
  IPP_WAVE_REFLECT                = 'WAVE_REFLECT';
  IPP_MORPH_FILTER                = 'MORPH_FILTER';
  IPP_MORPH_WINSIZE               = 'MORPH_WINSIZE';
  IPP_ROTATE_ANGLE                = 'ROTATE_ANGLE';
  IPP_FLIP_HORZ                   = 'FLIP_HORZ';
  IPP_FLIP_VERT                   = 'FLIP_VERT';
  IPP_GAMMACORRECTION_VALUE       = 'GAMMACORRECTION_VALUE';
  IPP_SHARPEN_SHARPEN             = 'SHARPEN_SHARPEN';
  IPP_SHARPEN_SIZE                = 'SHARPEN_SIZE';
  IPP_FFT_LEFT                    = 'FFT_LEFT';
  IPP_FFT_TOP                     = 'FFT_TOP';
  IPP_FFT_RIGHT                   = 'FFT_RIGHT';
  IPP_FFT_BOTTOM                  = 'FFT_BOTTOM';
  IPP_FFT_GRAYSCALE               = 'FFT_GRAYSCALE';
  IPP_RESIZE_PERCENT              = 'RESIZE_PERCENT';
  IPP_SHADOW_RADIUS               = 'SHADOW_RADIUS';
  IPP_SHADOW_OFFSET               = 'SHADOW_OFFSET';

  IPP_Property_Count = 59;
  IPP_Property_List : array[0 .. IPP_Property_Count - 1] of string =
    ( IPP_CONTRAST_CONTRAST           ,
      IPP_CONTRAST_BRIGHTNESS         ,
      IPP_HSV_H                       ,
      IPP_HSV_S                       ,
      IPP_HSV_V                       ,
      IPP_HSL_H                       ,
      IPP_HSL_S                       ,
      IPP_HSL_L                       ,
      IPP_RGB_R                       ,
      IPP_RGB_G                       ,
      IPP_RGB_B                       ,
      IPP_USERFILTER_VALUES00         ,
      IPP_USERFILTER_VALUES01         ,
      IPP_USERFILTER_VALUES02         ,
      IPP_USERFILTER_VALUES10         ,
      IPP_USERFILTER_VALUES11         ,
      IPP_USERFILTER_VALUES12         ,
      IPP_USERFILTER_VALUES20         ,
      IPP_USERFILTER_VALUES21         ,
      IPP_USERFILTER_VALUES22         ,
      IPP_USERFILTER_DIVISOR          ,
      IPP_EQUALIZATION_THRESHOLDDOWN  ,
      IPP_EQUALIZATION_THRESHOLDUP    ,
      IPP_EQUALIZATION_EQDOWN         ,
      IPP_EQUALIZATION_EQUP           ,
      IPP_EQUALIZATION_EQUALIZEBUTTON ,
      IPP_BUMPMAP_LEFT                ,
      IPP_BUMPMAP_TOP                 ,
      IPP_BUMPMAP_WIDTH               ,
      IPP_BUMPMAP_HEIGHT              ,
      IPP_BUMPMAP_COL                 ,
      IPP_BUMPMAP_SRC                 ,
      IPP_BUMPMAP_AUTO                ,
      IPP_LENS_LEFT                   ,
      IPP_LENS_TOP                    ,
      IPP_LENS_WIDTH                  ,
      IPP_LENS_HEIGHT                 ,
      IPP_LENS_REF                    ,
      IPP_LENS_AUTO                   ,
      IPP_WAVE_AMPLITUDE              ,
      IPP_WAVE_WAVELENGTH             ,
      IPP_WAVE_PHASE                  ,
      IPP_WAVE_REFLECT                ,
      IPP_MORPH_FILTER                ,
      IPP_MORPH_WINSIZE               ,
      IPP_ROTATE_ANGLE                ,
      IPP_GAMMACORRECTION_VALUE       ,
      IPP_SHARPEN_SHARPEN             ,
      IPP_SHARPEN_SIZE                ,
      IPP_FFT_LEFT                    ,
      IPP_FFT_TOP                     ,
      IPP_FFT_RIGHT                   ,
      IPP_FFT_BOTTOM                  ,
      IPP_FFT_GRAYSCALE               ,
      IPP_RESIZE_PERCENT              ,
      IPP_SHADOW_RADIUS               ,
      IPP_SHADOW_OFFSET               ,
      IPP_FLIP_HORZ                   ,
      IPP_FLIP_VERT);

implementation

uses
  Previews, clipbrd, NeurQuant, ImageEnView, imageenio, ievect, iegdiplus, math, iesettings, iewic, iexLayers
  {$ifdef IEHASTYPES}
  , Types
  {$endif}
  {$ifdef IEHASUITYPES}
  ,System.UITypes
  {$endif}
  ;

{$R-}

var
  IEFiltPres: TList;
  IEFiltPresNames: TStringList;


{!!
<FS>TImageEnProc.Create

<FM>Declaration<FC>
constructor Create(Owner: TComponent);

<FM>Description<FN>
Create a new instance of TImageEnProc. You can pass Owner as nil to create a component without an owner.

<FM>Example<FC>
// Load an image with a TIEBitmap, make it negative then save it
iebmp := TIEBitmap.Create;
ImageEnProc := TImageEnProc.create(nil);
ImageEnProc.AttachedIEBitmap := iebmp;
iebmp.Read('animage.tif');
ImageEnProc.Negative;
iebmp.Write('output.tif');
ImageEnProc.Free;
iebmp.Free;
!!}
constructor TImageEnProc.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  //
  fIEBitmap := TIEBitmap.Create;
  fIEBitmapCreated := true; // we create fIEBitmap
  fTransitionFullBitmap := nil;
  fImageEnViewBitmapChangeHandle := nil;
  fOnPreview := nil;
  fBitmap := nil;
  fImageEnView := nil;
  fTImage := nil;
  fPreviewsParams := [prppShowResetButton, prppHardReset];
  fOnProgress := nil;
  fOnFinishWork := nil;
  fTransition := nil;
  fUndoList := TIEUndoStore.Create;
  fRedoList := TIEUndoStore.Create;
  fUndoLocation := ieFile;
  fAutoUndo := assigned(Owner);
  fBackground := clBlack;
  fPreviewFont := TFont.Create;
  fPreviewFontEnabled := False;
  fUndoLimit := 1;
  fFiltersInitialDir := '';
  {$ifdef IEINCLUDEDIALOGIP}
  fIPDialogParams := TIPDialogParams.Create;
  fPreviewsLog := TStringList.Create;
  {$endif}
  fAutoConvertFormat := true;
  fOnSaveUndo := nil;
end;

{!!
<FS>TImageEnProc.CreateFromBitmap

<FM>Declaration<FC>
constructor CreateFromBitmap(Bitmap: TIEBitmap);
constructor CreateFromBitmap(Bitmap: TBitmap);

<FM>Description<FN>
Creates a new instance of TImageEnProc assigning the property <A TImageEnProc.AttachedIEBitmap> or <A TImageEnProc.AttachedBitmap>.

Note: Also sets <A TImageEnProc.AutoUndo> to <FC>false<FN>.

<FM>Example<FC>
// Draw text onto a TBitmap or TIEBitmap
with TImageEnProc.CreateFromBitmap(myBitmap) do
begin
  TextOut(Align_Text_Horz_Center, Align_Text_Near_Bottom, 'Me in Italy - 2015', 'Arial', 32, clRed, [fsBold]);
  Free;
end;
!!}
constructor TImageEnProc.CreateFromBitmap(Bitmap: TIEBitmap);
begin
  Create(nil);
  AutoUndo := false;
  AttachedIEBitmap := Bitmap;
end;

constructor TImageEnProc.CreateFromBitmap(Bitmap: TBitmap);
begin
  Create(nil);
  AutoUndo := false;
  AttachedBitmap := Bitmap;
end;

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

destructor TImageEnProc.Destroy;
begin
  if assigned(fImageEnView) then
    fImageEnView.RemoveBitmapChangeEvent(fImageEnViewBitmapChangeHandle);
  ClearAllUndo;
  ClearAllRedo;
  FreeAndNil( fUndoList );
  FreeAndNil( fRedoList );
  FreeAndNil(fPreviewFont);
  {$ifdef IEINCLUDEDIALOGIP}
  FreeAndNil(fIPDialogParams);
  FreeAndNil(fPreviewsLog);
  {$endif}
  FreeAndNil(fTransition);
  if fIEBitmapCreated then
    FreeAndNil(fIEBitmap);
  FreeAndNil(fTransitionFullBitmap);
  //
  inherited;
end;

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

{!!
<FS>TImageEnProc.Update

<FM>Declaration<FC>
procedure Update;

<FM>Description<FN>
If TImageEnProc is attached to a <A TImageEnView> (or inherited) object, Update calls the TImageEnView.Update method.
If TImageEnProc is attached to a TBitmap object, Update sets the modified property to True.
!!}
procedure TImageEnProc.Update;
begin
  // remove alpha if attached to fBitmap
  if assigned(fBitmap) then
    fIEBitmap.RemoveAlphaChannel;
  //
  fIEBitmap.Changed();

  if assigned(fImageEnView) then
    with fImageEnView do
    begin
      Update;
      ImageChange;
    end
  else
  if assigned(fBitmap) then
    fBitmap.modified := true;
end;

/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
// Undo/Redo

{!!
<FS>TImageEnProc.ClearAllUndo

<FM>Declaration<FC>
procedure ClearAllUndo;

<FM>Description<FN>
Removes all entries from the Undo stack.

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearUndoAt></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearUndo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Undo></C> </R>
</TABLE>
!!}
procedure TImageEnProc.ClearAllUndo;
begin
  fUndoList.ClearAll();
end;

{!!
<FS>TImageEnProc.ClearAllRedo

<FM>Declaration<FC>
procedure ClearAllRedo;

<FM>Description<FN>
Removes all entries from the Redo stack.

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearRedo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Redo></C> </R>
</TABLE>
!!}
procedure TImageEnProc.ClearAllRedo;
begin
  fRedoList.ClearAll();
end;


{!!
<FS>TImageEnProc.ClearUndo

<FM>Declaration<FC>
procedure ClearUndo;

<FM>Description<FN>
Removes the last entry from the Undo stack.

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearAllUndo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearUndoAt></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Undo></C> </R>
</TABLE>
!!}
procedure TImageEnProc.ClearUndo;
begin
  fUndoList.ClearAt( fUndoList.Count - 1 );
end;

{!!
<FS>TImageEnProc.ClearRedo

<FM>Declaration<FC>
procedure ClearRedo;

<FM>Description<FN>
Removes the last entry from the Redo stack.

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearAllRedo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearRedoAt></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Redo></C> </R>
</TABLE>
!!}
procedure TImageEnProc.ClearRedo;
begin
  ClearRedoAt( 0 );
end;


{!!
<FS>TImageEnProc.ClearRedoAt

<FM>Declaration<FC>
procedure ClearRedoAt(Position: Integer);

<FM>Description<FN>
Removes the entry at <FC>Position<FN> from the Redo stack.

Position = 0: Last saved Redo, 1: Second to last saved Redo,  2... up to <A TImageEnProc.RedoCount> - 1.

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearAllRedo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearRedo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Redo></C> </R>
</TABLE>
!!}
procedure TImageEnProc.ClearRedoAt(Position: Integer);
var
  uc: Integer;
begin
  uc := fRedoList.Count;
  if ( uc > 0 ) and ( Position < uc ) then
    fRedoList.ClearAt( uc - 1 - Position );
end;


{!!
<FS>TImageEnProc.Undo

<FM>Declaration<FC>
procedure Undo(AutoRedo: Boolean = False);

<FM>Description<FN>
Replaces the current image with the last image in the Undo stack.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>AutoRedo<FN></C> <C>Set to true for automatic undo/redo support. Saves the current state (before undo) to the redo stack (i.e. calls <A TImageEnProc.SaveRedo> is called) and removes this entry from the Undo stack (i.e. using <A TImageEnProc.ClearUndo>)</C> </R>
</TABLE>

<IMG help_images\undoredo.gif>

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\UndoRedo\UndoRedo.dpr </C> </R>
</TABLE>

<FM>Example<FC>
// Multiple Undo/Redo Example

procedure TForm1.FormCreate(Sender: TObject);
begin
  ImageEnView1.Proc.UndoLimit := 20; // 20 levels of undo
end;

procedure TForm1.ImageEnView1ImageChange(Sender: TObject);
begin
  // When image changes update our menu items
  UpdateMenu;
end;

procedure TForm1.Undo1Click(Sender: TObject);
begin
  // Undo (with automatic saving of redo)
  ImageEnView1.Proc.Undo( True );
  UpdateMenu;
end;

procedure TForm1.Redo1Click(Sender: TObject);
begin
  // Redo (with automatic saving of undo)
  ImageEnView1.Proc.Redo( True );
  UpdateMenu;
end;

procedure TForm1.UpdateMenu;
begin
  // Undo menu
  Undo1.Enabled := ImageEnView1.Proc.CanUndo;
  if ImageEnView1.Proc.CanUndo then
    Undo1.Caption := 'Undo ' + ImageEnView1.Proc.UndoCaptions[0]
  else
    Undo1.Caption := 'Undo';

  // Redo menu
  Redo1.Enabled := ImageEnView1.Proc.CanRedo;
  if ImageEnView1.Proc.CanRedo then
    Redo1.Caption := 'Redo ' + ImageEnView1.Proc.RedoCaptions[0]
  else
    Redo1.Caption := 'Redo';
end;

<FM>Compatibility Information<FN>
In v6.2.1 and older versions, <FC>AutoRedo<FN> did not remove the undone item from the Undo List. From v6.3.0, <FC>AutoRedo<FN> clears the entries.
To return to the older functionality, enable the IEUseLegacyUndoFunctionality define in ie.inc

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.AutoUndo></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.CanUndo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearAllUndo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearUndoAt></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearUndo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GetUndoInfo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.SaveUndo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.UndoAt></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.UndoCaptions></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.UndoCount></C> </R>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.UndoLimit></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.UndoLocation></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.UndoRect></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.OnSaveUndo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Redo></C> </R>
</TABLE>

!!}
procedure TImageEnProc.Undo(AutoRedo: Boolean = False);
begin
  UndoAt( 0, AutoRedo );
end;

{!!
<FS>TImageEnProc.UndoAt

<FM>Declaration<FC>
procedure UndoAt(Position: Integer; SaveToRedo: Boolean = False);

<FM>Description<FN>
Replaces the current image with the one at <FC>Position<FN> in the Undo stack.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>Position<FN></C> <C>Undo index to restore: 0 = last saved undo, 1 = second to last saved undo,  2...  up to <A TImageEnProc.UndoCount> - 1</C> </R>
<R> <C><FC>AutoRedo<FN></C> <C>Set to true for automatic redo support. Saves the current state (before undo) to the redo stack (i.e. calls <A TImageEnProc.SaveRedo>) and removes this and prior entries from the Undo stack</C> </R>
</TABLE>

<FM>Compatibility Information<FN>
In v6.2.1 and older versions, <FC>AutoRedo<FN> would only assign the current state to the Redo List, and the undone item is not cleared. From v6.3.0, <FC>AutoRedo<FN> clears all undone entries and assigns them to the redo list.
To return to the older functionality, enable the IEUseLegacyUndoFunctionality define in ie.inc

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\UndoRedo\UndoRedo.dpr </C> </R>
</TABLE>

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.CanUndo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.UndoRect></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Undo></C> </R>
</TABLE>
!!}
procedure TImageEnProc.UndoAt(Position: Integer; AutoRedo: Boolean = False);
var
  uc: Integer;
  obj: TObject;
  ms: TMemoryStream;
  src: TIEUndoSource;
  guid: TGuid;
  ieview: TImageEnView;
  i, l, sz, idx: Integer;
  iLyr, iMVI: Integer;
  bHandled: Boolean;
  lyrKind: TIELayerKind;
begin
  if not MakeConsistentBitmap([], False) then
    exit;

  uc := fUndoList.Count;
  idx := uc - 1 - Position;
  if ( uc > 0 ) and ( Position < uc ) then
  try
    // Copy undone items to Redo
    if AutoRedo then
    begin
      {$IFDEF IEUseLegacyUndoFunctionality}
      // V6.2.1 Functionality: Transfers only state to Redo
      SaveRedo(src);
      fRedoList.UndoObjects[ fRedoList.Count - 1 ] := fUndoList.UndoObjects[ idx ];
      {$ELSE}
      // V6.3.0 Functionality: Transfers Undo history to this point
      for I := uc - 1 downto idx do
      begin
        if I = uc - 1 then
          // Current image
          SaveRedo( fUndoList.UndoSources[ i ])
        else
          fRedoList.Add( fUndoList.UndoObjects[ i + 1 { Need state prior to this change } ],
                         fUndoList.UndoSources[ i ], 0, 0);

        fRedoList.Captions      [ fRedoList.Count - 1 ] := fUndoList.Captions[ i ];
        fRedoList.LayerIndexes  [ fRedoList.Count - 1 ] := fUndoList.LayerIndexes[ i ];
        fRedoList.UndoOperations[ fRedoList.Count - 1 ] := fUndoList.UndoOperations[ i ];
        fRedoList.MViewIndexes  [ fRedoList.Count - 1 ] := fUndoList.MViewIndexes[ i ];
      end;
      {$ENDIF}
    end;

    src := fUndoList.UndoSources[ idx ];
    obj := fUndoList.UndoObjects[ idx ];
    iLyr := fUndoList.LayerIndexes[ idx ];
    iMVI := fUndoList.MViewIndexes[ idx ];

    // Custom undo/redo handling for TImageEnMView
    if assigned(fOnUndoRedoEvent) then
    begin
      bHandled := False;
      fOnUndoRedoEvent(Self, True, src, Obj, iMVI, bHandled);
      if bHandled then
        exit;
    end;

    case src of
      ieuImage:
        begin
          // is an image
          if assigned(fImageEnView) and (fImageEnView is TImageEnView) and ( iLyr >= 0 ) then
          begin
            with (fImageEnView as TImageEnView) do
              Layers[ imin(imax( iLyr, 0 ), LayersCount-1) ].Bitmap.Assign( TIEBitmap(obj) );
          end
          else
            fIEBitmap.Assign(TIEBitmap(obj));
          Update;
        end;
      ieuSelection:
        begin
          // is a selection
          ms := TMemoryStream(obj);
          ms.Position := 0;
          if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
            (fImageEnView as TImageEnView).LoadSelectionFromStream(ms, iersMoveToAdapt);
        end;
      ieuObject:
        begin
          // is a TImageEnVect object/s
          ms := TMemoryStream(obj);
          ms.Position := 0;
          if assigned(fImageEnView) and (fImageEnView is TImageEnVect) then
            (fImageEnView as TImageEnVect).LoadFromStreamIEV(ms);
        end;
      ieuLayer, ieuFullLayer:
        begin
          // is a layer info block
          ms := TMemoryStream(obj);
          ms.Position := 0;
          if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
          begin
            ieview := fImageEnView as TImageEnView;
            while ms.Position < ms.Size do
            begin
              l := ms.Position;
              ReadLayerPropsFromStream( ms, False, sz, lyrKind, Guid);
              for i := 0 to ieview.LayersCount-1 do
                if CompareGUID(ieview.layers[i].GUID, Guid) then
                begin
                  ms.Position := l;
                  ieview.Layers[i].LoadFromStream( ms );
                  l := -1;  // found!
                  break;
                end;
              if l <> -1 then
                ms.Position := l + sz;  // not found, bypass
            end;
            ieview.Update;
          end;
        end;
      ieuObjectsAndLayers:
        begin
          // objects and layers
          ms := TMemoryStream(obj);
          ms.Position := 0;
          if assigned(fImageEnView) and (fImageEnView is TImageEnVect) then
            (fImageEnView as TImageEnVect).LoadFromStreamALL(ms)
          else
          if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
            (fImageEnView as TImageEnView).LayersLoadFromStream(ms);
        end;
    end;

  finally  
    // Delete items we have undone
    if AutoRedo then
    begin
      {$IFDEF IEUseLegacyUndoFunctionality}
      // V6.2.1 Functionality: Undo is not cleared
      {$ELSE}
      // V6.3.0 Functionality: Clear Undo that has been processed
      for I := uc - 1 downto idx do
        fUndoList.ClearAt( I, I = idx ); // Objects are now "owned" by Undo list, except current

      // Ensure we call change event in case user needs it to update Undo status
      if assigned( fImageEnView ) then
        fImageEnView.ImageChange;
      {$ENDIF}
    end;
  end;
end;

{!!
<FS>TImageEnProc.UndoRect

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

<FM>Description<FN>
Same as <A TImageEnProc.Undo>, except that it only restores the specified rectangle.

This is useful for applications that allow interactive user drawing (see the icon editor and "Brush" demos).

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.CanUndo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.UndoAt></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Undo></C> </R>
</TABLE>
!!}
// works only with images
procedure TImageEnProc.UndoRect(x1, y1, x2, y2: Integer);
var
  uc: Integer;
  obj: TObject;
  src: TIEUndoSource;
begin
  if not MakeConsistentBitmap([], False) then
    exit;
  uc := fUndoList.Count;
  if (uc > 0) then
  begin
    obj := fUndoList.UndoObjects[ uc - 1 ];
    src := fUndoList.UndoSources[ uc - 1 ];
    if src = ieuImage then
    begin
      // it is an image
      OrdCor(x1, y1, x2, y2);
      TIEBitmap(obj).CopyRectTo(fIEBitmap, x1, y1, x1, y1, x2 - x1 + 1, y2 - y1 + 1, true);
      Update;
    end;
  end;
end;


{!!
<FS>TImageEnProc.GetUndoInfo

<FM>Declaration<FC>
procedure GetUndoInfo(const index: Integer; Out UndoSource : <A TIEUndoSource>; out UndoOperation: Integer);

<FM>Description<FN>
Returns the <L TIEUndoSource>source</L> and <L Undo Operation Consts>operation</L> of the undo located at <FC>Index<FN>.
Index = 0: Last saved undo, 1: Second to last saved undo,  2... up to <A TImageEnProc.UndoCount> - 1.

<FM>Compatibility Information<FN>
<FC>TImageEnProc.GetUndoInfo<FN> replaces the older <FC>TImageEnProc.UndoPeekAt<FN>. Code such as:
<FC>Src := ImageEnView1.Proc.UndoPeekAt( idx );<FN>

Should be replaced with:
ImageEnView1.Proc.GetUndoInfo( ImageEnView1.Proc.UndoCount - 1 - idx, Src, iOp );<FN>

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.UndoCaptions></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Undo></C> </R>
</TABLE>
!!}
procedure TImageEnProc.GetUndoInfo(const index: Integer; Out UndoSource : TIEUndoSource; out UndoOperation: Integer);
begin
  UndoSource    := fUndoList.UndoSources[ fUndoList.Count - Index - 1 ];
  UndoOperation := fUndoList.UndoOperations[ fUndoList.Count - Index - 1 ];
end;


{!!
<FS>TImageEnProc.GetRedoInfo

<FM>Declaration<FC>
procedure GetRedoInfo(const index: Integer; Out RedoSource : <A TIEUndoSource>; out RedoOperation: Integer);

<FM>Description<FN>
Returns the <L TIEUndoSource>source</L> and <L Undo Operation Consts>operation</L> of the Redo located at <FC>Index<FN>.
Index = 0: Last saved Redo, 1: Second to last saved Redo,  2... up to <A TImageEnProc.RedoCount> - 1.

<FM>Compatibility Information<FN>
<FC>TImageEnProc.GetRedoInfo<FN> replaces the older <FC>TImageEnProc.RedoPeekAt<FN>. Code such as:
<FC>Src := ImageEnView1.Proc.RedoPeekAt( idx );<FN>

Should be replaced with:
ImageEnView1.Proc.GetRedoInfo( ImageEnView1.Proc.RedoCount - 1 - idx, Src, iOp );<FN>

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.RedoCaptions></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Redo></C> </R>
</TABLE>
!!}
procedure TImageEnProc.GetRedoInfo(const index: Integer; Out RedoSource : TIEUndoSource; out RedoOperation: Integer);
begin
  RedoSource    := fRedoList.UndoSources[ fRedoList.Count - Index - 1 ];
  RedoOperation := fRedoList.UndoOperations[ fRedoList.Count - Index - 1 ];
end;



{!!
<FS>TImageEnProc.Redo

<FM>Declaration<FC>
procedure Redo(AutoUndo: Boolean = False);

<FM>Description<FN>
Replaces the current image with the last image in the Redo stack.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>AutoUndo<FN></C> <C>Set to true for automatic undo support. Saves the current state (before redo) to the undo stack (i.e. <A TImageEnProc.SaveUndo> is called) and removes this entry from the Redo stack (i.e. <A TImageEnProc.ClearRedo> is called)</C> </R>
</TABLE>

<IMG help_images\undoredo.gif>

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\UndoRedo\UndoRedo.dpr </C> </R>
</TABLE>

<FM>Example<FC>
// Multiple Undo/Redo Example

procedure TForm1.FormCreate(Sender: TObject);
begin
  ImageEnView1.Proc.UndoLimit := 20; // 20 levels of undo
end;

procedure TForm1.ImageEnView1ImageChange(Sender: TObject);
begin
  // When image changes update our menu items
  UpdateMenu;
end;

procedure TForm1.Undo1Click(Sender: TObject);
begin
  // Undo (with automatic saving of redo)
  ImageEnView1.Proc.Undo( True );
  UpdateMenu;
end;

procedure TForm1.Redo1Click(Sender: TObject);
begin
  // Redo (with automatic saving of undo)
  ImageEnView1.Proc.Redo( True );
  UpdateMenu;
end;

procedure TForm1.UpdateMenu;
begin
  // Undo menu
  Undo1.Enabled := ImageEnView1.Proc.CanUndo;
  if ImageEnView1.Proc.CanUndo then
    Undo1.Caption := 'Undo ' + ImageEnView1.Proc.UndoCaptions[0]
  else
    Undo1.Caption := 'Undo';

  // Redo menu
  Redo1.Enabled := ImageEnView1.Proc.CanRedo;
  if ImageEnView1.Proc.CanRedo then
    Redo1.Caption := 'Redo ' + ImageEnView1.Proc.RedoCaptions[0]
  else
    Redo1.Caption := 'Redo';
end;

<FM>Compatibility Information<FN>
In v6.2.1 and older versions, the <FC>AutoUndo<FN> parameter was unavailable. Set to False to maintain v6.2.1 functionality

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.CanRedo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearAllRedo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearRedo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearRedoAt></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GetUndoInfo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.RedoAt></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.RedoCaptions></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.RedoCount></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.SaveRedo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Undo></C> </R>
</TABLE>
!!}
procedure TImageEnProc.Redo(AutoUndo: Boolean = False);
begin
  RedoAt( 0, AutoUndo );
end;

{!!
<FS>TImageEnProc.RedoAt

<FM>Declaration<FC>
procedure RedoAt(Position: Integer; AutoUndo: Boolean = False);

<FM>Description<FN>
Replaces the current image with the image at <FC>Position<FN> in the redo stack.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>Position<FN></C> <C>Redo index to restore: 0 = last saved redo, 1 = second to last saved redo,  2...  up to <A TImageEnProc.RedoCount> - 1</C> </R>
<R> <C><FC>AutoUndo<FN></C> <C>Set to true for automatic undo support. Saves the current state (before redo) to the undo stack (i.e. <A TImageEnProc.SaveUndo> is called) and removes this and prior entries from the Redo stack</C> </R>
</TABLE>

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\UndoRedo\UndoRedo.dpr </C> </R>
</TABLE>

<FM>Compatibility Information<FN>
In v6.2.1 and older versions, the <FC>AutoUndo<FN> parameter was unavailable. Set to False to maintain v6.2.1 functionality

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.CanRedo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Redo></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.RedoCaptions></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.RedoCount></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GetUndoInfo></C> </R>
</TABLE>
!!}
procedure TImageEnProc.RedoAt(Position: Integer; AutoUndo: Boolean = False);
var
  uc: Integer;
  obj: TObject;
  src: TIEUndoSource;
  ms: TMemoryStream;
  guid: TGuid;
  ieview: TImageEnView;
  idx, i, l, sz: Integer;
  iLyr, iMVI: Integer;
  bHandled: Boolean;
  lyrKind: TIELayerKind;
begin
  if not MakeConsistentBitmap([], False) then
    exit;

  uc := fRedoList.Count;
  idx := uc - 1 - Position;
  if (uc > 0) and (Position < uc) then
  try
    // Copy redone items to Undo
    if AutoUndo then
    begin
      {$IFDEF IEUseLegacyUndoFunctionality}
      // V6.2.1 Functionality: Redo is not transered to Undo list
      {$ELSE}
      // V6.2.1 Functionality: Transfer Redo to Undo list
      for I := uc - 1 downto idx do
      begin
        if I = uc - 1 then
          // Current image
          SaveUndo( fRedoList.UndoSources[ i ])
        else
          fUndoList.Add( fRedoList.UndoObjects[ i + 1 { Need state prior to this change } ],
                         fRedoList.UndoSources[ i ], 0 , 0);

        fUndoList.Captions      [ fUndoList.Count - 1 ] := fRedoList.Captions[ i ];
        fUndoList.LayerIndexes  [ fUndoList.Count - 1 ] := fRedoList.LayerIndexes[ i ];
        fUndoList.UndoOperations[ fUndoList.Count - 1 ] := fRedoList.UndoOperations[ i ];
        fUndoList.MViewIndexes  [ fUndoList.Count - 1 ] := fRedoList.MViewIndexes[ i ];
      end;
      {$ENDIF}
    end;

    obj := fRedoList.UndoObjects[ idx ];
    src := fRedoList.UndoSources[ idx ];
    iLyr := fRedoList.LayerIndexes[ idx ];
    iMVI := fRedoList.MViewIndexes[ idx ];

    // Custom undo/redo handling for TImageEnMView
    if assigned(fOnUndoRedoEvent) then
    begin
      bHandled := False;
      fOnUndoRedoEvent(Self, False, src, Obj, iMVI, bHandled);
      if bHandled then
        exit;
    end;

    case src of
      ieuImage:
        begin
          // is an image
          if assigned(fImageEnView) and (fImageEnView is TImageEnView) and ( iLyr >= 0 ) then
          begin
            with (fImageEnView as TImageEnView) do
              Layers[ imin(imax( iLyr, 0 ), LayersCount-1) ].Bitmap.Assign( TIEBitmap(obj) );
          end
          else
            fIEBitmap.Assign(TIEBitmap(obj));
          Update;
        end;
      ieuSelection:
        begin
          // is a selection
          ms := TMemoryStream(obj);
          ms.Position := 0;
          if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
            (fImageEnView as TImageEnView).LoadSelectionFromStream(ms, iersMoveToAdapt);
        end;
      ieuObject:
        begin
          // is a TImageEnVect object/s
          ms := TMemoryStream(obj);
          ms.Position := 0;
          if assigned(fImageEnView) and (fImageEnView is TImageEnVect) then
            (fImageEnView as TImageEnVect).LoadFromStreamIEV(ms);
        end;
      ieuLayer, ieuFullLayer:
        begin
          // is a layer info block
          ms := TMemoryStream(obj);
          ms.Position := 0;
          if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
          begin
            ieview := fImageEnView as TImageEnView;
            while ms.Position<ms.Size do
            begin
              l := ms.Position;
              ReadLayerPropsFromStream( ms, False, sz, lyrKind, Guid);
              for i := 0 to ieview.LayersCount-1 do
                if CompareGUID(ieview.layers[i].GUID, Guid) then
                begin
                  ms.Position := l;
                  ieview.Layers[i].LoadFromStream( ms );
                  l := -1;  // found!
                  break;
                end;
              if l <> -1 then
                ms.Position := l + sz;  // not found, bypass
            end;
            ieview.Update;
          end;
        end;
      ieuObjectsAndLayers:
        begin
          // objects and layers
          ms := TMemoryStream(obj);
          ms.Position := 0;
          if assigned(fImageEnView) and (fImageEnView is TImageEnVect) then
            (fImageEnView as TImageEnVect).LoadFromStreamALL(ms)
          else
          if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
            (fImageEnView as TImageEnView).LayersLoadFromStream(ms);
        end;
    end;

  Finally
    // Delete items we have re-done
    if AutoUndo then
    begin
      {$IFDEF IEUseLegacyUndoFunctionality}
      // V6.2.1 Functionality: Redo is not cleared
      {$ELSE}
      for I := uc - 1 downto idx do
        fRedoList.ClearAt( I, I = idx ); // Objects are now "owned" by Redo list, except current

      // Ensure we call change event in case user needs it to update Redo status
      if assigned( fImageEnView ) then
        fImageEnView.ImageChange;
      {$ENDIF}
    end;
  end;
end;

{!!
<FS>TImageEnProc.ClearUndoAt

<FM>Declaration<FC>
procedure ClearUndoAt(Position: Integer);

<FM>Description<FN>
Removes the entry at <FC>Position<FN> in the Undo stack.

Position = 0: Last saved undo, 1: Second to last saved undo,  2... up to <A TImageEnProc.UndoCount> - 1.

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearAllUndo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearUndo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Undo></C> </R>
</TABLE>
!!}
procedure TImageEnProc.ClearUndoAt(Position: Integer);
var
  uc: Integer;
begin
  uc := fUndoList.Count;
  if (uc > 0) and (Position < uc) then
    fUndoList.ClearAt( uc - 1 - Position );
end;

{!!
<FS>TImageEnProc.CanUndo

<FM>Declaration<FC>
property CanUndo: Boolean;

<FM>Description<FN>
Returns True when there are entries in the Undo stack (i.e. so <A TImageEnProc.Undo> can be used).

Note: <FC>CanUndo<FN> will be False after calling <A TImageEnProc.ClearAllUndo> or <A TImageEnProc.ClearUndo> if there is only one saved image.

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\UndoRedo\UndoRedo.dpr </C> </R>
</TABLE>

<FM>Example<FC>
procedure TMainForm.btnUndoClick(Sender: TObject);
begin
  If ImageEnView1.Proc.CanUndo then
    ImageEnView1.Proc.Undo
  else
    ShowMessage('Nothing to Undo!');
end;

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Undo></C> </R>
</TABLE>
!!}
function TImageEnProc.GetCanUndo: Boolean;
begin
  result := fUndoList.Count > 0;
end;

{!!
<FS>TImageEnProc.CanRedo

<FM>Declaration<FC>
property CanRedo: Boolean;

<FM>Description<FN>
Returns True when there are entries in the Redo stack (i.e. so <A TImageEnProc.Redo> can be used).

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\UndoRedo\UndoRedo.dpr </C> </R>
</TABLE>

<FM>Example<FC>
procedure TMainForm.btnRedoClick(Sender: TObject);
begin
  If ImageEnView1.Proc.CanRedo then
    ImageEnView1.Proc.Redo
  else
    ShowMessage('Nothing to Redo!');
end;

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Redo></C> </R>
</TABLE>
!!}
function TImageEnProc.GetCanRedo: Boolean;
begin
  result := fRedoList.Count > 0;
end;

{!!
<FS>TImageEnProc.UndoCount

<FM>Declaration<FC>
property UndoCount: Integer;

<FM>Description<FN>
Returns the number of entries in the Undo stack (i.e. the number of times the user can call <A TImageEnProc.Undo>).

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\UndoRedo\UndoRedo.dpr </C> </R>
</TABLE>

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.AutoUndo></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.CanUndo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.UndoAt></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.UndoCaptions></C> </R>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.UndoLimit></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Undo></C> </R>
</TABLE>
!!}
function TImageEnProc.GetUndoCount: Integer;
begin
  result := fUndoList.Count;
end;

{!!
<FS>TImageEnProc.RedoCount

<FM>Declaration<FC>
property RedoCount: Integer;

<FM>Description<FN>
Returns the number of entries in the Redo stack (i.e. the number of times the user can call <A TImageEnProc.Redo>).

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\UndoRedo\UndoRedo.dpr </C> </R>
</TABLE>

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.CanRedo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.RedoAt></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.RedoCaptions></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Redo></C> </R>
</TABLE>
!!}
function TImageEnProc.GetRedoCount: Integer;
begin
  result := fRedoList.Count;
end;

procedure TImageEnProc.SetUndoCaptions(index: Integer; const Value: String);
begin
  fUndoList.Captions[ fUndoList.Count - index - 1 ] := Value;
end;

{!!
<FS>TImageEnProc.UndoCaptions

<FM>Declaration<FC>
property UndoCaptions[index: Integer]: String;

<FM>Description<FN>
For each item in the Undo stack, ImageEn will include a relevant description of the function that has occured. This is useful to display a list of the available undo changes to the user.
Index = 0: Last saved undo, 1: Second to last saved undo,  2... up to <A TImageEnProc.UndoCount> - 1.

<IMG help_images\undoredo.gif>

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\UndoRedo\UndoRedo.dpr </C> </R>
</TABLE>

<FM>Example<FC>
// works only when AutoUndo = True and UndoLimit = 2
ImageEnView1.Proc.Contrast(10);
ImageEnView1.Proc.Negative;
ShowMessage( ImageEnView1.Proc.UndoCaptions[ 0 ] );  // this shows 'Negative'
ShowMessage( ImageEnView1.Proc.UndoCaptions[ 1 ] );  // this shows 'Contrast 10'

<FM>Compatibility Information<FN>
In v6.2.1 and older versions, <FC>UndoCaptions<FN> were hard coded strings. In v6.3.0, the captions became localizable strings. To re-enable the captions, enable the IEUseLegacyUndoCaptions define in ie.inc

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.AutoUndo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GetUndoInfo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.SaveUndo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.UndoAt></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.UndoCount></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Undo></C> </R>
</TABLE>

!!}
function TImageEnProc.GetUndoCaptions(index: Integer): String;
begin
  result := fUndoList.Captions[ fUndoList.Count - index - 1 ];
end;

{!!
<FS>TImageEnProc.RedoCaptions

<FM>Declaration<FC>
property RedoCaptions[index: Integer]: String;

<FM>Description<FN>
For each item in the Redo stack, ImageEn will include a relevant description of the function that has occured. This is useful to display a list of the available redo changes to the user.
Index = 0: Last saved redo, 1: Second to last saved redo,  2... up to <A TImageEnProc.RedoCount> - 1.

<IMG help_images\undoredo.gif>

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\UndoRedo\UndoRedo.dpr </C> </R>
</TABLE>

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.SaveRedo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Redo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.RedoAt></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.RedoCount></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GetUndoInfo></C> </R>
</TABLE>
!!}
function TImageEnProc.GetRedoCaptions(index: Integer): String;
begin
  result := fRedoList.Captions[ fRedoList.Count - index - 1 ];
end;


{!!
<FS>TImageEnProc.SaveUndo

<FM>Declaration<FC>
procedure SaveUndo(Source: <A TIEUndoSource> = ieuImage; ClearRedo: Boolean = false); overload;
procedure SaveUndo(const Caption: String; Source: <A TIEUndoSource> = ieuImage; ClearRedo: Boolean = false; Operation: Integer = 0); overload;

<FM>Description<FN>
Saves the current image to the Undo stack (i.e. after the next change, calling <A TImageEnProc.Undo> will return us to this state).

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>Caption<FN></C> <C>Description of the saved undo (which will be assigned to <A TImageEnProc.UndoCaptions>)</C> </R>
<R> <C><FC>Source<FN></C> <C>Specifies what to save (see below)</C> </R>
<R> <C><FC>ClearRedo<FN></C> <C>When true <A TImageEnProc.ClearAllRedo> is called to reset the redo list (which is standard behavior for application Undo)</C> </R>
<R> <C><FC>Operation<FN></C> <C>An optional value that allows you to locate a specific undo (via <A TImageEnProc.GetUndoInfo>). It can be zero or an <L Undo Operation Consts>undo const</L></C> </R>
</TABLE>

Values for <FC>Source<FN>:
<TABLE>
<R> <C>ieuImage</C> <C>The image (of the current layer, if there are multiple layers)</C> </R>
<R> <C>ieuSelection</C> <C>The area the user has selected (Not the image within the selection, just the selection area)</C> </R>
<R> <C>ieuObject</C> <C>All objects of a <A TImageEnVect></C> </R>
<R> <C>ieuLayer</C> <C>Properties of all layers (position, size, etc, but not the layer images)</C> </R>
<R> <C>ieuFullLayer</C> <C>Same as <FC>ieuLayer<FN> but also saves the layer images</C> </R>
<R> <C>ieuObjectsAndLayers</C> <C>Properties and images of all layers (<A TImageEnView>) or objects (<A TImageEnVect>)</C> </R>
</TABLE>

Notes:
- You do not need to manually call <FC>SaveUndo<FN> if you have enabled <A TImageEnProc.AutoUndo>
- <FC>ieuLayer<FN> and <FC>ieuFullLayer<FN> do not restore removed layers, or redact added layers. Use <FC>ieuObjectsAndLayers<FN> instead
- For TImageEnVect, <FC>ieuObject<FN> and <FC>ieuObjectsAndLayers<FN> are the same, except that <FC>ieuObjectsAndLayers<FN> also saves the background image

<FM>Examples<FC>
// Allow undo of Negative
ImageEnView1.Proc.SaveUndo;
ImageEnView1.Proc.Negative;

// Allow undo of Negative&Contrast
ImageEnView1.Proc.SaveUndo( 'Negative and contrast' );
ImageEnView1.Proc.Negative;
ImageEnView1.Proc.Contrast( 5 );

// Save undo before removing a layer (TImageEnView)
ImageEnView1.Proc.SaveUndo( 'Delete Layer', ieuObjectsAndLayers );
ImageEnView1.LayersRemove( ImageEnView1.LayersCurrent );

// Save undo before removing an object (TImageEnVect)
ImageEnVect1.Proc.SaveUndo( 'Delete Object', ieuObject ); // or ieuObjectsAndLayers
ImageEnVect1.RemoveObject( IEV_ALL_SELECTED_OBJECTS );

// Save undo before shifting all layers
ImageEnView1.Proc.SaveUndo( 'Move all Layers', ieuLayer );
ImageEnView1.LayersRepositionAll( -50, -50 );

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.AutoUndo></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.UndoCount></C> </R>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.UndoLimit></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Undo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.SaveRedo></C> </R>
</TABLE>

!!}
procedure TImageEnProc.SaveUndo(const Caption: String; Source: TIEUndoSource = ieuImage; ClearRedo: Boolean = false; Operation: Integer = 0);
  //
  procedure SaveUndoObject(obj: TObject);
  begin
    while fUndoList.Count >= fUndoLimit do
      fUndoList.ClearAt( 0 );

    fUndoList.Add( obj, Source, Operation, fMViewIndex );
    if Caption <> '' then
      fUndoList.Captions[ fUndoList.Count - 1 ] := Caption;

    if ClearRedo then
      ClearAllRedo();
  end;
  //
var
  ieb: TIEBitmap;
  ms: TMemoryStream;
  ieview: TImageEnView;
  i: Integer;
begin
  if fUndoLimit = 0 then
    exit;
  case Source of
    ieuImage:
      begin
        // save the bitmap
        if not MakeConsistentBitmap([], False) then
          exit;
        if (fIEBitmap.Width > 1) and (fIEBitmap.Height > 1) then
        begin
          ieb := TIEBitmap.Create;
          ieb.MinFileSize := 0;
          ieb.Location := fUndoLocation;
          ieb.Assign(fIEBitmap);
          if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
            fUndoList.LayerIndexes[ fUndoList.Count - 1 ] := (fImageEnView as TImageEnView).LayersCurrent;
          SaveUndoObject(ieb);
        end;
      end;
    ieuSelection:
      begin
        // save the selection (if connected to TImageEnView)
        if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
        begin
          ms := TMemoryStream.Create;
          (fImageEnView as TImageEnView).SaveSelectionToStream(ms);
          SaveUndoObject(ms);
        end;
      end;
    ieuObject:
      begin
        // save object, if fImageEnView is a TImageEnVect.
        if assigned(fImageEnView) and (fImageEnView is TImageEnVect) then
        begin
          ms := TMemoryStream.Create;
          (fImageEnView as TImageEnVect).SaveToStreamIEV(ms);
          SaveUndoObject(ms);
        end;
      end;
    ieuLayer, ieuFullLayer:
      begin
        // save layer info
        if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
        begin
          ieview := fImageEnView as TImageEnView;
          ms := TMemoryStream.Create;
          for i := 0 to ieview.LayersCount - 1 do
            ieview.Layers[i].SaveToStream( ms, not ((Source=ieuFullLayer) and (i=ieview.LayersCurrent)), -2 );
          SaveUndoObject(ms);
        end;
      end;
    ieuObjectsAndLayers:
      begin
        // layers and objects
        if assigned(fImageEnView) and (fImageEnView is TImageEnVect) then
        begin
          ms := TMemoryStream.Create;
          (fImageEnView as TImageEnVect).SaveToStreamALL(ms);
          SaveUndoObject(ms);
        end
        else
        if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
        begin
          ms := TMemoryStream.Create;
          (fImageEnView as TImageEnView).LayersSaveToStream(ms, -2);
          SaveUndoObject(ms);
        end;
      end;
  end;
  if assigned(fOnSaveUndo) then
    fOnSaveUndo(self, Source);
end;

procedure TImageEnProc.SaveUndo(Source: TIEUndoSource = ieuImage; ClearRedo: Boolean = false);
begin
  SaveUndo( '', Source, ClearRedo );
end;

{$ifdef IEIncludeDeprecatedInV6}
// Deprecated in 6.2.2
procedure TImageEnProc.SaveUndoCaptioned(const Caption: String; Source: TIEUndoSource = ieuImage);
begin
  SaveUndo( Caption, Source, False );
end;
{$endif}


{!!
<FS>TImageEnProc.SaveRedo

<FM>Declaration<FC>
procedure SaveRedo(Source: <A TIEUndoSource> = ieuImage); overload;
procedure SaveRedo(const Caption: String; Source: <A TIEUndoSource> = ieuImage); overload;

<FM>Description<FN>
Saves the current image to the Redo stack (i.e. after the next change, calling <A TImageEnProc.Redo> will return us to this state).

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>Caption<FN></C> <C>Description of the saved redo (which will be assigned to <A TImageEnProc.RedoCaptions>)</C> </R>
<R> <C><FC>Source<FN></C> <C>Specifies what to save (see below)</C> </R>
</TABLE>

Values for <FC>Source<FN>:
<TABLE>
<R> <C>ieuImage</C> <C>The image (of the current layer, if there are multiple layers)</C> </R>
<R> <C>ieuSelection</C> <C>The area the user has selected (Not the image within the selection, just the selection area)</C> </R>
<R> <C>ieuObject</C> <C>All objects of a <A TImageEnVect></C> </R>
<R> <C>ieuLayer</C> <C>Properties of all layers (position, size, etc, but not the layer images)</C> </R>
<R> <C>ieuFullLayer</C> <C>Same as <FC>ieuLayer<FN> but also saves the layer images</C> </R>
<R> <C>ieuObjectsAndLayers</C> <C>Properties and images of all layers (<A TImageEnView>) or objects (<A TImageEnVect>)</C> </R>
</TABLE>

Notes:
- You do not need to manually call <FC>SaveRedo<FN> if you have enabled <A TImageEnProc.AutoUndo>
- <FC>ieuLayer<FN> and <FC>ieuFullLayer<FN> do not restore removed layers, or redact added layers. Use <FC>ieuObjectsAndLayers<FN> instead
- For TImageEnVect, <FC>ieuObject<FN> and <FC>ieuObjectsAndLayers<FN> are the same, except that <FC>ieuObjectsAndLayers<FN> also saves the background image

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Redo></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.SaveUndo></C> </R>
</TABLE>
!!}
procedure TImageEnProc.SaveRedo(const Caption: String; Source: TIEUndoSource = ieuImage);
//
  procedure SaveRedoObject(obj: TObject);
  begin
    while fRedoList.Count >= fUndoLimit do
      fRedoList.ClearAt( 0 );

    fRedoList.Add( obj, Source, IEOP_CUSTOM, fMViewIndex );
    if Caption <> '' then
      fRedoList.Captions[ fRedoList.Count - 1 ] := Caption;
  end;
  
var
  ieb: TIEBitmap;
  ms: TMemoryStream;
  ieview: TImageEnView;
  i: Integer;
begin
  if fUndoLimit = 0 then
    exit;

  case Source of
    ieuImage:
      begin
        // save the bitmap
        if not MakeConsistentBitmap([], False) then
          exit;
        if (fIEBitmap.Width > 1) and (fIEBitmap.Height > 1) then
        begin
          ieb := TIEBitmap.Create;
          ieb.MinFileSize := 0;
          ieb.Location := fUndoLocation;
          ieb.Assign(fIEBitmap);
          if assigned(fImageEnView) and (fImageEnView is TImageEnView) then 
            fRedoList.LayerIndexes[ fRedoList.Count - 1 ] := (fImageEnView as TImageEnView).LayersCurrent;
          SaveRedoObject(ieb);
        end;
      end;
    ieuSelection:
      // save the selection (if connected to TImageEnView)
      if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
      begin
        ms := TMemoryStream.Create;
        (fImageEnView as TImageEnView).SaveSelectionToStream(ms);
        SaveRedoObject(ms);
      end;
    ieuObject:
      begin
        // save object, if fImageEnView is a TImageEnVect.
        if assigned(fImageEnView) and (fImageEnView is TImageEnVect) then
        begin
          ms := TMemoryStream.Create;
          (fImageEnView as TImageEnVect).SaveToStreamIEV(ms);
          SaveRedoObject(ms);
        end;
      end;
    ieuLayer, ieuFullLayer:
      begin
        // save layer info
        if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
        begin
          ieview := fImageEnView as TImageEnView;
          ms := TMemoryStream.Create;
          for i := 0 to ieview.LayersCount-1 do
            ieview.Layers[i].SaveToStream( ms, not ((Source=ieuFullLayer) and (i=ieview.LayersCurrent)), -2 );
          SaveRedoObject(ms);
        end;
      end;
    ieuObjectsAndLayers:
      begin
        // layers and objects
        if assigned(fImageEnView) and (fImageEnView is TImageEnVect) then
        begin
          ms := TMemoryStream.Create;
          (fImageEnView as TImageEnVect).SaveToStreamALL(ms);
          SaveRedoObject(ms);
        end
        else
        if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
        begin
          ms := TMemoryStream.Create;
          (fImageEnView as TImageEnView).LayersSaveToStream(ms, -2);
          SaveRedoObject(ms);
        end;
      end;
  end;
end;

procedure TImageEnProc.SaveRedo(Source: TIEUndoSource = ieuImage);
begin
  SaveRedo( '', Source );
end;

{$ifdef IEIncludeDeprecatedInV6}
// Deprecated in 6.2.2
procedure TImageEnProc.SaveRedoCaptioned(const Caption: String; Source: TIEUndoSource = ieuImage);
begin
  SaveRedo( Caption, Source );
end;
{$endif}


{!!
<FS>TImageEnProc.UndoLimit

<FM>Declaration<FC>
property UndoLimit: Integer;

<FM>Description<FN>
Specifies how many images can be saved using the <A TImageEnProc.SaveUndo> method.

Default: 1

When you call <A TImageEnProc.SaveUndo> the current image is pushed to the image stack.
Calling <A TImageEnProc.Undo> restores the last saved image.
Calling <A TImageEnProc.ClearUndo> removes the last saved image.

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.AutoUndo></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.UndoLocation></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Undo></C> </R>
</TABLE>

!!}
procedure TImageEnProc.SetUndoLimit(v: Integer);
begin
  fUndoLimit := v;
end;

// Undo/Redo
/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////


// Raise exception if there is no bitmap available
procedure TImageEnProc.CheckHaveValidBitmap();
var
  bHaveBitmap: Boolean;
begin
  bHaveBitmap := assigned(fIEBitmap);
  if assigned( fImageEnView ) and ( fImageEnView is TImageEnView ) and ( TImageEnView( fImageEnView ).fIEBitmapValid = False ) then
    bHaveBitmap := False;
  if bHaveBitmap = False then
    raise EIEException.create( 'Active layer does not contain bitmap' );
end;


function TImageEnProc.MakeConsistentBitmap(allowedFormats: TIEPixelFormatSet; ExceptionOnInvalidBitmap: Boolean = true): Boolean;
begin
  if ExceptionOnInvalidBitmap then
    CheckHaveValidBitmap();

  result := false;
  if not assigned(fIEBitmap) then
    exit;

  if assigned(fBitmap) then
    fIEBitmap.EncapsulateTBitmap(fBitmap, false); // synchronize fBitmap with fIEBitmap
  result := fIEBitmap.CheckFormat(allowedFormats, fAutoConvertFormat);
end;


//////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////
// Convolution

type

  TConvolveSharedFields = record
    kernel: PDoubleArray;
    factor: Double;
    bitmap: TIEBitmap;
    ksize: Integer;
    newbmp: TIEBitmap;
    coXMap: pintegerarray;  // map of X coordinates
    coYMap: pintegerarray;  // map of Y coordinates
    bitmapMaxX, bitmapMaxY: Integer;
    OnProgress: TIEProgressEvent;
    Sender: TObject;
  end;

  TConvolveThread = class(TIEExecutor)
  private
    sharedFields: TConvolveSharedFields;
    x1, y1, x2, y2: Integer;
    threadIndex: Integer;
    percentage: Integer;
  public
    procedure Execute; override;
    constructor Create(useThread: Boolean; x1_, y1_, x2_, y2_: Integer; const sharedFields_: TConvolveSharedFields; threadIndex_: Integer);
    procedure DoProgress;
  end;

constructor TConvolveThread.Create(useThread: Boolean; x1_, y1_, x2_, y2_: Integer; const sharedFields_: TConvolveSharedFields; threadIndex_: Integer);
begin
  inherited Create(useThread);
  x1 := x1_;
  y1 := y1_;
  x2 := x2_;
  y2 := y2_;
  sharedFields := sharedFields_;
  threadIndex := threadIndex_;
end;

procedure TConvolveThread.DoProgress;
begin
  sharedFields.OnProgress(sharedFields.Sender, percentage);
end;

procedure TConvolveThread.Execute();
var
  row, col, kpos: Integer;
  new_r, new_g, new_b: Double;
  real_col, real_row: Integer;
  px_src: PRGB;
  px_dst: PRGB;
  kern: pdouble;
  lper: Integer;
begin
  lper := -1;
  for row := y1 to y2 do
  begin
    px_dst := sharedFields.newbmp.Scanline[row];
    inc(px_dst, x1);
    for col := x1 to x2 do
    begin
      new_r := 0.0;
      new_g := 0.0;
      new_b := 0.0;
      kern := pdouble(sharedFields.kernel);
      for kpos := 0 to sharedFields.ksize-1 do
      begin
        real_row := row + sharedFields.coYMap[kpos];
        if real_row < 0 then
          real_row := 0
        else
        if real_row>sharedFields.bitmapMaxY then
          real_row := sharedFields.bitmapMaxY;
        real_col := col + sharedFields.coXMap[kpos];
        if real_col < 0 then
          real_col := 0 else
        if real_col>sharedFields.bitmapMaxX then
          real_col := sharedFields.bitmapMaxX;
        px_src := sharedFields.bitmap.Scanline[real_row];
        inc(px_src, real_col);
        with px_src^ do
        begin
          new_r := new_r + kern^ * r;
          new_g := new_g + kern^ * g;
          new_b := new_b + kern^ * b;
        end;
        inc(kern);
      end;
      with px_dst^ do
      begin
        r := blimit(round(sharedFields.factor * new_r));
        g := blimit(round(sharedFields.factor * new_g));
        b := blimit(round(sharedFields.factor * new_b));
      end;
      inc(px_dst);
    end;
    if (threadIndex = 0) and assigned(sharedFields.OnProgress) then
    begin
      percentage := trunc(row/(y2-y1)*100);
      if percentage<>lper then
      begin
        lper := percentage;
        if not assigned(GetThread()) then
          DoProgress();
      end;
    end;
  end;
  sharedFields.newbmp.CopyRectTo(sharedFields.bitmap, x1, y1, x1, y1, x2 - x1 + 1, y2 - y1 + 1, false);
end;



// kernelWidth and kernelHeight must be odd and >= 3
procedure IEConvolve(bitmap: TIEBitmap; kernel: array of double; kernelWidth, kernelHeight: Integer; factor: Double; x1, y1, x2, y2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  row, col, kpos: Integer;
  threads: TIEThreadPool;
  threadsCount: Integer;
  rowsPerThread: Integer;
  ty1, ty2: Integer;
  i: Integer;
  sharedFields: TConvolveSharedFields;
begin

  // check parameters
  if (Bitmap.Pixelformat<>ie24RGB) or (factor = 0) then
    exit;

  x2 := imin(x2, bitmap.Width); dec(x2);
  y2 := imin(y2, bitmap.Height); dec(y2);

  sharedFields.kernel := @kernel[0];
  sharedFields.ksize := kernelWidth*kernelHeight;
  sharedFields.factor := factor;
  sharedFields.bitmap := bitmap;
  sharedFields.bitmapMaxX := bitmap.Width-1;
  sharedFields.bitmapMaxY := bitmap.Height-1;
  sharedFields.OnProgress := fOnProgress;
  sharedFields.Sender := Sender;

  // build coXMap and coYMap (kernel linear coordinates to kernel X, Y coordinates)
  getmem(sharedFields.coXMap, sharedFields.ksize * sizeof(integer));
  getmem(sharedFields.coYMap, sharedFields.ksize * sizeof(integer));
  kpos := 0;
  for row := -(kernelHeight div 2) to (kernelHeight div 2) do
    for col := -(kernelWidth div 2) to (kernelWidth div 2) do
    begin
      sharedFields.coXMap[kpos] := col;
      sharedFields.coYMap[kpos] := row;
      inc(kpos);
    end;

  sharedFields.newbmp := TIEBitmap.Create(bitmap.Width, bitmap.Height, ie24RGB);

  if bitmap.Location = ieFile then
    threadsCount := 1
  else
    threadsCount := IEGetRequiredThreads(bitmap.Width, bitmap.Height);

  threads := TIEThreadPool.Create();
  rowsPerThread := (y2-y1) div threadsCount;
  ty1 := y1;
  ty2 := y1 + rowsPerThread;
  for i := 0 to threadsCount - 1 do
  begin
    threads.Add( TConvolveThread.Create(threadsCount > 1, x1, ty1, x2, ty2, sharedFields, i) );
    ty1 := ty2 + 1;
    if i = threadsCount - 2 then
      ty2 := y2 // last thread gets up to y2 (does not apply when threadsCount = 1)
    else
      ty2 := ty1 + rowsPerThread;
  end;
  threads.Join();
  threads.Free;

  sharedFields.newbmp.Free;
  freemem(sharedFields.coXMap);
  freemem(sharedFields.coYMap);

end;

{!!
<FS>TImageEnProc.Convolve

<FM>Declaration<FC>
procedure Convolve(Kernel: array of double; KernelWidth, KernelHeight: Integer; Factor: Double);

<FM>Description<FN>
Convolves the specified kernel over the selected region.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>Kernel<FN></C> <C>The convolution kernel (just a matrix made array).</C> </R>
<R> <C><FC>KernelWidth<FN></C> <C>The kernel matrix width (number of columns).</C> </R>
<R> <C><FC>KernelHeight<FN></C> <C>The kernel matrix height (number of rows).</C> </R>
<R> <C><FC>Factor<FN></C> <C>Multiplication factor.</C> </R>
</TABLE>

<FM>Example<FC>
// performs "blur" effect, using 3x3 kernel
ImageEnView.Proc.Convolve([0.0, 1.0, 0.0,
                           1.0, 1.0, 1.0,
                           0.0, 1.0, 0.0],
                           3, 3, 1/5);

// performs "blur" effect using 5x5 kernel
ImageEnView.Proc.Convolve([0.0, 0.0, 1.0, 0.0, 0.0,
                           0.0, 1.0, 1.0, 1.0, 0.0,
                           1.0, 1.0, 1.0, 1.0, 1.0,
                           0.0, 1.0, 1.0, 1.0, 0.0,
                           0.0, 0.0, 1.0, 0.0, 0.0],
                           5, 5, 1/13);

!!}
procedure TImageEnProc.Convolve(Kernel: array of double; KernelWidth, KernelHeight: Integer; Factor: Double);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_CONVOLVE,
                              {$ELSE}
                              IEMsg( IEMsg_CONVOLVE ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_CONVOLVE ) then
    exit;
  IEConvolve(ProcBitmap, Kernel, KernelWidth, KernelHeight, factor, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


// Convolution
//////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////



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

function IEAverageRGB(bitmap: TIEBitmap; mask: TIEMask; x1, y1, x2, y2: Integer): TRGB;
var
  row, col: Integer;
  px: PRGB;
  ar, ag, ab: Double;
  pixelsCount: Integer;
begin
  // check parameters
  if (Bitmap.Pixelformat<>ie24RGB) then
    exit;

  x2 := imin(x2, bitmap.Width); dec(x2);
  y2 := imin(y2, bitmap.Height); dec(y2);

  ar := 0.0;
  ag := 0.0;
  ab := 0.0;
  pixelsCount := 0;

  for row := y1 to y2 do
  begin
    px := bitmap.Scanline[row];
    inc(px, x1);
    for col := x1 to x2 do
    begin
      if not assigned(mask) or mask.IsEmpty or mask.IsPointInside(col+mask.X1, row+mask.Y1) then
      begin
        with px^ do
        begin
          ar := ar + r;
          ag := ag + g;
          ab := ab + b;
        end;
        inc(pixelsCount);
      end;
      inc(px);
    end;
  end;

  if pixelsCount <> 0 then
  begin
    result.r := trunc(ar / pixelsCount);
    result.g := trunc(ag / pixelsCount);
    result.b := trunc(ab / pixelsCount);
  end
  else
    result := CreateRGB(0, 0, 0);
end;



// Return the average color of an area of image
function IEAverageRGB_Sample(Bitmap : TIEBitmap; mask: TIEMask; iX1, iY1, iX2, iY2 : Integer; out iHueVariance : Integer; iSampleCount : Integer = 100) : TRGB;
var
  iPixelX, iPixelY : Integer;
  iTotalR, iTotalG, iTotalB : Integer;
  iPointCount : Integer;
  I1, I2 : Integer;
  aColor : TRGB;
  iHue, iSat, iVal : integer;
  iMinHue, iMaxHue : Integer;
  iMatrixX, iMatrixY : Integer; // Number of samples horz and vertically
begin
  iMinHue := 359;
  iMaxHue := 0;

  iX1 := iX1;
  if iX1 < 0 then
    iX1 := 0;
  iX2 := iX2;
  if iX2 > Bitmap.Width then
    iX2 := Bitmap.Width;
  if iX2 - iX1 <= 0 then
    exit;

  iY1 := iY1;
  if iY1 < 0 then
    iY1 := 0;
  iY2 := iY2;
  if iY2 > Bitmap.Height then
    iY2 := Bitmap.Height;
  if iY2 - iY1 <= 0 then
    exit;

  // Horizontal sample count
  iMatrixX := Trunc( SqRt( iSampleCount ));
  if iMatrixX < 5 then
    iMatrixX := 5;
  if iMatrixX > iX2 - iX1 then
    iMatrixX := iX2 - iX1;

  // Vertical sample count
  iMatrixY := Trunc( SqRt( iSampleCount ));
  if iMatrixY < 5 then
    iMatrixY := 5;
  if iMatrixY > iY2 - iY1 then
    iMatrixY := iY2 - iY1;

  // Selection too small?
  if ( iMatrixX < 2 ) or ( iMatrixY < 2 ) then
  begin
    Result := Bitmap.Pixels[ iX1, iY1 ];
    exit;
  end;

  iPixelY := iY1;
  iTotalR := 0;
  iTotalG := 0;
  iTotalB := 0;
  iPointCount := 0;

  // Sample points and average them
  for I1 := 1 to iMatrixX do
  begin
    iPixelX := iX1;
    for I2 := 1 to iMatrixY do
    begin
      if not assigned(mask) or mask.IsEmpty or mask.IsPointInside(iPixelX + mask.X1, iPixelY + mask.Y1) then
      begin
        aColor := Bitmap.Pixels[ imin( iPixelX, Bitmap.Width - 1), imin( iPixelY, Bitmap.Height - 1 ) ];
        RGB2HSV( aColor, iHue, iSat, iVal );

        if iHue < iMinHue then
          iMinHue := iHue;
        if iHue > iMaxHue then
          iMaxHue := iHue;

        inc( iTotalR, aColor.R );
        inc( iTotalG, aColor.G );
        inc( iTotalB, aColor.B );
        inc( iPointCount );
      end;

      // -1 so we get the outer bounds
      inc( iPixelX, ( iX2 - iX1 ) div ( iMatrixX - 1 ) );
    end;
    inc( iPixelY, ( iY2 - iY1 ) div ( iMatrixY - 1 ) );
  end;

  if iPointCount = 0 then
  begin
    Result := IEAverageRGB( bitmap, mask, iX1, iY1, iX2, iY2 );
    iHueVariance := 0;
  end
  else
  begin
    Result := CreateRGB( iTotalR div iPointCount,
                         iTotalG div iPointCount,
                         iTotalB div iPointCount );
    iHueVariance := iMaxHue - iMinHue;
  end;
end;




{!!
<FS>TImageEnProc.CalcAverageRGB

<FM>Declaration<FC>
function CalcAverageRGB(iSampleCount : Integer = 0): TRGB;

<FM>Description<FN>
Returns the average RGB values of the selection.

If iSampleCount < 1 then the entire image is analyzed. To speed up processing you can sample a smaller number of points, e.g. 100

<FM>Example<FC>
// Fill the selected area with the average color
ImageEnView.Proc.Fill( ImageEnView.Proc.CalcAverageRGB() );
!!}
function TImageEnProc.CalcAverageRGB(iSampleCount : Integer = 0): TRGB;
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
  iHueVariance : Integer;
begin
  result := CreateRGB(0, 0, 0);
  if not BeginImageAnalysis([ie24RGB], x1, y1, x2, y2, ProcBitmap, mask) then
    exit;
  if iSampleCount > 0 then
    result := IEAverageRGB_Sample(ProcBitmap, mask, x1, y1, x2, y2, iHueVariance, iSampleCount)
  else
    result := IEAverageRGB(ProcBitmap, mask, x1, y1, x2, y2);
  EndImageAnalysis(ProcBitmap);
  DoFinishWork;
end;



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

// working only with ie24RGB
procedure IEGetAverageValues(bitmap: TIEBitmap; mask: TIEMask; x1, y1, x2, y2: Integer; var avg: TIEArrayOfDouble); overload;
var
  c, row, col: Integer;
  px: pbyte;
  count: array [0..2] of integer;
begin
  // check parameters
  if (Bitmap.Pixelformat <> ie24RGB) then
    exit;

  x2 := imin(x2, bitmap.Width); dec(x2);
  y2 := imin(y2, bitmap.Height); dec(y2);

  for c := 0 to 2 do
  begin
    count[c] := 0;
    avg[c]   := 0;
  end;

  for row := y1 to y2 do
  begin
    px := bitmap.Scanline[row];
    inc(px, x1 * sizeof(TRGB));
    for col := x1 to x2 do
      if not assigned(mask) or mask.IsEmpty or mask.IsPointInside(col + mask.X1, row + mask.Y1) then
        for c := 0 to 2 do
        begin
          avg[c] := avg[c] + px^;
          inc(count[c]);
          inc(px);
        end;
  end;
  for c := 0 to 2 do
    avg[c] := avg[c] / count[c];
end;

procedure IEGetStandardDeviation(bitmap: TIEBitmap; mask: TIEMask; x1, y1, x2, y2: Integer; var stddev: TIEArrayOfDouble); overload;
var
  avg: TIEArrayOfDouble;
  c, row, col: Integer;
  px: pbyte;
  count: Integer;
begin
  // check parameters
  if (Bitmap.Pixelformat <> ie24RGB) then
    exit;

  x2 := imin(x2, bitmap.Width); dec(x2);
  y2 := imin(y2, bitmap.Height); dec(y2);

  SetLength(avg, 3);
  IEGetAverageValues(bitmap, avg);
  count := 0;
  for row := y1 to y2 do
  begin
    px := bitmap.Scanline[row];
    inc(px, x1 * sizeof(TRGB));
    for col := x1 to x2 do
      if not assigned(mask) or mask.IsEmpty or mask.IsPointInside(col + mask.X1, row + mask.Y1) then
      begin
        for c := 0 to 2 do
        begin
          stddev[c] := stddev[c] + sqr(px^ - avg[c]);
          inc(px);
        end;
        inc(count);
      end;
  end;
  if count > 0 then
    for c := 0 to 2 do
      stddev[c] := sqrt( stddev[c] / count )
  else
    for c := 0 to 2 do
      stddev[c] := 0.0;
end;

function IEGetStandardDeviation(bitmap: TIEBitmap; mask: TIEMask; x1, y1, x2, y2: Integer): Double; overload;
var
  stddev: TIEArrayOfDouble;
begin
  SetLength(stddev, 3);
  IEGetStandardDeviation(bitmap, mask, x1, y1, x2, y2, stddev);
  result := (stddev[0] + stddev[1] + stddev[2]) / 3.0;
end;

{!!
<FS>TImageEnProc.CalcStdDev

<FM>Declaration<FC>
function CalcStdDev(): Double;

<FM>Description<FN>
Return the Standard Deviation of the selected region.
!!}
function TImageEnProc.CalcStdDev(): Double;
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  result := 0.0;
  if not BeginImageAnalysis([ie24RGB], x1, y1, x2, y2, ProcBitmap, mask) then
    exit;
  result := IEGetStandardDeviation(ProcBitmap, mask, x1, y1, x2, y2);
  EndImageAnalysis(ProcBitmap);
  DoFinishWork;
end;

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


// Apply filter inside the specified area
// fSel.. in bitmap coordinates
procedure _ApplyFilter(bitmap: TIEBitmap; filter: TGraphFilter; fSelx1, fSely1, fSelx2, fSely2: Integer; var Progress: TProgressRec);
var
  x, y: Integer;
  newbitmap: TIEBitmap;
  mxh: Integer;
  l1, l2, l3: pRGBROW;
  lr1, lr3: Integer;
  px: pRGB;
  xl, xr, q, w: Integer;
  multix: array[0..8, 0..255] of integer;
  bitmapwidth1: Integer;
  lper, per: Integer;
begin
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  fSelX2 := imin(fSelX2, bitmap.Width); dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  if filter.divisor = 0 then
    filter.divisor := 1;
  // calc multix
  with filter do
    for q := 0 to 255 do
    begin
      w := 0;
      for x := 0 to 2 do
        for y := 0 to 2 do
        begin
          multix[w][q] := Values[x][y] * q;
          inc(w);
        end;
    end;
  //
  newbitmap := TIEBitmap.create;
  newbitmap.Allocate(bitmap.Width, bitmap.Height, ie24RGB);
  mxh := bitmap.Height - 1;
  Progress.per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  lper := -1;
  bitmapwidth1 := bitmap.width - 1;
  for y := fSelY1 to fSelY2 do
  begin
    lr1 := ilimit(y - 1, 0, mxh);
    l1 := PRGBROW(bitmap.GetRow(lr1));
    l2 := PRGBROW(bitmap.GetRow(y));
    lr3 := ilimit(y + 1, 0, mxh);
    l3 := PRGBROW(bitmap.GetRow(lr3));
    px := PRGB(newbitmap.Scanline[y]);
    inc(px, fSelX1);
    for x := fSelX1 to fSelX2 do
      with filter do
      begin
        xl := imax(x - 1, 0);
        xr := imin(x + 1, bitmapwidth1);
        px^.r := blimit(abs(multix[0, l1[xl].r] + multix[1, l1[x].r] + multix[2, l1[xr].r] +
          multix[3, l2[xl].r] + multix[4, l2[x].r] + multix[5, l2[xr].r] +
          multix[6, l3[xl].r] + multix[7, l3[x].r] + multix[8, l3[xr].r]) div Divisor);
        px^.g := blimit(abs(multix[0, l1[xl].g] + multix[1, l1[x].g] + multix[2, l1[xr].g] +
          multix[3, l2[xl].g] + multix[4, l2[x].g] + multix[5, l2[xr].g] +
          multix[6, l3[xl].g] + multix[7, l3[x].g] + multix[8, l3[xr].g]) div Divisor);
        px^.b := blimit(abs(multix[0, l1[xl].b] + multix[1, l1[x].b] + multix[2, l1[xr].b] +
          multix[3, l2[xl].b] + multix[4, l2[x].b] + multix[5, l2[xr].b] +
          multix[6, l3[xl].b] + multix[7, l3[x].b] + multix[8, l3[xr].b]) div Divisor);
        inc(px);
      end;
    with Progress do
      if assigned(fOnProgress) then
      begin
        per := trunc(per1 * (y - fSelY1 + 1));
        if per<>lper then
        begin
          fOnProgress(Sender, per);
          lper := per;
        end;
      end;
    bitmap.FreeRow(lr3);
    bitmap.FreeRow(y);
    bitmap.FreeRow(lr1);
  end;
  newbitmap.CopyRectTo(bitmap, fSelX1, fSelY1, fSelX1, fSelY1, fSelX2 - fSelX1 + 1, fSelY2 - fSelY1 + 1, false);
  FreeAndNil(newbitmap);
end;

procedure _ApplyFilter8g(bitmap: TIEBitmap; filter: TGraphFilter; fSelx1, fSely1, fSelx2, fSely2: Integer);
var
  x, y: Integer;
  newbitmap: TIEBitmap;
  mxh: Integer;
  l1, l2, l3: pbytearray;
  lr1, lr3: Integer;
  px: pbyte;
  xl, xr, q, w: Integer;
  multix: array[0..8, 0..255] of integer;
  bitmapwidth1: Integer;
begin
  if Bitmap.Pixelformat <> ie8g then
    exit;
  fSelX2 := imin(fSelX2, bitmap.Width); dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  if filter.divisor = 0 then
    filter.divisor := 1;
  // calc multix
  with filter do
    for q := 0 to 255 do
    begin
      w := 0;
      for x := 0 to 2 do
        for y := 0 to 2 do
        begin
          multix[w][q] := Values[x][y] * q;
          inc(w);
        end;
    end;
  //
  newbitmap := tiebitmap.create;
  newbitmap.Allocate(bitmap.width, bitmap.height, ie8g);
  mxh := bitmap.Height - 1;
  bitmapwidth1 := bitmap.width - 1;
  for y := fSely1 to fSely2 do
  begin
    lr1 := ilimit(y - 1, 0, mxh);
    l1 := pbytearray(bitmap.GetRow(lr1));
    l2 := pbytearray(bitmap.GetRow(y));
    lr3 := ilimit(y + 1, 0, mxh);
    l3 := pbytearray(bitmap.GetRow(lr3));
    px := pbyte(newbitmap.Scanline[y]);
    inc(px, fSelX1);
    for x := fSelx1 to fSelx2 do
      with filter do
      begin
        xl := imax(x - 1, 0);
        xr := imin(x + 1, bitmapwidth1);
        px^ := blimit(abs(multix[0, l1[xl]] + multix[1, l1[x]] + multix[2, l1[xr]] +
          multix[3, l2[xl]] + multix[4, l2[x]] + multix[5, l2[xr]] +
          multix[6, l3[xl]] + multix[7, l3[x]] + multix[8, l3[xr]]) div Divisor);
        inc(px);
      end;
    bitmap.FreeRow(lr3);
    bitmap.FreeRow(y);
    bitmap.FreeRow(lr1);
  end;
  newbitmap.CopyRectTo(bitmap, fSelX1, fSelY1, fSelX1, fSelY1, fSelX2 - fSelX1 + 1, fSelY2 - fSelY1 + 1, false);
  FreeAndNil(newbitmap);
end;

{!!
<FS>TImageEnProc.ApplyFilter

<FM>Declaration<FC>
procedure ApplyFilter(filter: <A TGraphFilter>);

<FM>Description<FN>
Applies a 3x3 filter to the current image (or the selected region).

<FM>Example<FC>
// Apply emboss filter
Const
  filter: TGraphFilter= (Values: ( (-1, 0, 1), (-1, 1, 1), (-1, 0, 1) ); Divisor: 1);
Begin
  ImageEnView1.Proc.ApplyFilter(filter);
End;
!!}
procedure TImageEnProc.ApplyFilter(filter: TGraphFilter);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
  Progress: TProgressRec;
begin
  Progress.fOnProgress := fOnProgress;
  Progress.Sender := Self;
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_APPLYFILTER,
                              {$ELSE}
                              IEMsg( IEMSG_FILTER ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_APPLYFILTER ) then
    exit;
  _ApplyFilter(ProcBitmap, filter, x1, y1, x2, y2, Progress);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

// changes HSL
// fSel.. are in bitmap coordinates
// oHue [-180, +180]
// oSat, oLum [-100, +100]
procedure _HSLvar(bitmap: TIEBitmap; oHue, oSat, oLum: Integer; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  x, y: Integer;
  Hue, Sat, Lum, doHue, doSat, doLum, aSat: Double;
  ppx: pRGB;
  per1: Double;
begin
  if bitmap.Pixelformat <> ie24RGB then
    exit;
  fSelX2 := imin(fSelX2, bitmap.Width); dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  doHue := oHue / 360;
  doSat := oSat / 100;
  doLum := oLum / 100;
  per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  for y := fSelY1 to fSelY2 do
  begin
    ppx := bitmap.ScanLine[y];
    inc(ppx, fSelx1);
    for x := fSelX1 to fSelX2 do
    begin
      // do not try to saturate gray scales (creates out of RGB color space items)
      if (ppx^.r = ppx^.g) and (ppx^.g = ppx^.b) and (doHue = 0) then
        aSat := 0
      else
        aSat := doSat;
      RGB2HSL(ppx^, Hue, Sat, Lum);
      HSL2RGB(ppx^, Hue + doHue, Sat + aSat, Lum + doLum);
      inc(ppx);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (y - fSelY1 + 1)));
  end;
end;


{!!
<FS>TImageEnProc.HSLvar

<FM>Declaration<FC>
procedure HSLvar(oHue, oSat, oLum: Integer);

<FM>Description<FN>
Changes the Hue, Saturation and Luminosity of the selected region.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>oHue<FN></C> <C>Offset to add to the Hue channel, from -180 to +180.</C> </R>
<R> <C><FC>oSat<FN></C> <C>Offset to add to the Saturation channel, from -100 to +100.</C> </R>
<R> <C><FC>oLum<FN></C> <C>Offset to add to the Luminosity channel, from -100 to +100.</C> </R>
</TABLE>

<FM>Examples<FC>
ImageEnView1.Proc.HSLVar(0, -100, 0);   // convert to gray
ImageEnView1.Proc.HSLVar(0, 0, 30);     // increase luminosity
!!}
// Change sHSL inside the specified selection
// fSel.. are in bitmap coordinates
// oHue [-180, +180]
// oSat, oLum [-100, +100]
procedure TImageEnProc.HSLvar(oHue, oSat, oLum: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format( IERS_HSLVAR, [ oHue, oSat, oLum ]),
                              {$ELSE}
                              IEMsg( IEMsg_AdjustHSL ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_HSLVAR ) then
    exit;
  _HSLvar(ProcBitmap, oHue, oSat, oLum, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

// Changes HSV inside the specified selection
// fSel.. are in bitmap coordinates
procedure _HSVvar(bitmap: TIEBitmap; oHue, oSat, oVal: Integer; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  x, y: Integer;
  Hue, Sat, Val: Integer;
  ppx: pRGB;
  per1: Double;
  aSat: Integer;
begin
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  fSelX2 := imin(fSelX2, bitmap.Width); dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  for y := fSely1 to fSely2 do
  begin
    ppx := bitmap.ScanLine[y];
    inc(ppx, fSelx1);
    for x := fSelx1 to fSelx2 do
    begin
      // do not try to saturate gray scales (creates out of RGB color space items)
      if (ppx^.r = ppx^.g) and (ppx^.g = ppx^.b) and (oHue = 0) then
        aSat := 0
      else
        aSat := oSat;
      RGB2HSV(ppx^, Hue, Sat, Val);
      HSV2RGB(ppx^, Hue + oHue, Sat + aSat, Val + oVal);
      inc(ppx);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (y - fSelY1 + 1)));
  end;
end;

{!!
<FS>TImageEnProc.HSVvar

<FM>Declaration<FC>
procedure HSVvar(oHue, oSat, oVal: Integer);

<FM>Description<FN>
Changes the Hue, Saturation and Value of the selected region.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>oHue<FN></C> <C>Offset to add to the Hue channel, from -180 to +180.</C> </R>
<R> <C><FC>oSat<FN></C> <C>Offset to add to the Saturation channel, from -100 to +100.</C> </R>
<R> <C><FC>oVal<FN></C> <C>Offset to add to the Value channel, from -100 to +100.</C> </R>
</TABLE>

<FM>Examples<FC>
ImageEnView1.Proc.HSVvar(0, -100, 0); // convert to gray
ImageEnView1.Proc.HSVvar(0, 0, 30);   // increase luminosity/brightness
!!}
procedure TImageEnProc.HSVvar(oHue, oSat, oVal: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_HSVVAR, [oHue, oSat, oVal]),
                              {$ELSE}
                              IEMsg( IEMsg_AdjustHSV ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_HSVVAR ) then
    exit;
  _HSVvar(ProcBitmap, oHue, oSat, oVal, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

// returns current background color

function TImageEnProc.GetReBackground: TColor;
begin
  if assigned(fImageEnView) then
    result := fImageEnView.Background
  else
    result := fBackground;
end;

{!!
<FS>TImageEnProc.Background

<FM>Declaration<FC>
property Background: TColor;

<FM>Description<FN>
Specifies the color shown in the unoccupied area when the current image is less than the control's size. It is also used also in geometric processing (such as rotation) to fill blank areas.

When TImageEnProc is attached to <A TImageEnView>, TImageEnProc.Background returns the TImageEnView.<A TImageEnView.Background>.
!!}
procedure TImageEnProc.SetReBackground(v: TColor);
begin
  if assigned(fImageEnView) then
    fImageEnView.Background := v
  else
    fBackground := v;
end;


{!!
<FS>TImageEnProc.GetReSel

<FM>Declaration<FC>
function GetReSel(var fSX1, fSY1, fSX2, fSY2: Integer; var PolySel: <A PPointArray>; var PolySelCount: Integer; var mask: <A TIEMask>): Boolean;

<FM>Description<FN>
Returns the selected area of the attached <A TImageEnView>. Returns False if there isn't a selected area.

If a <A TImageEnView> is not attached, it returns the full rect of the bitmap.

Note: This method is the same as accessing <A TImageEnView.SelectionMask>, but returns more information
!!}
// return selected area (bitmap coordinates)
// return true when there is a selected area
// note: x2, y2 are the bottom/right side plus 1
function TImageEnProc.GetReSel(var fSX1, fSY1, fSX2, fSY2: Integer; var PolySel: PPointArray; var PolySelCount: Integer; var mask: TIEMask): Boolean;
var
  ImageEnView: TImageEnView;
begin
  if assigned(fBitmap) then
    fIEBitmap.EncapsulateTBitmap(fBitmap, false); // synchronize fBitmap with fIEBitmap
  PolySelCount := 0;
  mask := nil;
  // default apply full image
  fSX1 := 0;
  fSY1 := 0;
  fSX2 := fIEBitmap.Width;
  fSY2 := fIEBitmap.Height;
  result := false;
  //
  if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
  begin
    // get selection from TImageEnView
    ImageEnView := fImageEnView as TImageEnView;
    mask := ImageEnView.SelectionMask;
    if ImageEnView.Selected then
    begin
      if not mask.IsEmpty then
      begin
        fSX1 := mask.X1;
        fSY1 := mask.Y1;
        fSX2 := mask.X2 + 1;
        fSY2 := mask.Y2 + 1;
      end;
      PolySel := ImageEnView.PolySelPoints;
      PolySelCount := ImageEnView.PolySelCount;
      result := true;
    end;
  end;
end;

{!!
<FS>TImageEnProc.ApplyFilterPreset

<FM>Declaration<FC>
procedure ApplyFilterPreset(filter: <A TIEFilterPresets>);

<FM>Description<FN>
Applies a preset filter to the current image.

<FC>filter<FN> can be one of the following constants:
  fpNone
  fpBlur
  fpEdge
  fpEmboss
  fpHighPass1
  fpHighPass2
  fpHighPass3
  fpLowPass1
  fpLowPass2

<FM>Example<FC>
ImageEnView1.Proc.ApplyFilterPreset(fpEdge);
!!}
procedure TImageEnProc.ApplyFilterPreset(filter: TIEFilterPresets);
begin
  ApplyFilter(PIEGraphFilter(IEFiltPres[filter])^);
end;

// clockwise rotate by 90 degrees
procedure _Rot90oEx(bakbmp: TIEBitmap; newbitmap: TIEBitmap);
var
  x, y: Integer;
  dx, dy: Integer;
  newpx, oldpx: pRGB;
begin
  dx := bakbmp.width;
  dy := bakbmp.Height;
  newbitmap.Allocate(dy, dx, bakbmp.PixelFormat);
  for x := 0 to dx - 1 do
  begin
    newpx := newbitmap.ScanLine[x];
    for y := 0 to dy - 1 do
    begin
      oldpx := bakbmp.scanline[dy - y - 1];
      inc(oldpx, x);
      newpx^ := oldpx^;
      inc(newpx);
    end;
  end;
end;

// accept ie8g and ie8p

procedure _Rot90oEx8(bakbmp: TIEBitmap; newbitmap: TIEBitmap);
var
  x, y: Integer;
  dx, dy: Integer;
  newpx, oldpx: pbyte;
begin
  dx := bakbmp.width;
  dy := bakbmp.Height;
  newbitmap.Allocate(dy, dx, bakbmp.PixelFormat);
  for x := 0 to dx - 1 do
  begin
    newpx := newbitmap.ScanLine[x];
    for y := 0 to dy - 1 do
    begin
      oldpx := bakbmp.scanline[dy - y - 1];
      inc(oldpx, x);
      newpx^ := oldpx^;
      inc(newpx);
    end;
  end;
end;

// rotates counter-clockwise by 90 degrees
procedure _Rot90Ex(bakbmp: TIEBitmap; newbitmap: TIEBitmap);
var
  x, y: Integer;
  dx, dy: Integer;
  newpx, oldpx: pRGB;
begin
  dx := bakbmp.width;
  dy := bakbmp.Height;
  newbitmap.Allocate(dy, dx, bakbmp.PixelFormat);
  for x := 0 to dx - 1 do
  begin
    newpx := newbitmap.ScanLine[dx - x - 1];
    for y := 0 to dy - 1 do
    begin
      oldpx := bakbmp.scanline[y];
      inc(oldpx, x);
      newpx^ := oldpx^;
      inc(newpx);
    end;
  end;
end;

// accept ie8g and ie8p

procedure _Rot90Ex8(bakbmp: TIEBitmap; newbitmap: TIEBitmap);
var
  x, y: Integer;
  dx, dy: Integer;
  newpx, oldpx: pbyte;
begin
  dx := bakbmp.width;
  dy := bakbmp.Height;
  newbitmap.Allocate(dy, dx, bakbmp.PixelFormat);
  for x := 0 to dx - 1 do
  begin
    newpx := newbitmap.ScanLine[dx - x - 1];
    for y := 0 to dy - 1 do
    begin
      oldpx := bakbmp.scanline[y];
      inc(oldpx, x);
      newpx^ := oldpx^;
      inc(newpx);
    end;
  end;
end;

// resize the bitmap without loss its content

{!!
<FS>TImageEnProc.ImageResize

<FM>Declaration<FC>
procedure ImageResize(newWidth, newHeight: Integer; HorizAlign: <A TIEHAlign> = iehLeft; VertAlign: <A TIEVAlign> = ievTop; FillAlpha: Integer = 255); overload;
procedure ImageResize(AddLeft, AddTop, AddRight, AddBottom: integer; FillAlpha: Integer); overload;

<FM>Description<FN>
Resizes the current image. The content of the image doesn't change (no stretching).

Overload 1:
<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>NewWidth<FN></C> <C>New image width</C> </R>
<R> <C><FC>NewHeight<FN></C> <C>New image height</C> </R>
<R> <C><FC>FillAlpha<FN></C> <C>Alpha value used to fill added regions (0: Fully Transparent - 255: Opaque)</C> </R>
<R> <C><FC>HorizAlign<FN></C> <C>Specifies how to horizontally align the old image</C> </R>
<R> <C><FC>VertAlign<FN></C> <C>Specifies how to vertically align the old image</C> </R>
</TABLE>

Overload 2:
<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>AddLeft<FN></C> <C>Pixels to add to the left of the image (or remove if AddLeft < 0)</C> </R>
<R> <C><FC>AddTop<FN></C> <C>Pixels to add to the top of the image (or remove if AddTop < 0)</C> </R>
<R> <C><FC>AddRight<FN></C> <C>Pixels to add to the right of the image (or remove if AddRight < 0)</C> </R>
<R> <C><FC>AddBottom<FN></C> <C>Pixels to add to the bottom of the image (or remove if AddBottom < 0)</C> </R>
<R> <C><FC>FillAlpha<FN></C> <C>Alpha value used to fill added regions (0: Fully Transparent - 255: Opaque)</C> </R>
</TABLE>

Note: The color of added background is specified by <A TImageEnProc.Background>

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\Resize\Resize.dpr </C> </R>
</TABLE>

<FM>Examples<FC>
// resize image to 1000x1000
ImageEnView1.Proc.ImageResize( 1000, 1000 );

// make a contour around the image
ImageEnView1.Proc.ImageResize( ImageEnView1.IEBitmap.Width + 80, ImageEnView1.IEBitmap.Height + 80, iehCenter, ievCenter );

// which is the same as:
ImageEnView1.Proc.ImageResize( 80, 80, 80, 80, clBlack, 255 );

// Add 50 pixels to the top and bottom of the image, remove 80 pixels from the left and right
ImageEnView1.Proc.ImageResize( -80, 50, -80, 50 );
!!}
procedure TImageEnProc.ImageResize(newWidth, newHeight: Integer; HorizAlign: TIEHAlign = iehLeft; VertAlign: TIEVAlign = ievTop; FillAlpha: Integer = 255);
begin
  if not MakeConsistentBitmap([]) then
    exit;
  if (newWidth <= 0) or (newHeight <= 0) or ((newWidth = fIEBitmap.Width) and (newHeight = fIEBitmap.Height)) then
    exit;

  if fAutoUndo then
    SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
             Format(IERS_RESIZE, [NewWidth, NewHeight]),
             {$ELSE}
             Format(IEMsg( IEMSG_ResizeCanvasXX ), [NewWidth, NewHeight]),
             {$ENDIF}
             ieuImage, True, IEOP_RESIZE );

  if (fIEBitmap.Width < 2) and (fIEBitmap.Height < 2) then
    // image empty
    Clear;
  if FillAlpha < 255 then
    fIEBitmap.AlphaChannel; // creates alpha channel if not present
  fIEBitmap.Resize(newWidth, newHeight, GetReBackground, FillAlpha, HorizAlign, VertAlign);
  Update;
  DoFinishWork;
end;

procedure TImageEnProc.ImageResize(AddLeft, AddTop, AddRight, AddBottom: integer; FillAlpha: Integer = 255);
begin
  if not MakeConsistentBitmap([]) then
    exit;
  if ( AddLeft = 0) and ( AddTop = 0) and (AddRight = 0 ) and ( AddBottom = 0 ) then
    exit;

  if (fIEBitmap.Width < 2) and (fIEBitmap.Height < 2) then
  begin
    // image empty
    ImageResize( fIEBitmap.Width + AddLeft + AddRight, fIEBitmap.Height + AddTop + AddBottom, iehLeft, ievTop, FillAlpha );
    exit;
  end;

  if fAutoUndo then
    SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
             Format(IERS_RESIZE, [NewWidth, NewHeight]),
             {$ELSE}
             Format(IEMsg( IEMSG_ResizeCanvasXX ), [ fIEBitmap.Width + AddLeft + AddRight, fIEBitmap.Height + AddTop + AddBottom ]),
             {$ENDIF}
             ieuImage, True, IEOP_RESIZE );

  if FillAlpha < 255 then
    fIEBitmap.AlphaChannel; // creates alpha channel if not present
  fIEBitmap.Resize( AddLeft, AddTop, AddRight, AddBottom, GetReBackground, FillAlpha );
  Update;
  DoFinishWork;
end;


// read filter file 3x3 version 1
function LoadFilterFromFile(const FileName: String): TGraphFilter;
var
  bb, dx, dy: byte;
  fr: TFileStream;
begin
  fr := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  fr.Read(bb, 1); // version
  fr.Read(dx, 1); // width (byte) = 3
  fr.Read(dy, 1); // height (byte) = 3
  if (bb <> 1) or (dx <> 3) or (dy <> 3) then
    FreeAndNil(fr)
  else
  begin
    // load
    fr.read(result, sizeof(TGraphFilter));
    FreeAndNil(fr);
  end;
end;

// write 3x3 filter (version 1)
procedure SaveFilterToFile(const FileName: String; const filt: TGraphFilter);
var
  bb: byte;
  fw: TFileStream;
begin
  fw := TFileStream.Create(FileName, fmCreate);
  bb := 1;
  fw.Write(bb, 1); // v.1
  bb := 3;
  fw.Write(bb, 1);
  fw.Write(bb, 1); // 3x3
  fw.Write(filt, sizeof(TGraphFilter));
  FreeAndNil(fw);
end;

// applies contrast to the specified area
(*
procedure _ContrastRGB(bitmap: TIEBitmap; vv: Integer; mR, mG, mB: Integer; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  vi: Integer;
  x, y: Integer;
  ppx: pRGB;
  per1: Double;
  LUTR: array [0..255] of byte;
  LUTG: array [0..255] of byte;
  LUTB: array [0..255] of byte;
begin
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  if vv >= 0 then
    vi := trunc((1 + vv / 10) * 65536)
  else
    vi := trunc((1 - sqrt(-vv) / 10) * 65536);

  for x := 0 to 255 do
  begin
    LUTR[x] := blimit(mR + (((x - mR) * vi) div 65536));
    LUTG[x] := blimit(mG + (((x - mG) * vi) div 65536));
    LUTB[x] := blimit(mB + (((x - mB) * vi) div 65536));
  end;

  per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  for y := fSely1 to fSely2 do
  begin
    ppx := bitmap.ScanLine[y];
    inc(ppx, fSelX1);
    for x := fSelX1 to fSelX2 do
    begin
      with ppx^ do
      begin
        r := LUTR[r];
        g := LUTG[g];
        b := LUTB[b];
      end;
      inc(ppx);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (y - fSelY1 + 1)));
  end;
end;
//*)
procedure _ContrastRGB(bitmap: TIEBitmap; vv: Double; mR, mG, mB: Integer; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  vi: Double;
  x, y: Integer;
  ppx: pRGB;
  per1: Double;
  LUTR: array [0..255] of byte;
  LUTG: array [0..255] of byte;
  LUTB: array [0..255] of byte;
begin
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  if vv >= 0 then
    vi := 1 + vv / 10
  else
    vi := 1 - sqrt(-vv) / 10;

  for x := 0 to 255 do
  begin
    LUTR[x] := blimit( round( mR + ((x - mR) * vi) ) );
    LUTG[x] := blimit( round( mG + ((x - mG) * vi) ) );
    LUTB[x] := blimit( round( mB + ((x - mB) * vi) ) );
  end;

  per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  for y := fSely1 to fSely2 do
  begin
    ppx := bitmap.ScanLine[y];
    inc(ppx, fSelX1);
    for x := fSelX1 to fSelX2 do
    begin
      with ppx^ do
      begin
        r := LUTR[r];
        g := LUTG[g];
        b := LUTB[b];
      end;
      inc(ppx);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (y - fSelY1 + 1)));
  end;
end;

{!!
<FS>TImageEnProc.ConvertToGray

<FM>Declaration<FC>
procedure ConvertToGray;

<FM>Description<FN>
Converts the selected region to gray levels. The image always will be in true color (16M of colors).
When <A TImageEnView.LegacyBitmap> is True, ImageEn can handle only black & white (pf1bit) or true color images (pf24bit).

Note: ConvertToGray simply sets the R,G,B channels to the same value.

<FM>Example<FC>
ImageEnView1.Proc.ConvertToGray;
!!}
procedure TImageEnProc.ConvertToGray;
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_CONVERTTOGRAY,
                              {$ELSE}
                              IEMsg( IEMsg_ConvertToGray ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_CONVERTTOGRAY ) then
    exit;
  _ConvertToGray(ProcBitmap, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

// Merges selected area of "bitmap" with the full DBitmap
// pcf: merge percentage (100=all of bitmap, 0=all of DBitmap)
// A copy of SrcBitmap will be resized to the specified selection
procedure _Merge(DestBitmap: TIEBitmap; SrcBitmap: TIEBitmap; pcf: Integer; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  x, y: Integer;
  ppx, ppx2: pRGB;
  per1: Double;
  tmpBitmap: TIEBitmap;
  c1, c2: Double;
begin
  if DestBitmap.Pixelformat <> ie24RGB then
    exit;
  fSelX2 := imin(fSelX2, DestBitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, DestBitmap.Height); dec(fSelY2);
  //
  tmpBitmap := TIEBitmap.Create;
  tmpBitmap.Allocate(fSelX2 - fSelX1 + 1, fSelY2 - fSelY1 + 1, ie24RGB);
  _IEBmpStretchEx(SrcBitmap, tmpBitmap, nil, nil);
  //
  per1 := 100 / (fSelY2 - fSelY1 + 0.5); // progress
  c1 := pcf / 100;
  c2 := (100 - pcf) / 100;
  for y := fSelY1 to fSelY2 do
  begin
    ppx := DestBitmap.ScanLine[y];
    ppx2 := tmpBitmap.ScanLine[y - fSelY1];
    inc(ppx, fSelX1);
    for x := fSelX1 to fSelX2 do
    begin
      ppx^.r := blimit(round(ppx^.r * c1 + ppx2^.r * c2));
      ppx^.g := blimit(round(ppx^.g * c1 + ppx2^.g * c2));
      ppx^.b := blimit(round(ppx^.b * c1 + ppx2^.b * c2));
      inc(ppx);
      inc(ppx2);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (y - fSelY1 + 1)));
  end;
  FreeAndNil(tmpBitmap);
end;

{$ifdef IEIncludeDeprecatedInV6}
// Deprecated in 6.2.0 (2015-06-27)
procedure TImageEnProc.MergeIEBitmap(DBitmap: TIEBitmap; pcf: Integer);
begin
  Merge(DBitmap, pcf);
end;
{$endif}

{!!
<FS>TImageEnProc.Merge

<FM>Declaration<FC>
procedure Merge(SrcBitmap: TIEBitmap; pcf: Integer = 50); overload;
procedure Merge(SrcBitmap: TBitmap; pcf: Integer); overload;
procedure Merge(SrcBitmap: TIEBitmap; Mask: <A TIEBitmap>); overload;

<FM>Description<FN>
Merge the current image with the specified bitmap.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC> SrcBitmap <FN></C> <C> Bitmap to merge with the current image </C> </R>
<R> <C><FC> pcf <FN></C> <C> Percentage of current image (100 = only the current image, 0 = only SrcBitmap) </C> </R>
<R> <C><FC> Mask <FN></C> <C> Gray scale (ie8g) mask, which indicates how merge source with the background image (255 = full SrcBitmap, 0 = full background) </C> </R>
</TABLE>

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\FullApps\PhotoEn3\ImageEx.dpr </C> </R>
</TABLE>

<FM>Example<FC>
// Merge 50% of ImageEn2 with ImageEn1
ImageEnView1.Proc.Merge( ImageEnView2.IEBitmap, 50 );
!!}
procedure TImageEnProc.Merge(SrcBitmap: TBitmap; pcf: Integer);
var
  iebmp: TIEBitmap;
begin
  iebmp := TIEBitmap.Create;
  iebmp.EncapsulateTBitmap(SrcBitmap, true);
  Merge(iebmp, pcf);
  FreeAndNil(iebmp);
  DoFinishWork;
end;

procedure TImageEnProc.Merge(SrcBitmap: TIEBitmap; pcf: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_MERGE, [pcf]),
                              {$ELSE}
                              IEMsg( IEMsg_Merge ) + ' ' + IntToStr( pcf ) +'%',
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_MERGE ) then
    exit;
  _Merge(ProcBitmap, SrcBitmap, pcf, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

procedure _MergeWithMask(DestBitmap: TIEBitmap; SrcBitmap: TIEBitmap; Mask: TIEBitmap; x1, y1, x2, y2: Integer);
var
  x, y: Integer;
  p_dest, p_src: PRGB;
  p_msk: pbyte;
  alpha: double;
begin
  if (DestBitmap.Pixelformat <> ie24RGB) or (SrcBitmap.PixelFormat <> ie24RGB) or (Mask.PixelFormat <> ie8g) then
    exit;
  if (DestBitmap.Width <> SrcBitmap.Width) or (DestBitmap.Width <> Mask.Width) or (DestBitmap.Height <> SrcBitmap.Height) or (DestBitmap.Height <> Mask.Height) then
    exit;
    
  x2 := imin(x2, DestBitmap.Width);  dec(x2);
  y2 := imin(y2, DestBitmap.Height); dec(y2);

  for y := y1 to y2 do
  begin
    p_src  := SrcBitmap.ScanLine[y];
    p_dest := DestBitmap.ScanLine[y];
    p_msk  := Mask.ScanLine[y];

    inc(p_src, x1);
    inc(p_dest, x1);
    inc(p_msk, x1);
    for x := x1 to x2 do
    begin
      alpha := p_msk^ / 255.0;
      p_dest^.r := trunc(p_dest^.r * (1 - alpha) + p_src^.r * (alpha));
      p_dest^.g := trunc(p_dest^.g * (1 - alpha) + p_src^.g * (alpha));
      p_dest^.b := trunc(p_dest^.b * (1 - alpha) + p_src^.b * (alpha));
      inc(p_src);
      inc(p_dest);
      inc(p_msk);
    end;
  end;
end;

procedure TImageEnProc.Merge(SrcBitmap: TIEBitmap; Mask: TIEBitmap);
var
  ProcBitmap: TIEBitmap;
  msk: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_MERGEWITHMASK, []),
                              {$ELSE}
                              IEMsg( IEMsg_MERGEWITHMASK ),
                              {$ENDIF}
                              ProcBitmap, msk, IEOP_MERGEWITHMASK ) then
    exit;
  _MergeWithMask(ProcBitmap, SrcBitmap, Mask, x1, y1, x2, y2);
  EndImageProcessing(ProcBitmap, msk);
  DoFinishWork;
end;


// sets a color range to a specified color
procedure _CastColorRange(bitmap: TIEBitmap; BeginColor, EndColor, CastColor: TRGB; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  x, y: Integer;
  e: pRGB;
  per1: Double;
begin
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  for y := fSely1 to fSely2 do
  begin
    e := bitmap.ScanLine[y];
    inc(e, fSelx1);
    for x := fSelx1 to fSelx2 do
    begin
      if (e^.r >= BeginColor.r) and (e^.g >= BeginColor.g) and (e^.b >= BeginColor.b) and
        (e^.r <= EndColor.r) and (e^.g <= EndColor.g) and (e^.b <= EndColor.b) then
        e^ := CastColor;
      inc(e);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (y - fSelY1 + 1)));
  end;
end;

// Performs threshold
// Assign DownVal to all pixels which have values less than DownLimit and
// UpVal to all pixels upper than UpLimit.
procedure IEApplyThreshold(bitmap: TIEBitmap; DownLimit, UpLimit, DownVal, UpVal: TRGB; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  x, y: Integer;
  e: pRGB;
  per1: Double;
begin
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  if EqualRGB(DownLimit, CreateRGB(0, 0, 0)) and EqualRGB(UpLimit, CreateRGB(255, 255, 255)) then
    exit;
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  for y := fSely1 to fSely2 do
  begin
    e := bitmap.ScanLine[y];
    inc(e, fSelx1);
    for x := fSelx1 to fSelx2 do
    begin
      if (e^.r <= DownLimit.r) then
        e^.r := DownVal.r;
      if (e^.g <= DownLimit.g) then
        e^.g := DownVal.g;
      if (e^.b <= DownLimit.b) then
        e^.b := DownVal.b;
      if (e^.r > UpLimit.r) then
        e^.r := UpVal.r;
      if (e^.g > UpLimit.g) then
        e^.g := UpVal.g;
      if (e^.b > UpLimit.b) then
        e^.b := UpVal.b;
      inc(e);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (y - fSelY1 + 1)));
  end;
end;


{!!
<FS>TImageEnProc.Threshold

<FM>Declaration<FC>
procedure Threshold(DownLimit, UpLimit, DownVal, UpVal: <A TRGB>);

<FM>Description<FN>
Assigns the DownVal color to all colors smaller or equal to DownLimit, and UpVal to all colors greater than UpLimit.

<FM>Example<FC>       
// Change all values less than R/G/B of 64 to black
ImageEn.Proc.Threshold(CreateRGB(64, 64, 64), CreateRGB(255, 255, 255), CreateRGB(0, 0, 0), CreateRGB(255, 255, 255));

// Change all values greater than R/G/B of 192 to white
ImageEn.Proc.Threshold(CreateRGB(0, 0, 0), CreateRGB(192, 192, 192), CreateRGB(0, 0, 0), CreateRGB(255, 255, 255));

// Change values with a red value greater than 192 to pure red
ImageEn.Proc.Threshold(CreateRGB(0, 0, 0), CreateRGB(192, 0, 0), CreateRGB(0, 0, 0), CreateRGB(255, 0, 0));

<FM>See Also<FN>
- <A CreateRGB>
- <A TRGB2TColor>
- <A TColor2TRGB>
!!}
// Performs threshold
// look at _Threshold
procedure TImageEnProc.Threshold(DownLimit, UpLimit, DownVal, UpVal: TRGB);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_THRESHOLD,
                              {$ELSE}
                              IEMsg( IEMSG_THRESHOLD ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_THRESHOLD ) then
    exit;
  IEApplyThreshold(ProcBitmap, DownLimit, UpLimit, DownVal, UpVal, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


procedure IEThreshold2(bitmap: TIEBitmap; LoThreshold, HiThreshold: Integer; Red, Green, Blue: Boolean; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  LoKonstant: Double;
  HiKonstant: Double;
  x, y: Integer;
  RGB: PRGB;
  per1: Double;
  LUT: array [0..255] of byte;
begin
  if Bitmap.Pixelformat <> ie24RGB then
    exit;

  if LoThreshold = 0 then
    LoKonstant := 255
  else
    LoKonstant := 255 / LoThreshold;

  if HiThreshold = 0 then
    HiKonstant := 255
  else
    HiKonstant := 255 / HiThreshold;

  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  per1 := 100 / (fSelY2 - fSelY1 + 0.5);

  // calculates the LUT
  for x := 0 to 255 do
  begin
    LUT[x] := blimit(trunc( x + ((255 - x) / LoKonstant) ));
    if LUT[x]>LoThreshold then
      LUT[x] := trunc(LUT[x]/HiKonstant);
  end;

  for y := fSely1 to fSely2 do
  begin
    RGB := bitmap.Scanline[y];
    for x := fSelx1 to fSelx2 do
    begin
      with RGB^ do
      begin
        if Red then
          r := LUT[r];
        if Green then
          g := LUT[g];
        if Blue then
          b := LUT[b];
      end;
      inc(RGB);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (y - fSelY1 + 1)));
  end;

end;

{!!
<FS>TImageEnProc.Threshold2

<FM>Declaration<FC>
procedure Threshold2(LoThreshold, HiThreshold: Integer; Red, Green, Blue: Boolean);

<FM>Description<FN>
This is a variant of <A TImageEnProc.Threshold>.
LoThreshold and HiThreshold specify the low and high pixel value.
Red, Green and Blue specify where to apply the threshold operation.
!!}
procedure TImageEnProc.Threshold2(LoThreshold, HiThreshold: Integer; Red, Green, Blue: Boolean);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_THRESHOLD2,
                              {$ELSE}
                              IEMsg( IEMSG_THRESHOLD ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_THRESHOLD2 ) then
    exit;
  IEThreshold2(ProcBitmap, LoThreshold, HiThreshold, Red, Green, Blue, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


{!!
<FS>TImageEnProc.HistAutoEqualize

<FM>Declaration<FC>
procedure HistAutoEqualize;

<FM>Description<FN>
Equalizes the color histogram of the selected region.

<FM>Example<FC>
ImageEnView1.Proc.HistAutoEqualize;
!!}
procedure TImageEnProc.HistAutoEqualize;
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_HISTAUTOEQUALIZE,
                              {$ELSE}
                              IEMsg( IEMsg_HISTAUTOEQUALIZE ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_HISTAUTOEQUALIZE ) then
    exit;
  _HistAutoEqualize(ProcBitmap, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

// Automatically equalizes the image histogram
procedure _HistAutoEqualize(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  x, y, i, mxh, xl, xr: Integer;
  e, s: pRGB;
  per1: Double;
  Hist: TIEHistogram;
  Left, Right: array[0..255] of integer;
  current: Integer;
  newbitmap: TIEBitmap;
  average: TRGB;
  gaverage: Integer;
  l1, l2, l3: pRGBROW;
  i1, i3: Integer;
  g: Integer;
  bitmapwidth1: Integer;
  n_av, total: Double;
  RedToGrayCoef, GreenToGrayCoef, BlueToGrayCoef: Integer;
begin
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  Hist := IEGetHistogram(bitmap, 0, 0, bitmap.width - 1, bitmap.height - 1, nil, [iehcRed, iehcGreen, iehcBlue, iehcGray]);
  n_av := bitmap.width * bitmap.height / 256;
  //
  current := 0;
  total := 0;
  for i := 0 to 255 do
  begin
    left[i] := blimit(current);
    total := total + Hist[i].gray;
    while total > n_av do
    begin
      total := total - n_av;
      inc(current);
    end;
    right[i] := blimit(current);
  end;

  RedToGrayCoef   := IEGlobalSettings().RedToGrayCoef;
  GreenToGrayCoef := IEGlobalSettings().GreenToGrayCoef;
  BlueToGrayCoef  := IEGlobalSettings().BlueToGrayCoef;

  mxh := bitmap.Height - 1;
  newbitmap := TIEBitmap.create;
  newbitmap.Allocate(bitmap.width, bitmap.height, ie24RGB);
  bitmapwidth1 := bitmap.width - 1;
  for y := fSely1 to fSely2 do
  begin
    e := bitmap.GetRow(y);
    s := newbitmap.ScanLine[y];
    inc(e, fSelx1);
    inc(s, fSelx1);
    i1 := ilimit(y - 1, 0, mxh);
    l1 := bitmap.GetRow(i1);
    l2 := pRGBROW(e);
    i3 := ilimit(y + 1, 0, mxh);
    l3 := bitmap.GetRow(i3);
    for x := fSelx1 to fSelx2 do
    begin
      xl := imax(x - 1, 0);
      xr := imin(x + 1, bitmapwidth1);
      average.r := blimit((l1[xl].r + l1[x].r + l1[xr].r +
        l2[xl].r + l2[x].r + l2[xr].r +
        l3[xl].r + l3[x].r + l3[xr].r) div 9);
      average.g := blimit((l1[xl].g + l1[x].g + l1[xr].g +
        l2[xl].g + l2[x].g + l2[xr].g +
        l3[xl].g + l3[x].g + l3[xr].g) div 9);
      average.b := blimit((l1[xl].b + l1[x].b + l1[xr].b +
        l2[xl].b + l2[x].b + l2[xr].b +
        l3[xl].b + l3[x].b + l3[xr].b) div 9);
      gaverage := (average.r * RedToGrayCoef + average.g * GreenToGrayCoef + average.b * BlueToGrayCoef) div 100;
      g := (e^.r * RedToGrayCoef + e^.g * GreenToGrayCoef + e^.b * BlueToGrayCoef) div 100;
      //
      if left[g] = right[g] then
      begin
        s^.r := left[e^.r];
        s^.g := left[e^.g];
        s^.b := left[e^.b];
      end
      else
      begin
        if gaverage > right[g] then
        begin
          s^.r := right[e^.r];
          s^.g := right[e^.g];
          s^.b := right[e^.b];
        end
        else
        if gaverage < left[g] then
        begin
          s^.r := left[e^.r];
          s^.g := left[e^.g];
          s^.b := left[e^.b];
        end
        else
        begin
          s^.r := average.r;
          s^.g := average.g;
          s^.b := average.b;
        end;
      end;
      //
      inc(e);
      inc(s);
    end;
    bitmap.FreeRow(y);
    bitmap.FreeRow(i1);
    bitmap.FreeRow(i3);
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (y - fSelY1 + 1)));
  end;
  newbitmap.CopyRectTo(bitmap, fSelX1, fSelY1, fSelX1, fSelY1, (fSelX2 - fSelX1 + 1), (fSelY2 - fSelY1 + 1), false);
  FreeAndNil(newbitmap);
end;

{!!
<FS>TImageEnProc.HistEqualize

<FM>Declaration<FC>
procedure HistEqualize(LoThresh, HiThresh: <A TRGB>);

<FM>Description<FN>
Equalize the color histogram of the selected region in the range <FC>LoThresh<FN> to <FC>HiThresh<FN>.

<FM>Example<FC>
// Compress the color histogram in the range LoThresh to HiThresh
var
  LoThresh, HiThresh: TRGB;
Begin
  LoThresh := CreateRGB(50, 50, 50);
  HiThresh := CreateRGB(150, 150, 150);
  ImageEnView1.Proc.HistEqualize(LoThresh, HiThresh);
End;

<FM>See Also<FN>
- <A CreateRGB>
- <A TRGB2TColor>
- <A TColor2TRGB>
!!}
procedure TImageEnProc.HistEqualize(LoThresh, HiThresh: TRGB);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_HISTEQUALIZE,
                              {$ELSE}
                              IEMsg( IEMSG_EQUALIZATION ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_HISTEQUALIZE ) then
    exit;
  IEHistEqualize(ProcBitmap, LoThresh, HiThresh, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

// Equalize Histogram
procedure IEHistEqualize(bitmap: TIEBitmap; LoThresh, HiThresh: TRGB; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  x, y, q: Integer;
  e: pRGB;
  per1: Double;
  LoMap, HiMap: THistogram;
  dx: Integer;
begin
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  HiThresh.r := imax(HiThresh.r, 1);
  HiThresh.g := imax(HiThresh.g, 1);
  HiThresh.b := imax(HiThresh.b, 1);
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  if equalrgb(LoThresh, HiThresh) then
    exit;
  for q := 0 to 255 do
  begin
    // work on LoThreh
    dx := 255 - LoThresh.r;
    if dx = 0 then
      dx := 1;
    LoMap[q].r := blimit(round(((q - LoThresh.r) / dx) * 255));
    dx := 255 - LoThresh.g;
    if dx = 0 then
      dx := 1;
    LoMap[q].g := blimit(round(((q - LoThresh.g) / dx) * 255));
    dx := 255 - LoThresh.b;
    if dx = 0 then
      dx := 1;
    LoMap[q].b := blimit(round(((q - LoThresh.b) / dx) * 255));
    // work on HiThresh
    HiMap[q].r := blimit(round((q / HiThresh.r) * 255));
    HiMap[q].g := blimit(round((q / HiThresh.g) * 255));
    HiMap[q].b := blimit(round((q / HiThresh.b) * 255));
  end;
  for y := fSely1 to fSely2 do
  begin
    e := bitmap.ScanLine[y];
    inc(e, fSelx1);
    for x := fSelx1 to fSelx2 do
    begin
      e^.r := LoMap[e^.r].r;
      e^.r := HiMap[e^.r].r;
      e^.g := LoMap[e^.g].g;
      e^.g := HiMap[e^.g].g;
      e^.b := LoMap[e^.b].b;
      e^.b := HiMap[e^.b].b;
      //
      inc(e);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (y - fSelY1 + 1)));
  end;
end;

// execute preview dialog
{$IFDEF IEINCLUDEDIALOGIP}
{!!
<FS>TImageEnProc.DoPreviews

<FM>Declaration<FC>
function DoPreviews(pe: <A TPreviewEffects> = [peAll]; IsResizeable: Boolean = true; FormWidth : Integer = -1; FormHeight : Integer = -1; FormLeft : Integer = -1; FormTop: Integer = -1): Boolean;

<FM>Description<FN>
Executes the Image Processing dialog to allow the user to perform various color and image manipulation functions upon the image.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>pe<FN></C> <C>The set of effects to show in the dialog. You may wish to use [peAll], or one of the constants for editing, color adjustment and effect sets: <A ppeColorAdjustments>, <A ppeEditingFunctions> or <A ppeSpecialEffects></C> </R>
<R> <C><FC>IsResizeable<FN></C> <C>If true, the user can enlarge the dialog</C> </R>
<R> <C><FC>FormWidth/FormHeight<FN></C> <C>The initial size of the form. -1 = default value. Dialog size is controlled also by <A TIPDialogParams>.DialogWidth and <A TIPDialogParams>.DialogHeight</C> </R>
<R> <C><FC>FormLeft/FormTop<FN></C> <C>The initial form position. -1 = default value (centered)</C> </R>
</TABLE>

Notes:
- To assign default values, read user specified values or persist values between sessions, use <A TIPDialogParams>
- For peRotate <A TIEImageEnGlobalSettings.DefaultRotateAntiAlias> specifies whether anti-alias is used
- For peResize <A TIEImageEnGlobalSettings.DefaultResampleFilter> specifies the resampling filter that it used to improve the quality
- peSoftShadow is not available if you have not <L TImageEnView.EnableAlphaChannel>enabled the alpha channel</L>
- The language used in the dialog is controlled by <A TIEImageEnGlobalSettings.MsgLanguage>. The styling can also be adjusted using <A TIEImageEnGlobalSettings.UseButtonGlyphsInDialogs>
- Most color effects (those in <A ppeColorAdjustments>) have no effect with 1bit images (even though changes may be shown in the preview if a <L TIEImageEnGlobalSettings.DefaultResampleFilter>quality sample</L> is in use)

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\FullApps\PhotoEn3\ImageEx.dpr </C> </R>
</TABLE>

<FM>Examples<FC>
ImageEnView1.Proc.DoPreviews( [ peAll ] );                      // Show all effects

ImageEnView1.Proc.DoPreviews( ppeColorAdjustments );            // Prompt to perform color adjustment

<IMG help_images\AdjustColors.gif>

ImageEnView1.Proc.DoPreviews( ppeSpecialEffects );              // Prompt to perform special effects

<IMG help_images\ImageEffects.gif>

ImageEnView1.Proc.DoPreviews( ppeSpecialEffects );              // Prompt to edit image

<IMG help_images\CropEffect.jpg>

ImageEnView1.Proc.PreviewsParams := ImageEnView1.Proc.PreviewsParams + [ prppDefaultLockPreview ];  // Default to preview
ImageEnView1.Proc.DoPreviews( [ peContrast, peUserFilt ] );     // Show contrast and user filters

// Prompt for image editing functions with best quality output
IEGlobalSettings().DefaultRotateAntiAlias := ierBicubic;
IEGlobalSettings().DefaultResampleFilter := rfLanczos3;
ImageEnView1.Proc.DoPreviews( ppeEditingFunctions );

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.IPDialogParams></C> </R>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.PreviewFont></C> </R>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.PreviewFontEnabled></C> </R>
<R> <C_IMG_PROPERTY> <C><A TImageEnProc.PreviewsLog></C> </R>
<R> <C_IMG_PUBLISHED> <C><A TImageEnProc.PreviewsParams></C> </R>
</TABLE>
!!}
function TImageEnProc.DoPreviews(pe: TPreviewEffects; IsResizeable: Boolean; FormWidth: Integer; FormHeight: Integer; FormLeft: Integer; FormTop: Integer): Boolean;
var
  fPreviews: TfPreviews;
  x1, y1, x2, y2: Integer;
  fPolyS: PPointArray;
  fPolySCount: Integer;
  mask: TIEMask;
begin
  CheckHaveValidBitmap();

  result := false;
  if assigned(fImageEnView) then
    fImageEnView.GetCanvas.Lock;
  try
    if not MakeConsistentBitmap([]) then
      exit;
    if (fIEBitmap.Width < 2) and (fIEBitmap.Height < 2) then
      exit;
    GetReSel(x1, y1, x2, y2, fPolyS, fPolySCount, mask);
    fPreviews := TfPreviews.Create(self);
    if IsResizeable then
    begin
      fPreviews.BorderIcons := [biSystemMenu, biMaximize];
      fPreviews.BorderStyle := bsSizeable;
    end
    else
    begin
      fPreviews.BorderIcons := [biSystemMenu];
      fPreviews.BorderStyle := bsDialog;
    end;
    fPreviews.ImageEn1.Background := Background;
    fPreviews.ImageEn2.Background := Background;
    fPreviews.pnlRotateBackground.Color := Background;
    fPreviews.pnlCropBackground.Color := Background;

    if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
    begin
      fPreviews.ImageEn1.EnableAlphaChannel := TImageEnView(fImageEnView).EnableAlphaChannel;
      fPreviews.ImageEn2.EnableAlphaChannel := TImageEnView(fImageEnView).EnableAlphaChannel;
    end;   

    if FormWidth > 0 then
      fPreviews.Width := FormWidth
    else
    if fIPDialogParams.DialogWidth > 0 then
      fPreviews.Width := fIPDialogParams.DialogWidth
    else
      fPreviews.ClientWidth := trunc(Default_Preview_Dialog_ClientWidth * (fPreviews.PixelsPerInch / 96));
    if FormHeight > 0 then
      fPreviews.Height := FormHeight
    else
    if fIPDialogParams.DialogHeight > 0 then
      fPreviews.Height := fIPDialogParams.DialogHeight
    else
      fPreviews.ClientHeight := trunc(Default_Preview_Dialog_ClientHeight * (fPreviews.PixelsPerInch / 96));
    if (FormLeft >= 0) or (FormTop >= 0) then
    begin
      fPreviews.Left := FormLeft;
      fPreviews.Top  := FormTop;
      fPreviews.Position := poDesigned;
    end
    else
      fPreviews.Position := poScreenCenter;
    fPreviews.DefaultLockPreview := prppDefaultLockPreview in PreviewsParams;
    fPreviews.ShowReset := prppShowResetButton in PreviewsParams;
    fPreviews.HardReset := prppHardReset in PreviewsParams;
    fPreviews.ResetAllTabs := not (prppResetSelectedTab in PreviewsParams);
    fPreviews.UpdateLanguage();

    if fPreviewFontEnabled then
      fPreviews.Font.Assign(fPreviewFont)
    else
      fPreviews.Font.Assign(IEGetDefaultDialogFont);

    fPreviews.Progress.fOnProgress := fOnProgress;
    fPreviews.Progress.Sender := self;
    fPreviews.ImageEn1.LegacyBitmap := false;
    fPreviews.OpenDialog1.InitialDir := fFiltersInitialDir;
    fPreviews.SaveDialog1.InitialDir := fFiltersInitialDir;
    with fPreviews do
    begin
      ImageEn1.IEBitmap.Allocate( (x2 - x1), (y2 - y1), fIEBitmap.PixelFormat );
      fIEBitmap.CopyRectTo(ImageEn1.IEBitmap, x1, y1, 0, 0, (x2 - x1), (y2 - y1), true);
      ImageEn1.Proc.MakeConsistentBitmap([ie24RGB]);
      ImageEn1.Update;
      Update;
    end;
    fPreviews.pe := pe;
    fPreviews.InitialPage := nil;
    fPreviews.fIPDialogParams := fIPDialogParams;
    fPreviews.OpList := fPreviewsLog;

    // Use same mouse wheel settings as owner component
    if assigned( fImageEnView ) and ( fImageEnView is TImageEnView ) then
      with TImageEnView( fImageEnView ) do
      begin
        fPreviews.ImageEn1.MouseWheelParams.Assign( MouseWheelParams );
        fPreviews.ImageEn2.MouseWheelParams.Assign( MouseWheelParams );
      end;

    if assigned(fOnPreview) then
      fOnPreview(self, fPreviews);
    if fPreviews.ShowModal = mrOk then
    begin
      result := true;

      // update lock preview
      if fPreviews.DefaultLockPreview then
        PreviewsParams := PreviewsParams + [prppDefaultLockPreview]
      else
        PreviewsParams := PreviewsParams - [prppDefaultLockPreview];

      if fAutoUndo then
        SaveUndo(fPreviews.UndoCaption, ieuImage, True);

      MakeConsistentBitmap([ie24RGB]);

      // apply results
      with fPreviews do
      begin
        if assigned(mask) and (not mask.IsEmpty) and ((x1 > 0) or (y1 > 0) or (x2 <= fIEBitmap.width) or (y2 <= fIEBitmap.Height)) then
        begin
          // polygonal selection
          mask.CopyIEBitmap(fIEBitmap, ImageEn1.IEBitmap, false, true, false);
        end
        else
        begin
          // change size if needed
          fIEBitmap.Width  := ImageEn1.IEBitmap.Width;
          fIEBitmap.Height := ImageEn1.IEBitmap.Height;

          imageen1.IEBitmap.CopyRectTo(fIEBitmap, 0, 0, x1, y1, imageen1.IEBitmap.Width, imageen1.IEBitmap.Height, true);
          if fIEBitmap.HasAlphaChannel then
            fIEBitmap.AlphaChannel.SyncFull();
        end;
      end;
      Update;
    end
    else
      result := false;
    fIPDialogParams.DialogWidth  := fPreviews.Width;
    fIPDialogParams.DialogHeight := fPreviews.Height;
    fPreviews.Release;
  finally
    if assigned(fImageEnView) then
      fImageEnView.GetCanvas.UnLock;
    DoFinishWork;
  end;
end;

{$ENDIF}

{!!
<FS>TImageEnProc.Resample

<FM>Declaration<FC>
procedure Resample(NewWidth, NewHeight: Integer; FilterType: <A TResampleFilter> = rfNone; bMaintainAspectRatio : Boolean = False); overload;
procedure Resample(ScaleBy: Double; FilterType: TResampleFilter = rfNone); overload;

<FM>Description<FN>
Resizes the current image. Unlike <A TImageEnProc.ImageResize>, the content of the image will change (i.e. it is stretched to the new size).

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>NewWidth<FN></C> <C>New image width in pixels. If NewWidth is -1 then it is calculated automatically, respecting the proportions.</C> </R>
<R> <C><FC>NewHeight<FN></C> <C>New image height in pixels. If NewHeight is -1 then it is calculated automatically, respecting the proportions.</C> </R>
<R> <C><FC>FilterType<FN></C> <C>Resampling interpolation algorithm.</C> </R>
<R> <C><FC>bMaintainAspectRatio<FN></C> <C>Automatically reduces NewWidth or NewHeight to ensure the original proportions of the image are maintained</C> </R>
</TABLE>

See also: <A TImageEnProc.ResampleTo>.

<FM>Examples<FC>
ImageEnView1.Proc.Resample(50, -1, rfNone);              // Resize the image to width of 50 (with height automatically set) without any smoothing algorithm
ImageEnView1.Proc.Resample(-1, 100, rfLanczos3);         // Resize the image to height of 100 (with width automatically calculated) and high quality smoothing
ImageEnView1.Proc.Resample(100, 100, rfLanczos3, True);  // Resize the image so that it is no higher or wider than 100, but maintains the original aspect ratio (e.g. a 4:3 portrait image would have the new dimensions 100 x 75)
ImageEnView1.Proc.Resample( 0.5, rfFastLinear );         // Resize the image to half its current size with fast, but good quality smoothing

!!}
// Resample the image to NewWidth and NewHeight
// if NewWidth or NewHeight is -1, it is calculated maintain aspect ratio
// if NewWidth or NewHeight is 0, it doesn't change
procedure TImageEnProc.Resample(NewWidth, NewHeight: Integer; FilterType: TResampleFilter = rfNone; bMaintainAspectRatio : Boolean = False);
var
  newbitmap: TIEBitmap;
begin
  if not MakeConsistentBitmap([]) then
    exit;
  if fIEBitmap.IsEmpty or ((NewWidth = fIEBitmap.Width) and (NewHeight = fIEBitmap.Height)) then
    exit;
  if fAutoUndo then
    SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
             Format(IERS_RESAMPLE, [NewWidth, NewHeight]),
             {$ELSE}
             IEMsg( IEMsg_ResizeImage ),
             {$ENDIF}
             ieuImage, True, IEOP_RESAMPLE );

  newbitmap := TIEBitmap.Create();
  try
    ResampleTo(newbitmap, NewWidth, NewHeight, FilterType, bMaintainAspectRatio); // ResampleTo resizes the bitmap and set pixelformat
    fIEBitmap.Assign(newbitmap);
  finally
    newbitmap.Free();
  end;

  Update;
  DoFinishWork;
end;

procedure TImageEnProc.Resample(ScaleBy: Double; FilterType: TResampleFilter = rfNone); 
begin
  if fIEBitmap.IsEmpty or ( ScaleBy = 0 ) then
    exit;
  Resample( Round( fIEBitmap.Width * ScaleBy ), Round( fIEBitmap.Height * ScaleBy ), FilterType, False );
end;

{!!
<FS>TImageEnProc.ResampleTo

<FM>Declaration<FC>
procedure ResampleTo(Target: <A TIEBitmap>; TargetWidth, TargetHeight: Integer; FilterType: <A TResampleFilter>);

<FM>Description<FN>
Copies a resized instance of the current image to a Target TIEBitmap. The content of the destination image changes (i.e. it is stretched to the new size).

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>Target<FN></C> <C>The target (destination) image.</C> </R>
<R> <C><FC>TargetWidth<FN></C> <C>Width in pixels of the target size. If TargetWidth is -1 then it is calculated automatically, respecting the proportions.</C> </R>
<R> <C><FC>TargetHeight<FN></C> <C>Height in pixels of the target size. If TargetHeight is -1 then it is calculated automatically, respecting the proportions.</C> </R>
<R> <C><FC>FilterType<FN></C> <C>Resampling interpolation algorithm.</C> </R>
<R> <C><FC>bMaintainAspectRatio<FN></C> <C>Automatically reduces NewWidth or NewHeight to ensure the original proportions of the image are maintained</C> </R>
</TABLE>

Resampling black & white (1bit) images with FilterType is not rfNone, Resample converts the image to 24bit.

See also: <A TImageEnProc.Resample>.

<FM>Example<FC>
// Create a thumbnail of image in ImageEnView1 to ImageEnView2.  Height and width are no larger than 100 pixels
ImageEnView1.Proc.ResampleTo( ImageEnView2.IEBitmap, 100, 100, rfFastLinear, True);
ImageEnView2.Update;
!!}
// if TargetWidth or TargetHeight is -1, it is calculated maintain aspect ratio
// if TargetWidth or TargetHeight is 0, it doesn't change
procedure TImageEnProc.ResampleTo(Target: TIEBitmap; TargetWidth, TargetHeight: Integer; FilterType: TResampleFilter; bMaintainAspectRatio : Boolean = False);
begin
  if not MakeConsistentBitmap([]) then
    exit;
  if (fIEBitmap.Width = 0) or (fIEBitmap.Height = 0) then
    exit;

  _IEAdjustResampleDimensions(TargetWidth, TargetHeight, fIEbitmap.Width, fIEbitmap.Height, bMaintainAspectRatio);
  Target.Allocate(TargetWidth, TargetHeight, fIEBitmap.PixelFormat);
  _IEResampleIEBitmap(fIEBitmap, Target, FilterType, fOnProgress, self);
  DoFinishWork;
end;

procedure _IESetAlpha0Color(bitmap: TIEBitmap; cl: TRGB);
var
  x, y: Integer;
  a: pbyte;
  p: PRGB;
  w, h: Integer;
begin
  if bitmap.PixelFormat = ie24RGB then
  begin
    w := bitmap.Width;
    h := bitmap.Height;
    for y := 0 to h - 1 do
    begin
      a := bitmap.AlphaChannel.Scanline[y];
      p := bitmap.Scanline[y];
      for x := 0 to w - 1 do
      begin
        if a^ = 0 then
          p^ := cl;
        inc(p);
        inc(a);
      end;
    end;
  end;
end;


// Adjust iTargetWidth, iTargetHeight by rules of TImageEnProc.ResampleTo
procedure _IEAdjustResampleDimensions(var iTargetWidth, iTargetHeight: Integer; iBitmapWidth, iBitmapHeight : Integer; bMaintainAspectRatio: Boolean);
var
  ARSize : TPoint;
begin
  // Maintain AR cannot be used if both dimensions are not specified
  if (iTargetWidth < 1) or (iTargetHeight < 1) then
    bMaintainAspectRatio := False;

  // check and adjust iTargetWidth and NewHeight
  if (iTargetWidth < 0) and (iTargetHeight < 0) and (bMaintainAspectRatio = False) then
    exit; // ERROR
  case iTargetWidth of
    -1: iTargetWidth := (iBitmapWidth * iTargetHeight) div iBitmapHeight;
     0: iTargetWidth := iBitmapWidth;
    else
      iTargetWidth := abs(iTargetWidth);
  end;
  if iTargetWidth < 1 then
    iTargetWidth := 1;
  case iTargetHeight of
    -1: iTargetHeight := (iBitmapHeight * iTargetWidth) div iBitmapWidth;
    0: iTargetHeight := iBitmapHeight;
  else
    iTargetHeight := abs(iTargetHeight);
  end;
  if iTargetHeight < 1 then
    iTargetHeight := 1;

  if bMaintainAspectRatio then
  begin
    ARSize := GetImageSizeWithinArea(iBitmapWidth, iBitmapHeight, iTargetWidth, iTargetHeight);
    iTargetWidth  := imax(ARSize.X, 1);
    iTargetHeight := imax(ARSize.Y, 1);
  end;
end;


// if FilterType is not rfNone, it must be ie24RGB or ie1g (when rfProjectBW or rfProjectWB)
// Resample also alphachannel
procedure _IEResampleIEBitmap(source, dest: TIEBitmap; FilterType: TResampleFilter; fOnProgress: TIEProgressEvent; Sender: TObject);
begin   
  if (source.Width = dest.Width) and (source.Height = dest.Height) then
  begin
    dest.Assign(source);
    exit;
  end;

  (* issue: 16 Jul 2009, 9:53. Now to remove artifacts due resampling transparent areas it is necessary to manually set transparent areas to gray
  if source.HasAlphaChannel then
    // this avoids transparent color merges with image colors
    _IESetAlpha0Color(source, CreateRGB(128, 128, 128)); *)

  if (FilterType = rfNone) then
    // all pixel formats unfiltered
    _IEBmpStretchEx(source, dest, fOnProgress, Sender)
  else
  if (source.PixelFormat = ie1g) then
  begin
    // 1bit filtered
    if FilterType in [rfProjectBW, rfProjectWB] then
      dest.PixelFormat := ie1g
    else
      dest.PixelFormat := ie24RGB;
    _Resample1BitEx(source, dest, FilterType);
  end
  else
  begin
    // 24bit filtered. Bicubic/bilinear support ie8g, ie16g, ie24rgb, ie48rgb
    _ResampleEx(source, dest, source.AlphaChannelOpt, FilterType, fOnProgress, Sender)
  end;

  if source.HasAlphaChannel then
  begin
    if (FilterType = rfNone) then
      _IEBmpStretchEx(source.AlphaChannel, dest.AlphaChannel, nil, nil)
    else
      _Resampleie8g(source.AlphaChannel, dest.AlphaChannel, FilterType);
    dest.AlphaChannel.Full := source.AlphaChannel.Full;
  end;
end;

procedure _IEResampleIEBitmap2(sourceANDdest: TIEBitmap; FilterType: TResampleFilter; NewWidth, NewHeight: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  temp: TIEBitmap;
begin
  if ( sourceANDdest.Width = NewWidth ) and 
     ( sourceANDdest.Height = NewHeight ) then
    exit;

  temp := TIEBitmap.Create;
  temp.Assign(sourceANDdest);
  sourceANDdest.Resize(NewWidth, NewHeight, 0, 255, iehLeft, ievTop);
  _IEResampleIEBitmap(temp, sourceANDdest, FilterType, fOnProgress, Sender);
  FreeAndNil(temp);
end;

procedure TImageEnProc.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = fImageEnView) and (Operation = opRemove) then
  begin
    fImageEnView.RemoveBitmapChangeEvent(fImageEnViewBitmapChangeHandle);
    fImageEnView := nil;
  end;
  if (AComponent = fTImage) and (Operation = opRemove) then
    fTImage := nil;
end;

// accept all pixelformats

procedure _GetMediaContrastRGB(bitmap: TIEBitmap; var mR, mG, mB: Integer);
var
  w, h, v: Integer;
  tr, tg, tb, ww, hh: Integer;
  x, y: Integer;
  ppx: pRGB;
  bpx: pbyte;
  wpx: pword;
  fpx: psingle;
  pxcmyk: PCMYK;
  pxcielab: PCIELab;
  pxrgb48: PRGB48;
  rgb: TRGB;
begin
  mR := 0;
  mG := 0;
  mB := 0;
  ww := bitmap.Width;
  hh := bitmap.Height;
  w := ww - 1;
  h := hh - 1;
  try
    for y := 0 to h do
    begin
      tr := 0;
      tg := 0;
      tb := 0;
      case bitmap.PixelFormat of
        ie1g: // gray scale (black & white)
          begin
            bpx := bitmap.ScanLine[y];
            for x := 0 to w do
              if pbytearray(bpx)^[x shr 3] and iebitmask1[x and $7] <> 0 then
              begin
                inc(tr, 255);
                inc(tg, 255);
                inc(tb, 255);
              end;
          end;
        ie8p: // color (palette)
          begin
            bpx := bitmap.ScanLine[y];
            for x := 0 to w do
            begin
              with bitmap.Palette[bpx^] do
              begin
                inc(tr, r);
                inc(tg, g);
                inc(tb, b);
              end;
              inc(bpx);
            end;
          end;
        ie8g: // gray scale (256 levels)
          begin
            bpx := bitmap.ScanLine[y];
            for x := 0 to w do
            begin
              inc(tr, bpx^);
              inc(tg, bpx^);
              inc(tb, bpx^);
              inc(bpx);
            end;
          end;
        ie16g: //  gray scale (65536 levels)
          begin
            wpx := bitmap.ScanLine[y];
            for x := 0 to w do
            begin
              inc(tr, wpx^);
              inc(tg, wpx^);
              inc(tb, wpx^);
              inc(wpx);
            end;
          end;
        ie24RGB: // color (true color)
          begin
            ppx := bitmap.ScanLine[y];
            for x := 0 to w do
            begin
              with ppx^ do
              begin
                inc(tr, r);
                inc(tg, g);
                inc(tb, b);
              end;
              inc(ppx);
            end;
          end;
        ie32RGB: // color (true color)
          begin
            bpx := bitmap.ScanLine[y];
            for x := 0 to w do
            begin
              inc(tr, bpx^); inc(bpx);
              inc(tg, bpx^); inc(bpx);
              inc(tb, bpx^); inc(bpx);
              inc(bpx); // bypass
            end;
          end;
        ie32f: //  float point gray scale
          begin
            fpx := bitmap.ScanLine[y];
            for x := 0 to w do
            begin
              v := trunc(fpx^ * 255);
              inc(tr, v);
              inc(tg, v);
              inc(tb, v);
              inc(fpx);
            end;
          end;
        ieCMYK: // CMYK
          begin
            pxcmyk := bitmap.ScanLine[y];
            for x := 0 to w do
            begin
              rgb := IECMYK2RGB(pxcmyk^);
              inc(tr, rgb.r);
              inc(tg, rgb.g);
              inc(tb, rgb.b);
              inc(pxcmyk);
            end;
          end;
        ieCIELab: // CIELab
          begin
            pxcielab := bitmap.ScanLine[y];
            for x := 0 to w do
            begin
              rgb := IECIELAB2RGB(pxcielab^);
              inc(tr, rgb.r);
              inc(tg, rgb.g);
              inc(tb, rgb.b);
              inc(pxcielab);
            end;
          end;
        ie48RGB: // RGB48
          begin
            pxrgb48 := bitmap.ScanLine[y];
            for x := 0 to w do
            begin
              inc(tr, trunc(pxrgb48^.r/255*65535));
              inc(tg, trunc(pxrgb48^.g/255*65535));
              inc(tb, trunc(pxrgb48^.b/255*65535));
              inc(pxrgb48);
            end;
          end;
      end;
      mR := mR + (tr div ww);
      mG := mG + (tg div ww);
      mB := mB + (tb div ww);
    end;
    mR := mR div hh;
    mG := mG div hh;
    mB := mB div hh;
  except
    // on overflow
    mR := 128;
    mG := 128;
    mB := 128;
  end;
end;

{!!
<FS>TImageEnProc.ImageEnVersion

<FM>Declaration<FC>
property ImageEnVersion: String;

<FM>Description<FN>
Returns the ImageEn version as a string.
!!}
function TImageEnProc.GetImageEnVersion: String;
begin
  result := IEMAINVERSION;
end;

procedure TImageEnProc.SetImageEnVersion(Value: String);
begin
  // this is a read-only property, but it must be displayed in object inspector
end;



{!!
<FS>TImageEnProc.GetHistogram

<FM>Declaration<FC>
procedure TImageEnProc.GetHistogram(Hist: pointer; Content: <A TIEHistogramContent> = [iehcRed, iehcGreen, iehcBlue, iehcGray, iehcHue]); overload;
function TImageEnProc.GetHistogram(Content: <A TIEHistogramContent> = [iehcRed, iehcGreen, iehcBlue, iehcGray, iehcHue]): <A TIEHistogram>; overload;

<FM>Description<FN>
First overload fills <FC>Hist<FN> with the histogram of the current image. <FC>Hist<FN> is a pointer to <A THistogram> array (Image will be converted to ie24RGB).
Second overload returns a dynamic array which contains 256, 360 or 65536 items, and works natively with 8 and 16 bit gray scale images.
Content specifies which color component to calculate. If only iehcHue is specified a 360 items histogram is created.
!!}
procedure TImageEnProc.GetHistogram(Hist: pointer; Content: TIEHistogramContent);
var
  fSX1, fSY1, fSX2, fSY2: Integer;
  fPolyS: PPointArray;
  fPolySCount: Integer;
  mask: TIEMask;
  rhist: TIEHistogram;
begin
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  GetReSel(fSX1, fSY1, fSX2, fSY2, fPolyS, fPolySCount, mask);
  SetLength(rhist, 256);  // just to avoid warnings
  rhist := IEGetHistogram(fIEBitmap, fSx1, fSy1, fSx2, fSy2, mask, Content);
  Move(rhist[0], PHistogram(Hist)^[0], 256 * sizeof(THistogramItem));
end;


function TImageEnProc.GetHistogram(Content: TIEHistogramContent): TIEHistogram;
var
  fSX1, fSY1, fSX2, fSY2: Integer;
  fPolyS: PPointArray;
  fPolySCount: Integer;
  mask: TIEMask;
begin
  if not MakeConsistentBitmap([ie8g, ie16g, ie24RGB]) then
    exit;
  GetReSel(fSX1, fSY1, fSX2, fSY2, fPolyS, fPolySCount, mask);
  result := IEGetHistogram(fIEBitmap, fSx1, fSy1, fSx2, fSy2, mask, Content);
end;


// make an histogram of r, g, b and gray channels
function IEGetHistogram(Bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; mask: TIEMask; content: TIEHistogramContent): TIEHistogram;
var
  x, y: Integer;
  rgb: PRGB;
  g8: pbyte;
  g16: pword;
  RedToGrayCoef, GreenToGrayCoef, BlueToGrayCoef: Integer;
  hue, sat, val: Integer;
begin
  if Bitmap.Width = 0 then
    exit; // Not yet initialized

  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  if content = [iehcHue] then
    SetLength(result, 360)
  else
    SetLength(result, 1 shl (Bitmap.BitCount div Bitmap.ChannelCount));
  ZeroMemory(@result[0], length(result) * sizeof(THistogramItem));
  case Bitmap.PixelFormat of
    ie8g:
      begin
        for y := fSely1 to fSely2 do
        begin
          g8 := Bitmap.ScanLine[y];
          inc(g8, fSelx1);
          for x := fSelx1 to fSelx2 do
          begin
            if not assigned(mask) or mask.IsEmpty or mask.IsPointInside(x, y) then
            begin
              if iehcRed in content then
                inc(result[g8^].r);
              if iehcGreen in content then
                inc(result[g8^].g);
              if iehcBlue in content then
                inc(result[g8^].b);
              if iehcGray in content then
                inc(result[g8^].Gray);
            end;
            inc(g8);
          end;
        end;
      end;
    ie16g:
      begin
        for y := fSely1 to fSely2 do
        begin
          g16 := Bitmap.ScanLine[y];
          inc(g16, fSelx1);
          for x := fSelx1 to fSelx2 do
          begin
            if not assigned(mask) or mask.IsEmpty or mask.IsPointInside(x, y) then
            begin
              if iehcRed in content then
                inc(result[g16^].r);
              if iehcGreen in content then
                inc(result[g16^].g);
              if iehcBlue in content then
                inc(result[g16^].b);
              if iehcGray in content then
                inc(result[g16^].Gray);
            end;
            inc(g16);
          end;
        end;
      end;
    ie24RGB:
      begin
        RedToGrayCoef   := IEGlobalSettings().RedToGrayCoef;
        GreenToGrayCoef := IEGlobalSettings().GreenToGrayCoef;
        BlueToGrayCoef  := IEGlobalSettings().BlueToGrayCoef;
        for y := fSely1 to fSely2 do
        begin
          rgb := Bitmap.ScanLine[y];
          inc(rgb, fSelx1);
          for x := fSelx1 to fSelx2 do
          begin
            if not assigned(mask) or mask.IsEmpty or mask.IsPointInside(x, y) then
            begin
              if iehcRed in content then
                inc(result[rgb^.r].r);
              if iehcGreen in content then
                inc(result[rgb^.g].g);
              if iehcBlue in content then
                inc(result[rgb^.b].b);
              if iehcGray in content then
                inc(result[(rgb^.r * RedToGrayCoef + rgb^.g * GreenToGrayCoef + rgb^.b * BlueToGrayCoef) div 100].Gray);
              if iehcHue in content then
              begin
                RGB2HSV(rgb^, hue, sat, val);
                inc(result[trunc(hue / 360 * length(result))].Hue);
              end;
            end;
            inc(rgb);
          end;
        end;
      end;
  end;
end;

// Supports only ie24RGB and ie1g
// return the number of colors in the specified selection
function IEGetImageNumColors(bitmap: TIEBitmap; x1, y1, x2, y2: Integer): Integer;
var
  x, y, c: Integer;
  px: PRGB;
  pb: pbyte;
  hash: TIEIntegerMap;
  has0, has1: boolean;
begin
  result := 0;

  x2 := imin(x2, bitmap.Width);  dec(x2);
  y2 := imin(y2, bitmap.Height); dec(y2);

  case bitmap.PixelFormat of
    ie1g:
      begin
        has0 := false;
        has1 := false;
        for y := y1 to y2 do
        begin
          pb := Bitmap.ScanLine[y];
          for x := x1 to x2 do
          begin
            if _GetPixelbw(pb, x) = 0 then
              has0 := true
            else
              has1 := true;
          end;
          if has0 and has1 then
            break;
        end;
        if has0 then
          inc(result);
        if has1 then
          inc(result);
      end;

    ie24RGB:
      begin
        hash := TIEIntegerMap.Create();
        try
          for y := y1 to y2 do
          begin
            px := Bitmap.ScanLine[y];
            inc(px, x1);
            for x := x1 to x2 do
            begin
              c := (px^.r shl 16) or (px^.g shl 8) or (px^.b);
              hash.Insert(c);
              inc(px);
            end;
          end;
          result := hash.KeysCount;
        finally
          hash.Free();
        end;
      end;
  end;
end;

{!!
<FS>TImageEnProc.CalcImageNumColors

<FM>Declaration<FC>
function CalcImageNumColors(): Integer;

<FM>Description<FN>
Returns the number of colors found in the current image. This value is not constrained by the internal format of the image (e.g. a 24 bit image doesn't necessarily have 16 million colors).
!!}
function TImageEnProc.CalcImageNumColors(): Integer;
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  result := 0;
  if not BeginImageAnalysis([ie24RGB, ie1g], x1, y1, x2, y2, ProcBitmap, mask) then
    exit;
  result := IEGetImageNumColors(fIEBitmap, x1, y1, x2, y2);
  EndImageAnalysis(ProcBitmap);
  DoFinishWork;
end;


{!!
<FS>TImageEnProc.Contrast

<FM>Declaration<FC>
procedure Contrast(vv: Double);

<FM>Description<FN>
Changes the contrast of selected region.
<FC>vv<FN> is the contrast value which may range from -100 to +100, where 0 is no change.

<FM>Example<FC>
ImageEnView1.Proc.Contrast(50);

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Contrast2></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Contrast3></C> </R>
</TABLE>
!!}
procedure TImageEnProc.Contrast(vv: Double);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
  mR, mG, mB: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format( IERS_CONTRAST, [ vv ]),
                              {$ELSE}
                              IEMsg( IEMsg_CONTRAST ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_CONTRAST ) then
    exit;
  _GetMediaContrastRGB(fIEBitmap, mR, mG, mB); // media over full image (not selection)
  _ContrastRGB(ProcBitmap, vv, mR, mG, mB, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

// supports all TIEBitmap pixelformats
function _ConvertTo1bitEx(Bitmap: TIEBitmap; var BackCol, ForeCol: TRGB): TIEBitmap;
var
  x, y, c: Integer;
  e: TRGB;
  d: pbyte;
  hash: TIEIntegerMap;
  bitpos: Integer;
  bb, ff: byte;
  t: TRGB;
  bitmapwidth1, bitmapheight1: Integer;
begin
  hash := TIEIntegerMap.Create();
  result := TIEBitmap.Create;
  result.Allocate(Bitmap.Width, Bitmap.Height, ie1g);
  bitmapwidth1 := bitmap.width - 1;
  bitmapheight1 := bitmap.height - 1;
  for y := 0 to Bitmapheight1 do
  begin
    if hash.KeysCount > 2 then
      break;
    d := result.ScanLine[y];
    bitpos := 0;
    for x := 0 to BitmapWidth1 do
    begin
      e := Bitmap.Pixels[x, y];
      c := (e.r shl 16) or (e.g shl 8) or (e.b);
      if hash.Insert(c) then
      begin
        if hash.KeysCount = 1 then
          BackCol := e
        else
          ForeCol := e;
      end;
      if (e.r = BackCol.r) and (e.g = BackCol.g) and (e.b = BackCol.b) then
        d^ := d^ and (not iebitmask1[bitpos])
      else
        d^ := d^ or iebitmask1[bitpos];
      inc(bitpos);
      if bitpos = 8 then
      begin
        bitpos := 0;
        inc(d);
      end;
    end;
  end;
  if hash.KeysCount <> 2 then
  begin
    FreeAndNil(result);
  end
  else
  begin
    bb := Round((BackCol.r * IEGlobalSettings().RedToGrayCoef + BackCol.g * IEGlobalSettings().GreenToGrayCoef + BackCol.b * IEGlobalSettings().BlueToGrayCoef) / 100);
    ff := Round((ForeCol.r * IEGlobalSettings().RedToGrayCoef + ForeCol.g * IEGlobalSettings().GreenToGrayCoef + ForeCol.b * IEGlobalSettings().BlueToGrayCoef) / 100);
    if bb > ff then
    begin
      _Negative1BitEx(result);
      t := BackCol;
      BackCol := ForeCol;
      ForeCol := t;
    end;
  end;
  FreeAndNil(hash);
end;

// make LUT needed to convert 1bit to 24bit
procedure MakeC1TO24;
var
  q, w, v: Integer;
begin
  for q := 0 to 255 do
  begin
    for w := 0 to 7 do
    begin
      if (q and iebitmask1[w]) <> 0 then
        v := 255
      else
        v := 0;
      C1TO24[q][w].r := v;
      C1TO24[q][w].g := v;
      C1TO24[q][w].b := v;
    end;
  end;
end;

// Creates a palette for the bitmap
// palette: the palette found
// max: size of the palette
// note: if the color count is larger than "max", they will be quantized
procedure _GetImagePalette(bitmap: TIEBitmap; var palette: array of TRGB; max: Integer);
var
  qt: TIEQuantizer;
begin
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  qt := TIEQuantizer.Create(Bitmap, palette, max);
  FreeAndNil(qt);
end;

{!!
<FS>TImageEnProc.CalcImagePalette

<FM>Declaration<FC>
procedure CalcImagePalette(var Palette: array of <A TRGB>; MaxCol: Integer);

<FM>Description<FN>
Fills the Palette array with the colors found in the current image.
<FC>Palette<FN> is the array to fill.
<FC>MaxCol<FN> is the size of Palette. If the image has more than MaxCol colors, the image is quantized to match the number of colors specified.

<FM>Example<FC>
var
  MyColorMap256: array [0..255] of TRGB;
  MyColorMap1000: array [0..999] of TRGB;
Begin
  ImageEnView1.Proc.CalcImagePalette(MyColorMap256, 256);
  ImageEnView1.Proc.CalcImagePalette(MyColorMap1000, 1000);
End;

<FM>See Also<FN>
- <A CreateRGB>
- <A TRGB2TColor>
- <A TColor2TRGB>
!!}
procedure TImageEnProc.CalcImagePalette(var Palette: array of TRGB; MaxCol: Integer);
begin
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  _GetImagePalette(fIEBitmap, Palette, MaxCol);
end;



///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//                                                                                                               //
//                                               CUT / COPY / PASTE                                              //
//                                                                                                               //

const
  Clipboard_Include_IE_Format = True;  // Always include IE format when cutting and pasting

{!!
<FS>TImageEnProc.CanCutToClipboard

<FM>Declaration<FC>
function CanCutToClipboard(Source: <A TIECopyPasteType> = iecpAuto): Boolean;

<FM>Description<FN>
Returns true if a call to <A TImageEnProc.CutToClipboard> is possible.

Possible values for <FC>Source<FN>:
<TABLE>
<R> <H>Item</H> <H>Effect</H> </R>
<R> <C><FC>iecpAuto<FN></C> <C> Result will true, if there is a selected portion of image or or layer </C> </R>
<R> <C><FC>iecpFullImage<FN></C> <C> Result will be true, unless the image is blank </C> </R>
<R> <C><FC>iecpSelection<FN></C> <C> Result will be true if there is a valid selection in the associated <A TImageEnView> </C> </R>
<R> <C><FC>iecpLayer<FN></C> <C> Result will be true if there is a layer selected in the associated <A TImageEnView> which is not the background layer </C> </R>
</TABLE>

Notes:
- The <FC>Source<FN> specified for <FC>CanCutToClipboard<FN>, must be the same as that you will use for <A TImageEnProc.CutToClipboard>.
- If the TImageEnProc is attached to a TIEBitmap, TImageEnMView or TImageEnFolderMView then only iecpFullImage is relevant (iecpAuto will have the same effect as iecpFullImage. iecpSelection and iecpLayer will always fail)

<FM>Example<FC>
// Enable the Cut button if cutting is possible
btnCutToClipboard.Enabled := ImageEnView1.Proc.CanCutToClipboard();

<FM>See Also<FN>
- <A TImageEnProc.CutToClipboard>
- <A TImageEnProc.CanCopyToClipboard>
- <A TImageEnProc.CopyToClipboard>
- <A TImageEnProc.CanPasteFromClipboard>
- <A TImageEnProc.PasteFromClipboard>
- <A TImageEnProc.PointPasteFromClip>
!!}
function TImageEnProc.CanCutToClipboard(Source: TIECopyPasteType = iecpAuto): Boolean;
begin
  If Source = iecpAuto then
    Result := CanCopyToClipboard( iecpSelection ) or CanCopyToClipboard( iecpLayer )
  else
    Result := CanCopyToClipboard( Source );
end;

{!!
<FS>TImageEnProc.CutToClipboard

<FM>Declaration<FC>
function CutToClipboard(Source: <A TIECopyPasteType> = iecpAuto; CutAlpha: Boolean = false): Boolean;

<FM>Description<FN>
Copies the selected region, image or layer to the clipboard and then removes it.

Possible values for <FC>Source<FN>:
<TABLE>
<R> <H>Item</H> <H>Effect</H> </R>
<R> <C><FC>iecpAuto<FN></C> <C> ImageEn automatically detects what to cut. If there is a valid selection, it is cut. If not, and a layer (other than the background) is selected, it is cut. Otherwise nothing is cut </C> </R>
<R> <C><FC>iecpFullImage<FN></C> <C> If the image is valid, it is copied to the clipboard, then cleared. Otherwise, it fails. </C> </R>
<R> <C><FC>iecpSelection<FN></C> <C> If there is a selection in the associated <A TImageEnView>, it is copied to the clipboard then cut from the image. If there is no selection, it fails </C> </R>
<R> <C><FC>iecpLayer<FN></C> <C> If there is a layer selected in the associated <A TImageEnView>, which is not the background layer, it is copied to the clipboard (as an image and a layer) and then removed from the image </C> </R>
</TABLE>

If <FC>CutAlpha<FN> is true, the selected area is made transparent.
Returns true if successful.

Note: If the TImageEnProc is attached to a TIEBitmap, TImageEnMView or TImageEnFolderMView then only iecpFullImage is relevant (iecpAuto will have the same effect as iecpFullImage. iecpSelection and iecpLayer will always fail)

<FM>Examples<FC>
// General cut to clipboard method
ImageEnView1.Proc.CutToClipboard();

// Cutting of selection to clipboard (leaving cut region as transparent)
ImageEnView1.Proc.CutToClipboard( iecpSelection, True );

// Cutting of selected layer to clipboard
ImageEnView1.Proc.CutToClipboard( iecpLayer );

// Cutting the whole image to the clipboard
ImageEnView1.Proc.CutToClipboard( iecpFullImage );

// Cut the selected image in a TImageEnMView to the clipboard (Note: bitmap is cleared, not removed)
if IEMView1.SelectedImage >= 0 then
  IEMView1.Proc.CutToClipboard( iecpFullImage );

<FM>See Also<FN>
- <A TImageEnProc.CanCutToClipboard>
- <A TImageEnProc.CanCopyToClipboard>
- <A TImageEnProc.CopyToClipboard>
- <A TImageEnProc.CanPasteFromClipboard>
- <A TImageEnProc.PasteFromClipboard>
- <A TImageEnProc.PointPasteFromClip>
!!}
function TImageEnProc.CutToClipboard(Source: TIECopyPasteType = iecpAuto; CutAlpha: Boolean = false): Boolean;
begin
  Result := False;
  case Source of
    iecpFullImage : Result := CopyToClipboard_Image( Clipboard_Include_IE_Format, True );
    iecpSelection : Result := CopyToClipboard_Selection( Clipboard_Include_IE_Format, True, CutAlpha );
    iecpLayer     : Result := CopyToClipboard_Layer( True );
    iecpAuto      :
      begin
        // If there is a valid selection, it is cut
        if CanCutToClipboard( iecpSelection ) then
          Result := CopyToClipboard_Selection( Clipboard_Include_IE_Format, True, CutAlpha )
        else
        // If not, and a layer (other than the background) is selected, it is cut
        if CanCutToClipboard( iecpLayer ) then
          Result := CopyToClipboard_Layer( True )

        // If not, cut nothing
      end;
  end;
end;


{!!
<FS>TImageEnProc.CanCopyToClipboard

<FM>Declaration<FC>
function CanCopyToClipboard(Source: <A TIECopyPasteType> = iecpAuto): Boolean;

<FM>Description<FN>
Returns true if a call to <A TImageEnProc.CopyToClipboard> is possible.

Possible values for <FC>Source<FN>:
<TABLE>
<R> <H>Item</H> <H>Effect</H> </R>
<R> <C><FC>iecpAuto<FN></C> <C> Result will always be true, unless the image is blank </C> </R>
<R> <C><FC>iecpFullImage<FN></C> <C> Result will always be true, unless the image is blank </C> </R>
<R> <C><FC>iecpSelection<FN></C> <C> Result will be true if there is a valid selection in the associated <A TImageEnView> </C> </R>
<R> <C><FC>iecpLayer<FN></C> <C> Result will be true if there is a layer selected in the associated <A TImageEnView> which is not the background layer </C> </R>
</TABLE>

Notes:
- The <FC>Source<FN> specified for <FC>CanCopyToClipboard<FN>, must be the same as that you will use for <A TImageEnProc.CopyToClipboard>.
- If the TImageEnProc is attached to a TIEBitmap, TImageEnMView or TImageEnFolderMView then only iecpFullImage is relevant (iecpAuto will have the same effect as iecpFullImage. iecpSelection and iecpLayer will always fail)

<FM>Example<FC>
// Enable the Copy button if copying is possible
btnCopyToClipboard.Enabled := ImageEnView1.Proc.CanCopyToClipboard();

<FM>See Also<FN>
- <A TImageEnProc.CanCutToClipboard>
- <A TImageEnProc.CutToClipboard>
- <A TImageEnProc.CopyToClipboard>
- <A TImageEnProc.CanPasteFromClipboard>
- <A TImageEnProc.PasteFromClipboard>
- <A TImageEnProc.PointPasteFromClip>
!!}
function TImageEnProc.CanCopyToClipboard(Source: TIECopyPasteType = iecpAuto): Boolean;
var
  iev: TImageEnView;
begin
  iev := nil;
  if assigned( fImageEnView ) and ( fImageEnView is TImageEnView ) then
    iev := TImageEnView( fImageEnView );

  case Source of
    iecpSelection : Result := Assigned( iev ) and iev.Selected;
    iecpLayer     : Result := Assigned( iev ) and ( iev.LayersSelCount( False ) > 0 );
    iecpFullImage : Result := ( fIEBitmap.Width > 1 ) and ( fIEBitmap.Height > 1 );
    else { iecpAuto }
                    Result := CanCopyToClipboard( iecpSelection ) or
                              CanCopyToClipboard( iecpLayer ) or
                              CanCopyToClipboard( iecpFullImage );
  end;
end;


{!!
<FS>TImageEnProc.CopyToClipboard

<FM>Declaration<FC>
function CopyToClipboard(Source: <A TIECopyPasteType> = iecpAuto): Boolean;

<FM>Description<FN>
Copies the selected region, image or layer to the clipboard.

Possible values for <FC>Source<FN>:
<TABLE>
<R> <H>Item</H> <H>Effect</H> </R>
<R> <C><FC>iecpAuto<FN></C> <C> ImageEn automatically detects what to copy. If there is a valid selection, it is copied. If not, and a layer (other than the background) is selected, it is copied. If not, and the image is valid it is copied </C> </R>
<R> <C><FC>iecpFullImage<FN></C> <C> If the image is valid, it is copied to the clipboard, then cleared. Otherwise, it fails. </C> </R>
<R> <C><FC>iecpSelection<FN></C> <C> If there is a selection in the associated <A TImageEnView>, it is copied to the clipboard then copied from the image. If there is no selection, it fails </C> </R>
<R> <C><FC>iecpLayer<FN></C> <C> If there is a layer selected in the associated <A TImageEnView>, which is not the background layer, it is copied to the clipboard (as an image and a layer) and then removed from the image </C> </R>
</TABLE>

Returns true if successful.

Note:
- The main reason for unexpected failures are very large images that exceed the available memory.
- If the TImageEnProc is attached to a TIEBitmap, TImageEnMView or TImageEnFolderMView then only iecpFullImage is relevant (iecpAuto will have the same effect as iecpFullImage. iecpSelection and iecpLayer will always fail)

<FM>Examples<FC>
// General copy to clipboard method
if ImageEnView1.Proc.CopyToClipboard(iecpAuto) = False then
  MessageDlg( 'Unable to copy to the clipboard. There is insufficient memory available for the operation.', mtError, [ mbOK ], 0 );

// Copying of selection to clipboard
ImageEnView1.Proc.CopyToClipboard( iecpSelection );

// Copying of selected layers to clipboard
ImageEnView1.Proc.CopyToClipboard( iecpLayer );

// Copying the whole image to the clipboard
ImageEnView1.Proc.CopyToClipboard( iecpFullImage );

// Copy the selected image in a TImageEnMView to the clipboard
if IEMView1.SelectedImage >= 0 then
  IEMView1.Proc.CopyToClipboard();

<FM>See Also<FN>
- <A TImageEnProc.CanCutToClipboard>
- <A TImageEnProc.CutToClipboard>
- <A TImageEnProc.CanCopyToClipboard>
- <A TImageEnProc.CanPasteFromClipboard>
- <A TImageEnProc.PasteFromClipboard>
- <A TImageEnProc.PointPasteFromClip>
!!}
function TImageEnProc.CopyToClipboard(Source: TIECopyPasteType = iecpAuto): Boolean;
begin
  Result := False;
  case Source of
    iecpFullImage : Result := CopyToClipboard_Image( Clipboard_Include_IE_Format, False );
    iecpSelection : Result := CopyToClipboard_Selection( Clipboard_Include_IE_Format, False);
    iecpLayer     : Result := CopyToClipboard_Layer( False );
    iecpAuto      :
      begin
        // If there is a valid selection, it is copied
        if CanCopyToClipboard( iecpSelection ) then
          Result := CopyToClipboard_Selection( Clipboard_Include_IE_Format, False )
        else
        // If not, and a layer (other than the background) is selected, it is copied
        if CanCopyToClipboard( iecpLayer ) then
          Result := CopyToClipboard_Layer( False )
        else
        // If not, and the image is valid it is copied
          Result := CopyToClipboard_Image( Clipboard_Include_IE_Format, False )
      end;
  end;
end;


// Creates a DIB from specified polygonal selection
function _CopyBitmaptoDibPolyEx(Source: TIEBitmap; sx1, sy1, sx2, sy2: Integer; SelPoly: PPointArray; SelPolyCount: Integer; mask: TIEMask; fillcolor: Integer; dpix, dpiy: Integer): THandle;
var
  tmpbmp: TIEBitmap;
begin
  tmpbmp := TIEBitmap.Create;
  tmpbmp.Allocate(mask.x2 - mask.x1 + 1, mask.y2 - mask.y1 + 1, Source.PixelFormat);
  tmpbmp.Fill(fillcolor);
  mask.CopyIEBitmap(tmpbmp, Source, true, false, false);
  result := _CopyBitmaptoDIBEx(tmpbmp, 0, 0, tmpbmp.width, tmpbmp.height, dpix, dpiy);
  FreeAndNil(tmpbmp);
end;

function _CopyBitmaptoClipboardEx(Source: TIEBitmap; InitClipboard: Boolean; IncludeImageEnFormat: Boolean; X1, Y1, X2, Y2: Integer; SelPoly: PPointArray; SelPolyCount: Integer; Mask: TIEMask; FillColor: TColor; DpiX, DpiY: Integer): Boolean;
var
  tmpbmp: TIEBitmap;
  freeBmp : Boolean;
  hbi: THandle;
  memHandle: THandle;
begin
  Result := False;
  if ( Source.Width < 2 ) or ( Source.Height < 2 ) then
    exit;

  if InitClipboard and ( IEOpenClipboard = False ) then
    exit;

  try
    if InitClipboard then
      EmptyClipboard;

    // set CF_DIB image
    if assigned(Mask) and (not Mask.IsEmpty) then
      hbi := _CopyBitmaptoDibPolyEx(Source, X1, Y1, X2, Y2, SelPoly, SelPolyCount, Mask, integer( FillColor ), DpiX, DpiY)
    else
      hbi := _CopyBitmaptoDIBEx(Source, X1, Y1, X2, Y2, DpiX, DpiY);
    if hbi = 0 then
      exit;

    if SetClipboardData(CF_DIB, hbi) = 0 then  // free only on fail
    begin
      GlobalFree(hbi);
      exit;
    end;

    // Add ImageEn internal format
    if IncludeImageEnFormat then
    begin
      if assigned(Mask) and (not Mask.IsEmpty) then
      begin
        tmpbmp := TIEBitmap.Create;
        Source.CopyWithMask1( tmpbmp, Mask );
        freeBmp := True;
      end
      else
      begin
        freeBmp := False;
        tmpbmp := Source;
      end;

      memHandle := GlobalAlloc( GMEM_MOVEABLE or GMEM_DDESHARE, tmpbmp.CalcRAWSize );
      if memHandle <> 0 then
      begin
        tmpbmp.SaveRAWToBufferOrStream( GlobalLock(memHandle), nil, false );
        GlobalUnLock(memHandle);
        if SetClipboardData( IERawClipFormat, memHandle ) = 0 then  // free only on fail
          GlobalFree(memHandle);  // don't set result = False because CF_DIB had success
      end;
      if freeBmp then
        FreeAndNil( tmpbmp );
    end;

    result := true;
  finally
    if InitClipboard then
      CloseClipboard;
  end;
end;


function TImageEnProc.CopyToClipboard_Image(IncludeImageEnFormat: Boolean; ClearImage: Boolean): Boolean;
begin
  result := false;
  if not MakeConsistentBitmap([]) then
    exit;

  if ClearImage and fAutoUndo then
    SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
              IERS_SELCUTTOCLIP, // Legacy RS... is OK
              {$ELSE}
              IEMsg( IEMsg_Cut ),
              {$ENDIF}
              ieuImage, True, IEOP_CUTTOCLIPBOARD );

  Result := _CopyBitmaptoClipboardEx( fIEBitmap, True, IncludeImageEnFormat,
                                      0, 0, 0, 0, nil, 0, nil, 0,  // These will not be used
                                      GetDpiX, GetDpiY );


  // CUT IMAGE
  if Result and ClearImage then
  begin
    if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
      TImageEnView( fImageEnView ).Blank()
    else
    begin
      fIEBitmap.Clear;
      Update();
    end;
  end;
end;


// Fails if there is no selection
function TImageEnProc.CopyToClipboard_Selection(IncludeImageEnFormat: Boolean; CutImage: Boolean; CutAlpha: Boolean = false): Boolean;
var
  fSX1, fSY1, fSX2, fSY2: Integer;
  fPolyS: PPointArray;
  fPolySCount: Integer;
  mask: TIEMask;
begin
  result := false;
  if not MakeConsistentBitmap([], False) then
    exit;
  if GetReSel(fsx1, fsy1, fsx2, fsy2, fPolyS, fPolySCount, mask) = False then
    exit;

  if CutImage and fAutoUndo then
    SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
              IERS_SELCUTTOCLIP,
              {$ELSE}
              IEMsg( IEMsg_CutSelection ),
              {$ENDIF}
              ieuImage, True, IEOP_SELCUTTOCLIP );

  Result := _CopyBitmaptoClipboardEx( fIEBitmap, True, IncludeImageEnFormat, fsx1, fsy1, fsx2, fsy2, fPolyS, fPolySCount, mask, GetReBackground, GetDPIX, GetDPIY );


  // CUT IMAGE
  if CutImage and Result then
  begin
    if assigned(mask) and (not mask.IsEmpty) then
    begin
      // polygonal selection
      _ClearSelMaskEx(fIEBitmap, mask, GetReBackground);
      if CutAlpha then
      begin
        _ClearSelMaskEx(fIEBitmap.AlphaChannel, mask, 0);
        fIEBitmap.AlphaChannel.SyncFull();
      end;
    end
    else
    begin
      fIEBitmap.FillRect(fSx1, fSy1, fSx2 - 1, fSy2 - 1, GetReBackground);
      if CutAlpha then
      begin
        fIEBitmap.AlphaChannel.FillRect(fSx1, fSy1, fSx2 - 1, fSy2 - 1, 0);
        fIEBitmap.AlphaChannel.SyncFull();
      end;
    end;
    Update;
  end;
end;


function TImageEnProc.CopyToClipboard_Layer(CutLayer: Boolean): Boolean;
var
  iev : TImageEnView;
  bmp : TIEBitmap;
  ms: TMemoryStream;
  memHandle: THandle;
  ptr: pointer;
begin
  result := false;
  if not ( assigned( fImageEnView ) and ( fImageEnView is TImageEnView )) then
    exit;

  iev := TImageEnView( fImageEnView );
  if iev.LayersSelCount( False ) = 0 then
    exit;

  // Copy the layer to the clipboard
  if IEOpenClipboard then
  try
    EmptyClipboard;

    // Layers to clipboard
    ms := TMemoryStream.Create;
    try
      // Write selected layers to clipboard
      iev.LayersSaveToStream( ms, -2, True, False, False, nil );
      memHandle := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, ms.size);
      ptr := GlobalLock( memHandle );
      CopyMemory( ptr, ms.memory, ms.size );
      GlobalUnLock( memHandle );
      if SetClipboardData( IELayerClipboardFormat , memHandle ) = 0 then
        GlobalFree( memHandle) ;  // don't set result = False because CF_DIB had success
      result := true;
    finally
      FreeAndNil(ms);
    end;

    // Include an image representation of current layer
    bmp := TIEBitmap.create;
    try
      iev.CurrentLayer.CopyToBitmap( bmp );
      _CopyBitmaptoClipboardEx( bmp, False, True,
                                0, 0, 0, 0, nil, 0, nil, 0,  // These will not be used
                                GetDpiX, GetDpiY );
    finally
      bmp.Free;
    end;

  finally
    CloseClipboard;
  end;


  // CUT LAYER
  if Result and CutLayer then
  begin
    if fAutoUndo and ( loAutoUndoChangesByUser in iev.LayerOptions ) then
      SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
                IERS_SELCUTTOCLIP, // Legacy RS... is OK
                {$ELSE}
                IEMsg( IEMsg_Cut ),
                {$ENDIF}
                ieuObjectsAndLayers, True, IEOP_CUTLAYERTOCLIPBOARD );
    iev.LayersRemoveEx( LYR_SELECTED_LAYERS );
    Update();
  end;
end;


{!!
<FS>TImageEnProc.CanPasteFromClipboard

<FM>Declaration<FC>
function CanPasteFromClipboard(Dest: <A TIECopyPasteType> = iecpAuto; InclImagesAsLayers: Boolean = True): Boolean;

<FM>Description<FN>
Returns <FC>true<FN> if the clipboard contains an image or an ImageEn layer that TImageEnProc can paste.
If <FC>Dest<FN> is <FC>iecpSelection<FN> then there must also be a valid selection in the associated <A TImageEnView>.
<FC>InclImagesAsLayers<FN> has no effect unless <FC>Dest<FN> is <FC>iecpLayer<FN>. If true, the result will be true if the clipboard contains a layer or an image. If false, the result will be true only if there is a layer on the clipboard.

Notes:
- The <FC>Dest<FN> you specify for <FC>CanPasteFromClipboard<FN>, should be the same as the FC>Dest<FN> for your call to <A TImageEnProc.CanPasteFromClipboard>
- If the TImageEnProc is attached to a TIEBitmap, TImageEnMView or TImageEnFolderMView then only iecpFullImage is relevant (iecpAuto will have the same effect as iecpFullImage. iecpSelection and iecpLayer will always fail)

<FM>Examples<FC>
// Enable the Paste button if pasting is possible
btnPasteFromClip.Enabled := ImageEnView1.Proc.CanPasteFromClipboard();

// Paste only if there is a layer on the clipboard
if ImageEnView1.Proc.CanPasteFromClipboard( iecpLayer, False );
  ImageEnView1.Proc.PasteFromClipboard( iecpLayer );

// Paste a layer if there is an image or layer on the clipboard
if ImageEnView1.Proc.CanPasteFromClipboard( iecpLayer );
  ImageEnView1.Proc.PasteFromClipboard( iecpLayer );

// Append an image to a TImageEnMView from the clipboard
if IEMView1.Proc.CanPasteFromClipboard() then
begin
  IEMView1.AppendImage( 0, 0 );
  IEMView1.Proc.PasteFromClipboard();
end;

<FM>See Also<FN>
- <A TImageEnProc.PasteFromClipboard>
- <A TImageEnProc.PointPasteFromClip>
- <A TImageEnView.LayersCreateFromClipboard>
- <A TImageEnProc.CanCutToClipboard>
- <A TImageEnProc.CutToClipboard>
- <A TImageEnProc.CanCopyToClipboard>
- <A TImageEnProc.CopyToClipboard>
!!}
function TImageEnProc.CanPasteFromClipboard(Dest: TIECopyPasteType = iecpAuto; InclImagesAsLayers: Boolean = True): Boolean;
var
  haveSelection: Boolean;
begin
  result := false;

  case Dest of
    iecpSelection :
      begin
        // Must have a valid selection
        haveSelection := False;
        if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
          haveSelection := TImageEnView( fImageEnView ).Selected;
        if not haveSelection then
          exit;
      end;
    iecpLayer:
      begin
        // Must have an associated TImageEnView selection
        if not ( assigned( fImageEnView ) and ( fImageEnView is TImageEnView )) then
          exit;
      end;
  end;


  if IEOpenClipboard then
  begin
    try
      if ( Dest = iecpLayer ) and ( InclImagesAsLayers = False ) then
        // Layer on clipboard only
        result := IsClipboardFormatAvailable( IELayerClipboardFormat )
      else
        // Note: don't need to check for IELayerClipboardFormat. It will always exist if IERawClipFormat exists
        result := IsClipboardFormatAvailable( IERawClipFormat ) or
                  {$ifdef IEINCLUDEPNG}
                  (IEGetClipboardDataByName('PNG') > 0) or
                  {$endif}
                  IsClipboardFormatAvailable(CF_DIB) or
                  IsClipboardFormatAvailable(CF_ENHMETAFILE);

    finally
      CloseClipboard;
    end;
  end;
end;


{!!
<FS>TImageEnProc.PasteFromClipboard

<FM>Declaration<FC>
function PasteFromClipboard(Dest: <A TIECopyPasteType> = iecpAuto; MergeAlpha: Boolean = True; MaintainAspectRatio: Boolean = True; CanStretch: Boolean = True): Boolean;

<FM>Description<FN>
Pastes an image or layer from the clipboard.

Possible values for <FC>Dest<FN>:
<TABLE>
<R> <H>Item</H> <H>Effect</H> </R>
<R> <C><FC>iecpAuto<FN></C> <C> ImageEn automatically detects the best destination. If an ImageEn layer exists on the clipboard, it is pasted as a new layer. If not, and there is a valid selection, the image is pasted to the selection. Failing that, the image on the clipboard replaces the current image </C> </R>
<R> <C><FC>iecpFullImage<FN></C> <C> The image on the clipboard replaces the existing image </C> </R>
<R> <C><FC>iecpSelection<FN></C> <C> If there is a selection in the associated <A TImageEnView>, the image is pasted to the selection. If there is no selection, it fails </C> </R>
<R> <C><FC>iecpLayer<FN></C> <C> The image or layer on the clipboard is pasted as a new layer in the associated <A TImageEnView> </C> </R>
</TABLE>

Other parameters (Relevant only when pasting to a selection):
<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>MergeAlpha<FN></C> <C> The alpha channel of the pasted bitmap will be merged with the background bitmap. It is only valid if image on the clipboard has been copied from <A TImageEnView> </C> </R>
<R> <C><FC>MaintainAspectRatio<FN></C> <C> If False and pasting to a selection, the inserted image will fill the entire selection. I.e. set to true to maintain the aspect ratio of the original bitmap </C> </R>
<R> <C><FC>CanStretch<FN></C> <C> When pasting to a selection, <FC>CanStretch<FN> determines whether a source image smaller than the selection is enlarged or maintains its original size (has no effect if <FC>MaintainAspectRatio<FN> is False, i.e. image will always be stretched) </C> </R>
</TABLE>

Result is false if a valid image was not found on the clipboard.

Notes:
- All uncompressed DIB formats are handled (1, 4, 8, 15, 16, 24 and 32 bits)
- Color images of 4, 8, 15, 16, 24 or 32 bits are converted to 24 bit. Monochrome images (1 bit) will remain 1 bit
- If the TImageEnProc is attached to a TIEBitmap, TImageEnMView or TImageEnFolderMView then only iecpFullImage is relevant (iecpAuto will have the same effect as iecpFullImage. iecpSelection and iecpLayer will always fail)

<FM>General Example<FC>
ImageEnView1.Proc.PasteFromClipboard( iecpAuto );

// Append an image to a TImageEnMView from the clipboard
if IEMView1.Proc.CanPasteFromClipboard() then
begin
  IEMView1.AppendImage( 0, 0 );
  IEMView1.Proc.PasteFromClipboard();
end;

<FM>Selection Examples<FC>
<FB>Source Image<FC>

<IMG help_images\PasteSource.png>

// Paste an image on the clipboard to selection, maintaining the aspect ratio. The image will take the full size of the selection, but maintain its aspect ratio (will not be distored)
ImageEnView1.Proc.PasteFromClipboard( iecpSelection, True );
<IMG help_images\PasteStretchAR.png>

// Paste an image on the clipboard to selection, maintaining the aspect ratio. If the image is smaller than the selection it will maintain its original dimensions, if it is larger it will be reduced in size to fit within the selection (while maintaining the aspect ratio)
ImageEnView1.Proc.PasteFromClipboard( iecpSelection, True, True, False );
<IMG help_images\PasteAR.png>

// Paste an image on the clipboard to selection. It will be stretched to the full area of the selection (which may distort the source image)
ImageEnView1.Proc.PasteFromClipboard( iecpSelection, True, False );
<IMG help_images\PasteStretch.png>

<FM>See Also<FN>
- <A TImageEnProc.CanPasteFromClipboard>
- <A TImageEnProc.PointPasteFromClip>
- <A TImageEnView.LayersCreateFromClipboard>
- <A TImageEnProc.CanCutToClipboard>
- <A TImageEnProc.CutToClipboard>
- <A TImageEnProc.CanCopyToClipboard>
- <A TImageEnProc.CopyToClipboard>

!!}
function TImageEnProc.PasteFromClipboard(Dest: TIECopyPasteType = iecpAuto; MergeAlpha: Boolean = True; MaintainAspectRatio: Boolean = True; CanStretch: Boolean = True): Boolean;
begin
  Result := False;
  case Dest of
    iecpFullImage : Result := PasteFromClipboard_Image();
    iecpSelection : Result := PasteFromClipboard_Selection( MergeAlpha, MaintainAspectRatio, CanStretch );
    iecpLayer     : Result := PasteFromClipboard_Layer() > -1;
    iecpAuto      :
      begin
        // If an ImageEn layer exists on the clipboard, it is pasted as a new layer.
        if CanPasteFromClipboard( iecpLayer, False ) then
          Result := PasteFromClipboard_Layer() > -1
        else
        // If not, and there is a valid selection, the image is pasted to the selection
        if CanPasteFromClipboard( iecpSelection ) then
          Result := PasteFromClipboard_Selection( MergeAlpha, MaintainAspectRatio, CanStretch )
        else
        // Failing that, the image on the clipboard replaces the current image
          Result := PasteFromClipboard_Image()
      end;
  end;
end;


function TImageEnProc.PasteFromClipboard_Image(): Boolean;
var
  hbi: THandle;
  memPtr: Pointer;
  meta: TMetaFile;
  io: TImageEnIO;

  procedure _SaveUndo();
  begin
    if fAutoUndo then
      SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
               IERS_PASTEFROMCLIPBOARD,
               {$ELSE}
               IEMsg( IEMsg_Paste ),
               {$ENDIF}
               ieuImage, True, IEOP_PASTEFROMCLIPBOARD );
  end;

begin
  Result := False;
  if not MakeConsistentBitmap([]) then
    exit;

  if IEOpenClipboard then
  try

    if IsClipboardFormatAvailable( IERawClipFormat ) then
    begin
      // ImageEn Internal format
      hbi := GetClipboardData( IERawClipFormat );
      if hbi <> 0 then
      begin
        _SaveUndo();
        memPtr := GlobalLock(hbi);
        fIEBitmap.LoadRAWFromBufferOrStream(memPtr, nil);
        GlobalUnLock(hbi);
        Update;
        Result := True;
      end;
    end

    {$ifdef IEINCLUDEPNG}
    else
    if IEGetClipboardDataByName('PNG') > 0 then
    begin
      // PNG format
      hbi := GetClipboardData( IEGetClipboardDataByName('PNG') );
      if hbi <> 0 then
      begin
        _SaveUndo();
        io := TImageEnIO.CreateFromBitmap(fIEBitmap);
        try
          memPtr := GlobalLock(hbi);
          io.LoadFromBuffer( memPtr, GlobalSize(hbi), ioPNG );
          GlobalUnLock(hbi);
        finally
          io.Free;
        end;
        Update;
        Result := True;
      end;
    end
    {$endif}

    else
    if IsClipboardFormatAvailable(CF_DIB) then
    begin
      // DIB format
      hbi := GetClipboardData(CF_DIB);
      if hbi <> 0 then
      begin
        _SaveUndo();
        _CopyDIB2BitmapEx(hbi, fIEBitmap, nil, false);
        Update;
        Result := True;
      end;
    end

    else
    if IsClipboardFormatAvailable(CF_ENHMETAFILE) then
    begin
      // EMF format
      hbi := GetClipboardData(CF_ENHMETAFILE);
      if hbi <> 0 then
      begin
        _SaveUndo();
        io := TImageEnIO.CreateFromBitmap(fIEBitmap);
        meta := TMetaFile.Create;
        try
          meta.Handle := hbi;
          io.ImportMetafile(meta, -1, -1, true);
        finally
          meta.free;
          io.Free;
        end;
        Update;
        Result := True;
      end;
    end;

  finally
    CloseClipboard;
  end;
end;

// Fails if there is no selection
function TImageEnProc.PasteFromClipboard_Selection(MergeAlpha: Boolean = True; MaintainAspectRatio: Boolean = False; CanStretch: Boolean = False): Boolean;
var
  paBitmap, pbBitmap: TIEBitmap;
  fSX1, fSY1, fSX2, fSY2: Integer;
  fPolyS: PPointArray;
  fPolySCount: Integer;
  hbi: THandle;
  mask: TIEMask;
  memPtr: pointer;
  Sz: TPoint;
  haveSelection: Boolean;
begin                 
  Result := False;
  if not MakeConsistentBitmap([]) then
    exit;
  haveSelection := GetReSel(fsx1, fsy1, fsx2, fsy2, fPolyS, fPolySCount, mask);

  if haveSelection = False then
    exit;

  // Paste to selection
  if IEOpenClipboard then
  try
    if IsClipboardFormatAvailable( IERawClipFormat ) then
    begin
      // ImageEn Internal format
      hbi := GetClipboardData( IERawClipFormat );
      if hbi <> 0 then
      begin
        if fAutoUndo then
        begin
          if CanStretch or not MaintainAspectRatio then
            SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
                      IERS_SELPASTEFROMCLIPSTRETCH,
                      {$ELSE}
                      IEMsg( IEMsg_Paste ),
                      {$ENDIF}
                      ieuImage, True, IEOP_SELPASTEFROMCLIPSTRETCH )
              else
            SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
                      IERS_SELPASTEFROMCLIP,
                      {$ELSE}
                      IEMsg( IEMsg_Paste ),
                      {$ENDIF}
                      ieuImage, True, IEOP_SELPASTEFROMCLIP );
        end;

        paBitmap := TIEBitmap.Create();
        pbBitmap := TIEBitmap.Create();
        try
          memPtr := GlobalLock(hbi);
          try
            pabitmap.LoadRAWFromBufferOrStream(memPtr, nil);
            if (pabitmap.Width = 0) or (pabitmap.Height = 0) then
              exit;
          finally
            GlobalUnLock(hbi);
          end;

          if MaintainAspectRatio then
          begin
            Sz := GetImageSizeWithinArea( paBitmap.Width, paBitmap.Height, fsx2 - fsx1, fsy2 - fsy1, CanStretch );
            fsx2 := fsx1 + Sz.X;
            fsy2 := fsy1 + Sz.Y;
          end;

          pbBitmap.Allocate(fsx2 - fsx1, fsy2 - fsy1, paBitmap.PixelFormat);
          _IEBmpStretchEx(paBitmap, pbBitmap, nil, nil);
          if paBitmap.HasAlphaChannel then
          begin
            _IEBmpStretchEx(paBitmap.AlphaChannel, pbBitmap.AlphaChannel, nil, nil);
            if MergeAlpha then
              mask.CombineWithAlpha(pbBitmap.AlphaChannel, mask.x1, mask.y1, false);
          end;
          pbBitmap.CopyWithMask2(fIEBitmap, mask);
        finally
          FreeAndNil(pbBitmap);
          FreeAndNil(paBitmap);
        end;
        Update();
        Result := True;
      end;
    end

    // DIB format
    else
    if IsClipboardFormatAvailable(CF_DIB) then
    begin
      hbi := GetClipboardData(CF_DIB);
      if hbi <> 0 then
      begin
        if fAutoUndo then
        begin
          if CanStretch or not MaintainAspectRatio then
            SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
                      IERS_SELPASTEFROMCLIPSTRETCH,
                      {$ELSE}
                      IEMsg( IEMsg_Paste ),
                      {$ENDIF}
                      ieuImage, True, IEOP_SELPASTEFROMCLIPSTRETCH )
          else
            SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
                      IERS_SELPASTEFROMCLIP,
                      {$ELSE}
                      IEMsg( IEMsg_Paste ),
                      {$ENDIF}
                      ieuImage, True, IEOP_SELPASTEFROMCLIP );
        end;

        paBitmap := TIEBitmap.Create();
        pbBitmap := TIEBitmap.Create();
        try
          _CopyDIB2BitmapEx(hbi, paBitmap, nil, false);

          if MaintainAspectRatio then
          begin
            Sz := GetImageSizeWithinArea( paBitmap.Width, paBitmap.Height, fsx2 - fsx1, fsy2 - fsy1, CanStretch );
            fsx2 := fsx1 + Sz.X;
            fsy2 := fsy1 + Sz.Y;
          end;

          pbBitmap.Allocate(fsx2 - fsx1, fsy2 - fsy1, paBitmap.PixelFormat);
          _IEBmpStretchEx(paBitmap, pbBitmap, nil, nil);
          mask.CopyIEBitmap(fIEBitmap, pbBitmap, false, true, false);
        finally
          FreeAndNil(pbBitmap);
          FreeAndNil(paBitmap);
        end;
        Update();
        Result := True;
      end;
    end;

  finally
    CloseClipboard;
  end;
end;

function TImageEnProc.PasteFromClipboard_Layer(): Integer;
var
  iev: TImageEnView;
  hmem: THandle;
  ms: TMemoryStream;
  ptr: pointer;
begin
  Result := -1;

  if assigned( fImageEnView ) and ( fImageEnView is TImageEnView ) then
    iev := TImageEnView( fImageEnView )
  else
    exit;


  if IEOpenClipboard then
  try
    if IsClipboardFormatAvailable( IELayerClipboardFormat ) then
    begin
      hmem := GetClipboardData( IELayerClipboardFormat );
      if hmem = 0 then
        exit;

      iev.LockUpdate();
      try
        if fAutoUndo and ( loAutoUndoChangesByUser in iev.LayerOptions ) then
          SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
                   IERS_PASTEFROMCLIPBOARD,  // Legacy RS... is OK
                   {$ELSE}
                   IEMsg( IEMsg_Paste ),
                   {$ENDIF}
                   ieuObjectsAndLayers, True, IEOP_PASTELAYERFROMCLIPBOARD );

        // Remove selected layers other than 0
        if iev.LayersSelCount( False ) > 0 then
        begin
          iev.Layers[ 0 ].fSelected := False;
          iev.LayersRemoveEx( LYR_SELECTED_LAYERS );
        end;

        // load layers from clipboard
        ptr := GlobalLock(hmem);
        ms := TMemoryStream.Create;
        try
          ms.Write( pbyte( ptr )^, GlobalSize( hmem ));
          ms.position := 0;
          if iev.LayersLoadFromStream( ms, True ) then
            Result := iev.LayersCurrent;
        finally
          FreeAndNil(ms);
        end;
        GlobalUnLock(hmem);

      finally
        iev.UnlockUpdate();
      end
    end
    else
    if CanPasteFromClipboard( iecpFullImage ) then
    begin
      // Paste image as new layer
      result := iev.LayersAddEx( ielkImage, -1, -1 );
      PasteFromClipboard_Image();
    end;

  finally
    CloseClipboard;
  end;
end;



{!!
<FS>TImageEnProc.PointPasteFromClip

<FM>Declaration<FC>
function PointPasteFromClip(XDest, YDest: Integer; MergeAlpha: Boolean = True): Boolean;

<FM>Description<FN>
Pastes the image on the clipboard at position x1, y1 (coordinates relative to component). All uncompressed DBI formats are handled (1, 4, 8, 15, 16, 24 and 32 bits).
<FC>MergeAlpha<FN> will merge the alpha channel of the pasted bitmap with the background bitmap (only valid if the image was <L TImageEnProc.CopyToClipboard>copied to the clipboard</L> in "ImageEn" format).
Result is false if a valid image was not found on the clipboard.

Note: Color images (4, 8, 15, 16, 24 or 32 bits) are converted to 24 bit. Monochrome images (1 bit) will remain 1 bit.

<FM>Example<FC>
// Paste the clipboard image at the current mouse position
procedure TForm1.ImageEn1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ImageEnView1.Proc.PointPasteFromClip(X, Y);
end;

<FM>See Also<FN>
- <A TImageEnProc.CanPasteFromClipboard>
- <A TImageEnProc.PasteFromClipboard>
- <A TImageEnView.LayersCreateFromClipboard>
- <A TImageEnProc.CanCutToClipboard>
- <A TImageEnProc.CutToClipboard>
- <A TImageEnProc.CanCopyToClipboard>
- <A TImageEnProc.CopyToClipboard>

!!}
function TImageEnProc.PointPasteFromClip(XDest, YDest: Integer; MergeAlpha: Boolean = True): Boolean;
var
  pabitmap: tiebitmap;
  hbi: THandle;
  memPtr: Pointer;
  mask: TIEMask;
begin
  Result := False;
  if not MakeConsistentBitmap([]) then
    exit;

  if IEOpenClipboard then
  try
    if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
      with fImageEnView as TImageEnView do
        if SelectionBase = iesbClientArea then
        begin
          XDest := XScr2Bmp(XDest, false);
          YDest := YScr2Bmp(YDest, false);
        end;

    if IsClipboardFormatAvailable( IERawClipFormat ) then
    begin
      // ImageEn Internal format
      hbi := GetClipboardData( IERawClipFormat );
      if hbi <> 0 then
      begin
        mask := nil;
        pabitmap := TIEBitmap.create;
        try
          if fAutoUndo then
            SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
             Format(IERS_POINTPASTEFROMCLIP, [XDest, YDest]),
             {$ELSE}
             IEMsg( IEMsg_Paste ),
             {$ENDIF}
             ieuImage, True, IEOP_POINTPASTEFROMCLIP );
          memPtr := GlobalLock(hbi);
          pabitmap.LoadRAWFromBufferOrStream(memPtr, nil);
          GlobalUnLock(hbi);
          mask := TIEMask.Create;
          mask.AllocateBits(fIEBitmap.Width, fIEBitmap.Height, 1);
          mask.Fill(255);
          mask.x1 := XDest;
          mask.x2 := YDest;
          mask.x2 := XDest + paBitmap.Width - 1;
          mask.y2 := YDest + paBitmap.Height - 1;
          if paBitmap.HasAlphaChannel and MergeAlpha then
            mask.CombineWithAlpha(paBitmap.AlphaChannel, mask.x1, mask.x2, false);
          paBitmap.CopyWithMask2(fIEBitmap, mask);
        finally
          mask.free;
          FreeAndNil(pabitmap);
        end;
        Update;
        Result := True;
      end;
    end

    // DIB format
    else
    if IsClipboardFormatAvailable(CF_DIB) then
    begin
      hbi := GetClipboardData(CF_DIB);
      if hbi <> 0 then
      begin
        pabitmap := TIEBitmap.create;
        try
          _CopyDIB2BitmapEx(hbi, paBitmap, nil, false);
          if fAutoUndo then
            SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
                     Format(IERS_POINTPASTEFROMCLIP, [XDest, YDest]),
                     {$ELSE}
                     IEMsg( IEMsg_Paste ),
                     {$ENDIF}
                     ieuImage, True, IEOP_POINTPASTEFROMCLIP );
          pabitmap.CopyRectTo(fIEBitmap, 0, 0, XDest, YDest, pabitmap.Width, pabitmap.Height, false);
        finally
          FreeAndNil(pabitmap);
        end;
        Update;
        Result := True;
      end;
    end;

  finally
    CloseClipboard;
  end;
end;


{$ifdef IEIncludeDeprecatedInV6}
// Deprecated in 7.0.0 (2017-02-02)
function TImageEnProc.CopyToClipboard(IncludeImageEnFormat: Boolean): Boolean;
begin
  Result := CopyToClipboard_Image( IncludeImageEnFormat, False );
end;
{$endif}


{$ifdef IEIncludeDeprecatedInV6}
// Deprecated in 7.0.0 (2017-02-02)
function TImageEnProc.SelCutToClip(IncludeImageEnFormat: Boolean = true; CutAlpha: Boolean = false): Boolean;
begin
  Result := CopyToClipboard_Selection( IncludeImageEnFormat, TRUE, CutAlpha );
end;
{$endif}


{$ifdef IEIncludeDeprecatedInV6}
// Deprecated in 7.0.0 (2017-02-02)
function TImageEnProc.SelCopyToClip(IncludeImageEnFormat: Boolean = True): Boolean;
var
  bSelected: Boolean;
begin
  bSelected := False;
  if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
    bSelected := TImageEnView( fImageEnView ).Selected;
  if bSelected then
    Result := CopyToClipboard_Selection( IncludeImageEnFormat, False )
  else
    Result := CopyToClipboard_Image( IncludeImageEnFormat, False );
end;
{$endif}


{$ifdef IEIncludeDeprecatedInV6}
// Deprecated in 7.0.0 (2017-02-02)
function TImageEnProc.IsClipboardAvailable(): Boolean;
begin
  Result := CanPasteFromClipboard( iecpAuto );
end;
{$endif}


{$ifdef IEIncludeDeprecatedInV6}
// Deprecated in 7.0.0 (2017-02-02)
function TImageEnProc.SelPasteFromClip(MergeAlpha: Boolean = True; MaintainAspectRatio: Boolean = false; CanStretch: Boolean = False): Boolean;  {$ifdef IEWarningForDeprecated} deprecated {$ifdef IESupportDeprecatedDescription} 'Use PasteFromClipboard(iecpSelection) instead - http://imageen.com/help/Compatibility.html' {$endif}; {$endif}
var
  haveSelection: Boolean;
begin
  haveSelection := False;
  if assigned(fImageEnView) and (fImageEnView is TImageEnView) then
    haveSelection := TImageEnView( fImageEnView ).Selected;
  if haveSelection then
    Result := PasteFromClipboard_Selection( MergeAlpha, MaintainAspectRatio, CanStretch )
  else
    Result := PasteFromClipboard_Image();
end;
{$endif}


{$ifdef IEIncludeDeprecatedInV6}
// Deprecated in 6.2.0 (2015-05-20)
procedure TImageEnProc.SelPasteFromClipStretch(MergeAlpha: Boolean = True);
begin
  {$IFDEF Delphi6orNewer} {$WARN SYMBOL_DEPRECATED OFF} {$ENDIF}
  SelPasteFromClip( MergeAlpha, False, True );
  {$IFDEF Delphi6orNewer} {$WARN SYMBOL_DEPRECATED ON} {$ENDIF}
end;
{$endif}



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






procedure ConvertBmpTo24Bit(ABitmap : TBitmap);
// NPC: 24/10/11
var
  ASource : TIEBitmap;
  ADest   : TIEBitmap;
  NullProgress: TProgressRec;
  Aborting: boolean;
begin
  NullProgress := NullProgressRec( Aborting );

  ASource := TIEBitmap.create;
  ADest   := TIEBitmap.create;
  try
    ASource.Assign(ABitmap);
    _Conv1To24Ex(ASource, ADest, NullProgress);
    ADest.CopyToTBitmap(ABitmap);
  finally
    ASource.Free;
    ADest.free;
  end;
end;


procedure ResizeBitmap(ABitmap : TBitmap; iWidth, iHeight: Integer; bStretchSmall : Boolean; Background : TColor; ResamplingFilter : TResampleFilter);
// NPC: 24/10/11

  procedure DoResizeBmp(ABitmap : TBitmap; iWidth, iHeight: Integer; ResamplingFilter : TResampleFilter);
  var
    ASource : TIEBitmap;
    ADest   : TIEBitmap;
  begin
    ASource := TIEBitmap.create;
    ADest   := TIEBitmap.create;
    try
      ASource.Assign(ABitmap);
      ADest.Resize(iWidth, iHeight, 0, 255, iehLeft, ievTop);
      ADest.PixelFormat := ie24RGB;
      _IEResampleIEBitmap(ASource, ADest, ResamplingFilter, nil, nil);
      ADest.CopyToTBitmap(ABitmap);
    finally
      ASource.Free;
      ADest.free;
    end;
  end;

var
  ATempBmp : TBitmap;
  iNewWidth, iNewHeight : Integer;
  DrawRect : TRect;
begin
  if (ABitmap.Width = iWidth) and (ABitmap.Height = iHeight) and (ABitmap.PixelFormat <> pf1bit) then
  begin
    ABitmap.PixelFormat := pf24bit;
    exit;
  end;

  ATempBmp := TBitmap.Create;
  try
    if ABitmap.PixelFormat = pf1bit then
      ConvertBmpTo24Bit(ABitmap);
    ABitmap.PixelFormat := pf24bit;

    // Create blank image
    ATempBmp.PixelFormat := pf24bit;
    ATempBmp.Width       := iWidth;
    ATempBmp.Height      := iHeight;
    ATempBmp.Canvas.Brush.Color := Background;
    ATempBmp.Canvas.FillRect(Rect(0, 0, iWidth, iHeight));

    DrawRect := GetImageRectWithinArea(ABitmap.width, ABitmap.height,
                                       ATempBmp.Width, ATempBmp.Height,
                                       0, 0,
                                       bStretchSmall, True);

    // Resize to output dimensions
    iNewWidth  := DrawRect.Right  - DrawRect.Left;
    iNewHeight := DrawRect.Bottom - DrawRect.Top;
    if (ABitmap.Width <> iNewWidth) or (ABitmap.Height <> iNewHeight) then
      DoResizeBmp(ABitmap, iNewWidth, iNewHeight, ResamplingFilter);

    // now draw it to our canvas
    ATempBmp.canvas.Draw(DrawRect.left, DrawRect.top, ABitmap);

    ABitmap.Assign(ATempBmp);
  finally
    FreeAndNil(ATempBmp);
  end;
end;
         

{!!
<FS>TImageEnProc.PrepareTransitionBitmaps

<FM>Declaration<FC>
procedure PrepareTransitionBitmaps(StartBitmap, EndBitmap : TBitmap; Effect : <A TIETransitionType>; iWidth : Integer = -1; iHeight : Integer = -1;
                                   BackgroundColor : TColor = -1; ResamplingFilter : <A TResampleFilter>);

<FM>Description<FN>
Use with <A TImageEnProc.CreateTransitionBitmap> to create a series of frames that transition from <FC>StartBitmap<FN> to <FC>EndBitmap<FN>.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>StartBitmap<FN></C> <C>The image that we transition from</C> </R>
<R> <C><FC>EndBitmap<FN></C> <C>The image that we transition to</C> </R>
<R> <C><FC>Effect<FN></C> <C>The desired <L TIETransitionType>transition effect</L></C> </R>
<R> <C><FC>iWidth, iHeight<FN></C> <C>The size to create the transition bitmaps.  If either of these are -1 then the size will be the larger of the two images in each dimension.  Aspect Ratios will be maintained and any non-image area will be filled with <FC>BackgroundColor<FN>.</C> </R>
<R> <C><FC>BackgroundColor<FN></C> <C>The color that will be used for blank frames or non-image area (if -1 then <A TImageEnMView.Background> is used)</C> </R>
<R> <C><FC>ResamplingFilter<FN></C> <C>The <L TResampleFilter>algorithm</L> that is used to improve quality when resizing images</C> </R>
</TABLE>

Note: Use <A TImageEnProc.PrepareTransitionBitmapsEx> if you need to create frames for an iettPanZoom transition

<FM>See Also<FN>
- <A TImageEnProc.PrepareTransitionBitmapsEx>
- <A TImageEnProc.CreateTransitionBitmap>

<FM>Example<FC>
procedure TransitionFrameCreationExample;
var
  OldBitmap, NewBitmap, TransBitmap : TBitmap;
  I : Integer;
  TransLevel : Single;
begin
  OldBitmap   := TBitmap.Create;
  NewBitmap   := TBitmap.Create;
  TransBitmap := TBitmap.Create;
  try
    OldBitmap.LoadFromFile('C:\OldImage.bmp');
    NewBitmap.LoadFromFile('C:\NewImage.bmp');

    // Call PrepareTransitionBitmaps once
    ImageEnProc.PrepareTransitionBitmaps(OldBitmap, NewBitmap, iettCrossDissolve);

    for i := 1 to 9 do
    begin                
      // Transition levels from 10% to 90%
      TransLevel := i * 10;
      
      // Call CreateTransitionBitmap for each required frame
      ImageEnProc.CreateTransitionBitmap(TransLevel, TransBitmap);
      TransBitmap.SaveToFile('C:\TransImage' + IntToStr(I) + '.bmp');
    end;
  finally
    OldBitmap.Free;
    NewBitmap.Free;
    TransBitmap.Free;
  end;
end;
!!}

procedure TImageEnProc.PrepareTransitionBitmaps(StartBitmap, EndBitmap : TBitmap; Effect : TIETransitionType; iWidth : Integer = -1; iHeight : Integer = -1;
                                                BackgroundColor : TColor = -1; ResamplingFilter: TResampleFilter = rfFastLinear);  
// NPC: 24/10/11
var
  ARect : TRect;
begin
  ARect := Rect(0, 0, 0, 0);
  PrepareTransitionBitmapsEx(StartBitmap, EndBitmap, Effect, ARect, ARect, True, iWidth, iHeight, False, BackgroundColor, ResamplingFilter);
end;

       

{!!
<FS>TImageEnProc.PrepareTransitionBitmapsEx

<FM>Declaration<FC>
procedure PrepareTransitionBitmapsEx(StartBitmap, EndBitmap : TBitmap; Effect : <A TIETransitionType>;
                                     StartRect, EndRect : TRect; RectMaintainAspectRatio : Boolean = True;
                                     iWidth : Integer = -1; iHeight : Integer = -1; bStretchSmall : Boolean = False;
                                     BackgroundColor : TColor = -1; ResamplingFilter : <A TResampleFilter>;
                                     Smoothing: Integer = 96; Timing : <A TIETransitionTiming> = iettLinear);


<FM>Description<FN>
An extended version of <A TImageEnProc.PrepareTransitionBitmaps> that is primarily used when creating a series of frames that show a Pan Zoom from <FC>StartRect<FN> to <FC>EndRect<FN> for image <FC>StartBitmap<FN>.
     
<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>StartBitmap<FN></C> <C>The image that we transition from</C> </R>
<R> <C><FC>EndBitmap<FN></C> <C>The image that we transition to (NIL for a iettPanZoom transition)</C> </R>
<R> <C><FC>Effect<FN></C> <C>The desired <L TIETransitionType>transition effect</L></C> </R>
<R> <C><FC>StartRect<FN></C> <C>When using an iettPanZoom effect this is the portion of the image that is shown at the start</C> </R>
<R> <C><FC>EndRect<FN></C> <C>When using an iettPanZoom effect this is the portion of the image that is shown at the end</C> </R>
<R> <C><FC>RectMaintainAspectRatio<FN></C> <C>ImageEn will ensure that the starting and ending rects are automatically adjusted to ensure the resultant image has the correct aspect ratio (iettPanZoom only)</C> </R>
<R> <C><FC>iWidth, iHeight<FN></C> <C>The size to create the transition bitmaps.  If either of these are -1 then the size will be the larger of the two images in each dimension.  Aspect Ratios will be maintained and any non-image area will be filled with <FC>BackgroundColor<FN>.</C> </R>
<R> <C><FC>bStretchSmall<FN></C> <C>If the images are smaller than the transition bitmap size (<FC>iWidth<FN> x <FC>iHeight<FN>) should they be stretched to fit (which can lead to distortion).</C> </R>
<R> <C><FC>BackgroundColor<FN></C> <C>The color that will be used for blank frames or non-image area (if -1 then <A TImageEnMView.Background> is used)</C> </R>
<R> <C><FC>ResamplingFilter<FN></C> <C>The <L TResampleFilter>algorithm</L> that is used to improve quality when resizing images</C> </R>
<R> <C><FC>Smoothing<FN></C> <C>In order to reduce the "jumpiness" of pan zoom effects, transition frames are alpha blended. A low value will improve smoothness, but increase blurriness. A high value will improve clarity, but increase jumpiness. Typical range is 64 - 196. 255 means no alpha blending</C> </R>
<R> <C><FC>Timing<FN></C> <C>The <L TIETransitionTiming>rate</L> at which the transition progresses</C> </R>
</TABLE>

To create Pan Zoom transitions for an image call it as follows:

PrepareTransitionBitmapsEx(MyBitmap, nil, iettPanZoom, StartingRect, EndingRect);
CreateTransitionBitmap(TransitionLevel, MyPanZoomBitmap);

<FM>See Also<FN>
- <A TImageEnProc.PrepareTransitionBitmaps>
- <A TImageEnProc.CreateTransitionBitmap>

<FM>Example<FC>
procedure PanZoomFrameCreationExample(StartingRect, EndingRect : TRect);
var
  MyBitmap, PanZoomBitmap : TBitmap;
  I : Integer;
  TransLevel : Single;
begin
  MyBitmap    := TBitmap.Create;
  PanZoomBitmap := TBitmap.Create;
  try
    MyBitmap.LoadFromFile('C:\MyImage.bmp');

    // Call PrepareTransitionBitmaps once
    ImageEnProc.PrepareTransitionBitmapsEx(MyBitmap, MyBitmap, iettPanZoom, StartingRect, EndingRect);

    for i := 0 to 10 do
    begin                     
      // Pan Zoom Transitions from StartingRect (0%) to EndingRect (100%)
      TransLevel := i * 10;

      // Call CreateTransitionBitmap for each required frame
      ImageEnProc.CreateTransitionBitmap(TransLevel, PanZoomBitmap);
      PanZoomBitmap.SaveToFile('C:\PanZoomImage' + IntToStr(I) + '.bmp');
    end;
  finally
    MyBitmap.Free;
    PanZoomBitmap.Free;
  end;
end;
!!}
procedure TImageEnProc.PrepareTransitionBitmapsEx(StartBitmap, EndBitmap : TBitmap; Effect : TIETransitionType;
                                                  StartRect, EndRect : TRect; RectMaintainAspectRatio : Boolean = True;
                                                  iWidth : Integer = -1; iHeight : Integer = -1; bStretchSmall : Boolean = False;
                                                  BackgroundColor : TColor = -1; ResamplingFilter: TResampleFilter = rfFastLinear;
                                                  Smoothing: Integer = 96; Timing : TIETransitionTiming = iettLinear);
// NPC: 24/10/11
var
  BColor : TColor;                                                  
begin
  if not assigned(fTransition) then
    fTransition := TIETransitionEffects.Create(nil);

  if BackgroundColor = -1 then
    BColor := GetReBackground
  else
    BColor := BackgroundColor;

  fTransition.Transition := Effect;
  fTransition.Timing     := Timing;
  fTransition.Background := BColor;
  fTransition.Smoothing  := Smoothing;

  if (iWidth < 0) or (iHeight < 0) then
  begin
    iWidth  := StartBitmap.Width;
    iHeight := StartBitmap.Height;
    if Effect <> iettPanZoom then
    begin
      iWidth  := max(iWidth,  EndBitmap.Width);
      iHeight := max(iHeight, EndBitmap.Height);
    end;
  end;   

  if Effect = iettPanZoom then
  begin
    // Need our full resolution images
    if not assigned(fTransitionFullBitmap) then
      fTransitionFullBitmap := TIEBitmap.create;
    fTransitionFullBitmap.Assign(StartBitmap);
  end;

  if RectMaintainAspectRatio and (Effect = iettPanZoom) then
  begin
    fTransition.StartRect := IEAdjustRectToAspectRatio( StartRect, fTransitionFullBitmap.Width, fTransitionFullBitmap.Height, iWidth, iHeight );
    fTransition.EndRect   := IEAdjustRectToAspectRatio( EndRect  , fTransitionFullBitmap.Width, fTransitionFullBitmap.Height, iWidth, iHeight );
  end
  else
  begin
    fTransition.StartRect := StartRect;
    fTransition.EndRect   := EndRect;
  end;

  ResizeBitmap(StartBitmap, iWidth, iHeight, bStretchSmall, BColor, ResamplingFilter);
  if Effect <> iettPanZoom then
    ResizeBitmap(EndBitmap, iWidth, iHeight, bStretchSmall, BColor, ResamplingFilter);

  if Effect = iettPanZoom then
  begin
    fTransition.FullImage := fTransitionFullBitmap;
    fTransition.PrepareBitmap(StartBitmap, StartBitmap)
  end
  else
  begin
    fTransition.PrepareBitmap(StartBitmap, EndBitmap);
  end;
end;

{!!
<FS>TImageEnProc.CreateTransitionBitmap

<FM>Declaration<FC>
procedure CreateTransitionBitmap(TransitionProgress : Single; DestBitmap : TBitmap);

<FM>Description<FN>
Use with <A TImageEnProc.PrepareTransitionBitmaps> or <A TImageEnProc.PrepareTransitionBitmapsEx> to create a series of frames that transition from one bitmap to another.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>TransitionProgress<FN></C> <C>The percentage that it is has progressed from the start image to the end image (ranging from 0.0 to 100.0)</C> </R>
<R> <C><FC>DestBitmap<FN></C> <C>Will be filled with the created transition frame.  It must be created before calling and will be automatically sized and set to 24 bit</C> </R>
</TABLE>

<FM>See Also<FN>
- <A TImageEnProc.PrepareTransitionBitmaps>
- <A TImageEnProc.PrepareTransitionBitmapsEx>

<FM>Example<FC>
procedure TransitionFrameCreationExample;
var
  OldBitmap, NewBitmap, TransBitmap : TBitmap;
  I : Integer;
  TransLevel : Single;
begin
  OldBitmap   := TBitmap.Create;
  NewBitmap   := TBitmap.Create;
  TransBitmap := TBitmap.Create;
  try
    OldBitmap.LoadFromFile('C:\OldImage.bmp');
    NewBitmap.LoadFromFile('C:\NewImage.bmp');

    // Call PrepareTransitionBitmaps once
    ImageEnProc.PrepareTransitionBitmaps(OldBitmap, NewBitmap, iettCrossDissolve);

    for i := 1 to 9 do
    begin
      // Transition levels from 10% to 90%
      TransLevel := i * 10;
      
      // Call CreateTransitionBitmap for each required frame
      ImageEnProc.CreateTransitionBitmap(TransLevel, TransBitmap);
      TransBitmap.SaveToFile('C:\TransImage' + IntToStr(I) + '.bmp');
    end;
  finally
    OldBitmap.Free;
    NewBitmap.Free;
    TransBitmap.Free;
  end;
end;
!!}
procedure TImageEnProc.CreateTransitionBitmap(TransitionProgress : Single; DestBitmap : TBitmap);
// NPC: 24/10/11
begin
  if not assigned(FTransition) then
    EIEException.Create('Transition has not been prepared!');

  fTransition.CreateBitmap(TransitionProgress, DestBitmap);
end;



procedure TImageEnProc.TextOut_Legacy(X, Y : Integer; const Text : String; AFont : TFont = nil; Angle : Integer = 0;
                                      bAntiAlias : Boolean = true; bAutoEnlarge : Boolean = False);
var
  LogFont : TLogFont;
  iHorzBuff, iVertBuff: Integer;
  AnExtent : TSize;
  OldFontHandle, 
  AFontHandle : HFont;
  ABrushStyle: TBrushStyle;
  AFontColor: TColor;
  angleXAdd: Integer;
  ProcBitmap: TIEBitmap;
  Mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_TEXTOUT,
                              {$ELSE}
                              IEMsg( IEMsg_InsertText ),
                              {$ENDIF}
                              ProcBitmap, Mask, IEOP_TEXTOUT ) then
    exit;

  OldFontHandle := ProcBitmap.Canvas.Font.Handle;
  ABrushStyle := ProcBitmap.Canvas.Brush.Style;
  AFontColor := ProcBitmap.Canvas.Font.Color;
  if AFont = nil then
    AFont := ProcBitmap.Canvas.Font;

  GetObject(AFont.Handle, SizeOf(TLogFont), @LogFont);
  try
    ProcBitmap.Canvas.Brush.Style := bsClear;
    ProcBitmap.Canvas.Font.Color  := AFont.Color;  // Color is not handled by logfont
    LogFont.lfEscapement  := Angle * 10;
    LogFont.lfOrientation := Angle * 10;
    if bAntiAlias then
      LogFont.lfQuality   := ANTIALIASED_QUALITY
    else
      LogFont.lfQuality   := NONANTIALIASED_QUALITY;
    AFontHandle := CreateFontIndirect(LogFont);
    ProcBitmap.Canvas.Font.Handle := AFontHandle;
    AnExtent  := ProcBitmap.Canvas.TextExtent(Text);

    // TextExtent does not handle Escapement
    angleXAdd := 0;
    if Angle <> 0 then
    begin
      angleXAdd := AnExtent.cY;
      AnExtent.cx := iMax( AnExtent.cx, AnExtent.cy );
      AnExtent.cy := AnExtent.cx;
      AnExtent.cx := AnExtent.cx + angleXAdd;
    end;

    if bAutoEnlarge and (( ProcBitmap.Width < AnExtent.cx ) or ( ProcBitmap.Height < AnExtent.cy )) then
      ProcBitmap.Resize( iMax( ProcBitmap.Width, AnExtent.cx ), iMax( ProcBitmap.Height, AnExtent.cy ), Background);

    iHorzBuff := ProcBitmap.Width div 20;
    iVertBuff := ProcBitmap.Height div 20;

    case X of
      Align_Text_Left         : X := 0;
      Align_Text_Near_Left    : X := iHorzBuff;
      Align_Text_Horz_Center  : X := (ProcBitmap.Width - AnExtent.cx) div 2;
      Align_Text_Near_Right   : X := ProcBitmap.Width - AnExtent.cx - iHorzBuff;
      Align_Text_Right        : X := ProcBitmap.Width - AnExtent.cx;
    end;
    inc( x, angleXAdd );

    case Y of
      Align_Text_Top          : Y := 0;
      Align_Text_Near_Top     : Y := iVertBuff;
      Align_Text_Vert_Center  : Y := (ProcBitmap.Height - AnExtent.cy) div 2;
      Align_Text_Near_Bottom  : Y := ProcBitmap.Height - AnExtent.cy - iVertBuff;
      Align_Text_Bottom       : Y := ProcBitmap.Height - AnExtent.cy;
    end;

    ProcBitmap.Canvas.TextOut(X, Y, Text);
  finally
    // Restore canvas properties
    ProcBitmap.Canvas.Brush.Style := ABrushStyle;
    ProcBitmap.Canvas.Font.Color  := AFontColor;
    ProcBitmap.Canvas.Font.Handle := OldFontHandle;
  end;

  EndImageProcessing(ProcBitmap, Mask);
  DoFinishWork;
end;


{!!
<FS>TImageEnProc.TextOut

<FM>Declaration<FC>
procedure TextOut(X, Y : Integer; const Text : String; AFont : TFont = nil; Angle : Integer = 0;
                  bAntiAlias : Boolean = true; bAutoEnlarge : Boolean = False); overload;
procedure TextOut(X, Y : Integer; const Text : String; const sFontName : String; iFontSize : Integer; cFontColor : TColor; Style : TFontStyles; Angle : Integer = 0;
                  bAntiAlias : Boolean = true; bAutoEnlarge : Boolean = False); overload;
procedure TextOut(Rect: TRect; const Text : String; AFont : TFont = nil; Angle : Integer = 0); overload;
procedure TextOut(Rect: TRect; const Text : String; const sFontName : String; iFontSize : Integer; cFontColor : TColor; Style : TFontStyles; Angle : Integer = 0); overload;

<FM>Description<FN>
Draw text at the specified position.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>X<FN></C> <C>Horizontal position. Either a pixel value or one of the following consts: Align_Text_Left, Align_Text_Near_Left*, Align_Text_Horz_Center, Align_Text_Near_Right* or Align_Text_Right</C> </R>
<R> <C><FC>Y<FN></C> <C>Vertical position. Either a pixel value or one or one of the following consts: Align_Text_Top, Align_Text_Near_Top*, Align_Text_Vert_Center, Align_Text_Near_Bottom* or Align_Text_Bottom</C> </R>
<R> <C><FC>Rect<FN></C> <C>The bounds for the text output. This will enforce text wrapping and clipping</C> </R>
<R> <C><FC>AFont<FN></C> <C>The text font can be specified using a TFont or by individual properties. If AFont is passed as nil then the Canvas.Font is used</C> </R>
<R> <C><FC>Angle<FN></C> <C>The Escapement value, i.e. -45 will draws text diagonally downwards (i.e. rotated 45 degrees clockwise)</C> </R>
<R> <C><FC>bAntiAlias<FN></C> <C>True uses best quality font. False using an anti-aliased one</C> </R>
<R> <C><FC>bAutoEnlarge<FN></C> <C>If the image is not large enough to fit the text it will be enlarged and filled with <A TImageEnProc.Background></C> </R>
</TABLE>
* "Near" values provide a 5% buffer from the edge


<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\TextOut\TextOut.dpr </C> </R>
</TABLE>

<FM>Example<FC>
// Add the filename at the bottom centre
ImageEnView1.Proc.TextOut(Align_Text_Horz_Center, Align_Text_Near_Bottom, ExtractFileName(ImageEnView1.IO.Params.Filename), 'Arial', 32, clRed, [fsBold]);


// Do the same but with a soft shadow effect (though you would be better to use a <A TIETextLayer>)

// add a new layer
ImageEnView1.LayersAdd;

// White fill the new layer
ImageEnView1.Proc.Fill(CreateRGB(255, 255, 255));

// Output our text
ImageEnView1.Proc.TextOut(Align_Text_Horz_Center, Align_Text_Near_Bottom, ExtractFileName(ImageEnView1.IO.Params.Filename), 'Arial', 32, clRed, [fsBold]);

// Make the white background transparent
ImageEnView1.Proc.SetTransparentColors(CreateRGB(255, 255, 255), CreateRGB(255, 255, 255), 0); // remove the white, making it as transparent

// Add our shadow
ImageEnView1.Proc.AddSoftShadow(2, 3, 3);

// Merge layer into main window
ImageEnView.LayersMergeAll();


// Draw text onto a TBitmap or TIEBitmap
with TImageEnProc.CreateFromBitmap(myBitmap) do
begin
  TextOut(Align_Text_Horz_Center, Align_Text_Near_Bottom, 'Me in Italy - 2015', 'Arial', 32, clRed, [fsBold]);
  Free;
end;
!!}

procedure TImageEnProc.TextOut(X, Y : Integer; const Text : String; AFont : TFont = nil; Angle : Integer = 0;
                               bAntiAlias : Boolean = true; bAutoEnlarge : Boolean = False);
var
  iHorzBuff, iVertBuff: Integer;
  AnExtent: TSize;
  ndx, ndy: Integer;
  ProcBitmap: TIEBitmap;
  Mask: TIEMask;
  x1, y1, x2, y2: Integer;
  CompCanvas: TIECanvas;
  iAlpha: Integer;
  radAngle: Double;
begin
  // LEGACY CODE
  if bAntiAlias = False then
  begin
    TextOut_Legacy( X, Y, Text, AFont, Angle, bAntiAlias, bAutoEnlarge );
    exit;
  end;

  if not BeginImageProcessing([], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_TextOut,
                              {$ELSE}
                              IEMsg( IEMsg_InsertText ),
                              {$ENDIF}
                              ProcBitmap, Mask, IEOP_TextOut ) then
    exit;

  if AFont <> nil then
    ProcBitmap.Canvas.Font.Assign( AFont );

  AnExtent := ProcBitmap.IECanvas.MeasureText( Text, True );

  if Angle <> 0 then
  begin
    radAngle := IEDegreesToRadians( -Angle ); // angle in radians
    ndx := trunc( abs( AnExtent.cx * cos( radAngle )) + abs( AnExtent.cy * sin( radAngle )));
    ndy := trunc( abs( AnExtent.cx * sin( radAngle )) + abs( AnExtent.cy * cos( radAngle )));
    AnExtent.cx := ndx;
    AnExtent.cy := ndy;
  end;

  if bAutoEnlarge and (( ProcBitmap.Width < AnExtent.cx ) or ( ProcBitmap.Height < AnExtent.cy )) then
  begin
    iAlpha := 255;
    if ProcBitmap.HasAlphaChannel then
      iAlpha := ProcBitmap.Alpha[0, 0];
    ProcBitmap.Resize( iMax( ProcBitmap.Width, AnExtent.cx ), iMax( ProcBitmap.Height, AnExtent.cy ), Background, iAlpha);
  end;

  iHorzBuff := ProcBitmap.Width div 20;
  iVertBuff := ProcBitmap.Height div 20;

  case X of
    Align_Text_Left         : X := 0;
    Align_Text_Near_Left    : X := iHorzBuff;
    Align_Text_Horz_Center  : X := (ProcBitmap.Width - AnExtent.cx) div 2;
    Align_Text_Near_Right   : X := ProcBitmap.Width - AnExtent.cx - iHorzBuff;
    Align_Text_Right        : X := ProcBitmap.Width - AnExtent.cx;
  end;

  case Y of
    Align_Text_Top          : Y := 0;
    Align_Text_Near_Top     : Y := iVertBuff;
    Align_Text_Vert_Center  : Y := (ProcBitmap.Height - AnExtent.cy) div 2;
    Align_Text_Near_Bottom  : Y := ProcBitmap.Height - AnExtent.cy - iVertBuff;
    Align_Text_Bottom       : Y := ProcBitmap.Height - AnExtent.cy;
  end;

  CompCanvas := ProcBitmap.CreateROICanvas(Rect(0, 0, ProcBitmap.Width, ProcBitmap.Height), true, true, true);
  try
    CompCanvas.Brush.Color := ProcBitmap.Canvas.Font.Color;
    CompCanvas.Font.Color  := ProcBitmap.Canvas.Font.Color;
    CompCanvas.Font.Name   := ProcBitmap.Canvas.Font.Name;
    CompCanvas.Font.Height := ProcBitmap.Canvas.Font.Height;
    CompCanvas.Font.Style  := ProcBitmap.Canvas.Font.Style;

    CompCanvas.DrawText( Text, X, Y, -Angle );
  finally
    CompCanvas.Free();
  end;

  EndImageProcessing(ProcBitmap, Mask);
  DoFinishWork;
end;

procedure TImageEnProc.TextOut(X, Y : Integer; const Text : String; const sFontName : String; iFontSize : Integer; cFontColor : TColor; Style : TFontStyles; Angle : Integer = 0; bAntiAlias : Boolean = true; bAutoEnlarge : Boolean = False);
var
  wasFontName : String;
  wasFontSize : Integer;
  wasFontColor : TColor;
  wasStyle : TFontStyles;
begin
  wasFontName := fIEBitmap.Canvas.Font.Name;
  wasFontSize := fIEBitmap.Canvas.Font.Size;
  wasFontColor := fIEBitmap.Canvas.Font.Color;
  wasStyle := fIEBitmap.Canvas.Font.Style;
  try
    fIEBitmap.Canvas.Font.Name  := sFontName;
    fIEBitmap.Canvas.Font.Size  := iFontSize;
    fIEBitmap.Canvas.Font.Color := cFontColor;
    fIEBitmap.Canvas.Font.Style := Style;

    TextOut(X, Y, Text, fIEBitmap.Canvas.Font, Angle, bAntiAlias, bAutoEnlarge);
  finally
    fIEBitmap.Canvas.Font.Name  := wasFontName;
    fIEBitmap.Canvas.Font.Size  := wasFontSize;
    fIEBitmap.Canvas.Font.Color := wasFontColor;
    fIEBitmap.Canvas.Font.Style := wasStyle;
  end;
end;

procedure TImageEnProc.TextOut(Rect: TRect; const Text : String; AFont : TFont = nil; Angle : Integer = 0);
var
  ProcBitmap: TIEBitmap;
  Mask: TIEMask;
  x1, y1, x2, y2: Integer;
  CompCanvas: TIECanvas;
begin
  if not BeginImageProcessing([], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_TextOut,
                              {$ELSE}
                              IEMsg( IEMsg_InsertText ),
                              {$ENDIF}
                              ProcBitmap, Mask, IEOP_TextOut ) then
    exit;

  if AFont <> nil then
    ProcBitmap.Canvas.Font.Assign( AFont );

  CompCanvas := ProcBitmap.CreateROICanvas( IECreateRect(0, 0, ProcBitmap.Width, ProcBitmap.Height), true, true, true);
  try
    CompCanvas.Brush.Color := ProcBitmap.Canvas.Font.Color;
    CompCanvas.Font.Color := ProcBitmap.Canvas.Font.Color;
    CompCanvas.Font.Name   := ProcBitmap.Canvas.Font.Name;
    CompCanvas.Font.Height := ProcBitmap.Canvas.Font.Height;
    CompCanvas.Font.Style  := ProcBitmap.Canvas.Font.Style;

    CompCanvas.DrawText( Text, Rect, -Angle );
  finally
    CompCanvas.Free();
  end;

  EndImageProcessing(ProcBitmap, Mask);
  DoFinishWork;
end;

procedure TImageEnProc.TextOut(Rect: TRect; const Text : String; const sFontName : String; iFontSize : Integer; cFontColor : TColor; Style : TFontStyles; Angle : Integer = 0);
var
  wasFontName : String;
  wasFontSize : Integer;
  wasFontColor : TColor;
  wasStyle : TFontStyles;
begin
  wasFontName := fIEBitmap.Canvas.Font.Name;
  wasFontSize := fIEBitmap.Canvas.Font.Size;
  wasFontColor := fIEBitmap.Canvas.Font.Color;
  wasStyle := fIEBitmap.Canvas.Font.Style;
  try
    fIEBitmap.Canvas.Font.Name  := sFontName;
    fIEBitmap.Canvas.Font.Size  := iFontSize;
    fIEBitmap.Canvas.Font.Color := cFontColor;
    fIEBitmap.Canvas.Font.Style := Style;

    TextOut(Rect, Text, fIEBitmap.Canvas.Font, Angle);
  finally
    fIEBitmap.Canvas.Font.Name  := wasFontName;
    fIEBitmap.Canvas.Font.Size  := wasFontSize;
    fIEBitmap.Canvas.Font.Color := wasFontColor;
    fIEBitmap.Canvas.Font.Style := wasStyle;
  end;
end;


{!!
<FS>TImageEnProc.IntensityRGBAll

<FM>Declaration<FC>
procedure IntensityRGBAll(r, g, b: Integer);

<FM>Description<FN>
Change the RGB channels of the current image or the selected region.
R, G and B are the channel offsets, from -255 to +255.
Negative values darken all the pixels in the image. Positive values lighten all pixels in the image. To darken colors use IntensityRGBAll (-10, -10, -10). To lighten colors use IntensityRGBAll (10, 10, 10). Also see AdjustBrightnessContrastSaturation which uses a non-linear LUT to adjust the pixel colors.  IntensityRGBAll adjusts the pixel colors by adding or subtracting the R, G, B values to each pixel in the image.

<FM>Example<FC>
// subtracts the Red channel
ImageEnView1.Proc.IntensityRGBall(-255, 0, 0);

// apply a Red filter (subtracts the Green and Blue channels)
ImageEnView1.Proc.IntensityRGBall(0, -255, -255);

// apply a darken filter (subtracts the same value from all channels)
ImageEnView1.Proc.IntensityRGBall(-10, -10, -10);

// apply a lighten filter (adds the same value to all channels)
ImageEnView1.Proc.IntensityRGBall(10, 10, 10);
!!}
procedure TImageEnProc.IntensityRGBAll(r, g, b: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_INTENSITYRGBALL, [r, g, b]),
                              {$ELSE}
                              IEMsg( IEMsg_AdjustRGB ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_INTENSITYRGBALL ) then
    exit;
  _IntensityRGBAll(ProcBitmap, r, g, b, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

// Changes RGB values inside the specified selection. r, g, b, are offsets.

procedure _IntensityRGBAll(bitmap: TIEBitmap; r, g, b: Integer; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  x, y: Integer;
  e: pRGB;
  per1: Double;
  LUTR, LUTG, LUTB: array [0..255] of byte;
begin
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  per1 := 100 / (fSelY2 - fSelY1 + 0.5);

  for x := 0 to 255 do
  begin
    LUTR[x] := blimit(x+r);
    LUTG[x] := blimit(x+g);
    LUTB[x] := blimit(x+b);
  end;

  for y := fSely1 to fSely2 do
  begin
    e := bitmap.ScanLine[y];
    inc(e, fSelx1);
    for x := fSelx1 to fSelx2 do
    begin
      with e^ do
      begin
        r := LUTR[r];
        g := LUTG[g];
        b := LUTB[b];
      end;
      inc(e);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (y - fSelY1 + 1)));
  end;
end;

// Returns a Bitmap which represents only one channel H, S or B
// ch: 0=H 1=S 2=V
// The resulting bitmap is always ie24RGB
function _GetHSVChannel(bitmap: TIEBitmap; ch: Integer; fOnProgress: TIEProgressEvent; Sender: TObject): TIEBitmap;
var
  x, y: Integer;
  e, d: pRGB;
  per1: Double;
  hsv: array[0..2] of integer;
  dv, r: Integer;
  bitmapwidth1, bitmapheight1: Integer;
begin
  result := nil;
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  result := TIEBitmap.Create;
  result.Allocate(Bitmap.Width, Bitmap.Height, ie24RGB);
  per1 := 100 / Bitmap.Height;
  case ch of
    0: dv := 359;
    1: dv := 99;
    2: dv := 99;
  else
    begin
      // when ch is not valid gets Hue
      ch := 0;
      dv := 359;
    end;
  end;
  bitmapheight1 := bitmap.height - 1;
  bitmapwidth1 := bitmap.width - 1;
  for y := 0 to BitmapHeight1 do
  begin
    e := bitmap.ScanLine[y];
    d := result.ScanLine[y];
    for x := 0 to BitmapWidth1 do
    begin
      RGB2HSV(e^, hsv[0], hsv[1], hsv[2]);
      r := trunc((hsv[ch] / dv) * 255);
      d^.r := r;
      d^.g := r;
      d^.b := r;
      inc(e);
      inc(d);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * y));
  end;
end;

// Returns a Bitmap that represents only one channel R, G or B
// ch: B=0 G=1 R = 2
// The resulting bitmap is always ie24RGB
function _GetRGBChannel(bitmap: TIEBitmap; ch: Integer; fOnProgress: TIEProgressEvent; Sender: TObject): TIEBitmap;
var
  x, y: Integer;
  e: pbytearray;
  d: pRGB;
  per1: Double;
  bitmapwidth1, bitmapheight1: Integer;
begin
  result := nil;
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  result := TIEBitmap.Create;
  result.Allocate(Bitmap.Width, Bitmap.Height, ie24RGB);
  per1 := 100 / Bitmap.Height;
  if ch > 2 then
    ch := 2;
  bitmapheight1 := bitmap.height - 1;
  bitmapwidth1 := bitmap.width - 1;
  for y := 0 to BitmapHeight1 do
  begin
    e := bitmap.ScanLine[y];
    d := result.ScanLine[y];
    for x := 0 to BitmapWidth1 do
    begin
      d^.b := e[ch];
      d^.g := e[ch];
      d^.r := e[ch];
      inc(pbyte(e), 3);
      inc(d);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * y));
  end;
end;

{!!
<FS>TImageEnProc.GetHSVChannel

<FM>Declaration<FC>
function GetHSVChannel(ch: Integer): <A TIEBitmap>;

<FM>Description<FN>
Returns a Bitmap with the HSV specified channel. The result Bitmap is a gray level representation of the specified channel.

<FC>ch<FN> is the HSV channel. 0 is Hue, 1 is Saturation, and 2 is Value.

<FM>Example<FC>
Hue := ImageEnView1.Proc.GetHSVChannel(0);
Sat := ImageEnView1.Proc.GetHSVChannel(1);
Val := ImageEnView1.Proc.GetHSVChannel(2);

ImageEnView2.IEBitmap.Assign(Hue); // copy Hue channel
ImageEnView3.IEBitmap.Assign(Sat); // copy Sat channel
ImageEnView4.IEBitmap.Assign(Val); // copy Val channel

Hue.Free;
Sat.Free;
Val.Free;

ImageEnView2.Update;
ImageEnView3.Update;
ImageEnView4.Update;

!!}
function TImageEnProc.GetHSVChannel(ch: Integer): TIEBitmap;
begin
  result := nil;
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  result := _GetHSVChannel(fIEBitmap, ch, fOnProgress, self);
  DoFinishWork;
end;

{!!
<FS>TImageEnProc.GetRGBChannel

<FM>Declaration<FC>
function GetRGBChannel(ch: <A TIEChannel>): <A TIEBitmap>;

<FM>Description<FN>
Returns a Bitmap with the RGB specified channel. The resulting Bitmap is a gray level representation of the specified channel.

<FC>ch<FN> is the RGB channel: iecRed, iecGreen, iecBlue

<FM>Example<FC>
blue  := ImageEnView1.Proc.GetRGBChannel(iecBlue);
green := ImageEnView1.Proc.GetRGBChannel(iecGreen);
red   := ImageEnView1.Proc.GetRGBChannel(iecRed);

ImageEnView2.IEBitmap.Assign(blue);  // show Blue channel
ImageEnView3.IEBitmap.Assign(green); // show Green channel
ImageEnView4.IEBitmap.Assign(red);   // show Red channel

ImageEnView2.Update;
ImageEnView3.Update;
ImageEnView4.Update;

red.Free;
green.Free;
blue.Free;
!!}
// Returns a Bitmap that contains only one channel of R, G or B
// ch: B=0 G=1 R = 2
function TImageEnProc.GetRGBChannel(ch: TIEChannel): TIEBitmap;
begin
  result := nil;
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  case ch of
    iecBlue  : result := _GetRGBChannel(fIEBitmap, 0 { B }, fOnProgress, self);
    iecGreen : result := _GetRGBChannel(fIEBitmap, 1 { G }, fOnProgress, self);
    iecRed   : result := _GetRGBChannel(fIEBitmap, 2 { R }, fOnProgress, self);
  end;
  DoFinishWork;
end;

{$ifdef IEIncludeDeprecatedInV5}
// Deprecated in 5.2.0
// Returns a Bitmap that contains only one channel of R, G or B
// ch: B=0 G=1 R = 2
function TImageEnProc.GetRGBChannel(ch: Integer): TIEBitmap;
begin
  result := nil;
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  result := _GetRGBChannel(fIEBitmap, ch, fOnProgress, self);
  DoFinishWork;
end;
{$endif}

// Returns three Bitmaps for each H, S or B channel
// ch: 0=H 1=S 2=V
// The resulting bitmap are always ie24RGB
// The caller must create the bitmaps
procedure _GetHSVChannelAll(bitmap: TIEBitmap; BitmapH, BitmapS, BitmapV: TIEBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  x, y: Integer;
  e, d1, d2, d3: pRGB;
  per1: Double;
  h, s, v: Integer;
  r: Integer;
  bitmapwidth1, bitmapheight1: Integer;
begin
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  BitmapH.Allocate(Bitmap.Width, Bitmap.Height, ie24RGB);
  BitmapS.Allocate(Bitmap.Width, Bitmap.Height, ie24RGB);
  BitmapV.Allocate(Bitmap.Width, Bitmap.Height, ie24RGB);
  per1 := 100 / Bitmap.Height;
  bitmapheight1 := bitmap.height - 1;
  bitmapwidth1 := bitmap.width - 1;
  for y := 0 to BitmapHeight1 do
  begin
    e := bitmap.ScanLine[y];
    d1 := BitmapH.ScanLine[y];
    d2 := BitmapS.ScanLine[y];
    d3 := BitmapV.ScanLine[y];
    for x := 0 to BitmapWidth1 do
    begin
      RGB2HSV(e^, h, s, v);
      // Sat
      r := trunc((s / 99) * 255);
      d2^.r := r;
      d2^.g := r;
      d2^.b := r;
      inc(d2);
      // Val
      r := trunc((v / 99) * 255);
      d3^.r := r;
      d3^.g := r;
      d3^.b := r;
      inc(d3);
      // Hue
      r := trunc((h / 359) * 255);
      d1^.r := r;
      d1^.g := r;
      d1^.b := r;
      //HSV2RGB(d1^, h, 99, 99);  // to obtain the Hue channel colorized
      inc(d1);
      //
      inc(e);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * y));
  end;
end;

{!!
<FS>TImageEnProc.GetHSVChannelAll

<FM>Declaration<FC>
procedure GetHSVChannelAll(BitmapH, BitmapS, BitmapV: <A TIEBitmap>);

<FM>Description<FN>
Copies the H, S and V channels to the bitmaps: BitmapH, BitmapS and BitmapV.

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\FullApps\PhotoEn3\ImageEx.dpr </C> </R>
</TABLE>

<FM>Example<FC>
ImageEnView1.Proc.GetHSVChannelAll( ImageEnView2.IEBitmap, ImageEnView3.IEBitmap, ImageEnView4.IEBitmap);
ImageEnView2.Update;
ImageEnView3.Update;
ImageEnVIew4.Update;
!!}
procedure TImageEnProc.GetHSVChannelAll(BitmapH, BitmapS, BitmapV: TIEBitmap);
begin
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  _GetHSVChannelAll(fIEBitmap, BitmapH, BitmapS, BitmapV, fOnProgress, self);
  DoFinishWork;
end;

// Returns three Bitmaps for each R, G, B channel
// ch: 0=R 1=G 2=B
// The resulting bitmaps are ie24RGB
// The caller must create the Bitmaps
procedure _GetRGBChannelAll(bitmap: TIEBitmap; BitmapR, BitmapG, BitmapB: TIEBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  x, y: Integer;
  e, d1, d2, d3: pRGB;
  per1: Double;
  bitmapwidth1, bitmapheight1: Integer;
begin
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  BitmapR.Allocate(Bitmap.Width, Bitmap.Height, ie24RGB);
  BitmapG.Allocate(Bitmap.Width, Bitmap.Height, ie24RGB);
  BitmapB.Allocate(Bitmap.Width, Bitmap.Height, ie24RGB);
  per1 := 100 / Bitmap.Height;
  bitmapheight1 := bitmap.height - 1;
  bitmapwidth1 := bitmap.width - 1;
  for y := 0 to BitmapHeight1 do
  begin
    e := bitmap.ScanLine[y];
    d1 := BitmapR.ScanLine[y];
    d2 := BitmapG.ScanLine[y];
    d3 := BitmapB.ScanLine[y];
    for x := 0 to BitmapWidth1 do
    begin
      d1^.r := e^.r;
      d1^.g := e^.r;
      d1^.b := e^.r;
      inc(d1);
      d2^.r := e^.g;
      d2^.g := e^.g;
      d2^.b := e^.g;
      inc(d2);
      d3^.r := e^.b;
      d3^.g := e^.b;
      d3^.b := e^.b;
      inc(d3);
      //
      inc(e);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * y));
  end;
end;

{!!
<FS>TImageEnProc.GetRGBChannelAll

<FM>Declaration<FC>
procedure GetRGBChannelAll(BitmapR, BitmapG, BitmapB: <A TIEBitmap>);

<FM>Description<FN>
Copies the R, G and B channels to the bitmaps: BitmapR, BitmapG and BitmapB.

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\FullApps\PhotoEn3\ImageEx.dpr </C> </R>
</TABLE>

<FM>Example<FC>
ImageEnView1.Proc.GetRGBChannelAll(ImageEnView2.IEBitmap, ImageEnView3.IEBitmap, ImageEnView4.IEBitmap);
ImageEnView2.Update;
ImageEnView3.Update;
ImageEnView4.Update;
!!}
procedure TImageEnProc.GetRGBChannelAll(BitmapR, BitmapG, BitmapB: TIEBitmap);
begin
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  _GetRGBChannelAll(fIEBitmap, BitmapR, BitmapG, BitmapB, fOnProgress, self);
  DoFinishWork;
end;

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


function _RGBToGray(const rgb: TRGB): Integer;
begin
  with rgb do
    result := (r * IEGlobalSettings().RedToGrayCoef + g * IEGlobalSettings().GreenToGrayCoef + b * IEGlobalSettings().BlueToGrayCoef) div 100;
end;

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

// Find the palette index that are more similar to specified color
// Col: color to find
// nc: number of colors in ColorMap
function _GetSimilColor(const ColorMap: array of TRGB; nc: Integer; Col: TRGB): Integer;
var
  q: Integer;
  Diff, ADiff: Integer;
begin
  ADiff := 1000;
  result := 0;
  for q := 0 to nc - 1 do
  begin
    Diff := abs(Col.R - ColorMap[q].R) + abs(Col.G - ColorMap[q].G) + abs(Col.B - ColorMap[q].B);
    if Diff < ADiff then
    begin
      result := q;
      ADiff := Diff;
    end;
  end;
end;

// clone the bitmap
function IECloneBitmap(Source: TBitmap): TBitmap;
begin
  result := TBitmap.Create;
  IECopyBitmap(Source, result);
end;

// Copies bitmap Source to Dest
// Width, Height and PixelFormat of Source are assigned to Dest
procedure IECopyBitmap(Source, Dest: TBitmap);
var
  ps, pd: pbyte;
  l: Integer;
  procedure ClearDest;
  begin
    Dest.Width := 1;
    Dest.Height := 1;
    Dest.Pixelformat := Source.PixelFormat;
  end;
begin
  if (Source.Width = 0) or (Source.Height = 0) then
  begin
    ClearDest;
  end
  else
  begin
    if (Dest.Width <> Source.Width) or (Dest.Height <> Source.Height) or (Dest.PixelFormat <> Source.PixelFormat) then
    begin
      ClearDest;
      Dest.Width := Source.Width;
      Dest.Height := Source.height;
    end;
    {$ifdef IEHASUINT64}
    ps := pbyte(u64min(uint64(Source.Scanline[0]), uint64(Source.Scanline[Source.Height - 1])));
    pd := pbyte(u64min(uint64(Dest.Scanline[0]), uint64(Dest.Scanline[Dest.Height - 1])));
    {$else}
    ps := pbyte(imin(int64(DWORD(Source.Scanline[0])), int64(DWORD(Source.Scanline[Source.Height - 1]))));
    pd := pbyte(imin(int64(DWORD(Dest.Scanline[0])), int64(DWORD(Dest.Scanline[Dest.Height - 1]))));
    {$endif}
    l := IEBitmapRowlen(Dest.Width, IEVCLPixelFormat2BitCount(Dest.Pixelformat), 32);
    copymemory(pd, ps, l * Dest.height);
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////
// Create a DIB from a TIEDibBitmap object (that can be only ie1g or ie24RGB)
// returns the handle of the DIB (you have do release with GlobalFree() )
// x1, y1, x2, y2: selection to copy (if x2 and y2 are zero it copy entire bitmap)
// it works with other pixel formats only if fBitmap is a TIEBitmap object
function _CopyBitmaptoDIBEx(fBitmap: TIEBaseBitmap; x1, y1, x2, y2: Integer; dpix, dpiy: Integer): THandle;
var
  pbi: PBITMAPINFO;
  i, q: Integer;
  pb, pc: pbyte;
  px: PRGB;
  hh, ww, lw: Integer;
  y: Integer;
  tmpbmp: TIEBitmap;
begin
  IEPrintLogWrite('_CopyBitmaptoDIBEx: begin');
  if (fBitmap.PixelFormat<>ie1g) and (fBitmap.PixelFormat<>ie24RGB) and (fBitmap.PixelFormat<>ie8g) and (fBitmap.PixelFormat<>ie8p) then
  begin
    IEPrintLogWrite('_CopyBitmaptoDIBEx: not supported pixel format, converting to 24bit and recurse');
    tmpbmp := TIEBitmap.Create;
    tmpbmp.Assign( fBitmap );
    if not tmpbmp.IsEmpty then
    begin
      tmpbmp.PixelFormat := ie24RGB;
      result := _CopyBitmapToDIBEx(tmpbmp, x1, y1, x2, y2, dpix, dpiy);
      FreeAndNil(tmpbmp);
      exit;
    end;
    FreeAndNil(tmpbmp);
  end;

  if x2 = 0 then
    x2 := fBitmap.Width;
  if y2 = 0 then
    y2 := fBitmap.Height;
  hh := y2 - y1;
  ww := x2 - x1;
  lw := IEBitmapRowLen(ww, fBitmap.BitCount, 32);
  case fBitmap.PixelFormat of
    ie1g:
      q := sizeof(TRGBQUAD)*2;
    ie8g, ie8p:
      q := sizeof(TRGBQUAD)*256;
    else
      q := 0;
  end;
  IEPrintLogWrite('_CopyBitmaptoDIBEx: allocate '+IntToStr(sizeof(TBITMAPINFO) + q + lw * hh)+' bytes');
  result := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, sizeof(TBITMAPINFO) + q + lw * hh);
  if result = 0 then
    exit;
  pbi := GlobalLock(result);
  fillchar(pbi^.bmiHeader, sizeof(TBITMAPINFOHEADER), 0);
  with pbi^.bmiHeader do
  begin
    biSize := sizeof(TBITMAPINFOHEADER);
    biWidth := ww;
    biHeight := hh;
    biPlanes := 1;
    biCompression := BI_RGB;
    biXPelsPerMeter := trunc(dpix * 39.3700787);
    biYPelsPerMeter := trunc(dpiy * 39.3700787);
  end;
  case fBitmap.PixelFormat of
    ie1g:
      begin
        // 1 bit gray scale
        IEPrintLogWrite('_CopyBitmaptoDIBEx: ie1g');
        pbi^.bmiHeader.biBitCount := 1;
        pb := @(pbi^.bmiColors);
        // write colormap
        pdword(pb)^ := 0; // black
        inc(pb, sizeof(TRGBQUAD));
        pdword(pb)^ := $FFFFFFFF; // white
        inc(pb, sizeof(TRGBQUAD));
        // write image
        for y := y2 - 1 downto y1 do
        begin
          px := fBitmap.Scanline[y];
          IECopyBits_large(pb, pbyte(px), 0, x1, ww, lw);
          inc(pb, lw);
        end;
      end;
    ie8g, ie8p:
      begin
        // 8 bit gray scale or palette
        IEPrintLogWrite('_CopyBitmaptoDIBEx: ie8g or ie8p');
        pbi^.bmiHeader.biBitCount := 8;
        pb := @(pbi^.bmiColors);
        case fBitmap.PixelFormat of
          ie8p:
            begin
              // write color map
              for i := 0 to fBitmap.PaletteLength-1 do
              begin
                with fBitmap.Palette[i], PRGBQUAD(pb)^ do
                begin
                  rgbBlue := b;
                  rgbGreen := g;
                  rgbRed := r;
                  rgbReserved := 0;
                end;
                inc(pb, sizeof(TRGBQUAD));
              end;
            end;
          ie8g:
            begin
              // write gray map
              for i := 0 to 255 do
              begin
                with PRGBQUAD(pb)^ do
                begin
                  rgbBlue := i;
                  rgbGreen := i;
                  rgbRed := i;
                  rgbReserved := 0;
                end;
                inc(pb, sizeof(TRGBQUAD));
              end;
            end;
        end;
        // write image
        for q := y2-1 downto y1 do
        begin
          pc := fBitmap.Scanline[q];
          inc(pc, x1);
          CopyMemory(pb, pc, lw);
          inc(pb, lw);
        end;
      end;
    ie24RGB:
      begin
        // 24 bit RGB
        IEPrintLogWrite('_CopyBitmaptoDIBEx: ie24RGB');
        pbi^.bmiHeader.biBitCount := 24;
        //pbi^.bmiHeader.biSizeImage := _BitmapRowlen(ww, 24)*hh;
        pb := @(pbi^.bmiColors);
        for q := y2 - 1 downto y1 do
        begin
          px := fbitmap.Scanline[q];
          inc(px, x1);
          CopyMemory(pb, px, lw);
          inc(pb, lw);
        end;
      end;
  end;
  GlobalUnLock(result);
end;

// Copy Len bits from Source to Dest
// Dest: pointer to destination buffer
// Source: pointer to source buffer
// DestStart: start bit of Dest
// SourceStart: start bit of Source
// Len: number of bits to copy
//
// for large "Len"s
procedure IECopyBits_large(Dest, Source: pbyte; DestStart, SourceStart, Len: Integer; SourceRowLen: Integer);
const
  mask1: array[0..7] of byte = ($0, $80, $C0, $E0, $F0, $F8, $FC, $FE);
  mask2: array[0..7] of byte = ($0, $1, $3, $7, $F, $1F, $3F, $7F);
  mask3: array[0..7] of byte = ($FF, $FE, $FC, $F8, $F0, $E0, $C0, $80);
var
  normalSourceStart, normalDestStart: Integer;
  saveleft, saveright: byte;
  bitstosaveinright: Integer;
  destrequiredbytes: Integer;
  bytestocopy: Integer;
  q: Integer;
  pred, t, xmask3, xmask1, xmask2: byte;
  p1, p2, pr: pbyte;
  tbuf: pbyte;
begin
  if (Len <= 0) or (DestStart < 0) or (SourceStart < 0) then
    exit;
  inc(Dest, DestStart shr 3);
  inc(Source, SourceStart shr 3);
  dec(SourceRowLen, SourceStart shr 3);
  normalDestStart := DestStart and $7;
  normalSourceStart := SourceStart and $7;
  destrequiredbytes := (normalDestStart + Len + 7) shr 3;
  xmask3 := mask3[normalSourceStart];
  xmask2 := mask2[normalDestStart];
  xmask1 := mask1[normalSourceStart];
  // 1 save
  saveleft := Dest^ and mask1[normalDestStart];
  bitstosaveinright := (destrequiredbytes shl 3) - normalDestStart - Len;
  pr := @(pbytearray(Dest)[destrequiredbytes - 1]);
  saveright := pr^ and mask2[bitstosaveinright];
  // 2 copy
  bytestocopy := (normalSourceStart + Len + 7) shr 3;
  tbuf := allocmem(bytestocopy + 8); // we need 0 filled from SourceRowLen to bytestocopy+8
  copymemory(tbuf, Source, imin(bytestocopy + 8, SourceRowLen));
  //
  if ((Len and $7) <> 0) or (normalDestStart > 0) or (normalSourceStart > 0) then
  begin
    // 3 shift left
    if normalSourceStart > 0 then
    begin
      p1 := tbuf;
      p2 := tbuf;
      inc(p2);
      for q := 0 to bytestocopy - 1 do
      begin
        p1^ := ((p1^ shl normalSourceStart) and xmask3) or ((p2^ and xmask1) shr (8 - normalSourceStart));
        inc(p1);
        inc(p2);
      end;
    end;
    // 4 shift right
    if normalDestStart > 0 then
    begin
      pred := 0;
      p1 := tbuf;
      for q := 0 to destrequiredbytes - 1 do
      begin
        t := (p1^ and xmask2) shl (8 - normalDestStart);
        p1^ := (p1^ shr normalDestStart) or pred;
        pred := t;
        inc(p1);
      end;
    end;
    // 5 restore
    tbuf^ := (tbuf^ and (not mask1[normalDestStart])) or saveleft;
    pr := @(pbytearray(tbuf)[destrequiredbytes - 1]);
    pr^ := (pr^ and (not mask2[bitstosaveinright])) or saveright;
  end;
  copymemory(Dest, tbuf, destrequiredbytes);
  freemem(tbuf);
end;

// for small "Len"s
procedure IECopyBits_small(Dest, Source: pbyte; DestStart, SourceStart, Len: Integer; SourceRowLen: Integer);
var
 dx, sx: Integer;
 bp: pbyte;
begin
  sx := SourceStart;
  for dx := DestStart to DestStart+Len-1 do
  begin
    bp := @(pbytearray(Dest)^[dx shr 3]);
    if (pbytearray(Source)^[sx shr 3] and iebitmask1[sx and $7]) <> 0 then
      bp^ := bp^ or iebitmask1[dx and 7]
    else
      bp^ := bp^ and not iebitmask1[dx and 7];
    inc(sx);
  end;
end;



// Copies the specified area of Source in Dest
// PixelFormat of Source can be only pf24bit or pf1bit
// Width and Height of Dest are calculated from the specified area
// x1, y1, x2, y2: selection to copy (if x2 and y2 are Zero it copies the full bitmap)
procedure _CopyBitmapRect(Source, Dest: TBitmap; x1, y1, x2, y2: Integer);
var
  pb, px: pbyte;
  hh, ww, lw: Integer;
  y: Integer;
  sinc, dinc: Integer;
begin
  if x2 = 0 then
    x2 := Source.Width;
  if x2 > Source.Width then
    x2 := Source.Width;
  if y2 = 0 then
    y2 := Source.Height;
  if y2 > Source.Height then
    y2 := Source.Height;
  hh := y2 - y1;
  ww := x2 - x1;
  Dest.width := 1;
  Dest.height := 1;
  Dest.PixelFormat := Source.PixelFormat;
  Dest.Width := ww;
  Dest.Height := hh;
  dinc := -IEVCLPixelFormat2RowLen(Dest.Width, Dest.PixelFormat);
  sinc := -IEVCLPixelFormat2RowLen(Source.Width, Source.PixelFormat);
  if Source.Pixelformat = pf24bit then
  begin
    //// pf24bit
    lw := ww * 3;
    px := Source.Scanline[y1];
    inc(px, x1 * 3);
    pb := Dest.scanline[0];
    for y := 0 to hh - 1 do
    begin
      CopyMemory(pb, px, lw);
      inc(pb, dinc);
      inc(px, sinc);
    end;
  end
  else
  if Source.Pixelformat = pf1bit then
  begin
    //// pf1bit
    px := Source.Scanline[y1];
    pb := Dest.scanline[0];
    for y := 0 to hh - 1 do
    begin
      IECopyBits_large(pb, px, 0, x1, ww, -sinc);
      inc(pb, dinc);
      inc(px, sinc);
    end;
  end;
end;


{!!
<FS>TImageEnProc.CheckLegacyBitmap

<FM>Declaration<FC>
procedure CheckLegacyBitmap(PixelFormat: <A TIEPixelFormat>);

<FM>Description<FN>
Sets <A TImageEnView.LegacyBitmap> = false when the specified pixel format cannot be handled using TBitmap.

<FM>Example<FC>
ImageEnView1.CheckLegacyBitmap(ieCMYK); // if ieCMYK cannot be handled by TBitmap then use TIEBitmap (sets ImageEnView1.LegacyBitmap := false)
ImageEnView1.IEBitmap.PixelFormat := ieCMYK;
ImageEnView1.Update();
!!}
// can only set TImageEnView.LegacyBitmap = false
procedure TImageEnProc.CheckLegacyBitmap(PixelFormat: TIEPixelFormat);
begin
  if assigned(fImageEnView) and (fImageEnView is TImageEnView) and (fImageEnView as TImageEnView).LegacyBitmap and (PixelFormat in [ie8p, ie16g, ie32f, ieCMYK, ie48RGB, ieCIELab]) then
    (fImageEnView as TImageEnView).LegacyBitmap := false;
end;


{!!
<FS>TImageEnProc.BeginImageProcessing

<FM>Declaration<FC>
function BeginImageProcessing(allowedFormats: <A TIEPixelFormatSet>; var x1, y1, x2, y2: Integer; const OpName: String; var ProcBitmap: <A TIEBitmap>; var mask: <A TIEMask>; OpID: Integer = 0; ExtractROI: Boolean = true): Boolean;

<FM>Description<FN>
BeginImageProcessing and <A TImageEnProc.EndImageProcessing> allow you to create custom image processing functions that automatically handle selection area, pixel format consistency and undo.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>AllowedFormats<FN></C> <C>The permitted pixel formats</C> </R>
<R> <C><FC>x1, y1, x2, y2<FN></C> <C>The destination rectangle coordinates to apply the function</C> </R>
<R> <C><FC>OpName<FN></C> <C>A string describing the function (for the <L TImageEnProc.UndoCaptions>undo caption</L>)</C> </R>
<R> <C><FC>ProcBitmap<FN></C> <C>The bitmap to process</C> </R>
<R> <C><FC>mask<FN></C> <C>The selection mask</C> </R>
<R> <C><FC>OpID<FN></C> <C>An optional ID for the task which is saved with the undo (and available via <A TImageEnProc.GetUndoInfo>). Any value can be specified or a <L Undo Operation Consts>const</L>.</C> </R>
<R> <C><FC>ExtractROI<FN></C> <C>If true (default) ProcBitmap contains only the Region Of Interest, otherwise it contains the full original bitmap</L>.</C> </R>
</TABLE>

By using BeginImageProcessing/EndImageProcessing, you can avoid considering if the selection is rectangle, elliptical, irregular or magic wand, just process the bitmap as a rectangle.

<FM>Example<FC>
procedure CustomNegative( proc: TImageEnProc );
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
  x, y: Integer;
  px: PRGB;
begin
  // we support only ie24RGB format
  if not proc.BeginImageProcessing([ie24RGB], x1, y1, x2, y2, 'CustomNegative', ProcBitmap, mask) then
    exit;
  for y := y1 to y2-1 do begin
    px := ProcBitmap.Scanline[y];
    for x := x1 to x2-1 do
    begin
      with px^ do
      begin
        r := 255-r;
        g := 255-g;
        b := 255-b;
      end;
      inc(px);
    end;
  end;
  // finalize
  proc.EndImageProcessing(ProcBitmap, mask);
end;

..
ImageEnView.SelectEllipse( 100, 100, 100, 100 );
CustomNegative( ImageEnView.Proc );
!!}
function TImageEnProc.BeginImageProcessing(allowedFormats: TIEPixelFormatSet; var x1, y1, x2, y2: Integer; const OpName: String; var ProcBitmap: TIEBitmap; var mask: TIEMask; OpID: Integer; ExtractROI: Boolean): Boolean;
var
  fPolyS: PPointArray;
  fPolySCount: Integer;
begin
  CheckHaveValidBitmap();

  result := false;
  if fAutoUndo then
    SaveUndo(OpName, ieuImage, True, OpID);
  if not MakeConsistentBitmap(allowedFormats) then
    exit;
  GetReSel(x1, y1, x2, y2, fPolyS, fPolySCount, mask);
  if ExtractROI and assigned(mask) and (not mask.IsEmpty) then
  begin
    ProcBitmap := TIEBitmap.Create;
    ProcBitmap.Allocate(mask.x2 - mask.x1 + 1, mask.y2 - mask.y1 + 1, fIEBitmap.PixelFormat);
    fIEBitmap.CopyRectTo(ProcBitmap, mask.x1, mask.y1, 0, 0, ProcBitmap.Width, ProcBitmap.Height, true);

    x1 := 0;
    y1 := 0;
    x2 := ProcBitmap.Width;
    y2 := ProcBitmap.Height;
  end
  else
    ProcBitmap := fIEBitmap;
  result := true;
end;

{!!
<FS>TImageEnProc.EndImageProcessing

<FM>Declaration<FC>
procedure EndImageProcessing(ProcBitmap: <A TIEBitmap>; mask: <A TIEMask>);

<FM>Description<FN>
<A TImageEnProc.BeginImageProcessing> and EndImageProcessing allow you to create custom image processing functions that automatically handle selection area, pixel format consistency and undo.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>ProcBitmap<FN></C> <C>The bitmap to process</C> </R>
<R> <C><FC>mask<FN></C> <C>The selection mask</C> </R>
</TABLE>

By using BeginImageProcessing/EndImageProcessing, you can avoid considering if the selection is rectangle, elliptical, irregular or magic wand, just process the bitmap as a rectangle.

<FM>Example<FC>
procedure CustomNegative( proc: TImageEnProc );
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
  x, y: Integer;
  px: PRGB;
begin
  // we support only ie24RGB format
  if not proc.BeginImageProcessing([ie24RGB], x1, y1, x2, y2, 'CustomNegative', ProcBitmap, mask) then
    exit;
  for y := x1 to x2-1 do begin
    px := ProcBitmap.Scanline[y];
    for x := y1 to y2-1 do begin
      with px^ do begin
        r := 255-r;
        g := 255-g;
        b := 255-b;
      end;
      inc(px);
    end;
  end;
  // finalize
  proc.EndImageProcessing(ProcBitmap, mask);
end;

..
ImageEnView.SelectEllipse( 100, 100, 100, 100 );
CustomNegative( ImageEnView.Proc );
!!}
procedure TImageEnProc.EndImageProcessing(ProcBitmap: TIEBitmap; mask: TIEMask);
begin
  if ProcBitmap <> fIEBitmap then
  begin
    mask.CopyIEBitmap(fIEBitmap, ProcBitmap, false, true, false);
    if ProcBitmap.HasAlphaChannel and not ProcBitmap.AlphaChannel.Full then
    begin
      mask.CopyIEBitmap(fIEBitmap.AlphaChannel, ProcBitmap.AlphaChannel, false, true, false);
      fIEBitmap.AlphaChannel.Full := false;
    end;
    FreeAndNil(ProcBitmap);
  end;
  Update;
end;

{!!
<FS>TImageEnProc.BeginImageAnalysis

<FM>Declaration<FC>
function BeginImageAnalysis(allowedFormats: <A TIEPixelFormatSet>; var x1, y1, x2, y2: Integer; var ProcBitmap: <A TIEBitmap>; var mask: <A TIEMask>): Boolean;

<FM>Description<FN>
BeginImageAnalysis and <A TImageEnProc.EndImageAnalysis> allow you to create custom image analysis functions that automatically handle selection area and pixel format consistency.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>AllowedFormats<FN></C> <C>The permitted pixel formats</C> </R>
<R> <C><FC>x1, y1, x2, y2<FN></C> <C>The destination rectangle coordinates to apply the function</C> </R>
<R> <C><FC>ProcBitmap<FN></C> <C>The bitmap to process</C> </R>
<R> <C><FC>mask<FN></C> <C>The selection mask</C> </R>
</TABLE>

By using BeginImageAnalysis/EndImageAnalysis, you can avoid considering if the selection is rectangle, elliptical, irregular or magic wand, just process the bitmap as a rectangle.

<FM>Example<FC>
procedure SearchWhitePixel( proc: TImageEnProc );
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
  x, y: Integer;
  px: PRGB;
begin
  // we support only ie24RGB format
  if not proc.BeginImageAnalysis([ie24RGB], x1, y1, x2, y2, ProcBitmap, mask) then
    exit;
  for y := y1 to y2-1 do begin
    px := ProcBitmap.Scanline[y];
    for x := x1 to x2-1 do begin
      with px^ do
         if (r = 255) and (g = 255) and (b = 255) then
  ShowMessage('Found White Pixel!');
      inc(px);
    end;
  end;
  // finalize
  proc.EndImageAnalysis(ProcBitmap);
end;

..
ImageEnView.SelectEllipse( 100, 100, 100, 100 );
SearchWhitePixel( ImageEnView.Proc );
!!}
function TImageEnProc.BeginImageAnalysis(allowedFormats: TIEPixelFormatSet; var x1, y1, x2, y2: Integer; var ProcBitmap: TIEBitmap; var mask: TIEMask): Boolean;
var
  fPolyS: PPointArray;
  fPolySCount: Integer;
begin
  result := false;
  if not MakeConsistentBitmap(allowedFormats) then
    exit;
  GetReSel(x1, y1, x2, y2, fPolyS, fPolySCount, mask);
  if assigned(mask) and (not mask.IsEmpty) then
  begin
    ProcBitmap := TIEBitmap.Create;
    ProcBitmap.Allocate(mask.x2 - mask.x1 + 1, mask.y2 - mask.y1 + 1, fIEBitmap.PixelFormat);
    fIEBitmap.CopyRectTo(ProcBitmap, mask.x1, mask.y1, 0, 0, ProcBitmap.Width, ProcBitmap.Height, false);
    x1 := 0;
    y1 := 0;
    x2 := ProcBitmap.width;
    y2 := ProcBitmap.height;
  end
  else
    ProcBitmap := fIEBitmap;
  result := true;
end;

{!!
<FS>TImageEnProc.EndImageAnalysis

<FM>Declaration<FC>
procedure EndImageAnalysis(ProcBitmap: <A TIEBitmap>);

<FM>Description<FN>
<A TImageEnProc.BeginImageAnalysis> and EndImageAnalysis allow you to create custom image analysis functions that automatically handle selection area and pixel format consistency.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>ProcBitmap<FN></C> <C>The bitmap to process</C> </R>
</TABLE>

By using BeginImageAnalysis/EndImageAnalysis, you can avoid considering if the selection is rectangle, elliptical, irregular or magic wand, just process the bitmap as a rectangle.

<FM>Example<FC>
procedure SearchWhitePixel( proc: TImageEnProc );
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
  x, y: Integer;
  px: PRGB;
begin
  // we support only ie24RGB format
  if not proc.BeginImageAnalysis([ie24RGB], x1, y1, x2, y2, ProcBitmap, mask) then
    exit;
  for y := y1 to y2-1 do begin
    px := ProcBitmap.Scanline[y];
    for x := x1 to x2-1 do begin
      with px^ do
         if (r = 255) and (g = 255) and (b = 255) then
  ShowMessage('Found White Pixel!');
      inc(px);
    end;
  end;
  // finalize
  proc.EndImageAnalysis(ProcBitmap);
end;

..
ImageEnView.SelectEllipse( 100, 100, 100, 100 );
SearchWhitePixel( ImageEnView.Proc );
!!}
procedure TImageEnProc.EndImageAnalysis(ProcBitmap: TIEBitmap);
begin
  if ProcBitmap <> fIEBitmap then
    FreeAndNil(ProcBitmap);
end;

{!!
<FS>TImageEnProc.Negative

<FM>Declaration<FC>
procedure Negative;

<FM>Description<FN>
Invert all colors of the selected region.

<FM>Example<FC>
ImageEnView1.Proc.Negative;
!!}
procedure TImageEnProc.Negative;
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_NEGATIVE,
                              {$ELSE}
                              IEMsg( IEMSG_NEGATIVE ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_NEGATIVE ) then
    exit;
  _Negative(ProcBitmap, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

// negate the buffers
procedure _NegativeBuffer(buf: pbyte; WidthBytes: Integer);
begin
  while WidthBytes > 0 do
  begin
    buf^ := not buf^;
    inc(buf);
    dec(WidthBytes);
  end;
end;

// As _Negative1Bit but works with TIEBitmap
// works only with ie1g
procedure _Negative1BitEx(Bitmap: TIEBitmap);
var
  x, y, dx: Integer;
  w: pword;
begin
  dx := Bitmap.Rowlen div 2;
  for y := 0 to bitmap.Height - 1 do
  begin
    w := bitmap.scanline[y];
    for x := 0 to dx - 1 do
    begin
      w^ := not w^;
      inc(w);
    end;
  end;
end;

function IEMMX_Negative(bitmap: TIEBitmap; x1, y1, x2, y2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject): Boolean;
{$ifdef IEMMXSUPPORTED}
{$ifdef IEUSEASM}
const
  v255: int64 = -1;
var
  row: Integer;
  ppx: pRGB;
  per1: Double;
  ww: Integer;
{$endif}
{$endif}
begin
  result := false;
  {$ifdef IEUSEASM}
  {$ifdef IEMMXSUPPORTED}
  if IEGlobalSettings().MMX then
  begin
    per1 := 100 / (y2 - y1 + 0.5);
    ww := x2 - x1 + 1;  // width in pixels
    case Bitmap.PixelFormat of
      ie24RGB:
        begin
          result := true;
          x1 := x1*3; // left position in bytes
          ww := ww*3; // width in bytes
        end;
    end;

    if result and ((ww mod 8) = 0) then
    begin
      for row := y1 to y2 do
      begin
        ppx := bitmap.ScanLine[row];
        asm
          MOV EAX, [ppx]
          ADD EAX, [x1]

          MOV EDX, EAX
          ADD EDX, [x1]
          ADD EDX, [ww]

          MOVQ mm2, [QWORD PTR v255]

          @loop:
            MOVQ mm0, [QWORD PTR EAX]
            MOVQ mm1, mm2
            PSUBB mm1,mm0
            MOVQ [EAX], mm1

            ADD EAX, 8
            CMP EAX, EDX
            JL @loop

          EMMS
        end;
        if assigned(fOnProgress) then
          fOnProgress(Sender, trunc(per1 * (row - y1 + 1)));
      end;
    end
    else
      result := false;

  end;
  {$endif}  // IEMMXSUPPORTED
  {$endif}  // IEUSEASM
end;

procedure _Negative(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  col, row: Integer;
  ppx: pRGB;
  p_byte: pbyte;
  p_word: pword;
  p_48rgb: PRGB48;
  p_float: psingle;
  p_cmyk: PCMYK;
  p_cielab: PCIELAB;
  per1: Double;
  bx: pbyte;
  tb: byte;
  bb: Integer;
  cr, cg, cb: byte;
  rgb: TRGB;
  i: Integer;
  bytewidth, bytewidth2: Integer;
begin
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  if not IEMMX_Negative(bitmap, fSelX1, fSelY1, fSelX2, fSelY2, fOnProgress, Sender) then
  begin
    case Bitmap.PixelFormat of
      ie24RGB:
        for row := fSelY1 to fSelY2 do
        begin
          ppx := bitmap.ScanLine[row];
          inc(ppx, fSelX1);
          for col := fSelX1 to fSelX2 do
          begin
            ppx^.r := 255 - ppx^.r;
            ppx^.g := 255 - ppx^.g;
            ppx^.b := 255 - ppx^.b;
            inc(ppx);
          end;
          if assigned(fOnProgress) then
            fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1)));
        end;
      ie32RGB:
        for row := fSelY1 to fSelY2 do
        begin
          p_byte := bitmap.ScanLine[row];
          inc(p_byte, fSelX1*4);
          for col := fSelX1 to fSelX2 do
          begin
            p_byte^ := 255 - p_byte^; inc(p_byte);
            p_byte^ := 255 - p_byte^; inc(p_byte);
            p_byte^ := 255 - p_byte^; inc(p_byte);
            inc(p_byte);
          end;
          if assigned(fOnProgress) then
            fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1)));
        end;
      ie1g:
        for row := fSelY1 to fSelY2 do
        begin
          bx := Bitmap.Scanline[row];
          inc(bx, fSelX1 shr 3);      // jump to first changed byte
          bytewidth := fSelX1 and $7; // upper part of first changed byte
          if bytewidth > 0 then
          begin
            tb := bx^;
            bb := $1;
            for i := bytewidth to 7 do
            begin
              tb := tb xor bb;  // flip only selected bit
              bb := bb shl 1;
            end;
            bx^ := tb;
            inc(bx);
            bytewidth := 1;
          end;
          bytewidth  := bytewidth + fSelX1 shr 3;  // mid part
          bytewidth2 := (fSelX2 + 1) shr 3;
          for col := bytewidth to bytewidth2 - 1 do
          begin
            bx^ := bx^ xor $ff; // flip whole byte
            inc(bx);
          end;
          bytewidth := (fSelX2 + 1) and $7; // last bits (final byte)
          if bytewidth > 0 then
          begin
            tb := bx^;
            bb := $80;
            for i := 0 to bytewidth - 1 do
            begin
              tb := tb xor bb;  // reverse bit
              bb := bb shr 1;
            end;
            bx^ := tb;
          end;
          if assigned(fOnProgress) then
            fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1)));
        end;
      ie8g:
        for row := fSelY1 to fSelY2 do
        begin
          p_byte := bitmap.ScanLine[row];
          inc(p_byte, fSelX1);
          for col := fSelX1 to fSelX2 do
          begin
            p_byte^ := 255 - p_byte^;
            inc(p_byte);
          end;
          if assigned(fOnProgress) then
            fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1)));
        end;
      ie8p:
        for bb := 0 to bitmap.PaletteLength-1 do
        begin
          with bitmap.Palette[bb] do
          begin
            cr := r;
            cg := g;
            cb := b;
          end;
          bitmap.Palette[bb] := CreateRGB(255-cr, 255-cg, 255-cb);
        end;
      ie16g:
        for row := fSelY1 to fSelY2 do
        begin
          p_word := bitmap.ScanLine[row];
          inc(p_word, fSelX1);
          for col := fSelX1 to fSelX2 do
          begin
            p_word^ := 65535 - p_word^;
            inc(p_word);
          end;
          if assigned(fOnProgress) then
            fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1)));
        end;
      ie48RGB:
        for row := fSelY1 to fSelY2 do
        begin
          p_48rgb := bitmap.ScanLine[row];
          inc(p_48rgb, fSelX1);
          for col := fSelX1 to fSelX2 do
          begin
            p_48rgb^.r := 255 - p_48rgb^.r;
            p_48rgb^.g := 255 - p_48rgb^.g;
            p_48rgb^.b := 255 - p_48rgb^.b;
            inc(p_48rgb);
          end;
          if assigned(fOnProgress) then
            fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1)));
        end;
      ie32f:
        for row := fSelY1 to fSelY2 do
        begin
          p_float := bitmap.ScanLine[row];
          inc(p_float, fSelX1);
          for col := fSelX1 to fSelX2 do
          begin
            p_float^ := 1 - p_float^;
            inc(p_float);
          end;
          if assigned(fOnProgress) then
            fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1)));
        end;
      ieCIELab:
        for row := fSelY1 to fSelY2 do
        begin
          p_cielab := bitmap.ScanLine[row];
          inc(p_cielab, fSelX1);
          for col := fSelX1 to fSelX2 do
          begin
            rgb := IECIELAB2RGB(p_cielab^);
            with rgb do
            begin
              r := 255-r;
              g := 255-g;
              b := 255-b;
            end;
            p_cielab^ := IERGB2CIELAB(rgb);
            inc(p_cielab);
          end;
          if assigned(fOnProgress) then
            fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1)));
        end;
      ieCMYK:
        for row := fSelY1 to fSelY2 do
        begin
          p_cmyk := bitmap.ScanLine[row];
          inc(p_cmyk, fSelX1);
          for col := fSelX1 to fSelX2 do
          begin
            rgb := IECMYK2RGB(p_cmyk^);
            with rgb do
            begin
              r := 255-r;
              g := 255-g;
              b := 255-b;
            end;
            p_cmyk^ := IERGB2CMYK(rgb);
            inc(p_cmyk);
          end;
          if assigned(fOnProgress) then
            fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1)));
        end;
    end;  // end case
  end;
end;

{!!
<FS>TImageEnProc.Flip

<FM>Declaration<FC>
procedure Flip(dir: <A TFlipDir>);

<FM>Description<FN>
Flip (mirror) the current image across the horizontal or vertical axis. <FC>dir<FN> is the flip direction.

<FM>Examples<FC>
ImageEnView1.Proc.Flip( fdHorizontal );
ImageEnView1.Proc.Flip( fdVertical );
                
<FM>See Also<FN>
- <A Lossless Jpeg Transformations>
!!}
procedure TImageEnProc.Flip(dir: TFlipDir);
begin
  if not MakeConsistentBitmap([]) then
    exit;
  if fAutoUndo then
  begin
    if dir = fdHorizontal then
      SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
               Format(IERS_FLIP, [ 'H' ]),
               {$ELSE}
               IEMsg( IEMSG_FLIP ) + ' ' + IEMsg( IEMSG_FLIPHOR ),
               {$ENDIF}
               ieuImage, True, IEOP_FLIPHORZ )
    else
      SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
               Format(IERS_FLIP, [ 'V' ]),
               {$ELSE}
               IEMsg( IEMSG_FLIP ) + ' ' + IEMsg( IEMSG_FLIPVER ),
               {$ENDIF}
               ieuImage, True, IEOP_FLIPVERT );
  end;
  _FlipEx(fIEBitmap, dir);
  Update;
  DoFinishWork;
end;

// Accepts TIEBitmap
// work with only ie24RGB, ie1g, ie8p, ie8g
procedure _FlipEx(bmp: TIEBitmap; dir: TFlipDir);
var
  x, y, w, h, xl: Integer;
  newbitmap: TIEBitmap;
  newpx, oldpx: PRGB;
  newb, oldb, tbuf: pbyte;
begin
  newbitmap := TIEBitmap.create;
  newbitmap.Allocate(bmp.Width, bmp.Height, bmp.PixelFormat);
  w := bmp.width - 1;
  h := bmp.height - 1;
  case dir of
    fdHorizontal:
      if bmp.PixelFormat = ie24RGB then
        // ie24RGB
        for y := 0 to h do
        begin
          newpx := newbitmap.ScanLine[y];
          oldpx := bmp.ScanLine[y];
          inc(oldpx, w);
          for x := 0 to w do
          begin
            newpx^ := oldpx^;
            inc(newpx);
            dec(oldpx);
          end;
        end
      else
      if (bmp.PixelFormat = ie8p) or (bmp.PixelFormat = ie8g) then
      begin
        // ie8g/ie8p
        for y := 0 to h do
        begin
          newb := newbitmap.ScanLine[y];
          oldb := bmp.ScanLine[y];
          inc(oldb, w);
          for x := 0 to w do
          begin
            newb^ := oldb^;
            inc(newb);
            dec(oldb);
          end;
        end
      end
      else
      if bmp.PixelFormat = ie1g then
      begin
        // ie1g
        w := bmp.width div 8;
        if (bmp.width and 7) <> 0 then
        begin
          inc(w);
          xl := 8 - (bmp.width and 7); // we need to shift left the image
        end
        else
          xl := 0;
        if xl = 0 then
        begin
          for y := 0 to h do
          begin
            newb := newbitmap.ScanLine[y];
            oldb := bmp.ScanLine[y];
            inc(oldb, w - 1);
            for x := 0 to w - 1 do
            begin
              newb^ := oldb^;
              ReverseBitsB(newb^);
              inc(newb);
              dec(oldb);
            end;
          end;
        end
        else
        begin
          // need to shift
          getmem(tbuf, w);
          for y := 0 to h do
          begin
            newb := tbuf;
            oldb := bmp.ScanLine[y];
            inc(oldb, w - 1);
            for x := 0 to w - 1 do
            begin
              newb^ := oldb^;
              ReverseBitsB(newb^);
              inc(newb);
              dec(oldb);
            end;
            IECopyBits_large(newbitmap.scanline[y], tbuf, 0, xl, bmp.Width, w);
          end;
          freemem(tbuf);
        end;

      end;
    fdVertical:
      if bmp.PixelFormat=ie24RGB then
        for y := 0 to h do
          copymemory(newbitmap.scanline[y], bmp.scanline[h - y], 3 * bmp.Width)
      else
      begin
        for y := 0 to h do
          copymemory(newbitmap.scanline[y], bmp.scanline[h - y], bmp.RowLen)
      end;
  end;
  bmp.AssignImage(newbitmap);
  FreeAndNil(newbitmap);

  if bmp.HasAlphaChannel then
    _FlipEx(bmp.AlphaChannel, dir);
end;

{!!
<FS>TImageEnProc.PreviewFont

<FM>Declaration<FC>
property PreviewFont: TFont;

<FM>Description<FN>
If <A TImageEnProc.PreviewFontEnabled> is set to True then PreviewFont specifies the font used in the <A TImageEnProc.DoPreviews> dialog. Ensure the size of the font matches the length of labels.

<FM>Example<FC>
ImageEnView1.Proc.PreviewFont.Name := 'MS Times New Roman';
ImageEnView1.Proc.PreviewFontEnabled := True;
ImageEnView1.Proc.DoPreviews([peAll]);
!!}
procedure TImageEnProc.SetPreviewFont(f: TFont);
begin
  fPreviewFont.assign(f);
end;



{!!
<FS>TImageEnProc.PreviewFontEnabled

<FM>Declaration<FC>
property PreviewFontEnabled: Boolean;

<FM>Description<FN>
If you set PreviewFontEnabled to True then you can use <A TImageEnProc.PreviewFont> to specify a custom font for the <A TImageEnProc.DoPreviews> dialogs.

<FM>Example<FC>
ImageEnView1.Proc.PreviewFont.Name := 'MS Times New Roman';
ImageEnView1.Proc.PreviewFontEnabled := True;
ImageEnView1.Proc.DoPreviews([peAll]);
!!}
procedure TImageEnProc.SetPreviewFontEnabled(Value : Boolean);
begin
  fPreviewFontEnabled := Value;
end;




{!!
<FS>TImageEnProc.CastColorRange

<FM>Declaration<FC>
procedure CastColorRange(BeginColor, EndColor, CastColor: <A TRGB>);

<FM>Description<FN>
Set all colors in the range BeginColor to EndColor to CastColor.

<FM>Example<FC>
// Change all gray levels from 50 to 100 to black
var
  BeginColor, EndColor, CastColor: TRGB;
Begin
  BeginColor := CreateRGB(50, 50, 50);
  EndColor := CreateRGB(100, 100, 100);
  CastColor := CreateRGB(0, 0, 0);
  ImageEnView1.Proc.CastColorRange(BeginColor, EndColor, CastColor);
End;

<FM>See Also<FN>
- <A CreateRGB>
- <A TRGB2TColor>
- <A TColor2TRGB>

!!}
procedure TImageEnProc.CastColorRange(BeginColor, EndColor, CastColor: TRGB);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_CASTCOLORRANGE,
                              {$ELSE}
                              IEMsg( IEMSG_CASTCOLORRANGE ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_CASTCOLORRANGE ) then
    exit;
  _CastColorRange(ProcBitmap, BeginColor, EndColor, CastColor, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

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

// ret number of casted pixels
function IEMatchHSVRange(bitmap: TIEBitmap; HueBegin, HueEnd, SatBegin, SatEnd, ValBegin, ValEnd: Integer; ColorizeMatched: Boolean; MatchColor: TRGB; ColorizeNonMatched: Boolean; NonMatchColor: TRGB; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject): Integer;
var
  row, col: Integer;
  px: PRGB;
  h, s, v: Integer;
  per1: Double;
begin
  result := 0;
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  for row := fSelY1 to fSelY2 do
  begin
    px := bitmap.Scanline[row];
    inc(px, fSelX1);
    for col := fSelX1 to fSelX2 do
    begin
      RGB2HSV(px^, h, s, v);
      if (h >= HueBegin) and (h <= HueEnd) and (s >= SatBegin) and (s <= SatEnd) and (v >= ValBegin) and (v <= ValEnd) then
      begin
        if ColorizeMatched then
          px^ := MatchColor;
        inc(result);
      end
      else
      if ColorizeNonMatched then
        px^ := NonMatchColor;
      inc(px);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1)));
  end;
end;

{!!
<FS>TImageEnProc.MatchHSVRange

<FM>Declaration<FC>
function MatchHSVRange(HueBegin, HueEnd, SatBegin, SatEnd, ValBegin, ValEnd: Integer; ColorizeMatched: Boolean; MatchColor: TRGB; ColorizeNonMatched: Boolean; NonMatchColor: TRGB): Integer;

<FM>Description<FN>
If <FC>ColorizeMatched<FN> is true then this method colorizes pixels that match the specified HSV (Hue, Saturation and Value) range to <FC>MatchColor<FN> color.
If <FC>ColorizeNonMatched<FN> is true, non matching pixels are set to <FC>NonMatchColor<FN>.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>HueBegin<FN></C> <C>Starting Hue value (0 to 359)</C> </R>
<R> <C><FC>HueEnd<FN></C> <C>Ending Hue value (0 to 359)</C> </R>
<R> <C><FC>SatBegin<FN></C> <C>Starting Saturation value (0 to 99)</C> </R>
<R> <C><FC>SatEnd<FN></C> <C>Ending Saturation value (0 to 99)</C> </R>
<R> <C><FC>ValBegin<FN></C> <C>Starting Intensity value (0 to 99)</C> </R>
<R> <C><FC>ValEnd<FN></C> <C>Ending Intensity value (0 to 99)/C> </R>
<R> <C><FC>ColorizeMatched<FN></C> <C>If true next parameter specifies the matched color</C> </R>
<R> <C><FC>MatchColor<FN></C> <C>New pixel color when HSV conversion fit inside specified ranges</C> </R>
<R> <C><FC>ColorizeNonMatched<FN></C> <C>If true next parameter specifies the non-matched color</C> </R>
<R> <C><FC>NonMatchColor<FN></C> <C>New pixel color when HSV conversion does not fit inside specified ranges</C> </R>
</TABLE>

Returns the number of matching pixels.
!!}
function TImageEnProc.MatchHSVRange(HueBegin, HueEnd, SatBegin, SatEnd, ValBegin, ValEnd: Integer; ColorizeMatched: Boolean; MatchColor: TRGB; ColorizeNonMatched: Boolean; NonMatchColor: TRGB): Integer;
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  result := 0;
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_MATCHHSVRANGE,
                              {$ELSE}
                              IEMsg( IEMSG_MATCHHSVRANGE ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_MATCHHSVRANGE ) then
    exit;
  result := IEMatchHSVRange(ProcBitmap, HueBegin, HueEnd, SatBegin, SatEnd, ValBegin, ValEnd, ColorizeMatched, MatchColor, ColorizeNonMatched, NonMatchColor, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

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

// Compare Bitmap1 with Bitmap2, return True if the images are equals
function _BitmapCompareX(Bitmap1, Bitmap2: TBitmap): Boolean;
var
  l: Integer;
begin
  if (Bitmap1.Width <> Bitmap2.Width) or (Bitmap1.Height <> Bitmap2.Height) then
  begin
    result := false;
    exit;
  end;
  l := IEVCLPixelFormat2RowLen(bitmap1.width, bitmap1.pixelformat); // row length
  result := CompareMem(Bitmap1.ScanLine[Bitmap1.Height - 1], 
    Bitmap2.ScanLine[Bitmap2.Height - 1],
    l * Bitmap1.Height);
end;

// Compare Bitmap1 with Bitmap2, return True if the images are equals
function _BitmapCompareXEx(Bitmap1, Bitmap2: TIEBitmap): Boolean;
var
  y: Integer;
begin
  if (Bitmap1.Width <> Bitmap2.Width) or (Bitmap1.Height <> Bitmap2.Height) then
  begin
    result := false;
    exit;
  end;
  if Bitmap1.HasAlphaChannel <> Bitmap2.HasAlphaChannel then
  begin
    result := false;
    exit;
  end;
  // compare image
  for y := 0 to bitmap1.Height - 1 do
  begin
    result := CompareMem(Bitmap1.ScanLine[y], Bitmap2.ScanLine[y], Bitmap1.RowLen);
    if not result then
      exit;
  end;
  // compare alpha
  if Bitmap1.hasalphaChannel then
  begin
    for y := 0 to bitmap1.AlphaChannel.Height - 1 do
    begin
      result := CompareMem(Bitmap1.AlphaChannel.ScanLine[y], Bitmap2.AlphaChannel.ScanLine[y], Bitmap1.AlphaChannel.RowLen);
      if not result then
        exit;
    end;
  end;
  result := true;
end;


{!!
<FS>TImageEnProc.Clear

<FM>Declaration<FC>
procedure Clear;

<FM>Description<FN>
Fill the current image with the <L TImageEnProc.Background>background color</L>.

<FM>Example<FC>
ImageEnView1.Proc.Background := clWhite;
ImageEnView1.Proc.Clear;

!!}
procedure TImageEnProc.Clear;
begin
  if not MakeConsistentBitmap([]) then
    exit;
  if fAutoUndo then
    SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
             IERS_CLEAR,
             {$ELSE}
             IEMsg( IEMSG_Clear ),
             {$ENDIF}
             ieuImage, True, IEOP_CLEAR );
  fIEBitmap.Fill(GetReBackground);
  Update;
  DoFinishWork;
end;

procedure _ClearSelMaskEx(fIEBitmap: TIEBitmap; mask: TIEMask; Background: TColor);
var
  tmpbmp: TIEBitmap;
begin
  tmpbmp := TIEBitmap.Create();
  try
    tmpbmp.Allocate(mask.x2 - mask.x1 + 1, mask.y2 - mask.y1 + 1, fIEBitmap.PixelFormat);
    fIEBitmap.CopyRectTo(tmpbmp, mask.x1, mask.y1, 0, 0, tmpbmp.Width, tmpbmp.Height, false);
    tmpbmp.Fill(Background);
    mask.CopyIEBitmap(fIEBitmap, tmpbmp, false, true, false);
  finally
    tmpbmp.Free();
  end;
end;

{!!
<FS>TImageEnProc.ClearSel

<FM>Declaration<FC>
procedure ClearSel;

<FM>Description<FN>
Fills the selected region with the <L TImageEnProc.Background>background color</L>.

!!}
procedure TImageEnProc.ClearSel;
var
  fSX1, fSY1, fSX2, fSY2: Integer;
  fPolyS: PPointArray;
  fPolySCount: Integer;
  mask: TIEMask;
begin
  if not MakeConsistentBitmap([]) then
    exit;
  if fAutoUndo then
    SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
             IERS_CLEARSEL,
             {$ELSE}
             IEMsg( IEMsg_CLEARSEL ),
             {$ENDIF}
             ieuImage, True, IEOP_CLEARSEL );
  GetReSel(fsx1, fsy1, fsx2, fsy2, fPolyS, fPolySCount, mask);
  if assigned(mask) and (not mask.IsEmpty) then
    _ClearSelMaskEx(fIEBitmap, mask, GetReBackground);
  Update;
  DoFinishWork;
end;

// copy the DIB hbi to fBitmap
function _IECopyDIB2Bitmap2Ex(hbi: THandle; fBitmap: TIEDibBitmap; xbits: pbyte; unlck: Boolean): Integer;
var
  pbi: PBITMAPINFO;
  hdb: HDRAWDIB;
  Width, Height: Integer; // image width and height
  BitCount, y: Integer; // Bitcount
  bits: pbyte;
  Compression: DWORD; // compression type
begin
  if unlck then
    pbi := pointer(hbi)
  else
    pbi := GlobalLock(hbi);
  Width := pbi^.bmiHeader.biWidth;
  Height := pbi^.bmiHeader.biHeight;
  BitCount := pbi^.bmiHeader.biBitCount;
  Compression := pbi^.bmiHeader.biCompression;
  result := BitCount;
  bits := nil;
  case BitCount of
    1:
      begin
        fBitmap.AllocateBits(Width, Height, 1);
        bits := pbyte(pbi);
        inc(bits, pbi^.bmiHeader.biSize);
        y := pbi^.bmiHeader.biClrUsed;
        if y = 0 then
          y := 2;
        inc(bits, sizeof(TRGBQUAD) * y); // bypass colormap
      end;
    4:
      begin
        fBitmap.AllocateBits(Width, Height, 24);
        bits := pbyte(pbi);
        inc(bits, pbi^.bmiHeader.biSize);
        y := pbi^.bmiHeader.biClrUsed;
        if y = 0 then
          y := 16;
        inc(bits, sizeof(TRGBQUAD) * y); // bypass colormap
      end;
    8:
      begin
        fBitmap.AllocateBits(Width, Height, 24);
        bits := pbyte(pbi);
        inc(bits, pbi^.bmiHeader.biSize);
        y := pbi^.bmiHeader.biClrUsed;
        if y = 0 then
          y := 256;
        inc(bits, sizeof(TRGBQUAD) * y); // bypass colormap
      end;
    16:
      begin
        fBitmap.AllocateBits(Width, Height, 24);
        bits := pbyte(pbi);
        inc(bits, pbi^.bmiHeader.biSize);
      end;
    24:
      begin
        fBitmap.AllocateBits(Width, Height, 24);
        bits := pbyte(pbi);
        inc(bits, pbi^.bmiHeader.biSize);
      end;
    32:
      begin
        fBitmap.AllocateBits(Width, Height, 24);
        if Compression = BI_BITFIELDS then
        begin
          // BITFIELDS, bitfield must be FF,00FF and 0000FF
          bits := pbyte(pbi);
          inc(bits, pbi^.bmiHeader.biSize);
          inc(bits, 3 * sizeof(dword)); // bypass bitfield
        end
        else
        if Compression = BI_RGB then
        begin
          bits := pbyte(pbi);
          inc(bits, pbi^.bmiHeader.biSize);
        end;
      end;
  end;
  if xbits <> nil then
    bits := xbits;
  if bits <> nil then
  begin
    hdb := IEDrawDibOpen;
    IEDrawDibDraw(hdb, fBitmap.HDC, 0, 0, Width, Height, PBitmapInfoHeader(pbi)^, bits, 0, 0, Width, Height, 0);
    IEDrawDibClose(hdb);
  end;
  if not unlck then
    GlobalUnLock(hbi);
end;

{!!
<FS>TImageEnProc.CropSel

<FM>Declaration<FC>
procedure CropSel(TransparencyOnly: Boolean = False);

<FM>Description<FN>
Removes all parts of the image outside the selected region.
When TransparencyOnly is true only the alpha channel is cropped.

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\SelectAndCrop\ImageEn_Crop.dpr </C> </R>
</TABLE>

<FM>Example<FC>
// Cut region 10, 10, 100, 100
ImageEnView1.Select(10, 10, 100, 100);
ImageEnView1.Proc.CropSel;

// Photoshop like cut
IMageEnView1.Select(10, 10, 100, 100);
ImageEnView1.Proc.CropSel(true);
!!}
procedure TImageEnProc.CropSel(TransparencyOnly: Boolean);
var
  fSX1, fSY1, fSX2, fSY2: Integer;
  fPolyS: PPointArray;
  fPolySCount: Integer;
  tmpbmp: TIEBitmap;
  mask: TIEMask;
begin
  if not MakeConsistentBitmap([]) then
    exit;
  if fAutoUndo then
    SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
             IERS_CROPSEL,
             {$ELSE}
             IEMsg( IEMsg_CropToSelection ),
             {$ENDIF}
             ieuImage, True, IEOP_CROPSEL );
  if GetReSel(fsx1, fsy1, fsx2, fsy2, fPolyS, fPolySCount, mask) and assigned(mask) and (not mask.IsEmpty) then
  begin
    if TransparencyOnly then
    begin
      fIEBitmap.AlphaChannel.CopyFromTIEMask(mask);
    end
    else
    begin
      tmpbmp := TIEBitmap.Create();
      try
        tmpbmp.Allocate(mask.x2 - mask.x1 + 1, mask.y2 - mask.y1 + 1, fIEBitmap.PixelFormat);
        tmpbmp.Fill(GetReBackground);
        mask.CopyIEBitmap(tmpbmp, fIEBitmap, true, false, true);
        fIEBitmap.Assign(tmpbmp);
      finally
        FreeAndNil(tmpbmp);
      end;
      // do we need alpha channel?
      fIEBitmap.AlphaChannel.SyncFull;
      if fIEBitmap.AlphaChannel.Full then
        fIEBitmap.RemoveAlphaChannel;
    end;
  end;
  Update;
  DoFinishWork;
end;


{!!
<FS>TImageEnProc.ConvertTo

<FM>Declaration<FC>
procedure ConvertTo(NumColors: Integer; DitherMethod: <A TIEDitherMethod> = ieOrdered);
function ConvertTo(PixelFormat: <A TIEPixelFormat>; PaletteType: <A TIEPaletteType> = ieptMedianCut; DitherType: <A TIEDitherType> = iedtSolid; CheckParametersOnly: boolean = false): boolean;
function ConvertTo(PixelFormat: TIEPixelFormat; Palette: array of TRGB; DitherType: TIEDitherType = iedtSolid; CheckParametersOnly: boolean = false): boolean; overload;

<FM>Description<FN>
First overload reduces the number of colors in the image.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>NumColors<FN></C> <C>Number of colors of the resulting image.</C> </R>
<R> <C><FC>DitherMethod<FN></C> <C>Color conversion algorithm to use.</C> </R>
<R> <C><FC>Palette<FN></C> <C>Specify a custom palette.</C> </R>
</TABLE>

When ieDithering is used and the required number of colors is less than or equal to 256 the resulting pixel format will be ie8p (unless TImageEnView.LegacyBitmap is true or TIEBitmap.Location is ieTBitmap).

Second overload changes image pixel format using a combination of palette type and dithering algorithm when necessary.
This method may change <A TImageEnView.LegacyBitmap> property if necessary.
Not all combinations of parameters are possible, check the return value. Returns True on success.

Third overload forces use of a specified palette.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>PixelFormat<FN></C> <C>Required pixel format. Can be: ie1g, ie8p, ie8g, ie16g, ie24RGB, ieCMYK, ie48RGB.</C> </R>
<R> <C><FC>PaletteType<FN></C> <C>Palette type to use when reducing colors.</C> </R>
<R> <C><FC>DitherType<FN></C> <C>Dither type to use when reducing colors.</C> </R>
<R> <C><FC>CheckParametersOnly<FN></C> <C>If True, does not actually convert the image, just checks parameters validity.</C> </R>
</TABLE>

Note: Requires at least Windows XP SP2 or Windows Server 2008.

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\Dithering\Dithering.dpr </C> </R>
</TABLE>

<FM>Example<FC>
// Converts current image to 256 colors
ImageEnView1.Proc.ConvertTo(256);

// Converts current image to 461 (!) colors
ImageEnView1.Proc.ConvertTo(461);

// Converts current image to 16 colors, using Floyd-Steinberg dithering
ImageEnView1.Proc.ConvertTo(16, ieDithering);

// Converts pixel format to 256 colors with palette, using halftone palette and 8x8 dithering
ImageEnView1.Proc.ConvertTo(ie8p, ieptFixedHalftone256, iedtOrdered8x8);

// Convert to 8 bits per pixel using the specified palette
const MYPALETTE: array [0..7] of TRGB = ((B: 0; G: 0; R:0), (B: 51; G: 0; R:0), (B: 102; G: 0; R:0), (B: 153; G: 0; R:0), (B: 204; G: 0; R:0), (B: 255; G: 0; R:0), (B: 0; G: 51; R:0), (B: 51; G: 51; R:0));
ImageEnView1.Proc.ConvertTo(ie8p, MYPALETTE, iedtErrorDiffusion);
ImageEnView1.IO.Params.BitsPerSample := 8;
ImageEnView1.IO.Params.SamplesPerPixel := 1;
ImageEnView1.IO.SaveToFile('output.png');

<FM>See Also<FN>
- <A TImageEnProc.ConvertToPalette>

!!}
// Decreases the colors number
// NumColors: Desidered color count
// If NumColors = 2 then calls ConvertToBWOrdered or ConvertTOBWThreshold
procedure TImageEnProc.ConvertTo(NumColors: Integer; DitherMethod: TIEDitherMethod);
var
  Progress: TProgressRec;
  bmp: TIEBitmap;
begin
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  if fAutoUndo then
    SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
             Format(IERS_CONVERTTO, [NumColors]),
             {$ELSE}
             Format( IEMsg( IEMSG_ConvertToXColors ), [NumColors]),
             {$ENDIF}
             ieuImage, True, IEOP_CONVERTTO );
  if NumColors < 3 then
  begin
    Progress.fOnProgress := fOnProgress;
    Progress.Sender := Self;
    if DitherMethod = ieOrdered then
      _ConvertToBWOrdered(fIEBitmap, Progress)
    else
      _ConvertToBWThreshold(fIEBitmap, -1, Progress);
  end
  else
  if NumColors < 1025 then
  begin
    if (DitherMethod = ieDithering) and (NumColors <= 256) then
    begin
      bmp := TIEBitmap.Create();
      try
        IEColorFloydSteinberg(fIEBitmap, bmp, NumColors);
        if fIEBitmap.Location = ieTBitmap then
          bmp.PixelFormat := ie24RGB;
        fIEBitmap.AssignImage(bmp);
      finally
        bmp.Free();
      end;
    end
    else
      _ConvertToEx(fIEBitmap, NumColors, nil, fOnProgress, self);
  end;
  Update;
  DoFinishWork;
end;


{$IFDEF IEINCLUDEWIC}

const
  wicDitherType: array [TIEDitherType] of DWORD   = (IE_WICBitmapDitherTypeSolid, IE_WICBitmapDitherTypeOrdered4x4, IE_WICBitmapDitherTypeOrdered8x8, IE_WICBitmapDitherTypeOrdered16x16,
                                                     IE_WICBitmapDitherTypeSpiral4x4, IE_WICBitmapDitherTypeSpiral8x8, IE_WICBitmapDitherTypeDualSpiral4x4, IE_WICBitmapDitherTypeDualSpiral8x8, IE_WICBitmapDitherTypeErrorDiffusion);

function TImageEnProc.ConvertTo(PixelFormat: TIEPixelFormat; PaletteType: TIEPaletteType; DitherType: TIEDitherType; CheckParametersOnly: boolean): boolean;
const
  wicPaletteType: array [TIEPaletteType] of DWORD = (IE_WICBitmapPaletteTypeMedianCut, IE_WICBitmapPaletteTypeFixedBW, IE_WICBitmapPaletteTypeFixedHalftone8,
                                                     IE_WICBitmapPaletteTypeFixedHalftone27, IE_WICBitmapPaletteTypeFixedHalftone64, IE_WICBitmapPaletteTypeFixedHalftone125,
                                                     IE_WICBitmapPaletteTypeFixedWebPalette, IE_WICBitmapPaletteTypeFixedHalftone252, IE_WICBitmapPaletteTypeFixedHalftone256,
                                                     IE_WICBitmapPaletteTypeFixedGray4, IE_WICBitmapPaletteTypeFixedGray16, IE_WICBitmapPaletteTypeFixedGray256);
var
  formatConverter: TIEWICFormatConverter;
  NewBitmap: TIEBitmap;
begin
  result := false;

  if not MakeConsistentBitmap([ie1g, ie8p, ie8g, ie16g, ie24RGB, ieCMYK, ie48RGB]) then
    exit;
  if fAutoUndo then
    SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
             Format(IERS_CONVERTTO2, [integer(PixelFormat), integer(PaletteType), integer(DitherType)]),
             {$ELSE}
             IEMsg( IEMsg_CONVERTTO ),
             {$ENDIF}
             ieuImage, True, IEOP_CONVERTTO2 );

  formatConverter := TIEWICFormatConverter.Create();
  NewBitmap := TIEBitmap.Create();
  try
    formatConverter.PaletteType := wicPaletteType[PaletteType];
    formatConverter.DitherType  := wicDitherType[DitherType];
    result := formatConverter.Convert(fIEBitmap, NewBitmap, PixelFormat, CheckParametersOnly, fOnProgress, self);
    CheckLegacyBitmap(NewBitmap.PixelFormat);
    fIEBitmap.AssignImage(NewBitmap);
  finally
    NewBitmap.Free();
    formatConverter.Free();
  end;

  Update();
  DoFinishWork();
end;

function TImageEnProc.ConvertTo(PixelFormat: TIEPixelFormat; Palette: array of TRGB; DitherType: TIEDitherType; CheckParametersOnly: boolean): boolean;
var
  formatConverter: TIEWICFormatConverter;
  NewBitmap: TIEBitmap;
begin
  result := false;

  if not MakeConsistentBitmap([ie1g, ie8p, ie8g, ie16g, ie24RGB, ieCMYK, ie48RGB]) then
    exit;
  if fAutoUndo then
    SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
             Format(IERS_CONVERTTO3, [integer(PixelFormat), integer(DitherType)]),
             {$ELSE}
             IEMsg( IEMsg_CONVERTTO ),
             {$ENDIF}
             ieuImage, True, IEOP_CONVERTTO3 );

  formatConverter := TIEWICFormatConverter.Create();
  NewBitmap := TIEBitmap.Create();
  try
    formatConverter.PaletteType := IE_WICBitmapPaletteTypeCustom;
    formatConverter.DitherType  := wicDitherType[DitherType];
    formatConverter.SetPalette(Palette);
    result := formatConverter.Convert(fIEBitmap, NewBitmap, PixelFormat, CheckParametersOnly, fOnProgress, self);
    CheckLegacyBitmap(NewBitmap.PixelFormat);
    fIEBitmap.AssignImage(NewBitmap);
  finally
    NewBitmap.Free();
    formatConverter.Free();
  end;

  Update();
  DoFinishWork();
end;
{$ENDIF}


{!!
<FS>TImageEnProc.ConvertToPalette

<FM>Declaration<FC>
procedure ConvertToPalette(NumColors: Integer; Palette: Pointer; DitherMethod: <A TIEDitherMethod>);

<FM>Description<FN>
Reduces the number of colors in the image to NumColor value and fills the Palette array with the color map used for color reduction.
<FC>DitherMethod<FN> specifies how to convert a color image to a black & white. It can be ieOrdered or ieThreshold.

<FM>Example<FC>
var
  Palette: array [0..255] of TRGB;
begin
  ImageEnView1.Proc.ConvertToPalette(256, @Palette[0], ieOrdered);
...
end;

<FM>See Also<FN>
- <A TImageEnProc.ConvertTo>
!!}
// Decreases the colors number
// NumColors: desidered color count
// If NumColors = 2 then calls ConvertToBWOrdered
procedure TImageEnProc.ConvertToPalette(NumColors: Integer; Palette: pointer; DitherMethod: TIEDitherMethod);
var
  Progress: TProgressRec;
  xpal: PRGBROW;
begin
  if NumColors = 0 then
    exit;
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  xpal := Palette;
  if fAutoUndo then
    SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
              IERS_CONVERTTOPALETTE,
              {$ELSE}
              IEMsg( IEMSG_CONVERTTOPALETTE ),
              {$ENDIF}
              ieuImage, True, IEOP_CONVERTTOPALETTE );
  if NumColors < 3 then
  begin
    Progress.fOnProgress := fOnProgress;
    Progress.Sender := Self;
    if DitherMethod = ieOrdered then
      _ConvertToBWOrdered(fIEBitmap, Progress)
    else
      _ConvertToBWThreshold(fIEBitmap, -1, Progress);
    xpal[0] := CreateRGB(0, 0, 0);
    xpal[1] := CreateRGB(255, 255, 255);
  end
  else
  if NumColors < 1025 then
    _ConvertToEx(fIEBitmap, NumColors, Palette, fOnProgress, self);
  Update;
  DoFinishWork;
end;

procedure _ConvertToEx(Bitmap: TIEBitmap; NumColors: Integer; OutPalette: PRGBROW; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  per1: Double;
  palette: PRGBROW;
  x, y, i: Integer;
  e: pRGB;
  qt: TIEQuantizer;
  bitmapwidth1, bitmapheight1: Integer;
begin
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  if OutPalette = nil then
    getmem(palette, sizeof(TRGB) * NumColors)
  else
    palette := OutPalette;
  per1 := 100 / (bitmap.height + 0.5);
  qt := TIEQuantizer.Create(Bitmap, palette^, NumColors);
  bitmapheight1 := bitmap.height - 1;
  bitmapwidth1 := bitmap.width - 1;
  for y := 0 to bitmapheight1 do
  begin
    e := bitmap.ScanLine[y];
    for x := 0 to bitmapwidth1 do
    begin
      i := qt.RGBIndex[e^];
      e^ := palette^[i];
      inc(e);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (y + 1)));
  end;
  FreeAndNil(qt);
  if OutPalette = nil then
    freemem(palette);
end;


// srcBitmap must be ie24RGB
// dstBitmap.PixelFormat forced to ie8p
// max colorCount is 256
procedure IEColorFloydSteinberg(srcBitmap: TIEBitmap; dstBitmap: TIEBitmap; colorCount: Integer);

  procedure ptu(var a: byte; b: Integer);
  begin
    if integer(a) + b < 0 then
      a := 0
    else
    if integer(a) + b > 255 then
      a := 255
    else
      a := integer(a) + b;
  end;

var
  qt: TIEQuantizer;
  palette: TIEArrayOfTRGB;
  imgWidth, imgHeight: Integer;
  i, j, k: Integer;
  pb: pbyte;
  err: Integer;
  srcRow0, srcRow1: TIEArrayOfTRGB;
begin
  // Create palette
  SetLength(palette, colorCount);
  qt := TIEQuantizer.Create(srcBitmap, palette, colorCount);

  try
    // Setup destination image
    imgWidth  := srcBitmap.Width;
    imgHeight := srcBitmap.Height;
    dstBitmap.Allocate(imgWidth, imgHeight, ie8p);
    dstBitmap.PaletteUsed := colorCount;
    for i := 0 to colorCount - 1 do
      dstBitmap.Palette[i] := palette[i];

    // Allocate and copy temporary source rows
    SetLength(srcRow0, imgWidth);
    SetLength(srcRow1, imgWidth);
    if imgHeight > 0 then
      CopyMemory(@srcRow0[0], srcBitmap.Scanline[0], imgWidth * 3);
    if imgHeight > 1 then
      CopyMemory(@srcRow1[0], srcBitmap.Scanline[1], imgWidth * 3);

    // Apply Floyd-Steinberg
    for i := 0 to imgHeight - 1 do
    begin
      pb := dstBitmap.ScanLine[i];
      for j := 0 to imgWidth - 1 do
      begin
        k := IEFindNearestColor(srcRow0[j], palette, colorCount);
        pb^ := k;
        inc(pb);

        // red
        err := integer(srcRow0[j].r) - palette[k].r;
        if j + 1 < imgWidth then
          ptu(srcRow0[j + 1].r, (err * 7) div 16);
        if i + 1 < imgHeight then
        begin
          if j - 1 > 0 then
            ptu(srcRow1[j - 1].r, (err * 3) div 16);
          ptu(srcRow1[j].r, (err * 5) div 16);
          if j + 1 < imgWidth then
            ptu(srcRow1[j + 1].r, err div 16);
        end;

        // green
        err := integer(srcRow0[j].g) - palette[k].g;
        if j + 1 < imgWidth then
          ptu(srcRow0[j + 1].g, (err * 7) div 16);
        if i + 1 < imgHeight then
        begin
          if j - 1 > 0 then
            ptu(srcRow1[j - 1].g, (err * 3) div 16);
          ptu(srcRow1[j].g, (err * 5) div 16);
          if j + 1 < imgWidth then
            ptu(srcRow1[j + 1].g, err div 16);
        end;

        // blue
        err := integer(srcRow0[j].b) - palette[k].b;
        if j + 1 < imgWidth then
          ptu(srcRow0[j + 1].b, (err * 7) div 16);
        if i + 1 < imgHeight then
        begin
          if j - 1 > 0 then
            ptu(srcRow1[j - 1].b, (err * 3) div 16);
          ptu(srcRow1[j].b, (err * 5) div 16);
          if j + 1 < imgWidth then
            ptu(srcRow1[j + 1].b, err div 16);
        end;

      end;

      // Swap rows and copy a new row
      IESwap(srcRow0, srcRow1);
      if i + 2 < imgHeight then
        CopyMemory(@srcRow1[0], srcBitmap.Scanline[i + 2], imgWidth * 3);
    end;

  finally
    qt.Free();
  end;
end;


procedure _ConvertToBWOrdered(bitmap: TIEBitmap; var Progress: TProgressRec);
var
  x, y, v, b: Integer;
  newbmp: TIEBitmap;
  p1: pRGB;
  p2: pbyte;
  bitmapwidth1, bitmapheight1: Integer;
  RedToGrayCoef, GreenToGrayCoef, BlueToGrayCoef: Integer;
begin
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  progress.per1 := 100 / (bitmap.height + 0.5);
  newbmp := TIEBitmap.Create;
  newbmp.Allocate(bitmap.Width, bitmap.Height, ie1g);
  bitmapheight1 := bitmap.height - 1;
  bitmapwidth1 := bitmap.width - 1;
  RedToGrayCoef   := IEGlobalSettings().RedToGrayCoef;
  GreenToGrayCoef := IEGlobalSettings().GreenToGrayCoef;
  BlueToGrayCoef  := IEGlobalSettings().BlueToGrayCoef;
  for y := 0 to bitmapheight1 do
  begin
    p1 := bitmap.ScanLine[y];
    p2 := newbmp.ScanLine[y];
    for x := 0 to bitmapwidth1 do
    begin
      b := x and 7;
      with p1^ do
      begin
        if (r > 250) and (g > 250) and (b > 250) then
          v := 64
        else
          v := ((r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100) shr 2;
      end;
      if v > BWORDERPATTERN[x and 7][y and 7] then
        p2^ := p2^ or iebitmask1[b]
      else
        p2^ := p2^ and (not iebitmask1[b]);
      inc(p1);
      if b = 7 then
        inc(p2);
    end;
    with Progress do
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * (y + 1)));
  end;
  bitmap.AssignImage(newbmp);
  FreeAndNil(newbmp);
end;

// Converts current image to black & white with ordered dithering (Bayer algorithm)
// The image must be pf24bit

{!!
<FS>TImageEnProc.ConvertToBWOrdered

<FM>Declaration<FC>
procedure ConvertToBWOrdered;

<FM>Description<FN>
Converts a true color image (24 bit) to black & white (1 bit) with an ordered dithering method.

!!}
procedure TImageEnProc.ConvertToBWOrdered;
var
  Progress: TProgressRec;
begin
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  if fAutoUndo then
    SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
              IERS_CONVERTTOBWORDERED,
              {$ELSE}
              IEMsg( IEMSG_Monochrome ),
              {$ENDIF}
              ieuImage, True, IEOP_CONVERTTOBWORDERED );
  Progress.fOnProgress := fOnProgress;
  Progress.Sender := Self;
  _ConvertToBWOrdered(fIEBitmap, Progress);
  Update;
  DoFinishWork;
end;

// If Threshold is -1 this one is autocalculated (median value), -2 maximum entropy
// bitmap: Accept all TIEPixelFormat values

procedure _ConvertToBWThreshold(bitmap: TIEBitmap; Threshold: Integer; var Progress: TProgressRec);
var
  newbmp: TIEBitmap;
begin
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  newbmp := TIEBitmap.Create;
  newbmp.Allocate(bitmap.width, bitmap.height, ie1g);
  _ConvertToBWThresholdEx(bitmap, newbmp, Threshold, Progress);
  bitmap.AssignImage(newbmp);
  FreeAndNil(newbmp);
end;

// Filter functions for resampling

function HermiteFilter(Value: Double): Double;
begin
  if (Value < 0.0) then
    Value := -Value;
  if (Value < 1.0) then
    Result := (2 * Value - 3) * sqr(Value) + 1
  else
    Result := 0.0;
end;
// Triangle filter

function TriangleFilter(Value: Double): Double;
begin
  if (Value < 0.0) then
    Value := -Value;
  if (Value < 1.0) then
    Result := 1.0 - Value
  else
    Result := 0.0;
end;
// Bell filter

function BellFilter(Value: Double): Double;
begin
  if (Value < 0.0) then
    Value := -Value;
  if (Value < 0.5) then
    Result := 0.75 - Sqr(Value)
  else
  if (Value < 1.5) then
  begin
    Value := Value - 1.5;
    Result := 0.5 * Sqr(Value);
  end
  else
    Result := 0.0;
end;
// B-spline filter

function SplineFilter(Value: Double): Double;
var
  tt: Double;
begin
  if (Value < 0.0) then
    Value := -Value;
  if (Value < 1.0) then
  begin
    tt := Sqr(Value);
    Result := 0.5 * tt * Value - tt + 2.0 / 3.0;
  end
  else
  if (Value < 2.0) then
  begin
    Value := 2.0 - Value;
    Result := 1.0 / 6.0 * Sqr(Value) * Value;
  end
  else
    Result := 0.0;
end;
// Lanczos3 filter

function Lanczos3Filter(Value: Double): Double;
  function SinC(Value: Double): Double;
  begin
    if (Value <> 0.0) then
    begin
      Value := Value * Pi;
      Result := sin(Value) / Value
    end
    else
      Result := 1.0;
  end;
begin
  if (Value < 0.0) then
    Value := -Value;
  if (Value < 3.0) then
    Result := SinC(Value) * SinC(Value / 3.0)
  else
    Result := 0.0;
end;

function MitchellFilter(Value: Double): Double;
const
  B = (1.0 / 3.0);
  C = (1.0 / 3.0);
var
  tt: Double;
begin
  if (Value < 0.0) then
    Value := -Value;
  tt := Sqr(Value);
  if (Value < 1.0) then
  begin
    Value := (((12.0 - 9.0 * B - 6.0 * C) * (Value * tt)) + ((-18.0 + 12.0 * B + 6.0 * C) * tt) + (6.0 - 2 * B));
    Result := Value / 6.0;
  end
  else
  if (Value < 2.0) then
  begin
    Value := (((-1.0 * B - 6.0 * C) * (Value * tt)) + ((6.0 * B + 30.0 * C) * tt) + ((-12.0 * B - 48.0 * C) * Value) + (8.0 * B + 24 * C));
    Result := Value / 6.0;
  end
  else
    Result := 0.0;
end;
// Nearest Filter

function NearestFilter(Value: Double): Double;
begin
  if (Value > -0.5) and (Value <= 0.5) then
    Result := 1
  else
    Result := 0;
end;
// Linear Filter

function LinearFilter(Value: Double): Double;
begin
  if Value < -1 then
    Result := 0
  else
  if Value < 0 then
    Result := 1 + Value
  else
  if Value < 1 then
    Result := 1 - Value
  else
    Result := 0;
end;

// Converts the current image to black & white with threshold (0..255)
// If Threshold is -1 it is automatically calculated, -2 maximum entropy
// The image must be pf24bit

{!!
<FS>TImageEnProc.ConvertToBWThreshold

<FM>Declaration<FC>
procedure ConvertToBWThreshold(Threshold: Integer);

<FM>Description<FN>
Converts a true color image (24 bit) to black & white (1 bit) using a thresholding algorithm.

The image is first converted to gray levels, then all levels less than Threshold are set to black, while the remainder are set to white.
Threshold is an intensity value (0..255).
If Threshold is -1, the threshold value used will be the average level of the original image.
If Threshold is -2, a Maximum Entropy Algorithm is used.

<FM>Example<FC>
// All pixels < 128 wil be black >= 128 will be white
ImageEnView1.Proc.ConvertToBWThreshold(128);

// Auto calculate the threshold value as the average of all color levels
ImageEnView1.Proc.ConvertToBWThreshold(-1);

// Use maximum entropy algorithm
ImageEnView1.Proc.ConvertToBWThreshold(-2);
!!}
procedure TImageEnProc.ConvertToBWThreshold(Threshold: Integer);
var
  Progress: TProgressRec;
begin
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  if fAutoUndo then
    SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
             Format(IERS_CONVERTTOBWTHRESHOLD, [Threshold]),
             {$ELSE}
             IEMsg( IEMSG_Monochrome ),
             {$ENDIF}
             ieuImage, True, IEOP_CONVERTTOBWTHRESHOLD );
  Progress.fOnProgress := fOnProgress;
  Progress.Sender := Self;
  _ConvertToBWThreshold(fIEBitmap, Threshold, Progress);
  Update;
  DoFinishWork;
end;

// convert a row from 1bit to 24bit

procedure _ConvRow1To24(spx, dpx: pbyte; Width: Integer);
var
  x, xx: Integer;
begin
  xx := (Width div 8) - 1;
  for x := 0 to xx do
  begin
    CopyMemory(dpx, @(C1TO24[spx^]), 24);
    inc(spx);
    inc(dpx, 24);
  end;
  x := Width and 7;
  if x <> 0 then
    // copy remaining
    CopyMemory(dpx, @(C1TO24[spx^]), x * 3);
end;

// Converts from pf1bit (SrcBitmap) to pf24bit (DstBitmap)
// note: uses the table C1TO24

procedure _Conv1to24(var SrcBitmap, DstBitmap: TBitmap; var Progress: TProgressRec);
var
  spx, dpx: pbyte;
  x, y: Integer;
  xx: Integer;
begin
  DstBitmap.Width := 1;
  DstBitmap.Height := 1;
  DstBitmap.PixelFormat := pf24bit;
  DstBitmap.Width := SrcBitmap.Width;
  DstBitmap.Height := SrcBitmap.Height;
  xx := (SrcBitmap.Width div 8) - 1;
  progress.per1 := 100 / (SrcBitmap.height + 0.5);
  for y := 0 to SrcBitmap.Height - 1 do
  begin
    spx := SrcBitmap.ScanLine[y];
    dpx := DstBitmap.ScanLine[y];
    for x := 0 to xx do
    begin
      CopyMemory(dpx, @(C1TO24[spx^]), 24);
      inc(spx);
      inc(dpx, 24);
    end;
    x := SrcBitmap.Width and 7;
    if x <> 0 then
      // copy remaining
      CopyMemory(dpx, @(C1TO24[spx^]), x * 3);
    with Progress do
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * (y + 1)));
  end;
end;

procedure _Conv1to24Ex(var SrcBitmap, DstBitmap: TIEBitmap; var Progress: TProgressRec);
var
  spx, dpx: pbyte;
  x, y: Integer;
  xx: Integer;
begin
  DstBitmap.Allocate(SrcBitmap.Width, SrcBitmap.Height, ie24RGB);
  xx := (SrcBitmap.Width div 8) - 1;
  progress.per1 := 100 / (SrcBitmap.height + 0.5);
  for y := 0 to SrcBitmap.Height - 1 do
  begin
    spx := SrcBitmap.ScanLine[y];
    dpx := DstBitmap.ScanLine[y];
    for x := 0 to xx do
    begin
      CopyMemory(dpx, @(C1TO24[spx^]), 24);
      inc(spx);
      inc(dpx, 24);
    end;
    x := SrcBitmap.Width and 7;
    if x <> 0 then
      // copy remaining
      CopyMemory(dpx, @(C1TO24[spx^]), x * 3);
    with Progress do
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * (y + 1)));
  end;
end;

{!!
<FS>TImageEnProc.ConvertTo24Bit

<FM>Declaration<FC>
procedure ConvertTo24Bit;

<FM>Description<FN>
Converts a black & white (pf1bit) image to true color (pf24bit).

!!}
procedure TImageEnProc.ConvertTo24Bit;
var
  Progress: TProgressRec;
  ftmp: TIEBitmap;
begin
  if assigned(fIEBitmap) and (fIEBitmap.Pixelformat<>ie1g) then
    exit;
  if assigned(fBitmap) and (fBitmap.PixelFormat<>pf1bit) then
    exit;
  if not MakeConsistentBitmap([ie1g]) then
    exit;
  if fAutoUndo then
    SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
              IERS_CONVERTTO24BIT,
              {$ELSE}
              IEMsg( IEMSG_CONVERTTO24BIT ),
              {$ENDIF}
              ieuImage, True, IEOP_CONVERTTO24BIT );
  Progress.fOnProgress := fOnProgress;
  Progress.Sender := Self;
  ftmp := TIEBitmap.Create;
  ftmp.Assign(fIEBitmap);
  _Conv1To24Ex(ftmp, fIEBitmap, Progress);
  FreeAndNil(ftmp);
  Update;
  DoFinishWork;
end;

{!!
<FS>TImageEnProc.BumpMapping

<FM>Declaration<FC>
procedure BumpMapping(LightX, LightY, LampX, LampY, pcf: Integer; Color: <A TRGB>);

<FM>Description<FN>
Applies a bump mapping effect to the current image. This effect and a preview are also available in the <L TImageEnProc.DoPreviews>Image Processing dialog</L>.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>LightX/LightY<FN></C> <C>Source light position</C> </R>
<R> <C><FC>LampX/LampY<FN></C> <C>Width and height of the source light</C> </R>
<R> <C><FC>pcf<FN></C> <C>Percentage of the effect to apply to the original image (0 to 100)</C> </R>
<R> <C><FC>Color<FN></C> <C>Source light color</C> </R>
</TABLE>

<FM>Example<FC>
ImageEnView1.Proc.BumpMapping(100, 100, 50, 50, 10, CreateRGB(255, 255, 255));

<FM>See Also<FN>
- <A CreateRGB>
- <A TRGB2TColor>
- <A TColor2TRGB>
!!}
procedure TImageEnProc.BumpMapping(LightX, LightY, LampX, LampY, pcf: Integer; Color: TRGB);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
  Progress: TProgressRec;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_BUMPMAPPING,
                              {$ELSE}
                              IEMsg( IEMSG_BUMPMAP ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_BUMPMAPPING ) then
    exit;
  Progress.fOnProgress := fOnProgress;
  Progress.Sender := Self;
  _BumpMapping(ProcBitmap, LightX, LightY, LampX, LampY, pcf, Color, x1, y1, x2, y2, Progress);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

procedure _ConvertToGray(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  x, y: Integer;
  v: byte;
  ppx: pRGB;
  per1: Double;
  RedToGrayCoef, GreenToGrayCoef, BlueToGrayCoef: Integer;
begin
  if bitmap.Pixelformat <> ie24RGB then
    exit;
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  RedToGrayCoef   := IEGlobalSettings().RedToGrayCoef;
  GreenToGrayCoef := IEGlobalSettings().GreenToGrayCoef;
  BlueToGrayCoef  := IEGlobalSettings().BlueToGrayCoef;
  for y := fSelY1 to fSelY2 do
  begin
    ppx := bitmap.ScanLine[y];
    inc(ppx, fSelX1);
    for x := fSelX1 to fSelX2 do
    begin
      with ppx^ do
      begin
        v := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;
        r := v;
        g := v;
        b := v;
      end;
      inc(ppx);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (y - fSelY1 + 1)));
  end;
end;

// iDepth: Default 20
procedure _ConvertToSepia(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; iDepth: Byte; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  x, y: Integer;
  ppx: pRGB;
  per1: Double;
begin
  if bitmap.Pixelformat <> ie24RGB then
    exit;
  fSelX2 := imin(fSelX2, bitmap.Width);
  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height);
  dec(fSelY2);
  per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  for y := fSelY1 to fSelY2 do
  begin
    ppx := bitmap.ScanLine[y];
    inc(ppx, fSelX1);
    for x := fSelX1 to fSelX2 do
    begin
      with ppx^ do
      begin
        b := (b + g + r) div 3;
        g := b;
        r := b;
        inc(r, iDepth * 2);
        inc(g, iDepth);
        if r < (iDepth * 2) then
          r := 255;
        if g < (iDepth) then
          g := 255;
      end;
      inc(ppx);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (y - fSelY1 + 1)));
  end;
end;

{!!
<FS>TImageEnProc.ConvertToSepia

<FM>Declaration<FC>
procedure ConvertToSepia(Depth : Integer = 20);

<FM>Description<FN>
Apply a Sepia effect to the selected region.

<FM>See Also<FN>
- <A TImageEnProc.Colorize>

<FM>Example<FC>
ImageEnView1.Proc.ConvertToSepia;
!!}
procedure TImageEnProc.ConvertToSepia(Depth : Integer = 20);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_CONVERTTOSEPIA,
                              {$ELSE}
                              IEMsg( IEMSG_CONVERTTOSEPIA ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_CONVERTTOSEPIA ) then
    exit;
  _ConvertToSepia(ProcBitmap, x1, y1, x2, y2, Depth, fOnProgress, Self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

// LightX, LightY: light center
// LAmpX, LAmpY: light size (in pixels)
// pcf: percentage of the effect
// Color: bump color
procedure _BumpMapping(Bitmap: TIEBitmap; LightX, LightY, LAmpX, LAmpY, pcf: Integer; Color: TRGB; fselx1, fsely1, fselx2, fsely2: Integer; var Progress: TProgressRec);
type
  tenvmap = array[0..255, 0..255] of byte;
  penvmap = ^tenvmap;
var
  envmap: penvmap;
  x, y: Integer;
  dnx, dny, dnz: Double;
  nx, ny: Integer;
  px1: pRGB;
  b1: pbyte;
  l1, l2, l3: pbytearray;
  bumpmap: TIEBitmap;
  c1, c2, c3: Double;
  cr, cg, cb: Double;
  RedToGrayCoef, GreenToGrayCoef, BlueToGrayCoef: Integer;
begin
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  if (LAmpX = 0) or (LAmpY = 0) then
    exit;
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  Progress.per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  // calc environment map
  getmem(envmap, 256 * 256);
  for x := 0 to 255 do
    for y := 0 to 255 do
    begin
      dnx := (x - 128) / 128;
      dny := (y - 128) / 128;
      dnz := 1 - sqrt(dnx * dnx + dny * dny);
      if dnz < 0 then
        dnz := 0;
      envmap^[x, y] := trunc(dnz * 256);
    end;
  envmap[128, 128] := (envmap[129, 129]+envmap[127, 127]) div 2;
  // create bumpmap
  bumpmap := TIEBitmap.Create;
  bumpmap.Allocate(bitmap.width, bitmap.height, ie8g);
  RedToGrayCoef   := IEGlobalSettings().RedToGrayCoef;
  GreenToGrayCoef := IEGlobalSettings().GreenToGrayCoef;
  BlueToGrayCoef  := IEGlobalSettings().BlueToGrayCoef;
  for y := fSelY1 to fSelY2 do
  begin
    px1 := bitmap.ScanLine[y];
    b1 := bumpmap.ScanLine[y];
    inc(px1, fSelX1);
    inc(b1, fSelX1);
    for x := fSelX1 to fSelX2 do
    begin
      with px1^ do
        b1^ := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;
      inc(px1);
      inc(b1);
    end;
  end;
  // make bump mapping
  c1 := pcf / 100;
  c3 := (100 - pcf) / 100;
  cr := Color.r / 255;
  cg := Color.g / 255;
  cb := Color.b / 255;
  for y := fSelY1 to fSelY2 do
  begin
    px1 := bitmap.ScanLine[y];
    inc(px1, fSelX1);
    l1 := bumpmap.ScanLine[imax(y - 1, 0)];
    l2 := bumpmap.ScanLine[y];
    l3 := bumpmap.ScanLine[imin(y + 1, fSelY2)];
    for x := fSelX1 to fSelX2 do
    begin
      nx := l2^[imin(x + 1, fSelX2)] - l2^[imax(x - 1, fSelX1)];
      ny := l3^[x] - l1[x];
      nx := blimit(nx + 128 - trunc((x - LightX) / LAmpX * 128));
      ny := blimit(ny + 128 - trunc((y - LightY) / LAmpY * 128));
      with px1^ do
      begin
        c2 := envmap[nx, ny] * c3;
        r := blimit(round(r * c1 + c2 * cr));
        g := blimit(round(g * c1 + c2 * cg));
        b := blimit(round(b * c1 + c2 * cb));
      end;
      inc(px1);
    end;
    with Progress do
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * (y - fSelY1 + 1)));
  end;
  //
  FreeAndNil(bumpmap);
  freemem(envmap);
end;

// angle hasn't limits
// counter-clockwise
{!!
<FS>TImageEnProc.Rotate

<FM>Declaration<FC>
procedure Rotate(Angle: Double; AntiAliasMode: <A TIEAntialiasMode> = ierFast; BackgroundColor: TColor = -1);

<FM>Description<FN>
Rotate the current image by the specified angle (negative or positive degrees counter-clockwise).

<FC>AntialiasMode<FN> specifies the algorithm used to improve rotation quality:
  ierNone : No anti-aliasing (lowest quality)
  ierFast : Fast but lower quality
  ierBilinear : Bilinear, high quality
  ierBicubic : Bicubic, highest quality

BackgroundColor specifies an alternative background color. If it is -1, Rotate uses the default background.

<FM>Examples<FC>     
// Rotate the image 45° clockwise at highest quality and using the ImageEnView background color
ImageEnView1.Proc.Rotate( 315, ierBicubic, -1 );

// Rotate the image 90° clockwise (Note: AntialiasMode is irrelevant for 90 deg. rotations)
ImageEnView1.Proc.Rotate( 270 );

// Rotate the image 180° clockwise
ImageEnView1.Proc.Rotate( 180 );

// Rotate the image 90° counter-clockwise
ImageEnView1.Proc.Rotate( 90 );

<FM>See Also<FN>
- <A Lossless Jpeg Transformations>
- <A AngleToImageEnRotateAngle>

!!}

{$ifdef IEIncludeDeprecatedInV4}
// Deprecated in 5.0.0
procedure TImageEnProc.Rotate(Angle: Double; AntiAlias: Boolean; AntialiasMode: TIEAntialiasMode; BackgroundColor: TColor);
begin
  if AntiAlias then
    Rotate(Angle, AntiAliasMode, BackgroundColor)
  else             
    Rotate(Angle, ierNone, BackgroundColor)
end;
{$endif}


procedure TImageEnProc.Rotate(Angle: Double; AntiAliasMode: TIEAntialiasMode; BackgroundColor: TColor);
var
  BColor : TColor;
begin
  if Angle = 0 then
    exit;
  if not MakeConsistentBitmap([]) then
    exit;
  if fAutoUndo then
    SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
             Format( IERS_ROTATE, [ Angle ]),
             {$ELSE}
             IEMsg( IEMSG_Rotate ) + Format( ' %d°', [ Trunc( ImageEnRotateAngleToAngle( Angle ))]),
             {$ENDIF}
             ieuImage, True, IEOP_ROTATE );
  if BackgroundColor = -1 then
    BColor := GetReBackground
  else
    BColor := BackgroundColor;

  fIEBitmap.RotateEx(Angle, AntialiasMode, BColor, fOnProgress, Self);

  Update;
  DoFinishWork;
end;

// accept TIEBitmap and works only with ie24RGB and ie1g
procedure _RotateEx(fBitmap: TIEBitmap; fangle: Double; antialias: Boolean; Background: TRGB; fOnProgress: TIEProgressEvent; Sender: TObject);
const
  SCALE = 4096;
  HALFSCALE = 2048;
var
  rangle: Double; // angle in radiants
  bakBitmap: tiebitmap;
  xshearfac, yshearfac, new0: Double;
  cols, rows, tempcols, yshearjunk, newrows, x2shearjunk, newcols, row, intnew0: Integer;
  col, fracnew0, omfracnew0, neww, xnew: Integer;
  bgxel, prevxel, xel: TRGB;
  temp1xels, temp2xels: pRGBROW;
  xP, nxP: pRGB;
  ppx, ppx2: pRGB;
  iangle: Integer;
  nullpr: TProgressRec;
  per: Double;
  lprog: Integer;

  procedure DoProgress(newVal: Integer);
  begin
    if assigned(fOnProgress) and (newVal<>lprog) then
    begin
      fOnProgress(Sender, newVal);
      lprog := newVal;
    end;
  end;

begin
  if fangle = 0 then
    exit;
  if fbitmap.PixelFormat = ie24RGB then
  begin
    lprog := -1;
    iangle := trunc(fangle * 1000);
    iangle := iangle mod 360000;
    fangle := iangle / 1000;
    bakBitmap := TIEBitmap.Create;
    //
    if (fangle >= -45) and (fangle <= 45) then
      bakBitmap.AssignImage(fBitmap);
    // rotates by 90 degrees until the angle is not equal or less than 45 degrees
    while fangle > 45 do
    begin
      fangle := fangle - 90;
      _Rot90Ex(fBitmap, bakbitmap);
      if fangle <= 45 then
        break;
      fBitmap.AssignImage(bakBitmap);
    end;
    // rotates by -90 degrees until the angle is not equal or less than -45 degrees
    while fangle < -45 do
    begin
      fangle := fangle + 90;
      _Rot90oEx(fBitmap, bakbitmap);
      if fangle >= -45 then
        break;
      fBitmap.AssignImage(bakbitmap);
    end;
    if fangle = 0 then
    begin
      fBitmap.AssignImage(bakBitmap);
      FreeAndNil(bakbitmap);
      exit;
    end;
    // now "fangle" is inside the range -45...45
    // in bakbitmap there is the working image
    rangle := IEDegreesToRadians( fangle ); // converts fangle to radians
    cols := bakbitmap.Width; // columns original image
    rows := bakbitmap.Height; // rows original image
    xshearfac := abs(sin(rangle / 2) / cos(rangle / 2)); // horizontal shear
    yshearfac := abs(sin(rangle)); // vertical shear
    tempcols := round(rows * xshearfac + cols + 1); // columns in horizontal shear buffer
    yshearjunk := round((tempcols - cols) * yshearfac);
    newrows := round(tempcols * yshearfac + rows + 1);
    x2shearjunk := round((newrows - rows - yshearjunk) * xshearfac);
    newrows := round(newrows - (2 * yshearjunk));
    newcols := round(newrows * xshearfac + tempcols + 1 - 2 * x2shearjunk);
    per := 100 / (rows + tempcols + newrows);
    /////// STEP-1, horizontal shear
    bgxel := Background; // fill color
    getmem(temp1xels, tempcols * rows * 3); // horizontal shear buffer
    for row := 0 to rows - 1 do
    begin
      if rangle > 0 then
        new0 := row * xshearfac
      else
        new0 := (rows - row) * xshearfac;
      intnew0 := trunc(new0);
      if antialias then
      begin
        // ANTIALIAS
        fracnew0 := trunc((new0 - intnew0) * SCALE);
        omfracnew0 := trunc(SCALE - fracnew0);
        nxP := @temp1xels[row * tempcols];
        for col := 0 to tempcols - 1 do
        begin
          nxP^ := bgxel;
          inc(nxP);
        end;
        prevxel := bgxel;
        nxP := @(temp1xels[row * tempcols + intnew0]);
        xP := pRGB(bakbitmap.scanline[row]);
        for col := 0 to cols - 1 do
        begin
          nxP^.r := blimit(trunc((fracnew0 * prevxel.r + omfracnew0 * xP^.r + HALFSCALE) / SCALE));
          nxP^.g := blimit(trunc((fracnew0 * prevxel.g + omfracnew0 * xP^.g + HALFSCALE) / SCALE));
          nxP^.b := blimit(trunc((fracnew0 * prevxel.b + omfracnew0 * xP^.b + HALFSCALE) / SCALE));
          prevxel := xP^;
          inc(nxP);
          inc(xP);
        end;
        if (fracnew0 > 0) and (intnew0 + cols < tempcols) then
        begin
          nxP^.r := blimit(trunc((fracnew0 * prevxel.r + omfracnew0 * bgxel.r + HALFSCALE) / SCALE));
          nxP^.g := blimit(trunc((fracnew0 * prevxel.g + omfracnew0 * bgxel.g + HALFSCALE) / SCALE));
          nxP^.b := blimit(trunc((fracnew0 * prevxel.b + omfracnew0 * bgxel.b + HALFSCALE) / SCALE));
        end
      end
      else
      begin
        // NO ANTIALIAS
        // fills the left area with the Background
        nxP := @(temp1xels[row * tempcols]);
        for col := 0 to intnew0 - 1 do
        begin
          nxP^ := bgxel;
          inc(nxP);
        end;
        // copies the image area
        CopyMemory(nxP, bakbitmap.scanline[row], cols * 3);
        inc(nxP, cols);
        // fills the other with Background
        for col := (intnew0 + cols) to tempcols - 1 do
        begin
          nxP^ := bgxel;
          inc(nxP);
        end;
      end;
      DoProgress(trunc(per * (row)));
    end;
    /////// STEP-2, vertical shear
    getmem(temp2xels, tempcols * newrows * 3);
    for col := 0 to tempcols - 1 do
    begin
      if rangle > 0 then
        new0 := (tempcols - col) * yshearfac
      else
        new0 := (col * yshearfac);

      intnew0 := trunc(new0);
      fracnew0 := trunc((new0 - intnew0) * SCALE);

      omfracnew0 := SCALE - fracnew0;
      dec(intnew0, yshearjunk);
      // fills the column col with background
      for row := 0 to newrows - 1 do
        temp2xels[row * tempcols + col] := bgxel;
      if antialias then
      begin
        // ANTIALIAS
        prevxel := bgxel;
        for row := 0 to rows - 1 do
        begin
          xnew := row + intnew0;
          if (xnew >= 0) and (xnew < newrows) then
          begin
            nxP := @temp2xels[xnew * tempcols + col];
            xel := temp1xels[row * tempcols + col];
            nxP^.r := blimit(trunc((fracnew0 * prevxel.r + omfracnew0 * xel.r + HALFSCALE) / SCALE));
            nxP^.g := blimit(trunc((fracnew0 * prevxel.g + omfracnew0 * xel.g + HALFSCALE) / SCALE));
            nxP^.b := blimit(trunc((fracnew0 * prevxel.b + omfracnew0 * xel.b + HALFSCALE) / SCALE));
            prevxel := xel;
          end;
        end;
        if (fracnew0 > 0) and (intnew0 + rows < newrows) then
        begin
          nxP := @temp2xels[(intnew0 + rows) * tempcols + col];
          nxP^.r := blimit(trunc((fracnew0 * prevxel.r + omfracnew0 * bgxel.r + HALFSCALE) / SCALE));
          nxP^.g := blimit(trunc((fracnew0 * prevxel.g + omfracnew0 * bgxel.g + HALFSCALE) / SCALE));
          nxP^.b := blimit(trunc((fracnew0 * prevxel.b + omfracnew0 * bgxel.b + HALFSCALE) / SCALE));
        end;
      end
      else
      begin
        // NO ANTIALIAS
        // translate columns vertically
        for row := 0 to rows - 1 do
        begin
          neww := row + intnew0;
          if (neww >= 0) and (neww < newrows) then
            temp2xels[neww * tempcols + col] := temp1xels[row * tempcols + col];
        end;
      end;
      DoProgress(trunc(per * (rows + col)));
    end;
    freemem(temp1xels);
    /////// STEP-3, horizontal shear
    fbitmap.height := newrows;
    fbitmap.width := newcols;
    fbitmap.fill(TRGB2TColor(Background));
    for row := 0 to newrows - 1 do
    begin
      if rangle > 0 then
        new0 := row * xshearfac
      else
        new0 := (newrows - row) * xshearfac;

      intnew0 := trunc(new0);
      fracnew0 := trunc((new0 - intnew0) * SCALE);

      omfracnew0 := SCALE - fracnew0;
      dec(intnew0, x2shearjunk);
      if antialias then
      begin
        // ANTIALIAS
        prevxel := bgxel;
        xP := @temp2xels[row * tempcols];
        ppx := fbitmap.scanline[row];
        for col := 0 to tempcols - 1 do
        begin
          neww := intnew0 + col;
          if (neww >= 0) and (neww < newcols) then
          begin
            nxP := ppx;
            inc(nxP, neww);
            //
            nxP^.r := blimit(trunc((fracnew0 * prevxel.r + omfracnew0 * xP^.r + HALFSCALE) / SCALE));
            nxP^.g := blimit(trunc((fracnew0 * prevxel.g + omfracnew0 * xP^.g + HALFSCALE) / SCALE));
            nxP^.b := blimit(trunc((fracnew0 * prevxel.b + omfracnew0 * xP^.b + HALFSCALE) / SCALE));
            prevxel := xP^;
          end;
          inc(xP);
        end;
        if (fracnew0 > 0) and (intnew0 + tempcols < newcols) then
        begin
          nxP := ppx;
          inc(nxP, (intnew0 + tempcols));
          //
          nxP^.r := blimit(trunc((fracnew0 * prevxel.r + omfracnew0 * bgxel.r + HALFSCALE) / SCALE));
          nxP^.g := blimit(trunc((fracnew0 * prevxel.g + omfracnew0 * bgxel.g + HALFSCALE) / SCALE));
          nxP^.b := blimit(trunc((fracnew0 * prevxel.b + omfracnew0 * bgxel.b + HALFSCALE) / SCALE));
        end;
        //
      end
      else
      begin
        // NO ANTIALIAS
        xP := pRGB(@(temp2xels[row * tempcols]));
        ppx := fbitmap.scanline[row];
        for col := 0 to tempcols - 1 do
        begin
          neww := intnew0 + col;
          if (neww >= 0) and (neww < newcols) then
          begin
            ppx2 := ppx;
            inc(ppx2, neww);
            ppx2^ := xP^;
          end;
          inc(xP);
        end;
      end;
      DoProgress(trunc(per * (rows + tempcols + row)));
    end;
    freemem(temp2xels);
    FreeAndNil(bakBitmap);
  end
  else
  begin
    // ie1g
    NullPr := ProgressRec( Sender, fOnProgress, nil );
    if (Background.r <> 0) and (Background.g <> 0) and (Background.b <> 0) then
      _rotate1bitEx(fBitmap, fangle, 1, nullpr)
    else
      _rotate1bitEx(fBitmap, fangle, 0, nullpr);
  end;
end;

// accept ie8g and ie8p
procedure _RotateEx8(fBitmap: TIEBitmap; fangle: Double; antialias: Boolean; Background: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
const
  SCALE = 4096;
  HALFSCALE = 2048;
var
  rangle: Double; // angle in radiants
  bakBitmap: tiebitmap;
  xshearfac, yshearfac, new0: Double;
  cols, rows, tempcols, yshearjunk, newrows, x2shearjunk, newcols, row, intnew0: Integer;
  col, fracnew0, omfracnew0, neww, xnew: Integer;
  bgxel, prevxel, xel: byte;
  temp1xels, temp2xels: pbytearray;
  xP, nxP: pbyte;
  ppx, ppx2: pbyte;
  iangle: Integer;
  per: Double;
begin
  if fangle = 0 then
    exit;
  if (fbitmap.PixelFormat = ie8g) or (fBitmap.PixelFormat = ie8p) then
  begin
    iangle := trunc(fangle * 1000);
    iangle := iangle mod 360000;
    fangle := iangle / 1000;
    bakBitmap := tiebitmap.create;
    //
    if (fangle >= -45) and (fangle <= 45) then
      bakBitmap.AssignImage(fBitmap);
    // rotates by 90 degrees until the angle is not equal or less than 45 degrees
    while fangle > 45 do
    begin
      fangle := fangle - 90;
      _Rot90Ex8(fBitmap, bakbitmap);
      if fangle <= 45 then
        break;
      fBitmap.Assign(bakBitmap);
    end;
    // rotates by -90 degrees until the angle is not equal or less than -45 degrees
    while fangle < -45 do
    begin
      fangle := fangle + 90;
      _Rot90oEx8(fBitmap, bakbitmap);
      if fangle >= -45 then
        break;
      fBitmap.Assign(bakbitmap);
    end;
    if fangle = 0 then
    begin
      fBitmap.Assign(bakBitmap);
      FreeAndNil(bakbitmap);
      exit;
    end;
    // now "fangle" is inside the range -45...45
    // in bakbitmap there is the working image
    rangle := IEDegreesToRadians( fangle ); // converts fangle to radiants
    cols := bakbitmap.Width; // columns original image
    rows := bakbitmap.Height; // rows original image
    xshearfac := abs(sin(rangle / 2) / cos(rangle / 2)); // horizontal shear
    yshearfac := abs(sin(rangle)); // vertical shear
    tempcols := round(rows * xshearfac + cols + 1); // columns in horizontal shear buffer
    yshearjunk := round((tempcols - cols) * yshearfac);
    newrows := round(tempcols * yshearfac + rows + 1);
    x2shearjunk := round((newrows - rows - yshearjunk) * xshearfac);
    newrows := round(newrows - (2 * yshearjunk));
    newcols := round(newrows * xshearfac + tempcols + 1 - 2 * x2shearjunk);
    per := 100 / (rows + tempcols + newrows);
    /////// STEP-1, horizontal shear
    bgxel := Background; // fill color
    getmem(temp1xels, tempcols * rows); // horizontal shear buffer
    for row := 0 to rows - 1 do
    begin
      if rangle > 0 then
        new0 := row * xshearfac
      else
        new0 := (rows - row) * xshearfac;
      intnew0 := trunc(new0);
      if antialias then
      begin
        // ANTIALIAS
        fracnew0 := trunc((new0 - intnew0) * SCALE);
        omfracnew0 := trunc(SCALE - fracnew0);
        nxP := @temp1xels[row * tempcols];
        for col := 0 to tempcols - 1 do
        begin
          nxP^ := bgxel;
          inc(nxP);
        end;
        prevxel := bgxel;
        nxP := @(temp1xels[row * tempcols + intnew0]);
        xP := pbyte(bakbitmap.scanline[row]);
        for col := 0 to cols - 1 do
        begin
          nxP^ := blimit(trunc((fracnew0 * prevxel + omfracnew0 * xP^ + HALFSCALE) / SCALE));
          prevxel := xP^;
          inc(nxP);
          inc(xP);
        end;
        if (fracnew0 > 0) and (intnew0 + cols < tempcols) then
          nxP^ := blimit(trunc((fracnew0 * prevxel + omfracnew0 * bgxel + HALFSCALE) / SCALE));
      end
      else
      begin
        // NO ANTIALIAS
        // fills the left area with the Background
        nxP := @(temp1xels[row * tempcols]);
        for col := 0 to intnew0 - 1 do
        begin
          nxP^ := bgxel;
          inc(nxP);
        end;
        // copies the image area
        CopyMemory(nxP, bakbitmap.scanline[row], cols);
        inc(nxP, cols);
        // fills the other with Background
        for col := (intnew0 + cols) to tempcols - 1 do
        begin
          nxP^ := bgxel;
          inc(nxP);
        end;
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per * (row)));
    end;
    /////// STEP-2, vertical shear
    getmem(temp2xels, tempcols * newrows);
    for col := 0 to tempcols - 1 do
    begin
      if rangle > 0 then
        new0 := (tempcols - col) * yshearfac
      else
        new0 := (col * yshearfac);
      intnew0 := trunc(new0);
      fracnew0 := trunc((new0 - intnew0) * SCALE);
      omfracnew0 := SCALE - fracnew0;
      dec(intnew0, yshearjunk);
      // fills the column col with background
      for row := 0 to newrows - 1 do
        temp2xels[row * tempcols + col] := bgxel;
      if antialias then
      begin
        // ANTIALIAS
        prevxel := bgxel;
        for row := 0 to rows - 1 do
        begin
          xnew := row + intnew0;
          if (xnew >= 0) and (xnew < newrows) then
          begin
            nxP := @temp2xels[xnew * tempcols + col];
            xel := temp1xels[row * tempcols + col];
            nxP^ := blimit(trunc((fracnew0 * prevxel + omfracnew0 * xel + HALFSCALE) / SCALE));
            prevxel := xel;
          end;
        end;
        if (fracnew0 > 0) and (intnew0 + rows < newrows) then
        begin
          nxP := @temp2xels[(intnew0 + rows) * tempcols + col];
          nxP^ := blimit(trunc((fracnew0 * prevxel + omfracnew0 * bgxel + HALFSCALE) / SCALE));
        end;
      end
      else
      begin
        // NO ANTIALIAS
        // translate columns vertically
        for row := 0 to rows - 1 do
        begin
          neww := row + intnew0;
          if (neww >= 0) and (neww < newrows) then
            temp2xels[neww * tempcols + col] := temp1xels[row * tempcols + col];
        end;
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per * (rows + col)));
    end;
    freemem(temp1xels);
    /////// STEP-3, horizontal shear
    fbitmap.height := newrows;
    fbitmap.width := newcols;
    fbitmap.fill(Background);
    for row := 0 to newrows - 1 do
    begin
      if rangle > 0 then
        new0 := row * xshearfac
      else
        new0 := (newrows - row) * xshearfac;
      intnew0 := trunc(new0);
      fracnew0 := trunc((new0 - intnew0) * SCALE);
      omfracnew0 := SCALE - fracnew0;
      dec(intnew0, x2shearjunk);
      if antialias then
      begin
        // ANTIALIAS
        prevxel := bgxel;
        xP := @temp2xels[row * tempcols];
        ppx := fbitmap.scanline[row];
        for col := 0 to tempcols - 1 do
        begin
          neww := intnew0 + col;
          if (neww >= 0) and (neww < newcols) then
          begin
            nxP := ppx;
            inc(nxP, neww);
            //
            nxP^ := blimit(trunc((fracnew0 * prevxel + omfracnew0 * xP^ + HALFSCALE) / SCALE));
            prevxel := xP^;
          end;
          inc(xP);
        end;
        if (fracnew0 > 0) and (intnew0 + tempcols < newcols) then
        begin
          nxP := ppx;
          inc(nxP, (intnew0 + tempcols));
          //
          nxP^ := blimit(trunc((fracnew0 * prevxel + omfracnew0 * bgxel + HALFSCALE) / SCALE));
        end;
        //
      end
      else
      begin
        // NO ANTIALIAS
        xP := pbyte(@(temp2xels[row * tempcols]));
        ppx := fbitmap.scanline[row];
        for col := 0 to tempcols - 1 do
        begin
          neww := intnew0 + col;
          if (neww >= 0) and (neww < newcols) then
          begin
            ppx2 := ppx;
            inc(ppx2, neww);
            ppx2^ := xP^;
          end;
          inc(xP);
        end;
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per * (rows + tempcols + row)));
    end;
    freemem(temp2xels);
    FreeAndNil(bakBitmap);
  end;
end;

// xx, yy: lens center
// width, height: lens size
// refraction: refraction value (1.7)

procedure _lens(Bitmap: TIEBitmap; xx, yy: Integer; width, height: Integer; refraction: Double; var Progress: TProgressRec);
  {}
  procedure find_projected_pos(refraction: Double; a, b, x, y: Double; projx, projy: pdouble);
  var
    c: Double;
    n: array[0..2] of double;
    nxangle, nyangle, theta1, theta2: Double;
    ri1, ri2: Double;
  begin
    ri1 := 1.0;
    ri2 := abs(refraction);
    c := dmin(a, b);
    n[0] := x;
    n[1] := y;

    if refraction > 0 then
      n[2] := sqrt((1 - x * x / (a * a) - y * y / (b * b)) * (c * c))
    else
      n[2] := -sqrt((1 - x * x / (a * a) - y * y / (b * b)) * (c * c));
    nxangle := cos(n[0] / sqrt(n[0] * n[0] + n[2] * n[2]));
    theta1 := PI / 2 - nxangle;
    theta2 := ArcSin(sin(theta1) * ri1 / ri2);
    theta2 := PI / 2 - nxangle - theta2;
    projx^ := x - tan(theta2) * n[2];
    nyangle := ArcCos(n[1] / sqrt(n[1] * n[1] + n[2] * n[2]));
    theta1 := PI / 2 - nyangle;
    theta2 := ArcSin(sin(theta1) * ri1 / ri2);
    theta2 := PI / 2 - nyangle - theta2;
    projy^ := y - tan(theta2) * n[2];
  end;
  {}
var
  row: Integer;
  col, scol, srow: Integer;
  regionwidth, regionheight: Integer;
  dx, dy, xsqr, ysqr: Double;
  a, b, asqr, bsqr, x, y: Double;
  origbmp, destbmp: TIEBitmap;
  src, dest: array of PRGB; // list of scanline pointers
  x1, y1, x2, y2: Integer;
  bitmapwidth1, bitmapheight1: Integer;
begin
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  if (Refraction<1) and (Refraction>-1) then
    exit;
  x1 := xx - (width div 2);
  y1 := yy - (height div 2);
  x2 := xx + (width div 2);
  y2 := yy + (height div 2);
  x1 := ilimit(x1, 0, bitmap.width - 1);
  y1 := ilimit(y1, 0, bitmap.height - 1);
  x2 := ilimit(x2, 0, bitmap.width - 1);
  y2 := ilimit(y2, 0, bitmap.height - 1);
  Progress.per1 := 100 / (Y2 - Y1 + 0.5);

  regionwidth := x2 - x1;
  a := regionwidth / 2;
  regionheight := y2 - y1;
  b := regionheight / 2;
  asqr := a * a;
  bsqr := b * b;

  destbmp := TIEBitmap.Create;
  origbmp := TIEBitmap.Create;

  try

    destbmp.Location := ieMemory; // needed to set dest[]
    destbmp.Allocate(x2 - x1, y2 - y1, ie24RGB);

    origbmp.Location := ieMemory; // needed to set src[]
    origbmp.AssignImage(Bitmap);
    if Bitmap.HasAlphaChannel then
      origbmp.AlphaChannel.AssignImage(Bitmap.AlphaChannel);

    // build scanline pointers
    SetLength(src, origbmp.height);
    for row := 0 to origbmp.height - 1 do
      src[row] := origbmp.scanline[row];
    SetLength(dest, destbmp.height);
    for row := 0 to destbmp.height - 1 do
      dest[row] := destbmp.scanline[row];

    bitmapwidth1 := origbmp.width - 1;
    bitmapheight1 := origbmp.height - 1;
    for col := 0 to regionwidth - 1 do
    begin
      dx := col - a + 0.5;
      xsqr := dx * dx;
      for row := 0 to regionheight - 1 do
      begin
        dy := -(row - b) - 0.5;
        ysqr := dy * dy;
        if (ysqr < (bsqr - (bsqr * xsqr) / asqr)) then
        begin
          find_projected_pos(refraction, a, b, dx, dy, @x, @y);
          y := -y;
          srow := trunc(y + b);
          srow := ilimit(srow, 0, bitmapheight1);
          scol := trunc(x + a);
          scol := ilimit(scol, 0, bitmapwidth1);
          PRGBROW(dest[row])[col] := PRGBROW(src[y1 + srow])[x1 + scol];
          if origbmp.HasAlphaChannel then
            destbmp.Alpha[col, row] := origbmp.Alpha[x1 + scol, y1 + srow];
        end
        else
        begin
          PRGBROW(dest[row])[col] := PRGBROW(src[y1 + row])[x1 + col];
          if origbmp.HasAlphaChannel then
            destbmp.Alpha[col, row] := origbmp.Alpha[x1 + col, y1 + row];
        end;
      end;
      with Progress do
        if assigned(fOnProgress) then
          fOnProgress(Sender, trunc(per1 * (col - X1 + 1)));
    end;
    destbmp.CopyRectTo(Bitmap, 0, 0, x1, y1, destbmp.Width, destbmp.Height, true);
    if Bitmap.HasAlphaChannel then
      Bitmap.AlphaChannel.SyncFull();

  finally
    FreeAndNil(destbmp);
    FreeAndNil(origbmp);
  end;
end;


{!!
<FS>TImageEnProc.Lens

<FM>Declaration<FC>
procedure Lens(cx, cy, Width, Height: Integer; Refraction: Double);

<FM>Description<FN>
Applies a lens effect to the current image. This effect and a preview are also available in the <L TImageEnProc.DoPreviews>Image Processing dialog</L>.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>cx<FN></C> <C>Horizontal lens position</C> </R>
<R> <C><FC>cy<FN></C> <C>Vertical lens position</C> </R>
<R> <C><FC>Width<FN></C> <C>Lens width</C> </R>
<R> <C><FC>Height<FN></C> <C>Lens height</C> </R>
<R> <C><FC>Refraction<FN></C> <C>Lens refraction (from 1)</C> </R>
</TABLE>

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\Lens\LensTest.dpr </C> </R>
</TABLE>
!!}
// cx, cy: lens center
// Width, Height: lens size
// Refraction: refraction value (from 1)
procedure TImageEnProc.Lens(cx, cy, Width, Height: Integer; Refraction: Double);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
  Progress: TProgressRec;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_LENS,
                              {$ELSE}
                              IEMsg( IEMSG_LENS ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_LENS ) then
    exit;
  Progress.fOnProgress := fOnProgress;
  Progress.Sender := Self;
  _lens(ProcBitmap, cx, cy, Width, Height, Refraction, Progress);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

procedure TImageEnProc.OnBitmapChange(Sender: TObject; destroying: Boolean);
begin
  if destroying then
  begin
    fImageEnView := nil;
  end
  else
  if assigned(fImageEnView) then
  begin
    if assigned(fIEBitmap) then
    begin
      if fIEBitmapCreated then
      begin
        fIEBitmapCreated := false;
        FreeAndNil(fIEBitmap);
      end;
      fIEBitmap := fImageEnView.IEBitmap;
      fBitmap := nil; // both fBitmap and fIEBitmap aren't allowed if not encapsulated
    end
    else
    if assigned(fBitmap) then
    begin
      fBitmap := fImageEnView.Bitmap;
      if fIEBitmapCreated then
        fIEBitmap.EncapsulateTBitmap(fBitmap, true);
    end;

  end;
end;

// return <> 0 if active /   0=disattive
function _GetPixelbw(row: pbyte; pix: Integer): Integer; {$ifdef IESUPPORTINLINE} inline; {$endif}
begin
  result := pbytearray(row)^[pix shr 3] and iebitmask1[pix and $7];
end;

// Set pixel "pix" to vv ( <> 0=1 0=0)
procedure _SetPixelbw(row: pbyte; pix: Integer; vv: Integer); {$ifdef IESUPPORTINLINE} inline; {$endif}
var
  bp: pbyte;
begin
  bp := pbyte(uint64(row) + (uint64(pix) shr 3));
  if vv <> 0 then
    bp^ := bp^ or iebitmask1[pix and 7]
  else
    bp^ := bp^ and not iebitmask1[pix and 7];
end;

// fBitmap.PixelFormat must be ie1g
procedure _rotate1bitex(fBitmap: TIEBitmap; angle: Double; background: Integer; var Progress: TProgressRec);
var
  xrotimage: TIEBitmap;
  nx, ny, newheight, newwidth, oldheight, oldwidth, i, j, x, x7, x6, y, w, xl, x3: Integer;
  halfnewheight, halfnewwidth, halfoldheight, halfoldwidth: Double;
  radians: Double;
  cosval, sinval: Double;
  drow, bp, newb, oldb, tbuf: pbyte;
  anx, any: pintegerarray;
  prog, lprog: Integer;
begin
  oldheight := fBitmap.height;
  oldwidth := fBitmap.width;
  xrotimage := TIEBitmap.Create;
  xrotimage.Location := ieMemory;
  lprog := -1;
  if (angle = 90) or (angle = -90) or (angle = 270) or (angle = 180) or (angle = -180) then
  begin
    if angle = 90 then
    begin
      // +90
      newwidth := oldheight;
      newheight := oldwidth;
      xrotimage.allocate(newwidth, newheight, ie1g);
      xrotimage.Fill(0);
      for x := 0 to oldwidth - 1 do
      begin
        drow := xrotimage.ScanLine[oldwidth - x - 1];
        x7 := iebitmask1[x and $7];
        x3 := x shr 3;
        for y := 0 to oldheight - 1 do
        begin
          if (pbytearray(fBitmap.Scanline[y])[x3] and x7) <> 0 then
          begin
            bp := pbyte(uint64(drow) + (uint64(y) shr 3));
            bp^ := bp^ or (iebitmask1[y and 7]);
          end;
        end;
      end;
    end
    else
    if (angle = -90) or (angle = 270) then
    begin
      // -90, 270
      newwidth := oldheight;
      newheight := oldwidth;
      xrotimage.allocate(newwidth, newheight, ie1g);
      xrotimage.Fill(0);
      for x := 0 to oldwidth - 1 do
      begin
        drow := xrotimage.ScanLine[x];
        x7 := iebitmask1[x and $7];
        x3 := x shr 3;
        for y := 0 to oldheight - 1 do
          if (pbytearray(fBitmap.Scanline[oldheight - y - 1])[x3] and x7) <> 0 then
          begin
            bp := pbyte(uint64(drow) + (uint64(y) shr 3));
            bp^ := bp^ or (iebitmask1[y and 7]);
          end;
      end;
    end
    else
    if (angle = 180) or (angle = -180) then
    begin
      // 180, -180
      newwidth := oldwidth;
      newheight := oldheight;
      xrotimage.allocate(newwidth, newheight, ie1g);
      w := oldwidth div 8;
      if (oldwidth and 7) <> 0 then
      begin
        inc(w);
        xl := 8 - (oldwidth and 7); // we need to shift left the image
      end
      else
        xl := 0;
      if xl = 0 then
      begin
        for y := 0 to oldheight - 1 do
        begin
          newb := xrotimage.ScanLine[y];
          oldb := fBitmap.Scanline[oldheight - 1 - y];
          inc(oldb, w - 1);
          for x := 0 to w - 1 do
          begin
            newb^ := oldb^;
            ReverseBitsB(newb^);
            inc(newb);
            dec(oldb);
          end;
        end;
      end
      else
      begin
        // need to shift
        getmem(tbuf, w);
        for y := 0 to oldheight - 1 do
        begin
          newb := tbuf;
          oldb := fBitmap.Scanline[oldheight - 1 - y];
          inc(oldb, w - 1);
          for x := 0 to w - 1 do
          begin
            newb^ := oldb^;
            ReverseBitsB(newb^);
            inc(newb);
            dec(oldb);
          end;
          IECopyBits_large(xrotimage.scanline[y], tbuf, 0, xl, oldWidth, w);
        end;
        freemem(tbuf);
      end;
    end;
  end
  else
  begin
    radians := -(angle) / ((180 / PI));
    cosval := trunc(cos(radians) * 10000) / 10000;
    sinval := trunc(sin(radians) * 10000) / 10000;
    newwidth := trunc(abs(oldwidth * cosval) + abs(oldheight * sinval));
    newheight := trunc(abs(-oldwidth * sinval) + abs(oldheight * cosval));
    halfnewheight := newheight / 2 - 0.5;
    halfnewwidth := newwidth / 2 - 0.5;
    halfoldwidth := oldwidth / 2 - 0.5;
    halfoldheight := oldheight / 2 - 0.5;
    xrotimage.allocate(newwidth, newheight, ie1g);
    //
    Progress.per1 := 100 / (newheight);
    xrotimage.Fill(0);
    getmem(anx, sizeof(integer) * newwidth);
    getmem(any, sizeof(integer) * newwidth);
    for j := 0 to newwidth - 1 do
    begin
      anx[j] := trunc((j - halfnewwidth) * cosval);
      any[j] := trunc((0 - (j - halfnewwidth)) * sinval);
    end;
    for i := 0 to newheight - 1 do
    begin
      drow := xrotimage.scanline[i];
      x6 := trunc((i - halfnewheight) * sinval + halfoldwidth);
      x7 := trunc((i - halfnewheight) * cosval + halfoldheight);
      for j := 0 to newwidth - 1 do
      begin
        nx := anx[j] + x6;
        ny := any[j] + x7;
        if ((nx < oldwidth) and (ny < oldheight) and (nx >= 0) and (ny >= 0)) then
        begin
          if (pbytearray(fBitmap.Scanline[ny])^[nx shr 3] and iebitmask1[nx and $7]) <> 0 then
          begin
            bp := pbyte(uint64(drow) + (uint64(j) shr 3));
            bp^ := bp^ or (iebitmask1[j and 7]);
          end;
        end
        else
        if background <> 0 then
        begin
          bp := pbyte(uint64(drow) + (uint64(j) shr 3));
          bp^ := bp^ or (iebitmask1[j and 7]);
        end;
      end;
      with Progress do
        if assigned(fOnProgress) then
        begin
          prog := trunc(per1 * i);
          if prog <> lprog then
          begin
            fOnProgress(Sender, prog);
            lprog := prog;
          end;
        end;
    end;
    freemem(anx);
    freemem(any);
  end;
  fBitmap.Assign(xrotimage);
  FreeAndNil(xrotimage);
end;

procedure _rotate1bit(fBitmap: TBitmap; angle: Double; background: Integer; var Progress: TProgressRec);
var
  bmp: TIEBitmap;
begin
  bmp := TIEBitmap.Create;
  bmp.EncapsulateTBitmap(fBitmap, true);
  _rotate1bitex(bmp, angle, background, Progress);
  FreeAndNil(bmp);
end;

// fBitmap must be ie8g or ie8p

procedure _rotate8bit(fBitmap: TIEBitmap; angle: Double; background: Integer);
var
  xrotimage: TIEBitmap;
  nx, ny, newheight, newwidth, oldheight, oldwidth, i, j, x, x7, x6, y: Integer;
  halfnewheight, halfnewwidth, halfoldheight, halfoldwidth: Double;
  radians: Double;
  cosval, sinval: Double;
  drow, bp: pbyte;
  anx, any: pintegerarray;
begin
  if (fBitmap.PixelFormat <> ie8g) and (fBitmap.PixelFormat <> ie8p) then
    exit;
  oldheight := fBitmap.height;
  oldwidth := fBitmap.width;
  xrotimage := TIEBitmap.Create;
  xrotimage.Location := ieMemory;
  if (angle = 90) or (angle = -90) or (angle = 270) or (angle = 180) or (angle = -180) then
  begin
    if angle = 90 then
    begin
      // +90
      newwidth := oldheight;
      newheight := oldwidth;
      xrotimage.allocate(newwidth, newheight, fBitmap.PixelFormat);
      for x := 0 to oldwidth - 1 do
      begin
        drow := xrotimage.ScanLine[oldwidth - x - 1];
        for y := 0 to oldheight - 1 do
        begin
          drow^ := pbytearray(fBitmap.Scanline[y])[x];
          inc(drow);
        end;
      end;
    end
    else
    if (angle = -90) or (angle = 270) then
    begin
      // -90, 270
      newwidth := oldheight;
      newheight := oldwidth;
      xrotimage.allocate(newwidth, newheight, fBitmap.PixelFormat);
      for x := 0 to oldwidth - 1 do
      begin
        drow := xrotimage.ScanLine[x];
        for y := 0 to oldheight - 1 do
        begin
          drow^ := pbytearray(fBitmap.Scanline[oldheight - y - 1])[x];
          inc(drow);
        end;
      end;
    end
    else
    if (angle = 180) or (angle = -180) then
    begin
      // 180, -180
      newwidth := oldwidth;
      newheight := oldheight;
      xrotimage.allocate(newwidth, newheight, fBitmap.PixelFormat);
      for y := 0 to newheight - 1 do
      begin
        drow := xrotimage.Scanline[y];
        bp := fBitmap.Scanline[newheight - y - 1];
        inc(bp, newwidth - 1);
        for x := 0 to newwidth - 1 do
        begin
          drow^ := bp^;
          inc(drow);
          dec(bp);
        end;
      end;
    end;
  end
  else
  begin
    radians := -(angle) / ((180 / PI));
    cosval := trunc(cos(radians) * 10000) / 10000;
    sinval := trunc(sin(radians) * 10000) / 10000;
    newwidth := trunc(abs(oldwidth * cosval) + abs(oldheight * sinval));
    newheight := trunc(abs(-oldwidth * sinval) + abs(oldheight * cosval));
    halfnewheight := newheight / 2 - 0.5;
    halfnewwidth := newwidth / 2 - 0.5;
    halfoldwidth := oldwidth / 2 - 0.5;
    halfoldheight := oldheight / 2 - 0.5;
    xrotimage.allocate(newwidth, newheight, fBitmap.PixelFormat);
    //
    getmem(anx, sizeof(integer) * newwidth);
    getmem(any, sizeof(integer) * newwidth);
    for j := 0 to newwidth - 1 do
    begin
      anx[j] := trunc((j - halfnewwidth) * cosval);
      any[j] := trunc((0 - (j - halfnewwidth)) * sinval);
    end;
    for i := 0 to newheight - 1 do
    begin
      drow := xrotimage.scanline[i];
      x6 := trunc((i - halfnewheight) * sinval + halfoldwidth);
      x7 := trunc((i - halfnewheight) * cosval + halfoldheight);
      for j := 0 to newwidth - 1 do
      begin
        nx := anx[j] + x6;
        ny := any[j] + x7;
        if ((nx < oldwidth) and (ny < oldheight) and (nx >= 0) and (ny >= 0)) then
        begin
          drow^ := pbytearray(fBitmap.Scanline[ny])[nx];
        end
        else
        begin
          drow^ := background;
        end;
        inc(drow);
      end;
    end;
    freemem(anx);
    freemem(any);
  end;
  fBitmap.Assign(xrotimage);
  FreeAndNil(xrotimage);
end;

{!!
<FS>TImageEnProc.PreviewsParams

<FM>Declaration<FC>
property PreviewsParams: <A TPRPreviewsParams>;

<FM>Description<FN>
Access to further configuration settings for the <L TImageEnProc.DoPreviews>Image Processing dialog</L>.

Default : [prppShowResetButton, prppHardReset];

<FM>Example<FC>
// Show preview by default
ImageEnView1.Proc.PreviewsParams := ImageEnView1.Proc.PreviewsParams + [ prppDefaultLockPreview ];
!!}
procedure TImageEnProc.SetPRPreviewParams(v: TPRPreviewsParams);
begin
  fPreviewsParams := v;
end;

function TImageEnProc.GetPRPreviewParams: TPRPreviewsParams;
begin
  result := fPreviewsParams;
end;

{!!
<FS>TImageEnProc.Wave

<FM>Declaration<FC>
procedure Wave(amplitude, wavelength, phase: Integer; reflective: Boolean);

<FM>Description<FN>
Applies a wave effect to the current image. This effect and a preview are also available in the <L TImageEnProc.DoPreviews>Image Processing dialog</L>.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>amplitude<FN></C> <C>Amplitude (height) of the wave (from 0).</C> </R>
<R> <C><FC>wavelength<FN></C> <C>Length of the wave (from 0).</C> </R>
<R> <C><FC>phase<FN></C> <C>phase of the wave in degress (0..359).</C> </R>
<R> <C><FC>reflective<FN></C> <C>If <FC>true<FN> makes a special effect.</C> </R>
</TABLE>

<FM>Example<FC>
ImageEnView1.Proc.Wave(10, 10, 0, false);

!!}
procedure TImageEnProc.Wave(amplitude, wavelength, phase: Integer; reflective: Boolean);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
  Progress: TProgressRec;
begin
  if not BeginImageProcessing([ie8g, ie32RGB, ieCMYK, ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_WAVE,
                              {$ELSE}
                              IEMsg( IEMSG_WAVE ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_WAVE ) then
    exit;
  Progress.fOnProgress := fOnProgress;
  Progress.Sender := Self;
  IEWave(ProcBitmap, amplitude, wavelength, phase, reflective, Progress);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

// amplitude
// wavelength
// phase (angle in degrees)
// reflective
procedure IEWave(Bitmap: TIEBitmap; amplitude, wavelength, phase: Integer; reflective: Boolean; var Progress: TProgressRec);
var
  width, height: Integer;
  fphase: Double;
  dest: pbyte;
  x, y: Integer;
  x1_in, y1_in, x2_in, y2_in: Boolean;
  cen_x, cen_y: Double;
  xhsiz, yhsiz: Double;
  amnt, d: Double;
  needx, needy: Double;
  dx, dy: Double;
  xscale, yscale: Double;
  xi, yi: Integer;
  v0, v1, v2, v3: integer;
  k: Integer;
  bytesPerPixel: integer;
  src: array of byte;
  rowlen: integer;
begin
  // check values
  if (amplitude = 0) or (wavelength = 0) then
    exit;

  if Bitmap.HasAlphaChannel then
  begin
    IEWave(Bitmap.AlphaChannel, amplitude, wavelength, phase, reflective, Progress);
    Bitmap.AlphaChannel.SyncFull();
  end;

  width  := Bitmap.Width;
  height := Bitmap.Height;
  rowlen := Bitmap.Rowlen;

  SetLength(src, rowlen * height);
  for y := 0 to height - 1 do
    CopyMemory(@src[y * rowlen], Bitmap.ScanLine[y], rowlen);

  bytesPerPixel := Bitmap.BitCount div 8;

  Progress.per1 := 100 / height;
  fphase := IEDegreesToRadians( phase );

  cen_x := (width - 1) / 2.0;
  cen_y := (height - 1) / 2.0;
  xhsiz := width / 2.0;
  yhsiz := height / 2.0;
  if (xhsiz < yhsiz) then
  begin
    xscale := yhsiz / xhsiz;
    yscale := 1.0;
  end
  else
  if (xhsiz > yhsiz) then
  begin
    xscale := 1.0;
    yscale := xhsiz / yhsiz;
  end
  else
  begin
    xscale := 1.0;
    yscale := 1.0;
  end;

  wavelength := wavelength * 2;

  for y := 0 to height - 1 do
  begin
    dest := Bitmap.ScanLine[y];
    for x := 0 to width - 1 do
    begin
      dx := (x - cen_x) * xscale;
      dy := (y - cen_y) * yscale;
      d := sqrt(dx * dx + dy * dy);
      if reflective then
      begin
        amnt := amplitude * abs(sin(((d / wavelength) * (2.0 * PI) + fphase)));
        needx := (amnt * dx) / xscale + cen_x;
        needy := (amnt * dy) / yscale + cen_y;
      end
      else
      begin
        amnt := amplitude * sin(((d / wavelength) * (2.0 * PI) + fphase));
        needx := (amnt + dx) / xscale + cen_x;
        needy := (amnt + dy) / yscale + cen_y;
      end;
      xi := trunc(needx);
      yi := trunc(needy);
      if (xi > width - 2) then
        xi := width - 2
      else
      if (xi < 0) then
        xi := 0;
      if (yi > height - 2) then
        yi := height - 2
      else
      if (yi < 0) then
        yi := 0;

      x1_in := (0 <= xi) and (xi <= width - 1);
      y1_in := (0 <= yi) and (yi <= height - 1);
      x2_in := (0 <= xi + 1) and (xi + 1 <= width - 1);
      y2_in := (0 <= yi + 1) and (yi + 1 <= height - 1);
      for k := 0 to bytesPerPixel - 1 do
      begin

        v0 := 0;
        v1 := 0;
        v2 := 0;
        v3 := 0;

        if x1_in and y1_in then
          v0 := src[rowlen * yi + xi * bytesPerPixel + k];
        if x2_in and y1_in then
          v1 := src[rowlen * yi + xi * bytesPerPixel + bytesPerPixel + k];
        if x1_in and y2_in then
          v2 := src[rowlen * yi + xi * bytesPerPixel + rowlen + k];
        if x2_in and y2_in then
          v3 := src[rowlen * yi + xi * bytesPerPixel + bytesPerPixel + k + rowlen];

        dest^ := IEBilinear(needx, needy, v0, v1, v2, v3);
        inc(dest);
      end;
    end;

    with Progress do
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * y));
  end;
end;

// creates a palette from ColorMap
// Ncol max 256
// destroy with DeleteObject
function _CreateWinPalette(var ColorMap: array of TRGB; NCol: Integer): HPalette;
type
  tpal = record
    palVersion: word;
    palNumEntries: word;
    PaletteEntry: array[0..255] of TPALETTEENTRY;
  end;
  plogpalette = ^tlogpalette;
var
  pa: tpal;
  q: Integer;
begin
  pa.palVersion := $300;
  pa.palNumEntries := NCol;
  for q := 0 to NCol - 1 do
  begin
    pa.PaletteEntry[q].peRed := ColorMap[q].r;
    pa.PaletteEntry[q].peGreen := ColorMap[q].g;
    pa.PaletteEntry[q].peBlue := ColorMap[q].b;
    pa.PaletteEntry[q].peFlags := 0;
  end;
  result := CreatePalette(plogpalette(@pa)^);
end;

const
  IEHIDDENFILEVERSION = 0;
  IEHIDDENENCODEALG = 0;

type
  TIEHiddenRec = packed record
    Version: byte; // version: IEHIDDENFILEVERSION
    EncodeAlg: byte; // crypt algorithm : IEHIDDENENCODEALG
    res1, res2: byte; // reserved
    DataLen: Integer; // data length
  end;


{!!
<FS>TImageEnProc.WriteHiddenData

<FM>Declaration<FC>
function WriteHiddenData(data: PAnsiChar; count: Integer): Integer;

<FM>Description<FN>
<A TImageEnProc.WriteHiddenText> and WriteHiddenData write hidden text or raw data within a true color image. Hidden information is stored inside the image (uses a pixel color modulation) and is independent of the image file format.
Use <A TImageEnProc.WriteHiddenText> to write a simple string or WriteHiddenData to write a block of bytes (e.g. to embed a hidden image or sound).

Note: The hidden text will be lost if you save the image as Jpeg or if you subsample the colors.

<FM>Example<FC>
// Hide image "alfa.jpg" within "beta.jpg", then save as "gamma.png"
procedure TForm1.Button2(Sender: TObject);
var
  ms: TMemoryStream;
begin
  ImageEnView1.IO.LoadFromFile('C:\beta.jpg');
  ms := TMemoryStream.Create;
  ms.LoadFromFile('C:\alfa.jpg');
  ImageEnView1.Proc.WriteHiddenData(ms.Memory, ms.Size);
  ms.free;
  ImageEnView1.IO.SaveToFile('D:\gamma.png');
end;

// Read a hidden Jpeg image
procedure TForm1.Button1Click(Sender: TObject);
var
  ms: TMemoryStream;
Begin
  ImageEnView1.IO.LoadFromFile('D:\gamma.png');
  ms := TMemoryStream.Create;
  ms.Size := ImageEnView1.Proc.ReadHiddenData(nil, 0) );
  ImageEnView1.Proc.ReadHiddenData(ms.Memory, ms.Size);
  ImageEnView2.IO.LoadFromStreamJpeg(ms);
  ms.Free;
End;

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearHiddenText></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GetHiddenDataSpace></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ReadHiddenData></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ReadHiddenText></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WriteHiddenText></C> </R>
</TABLE>
!!}
function TImageEnProc.WriteHiddenData(data: PAnsiChar; count: Integer): Integer;
var
  row, col: Integer;
  px: pbyte;
  wb, bc: Integer;
  hr: TIEHiddenRec;
  bb: byte;
  rlen: integer;
begin
  result := 0;
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  if fAutoUndo then
    SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
              IERS_WRITEHIDDENDATA,
              {$ELSE}
              IEMsg( IEMSG_WRITEHIDDENDATA ),
              {$ENDIF}
              ieuImage, True, IEOP_WRITEHIDDENDATA );
  fillchar(hr, sizeof(TIEHiddenRec), 0);
  if count = -1 then
  begin
    // writes a wrong header
    hr.DataLen := -1;
    hr.Version := 255;
    hr.EncodeAlg := 255;
    hr.res1 := 255;
    hr.res2 := 255;
  end
  else
    hr.DataLen := count;
  wb := 0; // bit 0..7
  bc := 0;
  inc(count, sizeof(TIEHiddenRec));
  for row := 0 to fIEBitmap.Height - 1 do
  begin
    px := fIEBitmap.ScanLine[row];
    rlen := fIEBitmap.Width * 3;
    for col := 0 to rlen - 1 do
    begin
      if bc < sizeof(TIEHiddenRec) then
        bb := pbytearray(@hr)^[bc]
      else
        bb := pbyte(data)^;
      if (bb and (1 shl wb)) <> 0 then
      begin
        // write 1: make px^ odd
        if (px^ and 1) = 0 then
          inc(px^);
      end
      else
      begin
        // write 0: make px^ even
        if (px^ and 1) <> 0 then
        begin
          if px^ = 255 then
            dec(px^)
          else
            inc(px^);
        end;
      end;
      inc(wb);
      if wb = 8 then
      begin
        wb := 0;
        inc(bc);
        if bc = count then
          break;
        if bc > sizeof(TIEHiddenRec) then
          inc(data);
      end;
      inc(px);
    end;
    if bc = count then
      break;
  end;
  Update;
  result := count - sizeof(TIEHiddenRec);
  DoFinishWork;
end;

{!!
<FS>TImageEnProc.WriteHiddenText

<FM>Declaration<FC>
function WriteHiddenText(text: AnsiString): Integer;

<FM>Description<FN>
WriteHiddenText and <A TImageEnProc.WriteHiddenData> write hidden text or raw data within a true color image. Hidden information is stored inside the image (uses a pixel color modulation) and is independent of the image file format.
Use WriteHiddenText to write a simple string or <A TImageEnProc.WriteHiddenData> to write a block of bytes (e.g. to embed a hidden image or sound).

Note: The hidden text will be lost if you save the image as Jpeg or if you subsample the colors.

<FM>Example<FC>
// Hide "Copyright by XYZ" in 'alfa.tif'
ImageEnView1.Proc.WriteHiddenText('Copyright by XYZ');
ImageEnView1.IO.SaveToFile('D:\alfa.tif');

// Read simple string from 'alfa.tif'
ImageEnView1.IO.LoadFromFile('D:\alfa.tif');
mystring := ImageEnView1.Proc.ReadHiddenText;

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\FullApps\PhotoEn3\ImageEx.dpr </C> </R>
</TABLE>

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearHiddenText></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GetHiddenDataSpace></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ReadHiddenData></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ReadHiddenText></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WriteHiddenData></C> </R>
</TABLE>
!!}
// return written bytes
function TImageEnProc.WriteHiddenText(text: AnsiString): Integer;
begin
  result := WriteHiddenData(PAnsiChar(text), length(text));
end;

{!!
<FS>TImageEnProc.ClearHiddenText

<FM>Declaration<FC>
procedure ClearHiddenText;

<FM>Description<FN>
Remove text or data added by use of <A TImageEnProc.WriteHiddenText> or <A TImageEnProc.WriteHiddenData>.

!!}
procedure TImageEnProc.ClearHiddenText;
var
  space: PAnsiChar;
  dim: Integer;
begin
  dim := GetHiddenDataSpace;
  space := Allocmem(dim); // zero filled
  try
    WriteHiddenData(space, dim); // zero fill
    WriteHiddenData(space, 0); // directory fill
  finally
    freemem(space);
  end;
  DoFinishWork;
end;

// calculates hidden space

{!!
<FS>TImageEnProc.GetHiddenDataSpace

<FM>Declaration<FC>
function GetHiddenDataSpace: Integer;

<FM>Description<FN>
Returns the available hidden space inside the current image (in bytes).

<FM>Example<FC>
// Show how many hidden characters 'alfa.tif' can contain
ImageEnView1.IO.LoadFromFile('C:\alfa.tif');
freesp := ImageEnView1.Proc.GetHiddenDataSpace;
ShowMessage('You can type '+IntToStr(freesp)+' hidden characters');

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ReadHiddenData></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ReadHiddenText></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WriteHiddenData></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WriteHiddenText></C> </R>
</TABLE>
!!}
function TImageEnProc.GetHiddenDataSpace: Integer;
begin
  result := 0;
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  result := fIEBitmap.Width * fIEBitmap.Height * 3 div 8 - sizeof(TIEHiddenRec);
end;

{!!
<FS>TImageEnProc.ReadHiddenData

<FM>Declaration<FC>
function ReadHiddenData(data: PAnsiChar; maxlen: Integer): Integer;

<FM>Description<FN>
<A TImageEnProc.ReadHiddenText> and ReadHiddenData return the hidden text or raw data written with <A TImageEnProc.WriteHiddenText> or <A TImageEnProc.WriteHiddenData>. Hidden information is stored inside the image (uses a pixel color modulation) and is independent of the image file format.
Use <A TImageEnProc.ReadHiddenText> to read a simple string or <A TImageEnProc.ReadHiddenData> to read a buffer of raw data.
If you set data to nil and maxlen to 0, ReadHiddenData will returns the length of data to read.

Note: The hidden text will be lost if you save the image as Jpeg or if you subsample the colors.

<FM>Example<FC>
// Hide image "alfa.jpg" within "beta.jpg", then save to "gamma.png"
procedure TForm1.Button2(Sender: TObject);
var
  ms: TMemoryStream;
begin
  ImageEnView1.IO.LoadFromFile('C:\beta.jpg');
  ms := TMemoryStream.Create;
  ms.LoadFromFile('C:\alfa.jpg');
  ImageEnView.Proc.WriteHiddenData(ms.Memory, ms.Size);
  ms.free;
  ImageEnView1.IO.SaveToFile('D:\gamma.png');
end;

// Read a hidden Jpeg image
procedure TForm1.Button1Click(Sender: TObject);
var
  ms: TMemoryStream;
Begin
  ImageEnView1.IO.LoadFromFile('D:\gamma.png');
  ms := TMemoryStream.Create;
  ms.Size := ImageEnView1.Proc.ReadHiddenData(nil, 0) );
  ImageEnView1.Proc.ReadHiddenData(ms.Memory, ms.Size);
  ImageEnView2.IO.LoadFromStreamJpeg(ms);
  ms.Free;
End;

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearHiddenText></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GetHiddenDataSpace></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ReadHiddenText></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WriteHiddenData></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WriteHiddenText></C> </R>
</TABLE>
!!}
// if maxlen is 0 and data=nil returns the data length
function TImageEnProc.ReadHiddenData(data: PAnsiChar; maxlen: Integer): Integer;
var
  row, col: Integer;
  px: pbyte;
  rb, rc: Integer;
  hr: TIEHiddenRec;
  bb: byte;
  buflen: Integer;
  rlen: integer;

  function IsValidHeader: Boolean;
  begin
    with hr do
      result :=  (DataLen<buflen) and (Version<=IEHIDDENFILEVERSION) and (EncodeAlg<=IEHIDDENENCODEALG) and (res1 = 0) and (res2 = 0);
  end;

  function ExitMainLoop: Boolean;
  begin
    result :=  (maxlen = 0) or (rc >= hr.DataLen + sizeof(TIEHiddenRec)) or (not IsValidHeader);
  end;

begin
  result := 0;
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  buflen := fIEBitmap.Width*fIEBitmap.Height*3;
  rb := 0; // read bits
  rc := 0; // read bytes
  bb := 0;
  for row := 0 to fIEBitmap.Height - 1 do
  begin
    px := fIEBitmap.ScanLine[row];
    rlen := fIEBitmap.Width * 3;
    for col := 0 to rlen - 1 do
    begin
      if (px^ and 1) <> 0 then
        // odd: 1
        bb := bb or (1 shl rb);
      inc(rb);
      if rb = 8 then
      begin
        // filled a byte
        if rc < sizeof(TIEHiddenRec) then
          pbytearray(@hr)^[rc] := bb
        else
        begin
          if ExitMainLoop then
            break;
          pbyte(data)^ := bb;
          inc(data);
          dec(maxlen);
        end;
        inc(rc);
        rb := 0;
        bb := 0;
      end;
      inc(px);
    end;
    if ExitMainLoop then
      break;
  end;
  if IsValidHeader then
    result := hr.DataLen;
  DoFinishWork;
end;

{!!
<FS>TImageEnProc.ReadHiddenText

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

<FM>Description<FN>
ReadHiddenText and <A TImageEnProc.ReadHiddenData> return the hidden text or raw data written with <A TImageEnProc.WriteHiddenText> or <A TImageEnProc.WriteHiddenData>. Hidden information is stored inside the image (uses a pixel color modulation) and is independent of the image file format.
Use <A TImageEnProc.ReadHiddenText> to read a simple string or <A TImageEnProc.ReadHiddenData> to read a buffer of raw data.

Note: The hidden text will be lost if you save the image as Jpeg or if you subsample the colors.

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\FullApps\PhotoEn3\ImageEx.dpr </C> </R>
</TABLE>

<FM>Example<FC>
// Hides "copyright by XYZ" in 'alfa.tif'
ImageEnView1.Proc.WriteHiddenText('Copyright by XYZ');
ImageEnView1.IO.SaveToFile('alfa.tif');

// Read simple string from 'alfa.tif'
ImageEnView1.IO.LoadFromFile('alfa.tif');
mystring := ImageEnView1.Proc.ReadHiddenText;

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ClearHiddenText></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.GetHiddenDataSpace></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.ReadHiddenData></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WriteHiddenData></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WriteHiddenText></C> </R>
</TABLE>
!!}
function TImageEnProc.ReadHiddenText: AnsiString;
var
  ln: Integer;
begin
  ln := ReadHiddenData(nil, 0);
  if ln > 0 then
  begin
    SetLength(result, ln);
    ReadHiddenData(PAnsiChar(result), ln);
  end
  else
    result := '';
end;


// Convert IYU1 to Bitmap (24bit)
// YUV (4:1:1)
// "12 bit format used in mode 2 of the IEEE 1394 Digital Camera 1.04 spec"
//
// xbits : image buffer
// fBitmap : TIEBaseBitmap object. PixelFormat, Height and Width must be assigned
// dirc : direction. True= Top->down  False=Down->Top

procedure _CopyIYU1ToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
type
  TIYU1 = packed record
    u0: byte;
    y0: byte;
    y1: byte;
    v0: byte;
    y2: byte;
    y3: byte;
  end;
  PIYU1 = ^TIYU1;
var
  row, col, rr: Integer;
  yuv: PIYU1;
  px: PRGB;
  zinc: Integer;
  w, h: Integer;
begin
  w := fBitmap.Width;
  h := fBitmap.Height;
  if dirc then
  begin
    zinc := 1;
    row  := 0;
  end
  else
  begin
    zinc := -1;
    row  := h - 1;
  end;
  yuv := PIYU1(xbits);
  for rr := 0 to h - 1 do
  begin
    px := fBitmap.Scanline[row];
    col := 0;
    while col < w - 1 do
      with yuv^ do
      begin
        YUV2RGB(y0, u0, v0, px^);
        inc(px);
        YUV2RGB(y1, u0, v0, px^);
        inc(px);
        YUV2RGB(y2, u0, v0, px^);
        inc(px);
        YUV2RGB(y3, u0, v0, px^);
        inc(px);
        inc(col, 4);
        inc(yuv);
      end;
    inc(row, zinc);
  end;
end;

// Convert IYU2 to Bitmap (24bit)
// YUV (4:4:4)
// "24 bit format used in mode 2 of the IEEE 1394 Digital Camera 1.04 spec"
//
// xbits : image buffer
// fBitmap : TIEBaseBitmap object. PixelFormat, Height and Width must be assigned
// dirc : direction. True= Top->down  False=Down->Top

procedure _CopyIYU2ToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
type
  TIYU2 = packed record
    u0: byte;
    y0: byte;
    v0: byte;
  end;
  PIYU2 = ^TIYU2;
var
  row, col, rr: Integer;
  yuv: PIYU2;
  px: PRGB;
  zinc: Integer;
  w, h: Integer;
begin
  w := fBitmap.Width;
  h := fBitmap.Height;
  if dirc then
  begin
    zinc := 1;
    row  := 0;
  end
  else
  begin
    zinc := -1;
    row  := h - 1;
  end;
  yuv := PIYU2(xbits);
  for rr := 0 to h - 1 do
  begin
    px := fBitmap.Scanline[row];
    col := 0;
    while col < w - 1 do
      with yuv^ do
      begin
        YUV2RGB(y0, u0, v0, px^);
        inc(px);
        inc(col);
        inc(yuv);
      end;
    inc(row, zinc);
  end;
end;

// Convert UYVY to Bitmap (24bit)
// YUV (4:2:2)
//
// xbits : image buffer
// fBitmap : TIEBaseBitmap object. PixelFormat, Height and Width must be assigned
// dirc : direction. True= Top->down  False=Down->Top

procedure _CopyUYVYToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
type
  TUYVY = packed record
    u0: byte;
    y0: byte;
    v0: byte;
    y1: byte;
  end;
  PUYVY = ^TUYVY;
var
  row, col, rr: Integer;
  yuv: PUYVY;
  px: PRGB;
  zinc: Integer;
  w, h: Integer;
begin
  w := fBitmap.Width;
  h := fBitmap.Height;
  if dirc then
  begin
    zinc := 1;
    row  := 0;
  end
  else
  begin
    zinc := -1;
    row  := h - 1;
  end;
  yuv := PUYVY(xbits);
  for rr := 0 to h - 1 do
  begin
    px := fBitmap.Scanline[row];
    col := 0;
    while col < w - 1 do
      with yuv^ do
      begin
        YUV2RGB(y0, u0, v0, px^);
        inc(px);
        YUV2RGB(y1, u0, v0, px^);
        inc(px);
        inc(col, 2);
        inc(yuv);
      end;
    inc(row, zinc);
  end;
end;


// Convert YVYU to Bitmap (24bit)
// YUV (4:2:2)
//
// xbits : image buffer
// fBitmap : TIEBaseBitmap object. PixelFormat, Height and Width must be assigned
// dirc : direction. True= Top->down  False=Down->Top

procedure _CopyYVYUToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
type
  TYVYU = packed record
    y0: byte;
    v0: byte;
    y1: byte;
    u0: byte;
  end;
  PYVYU = ^TYVYU;
var
  row, col, rr: Integer;
  yuv: PYVYU;
  px: PRGB;
  zinc: Integer;
  w, h: Integer;
begin
  w := fBitmap.Width;
  h := fBitmap.Height;
  if dirc then
  begin
    zinc := 1;
    row  := 0;
  end
  else
  begin
    zinc := -1;
    row  := h - 1;
  end;
  yuv := PYVYU(xbits);
  for rr := 0 to h - 1 do
  begin
    px := fBitmap.Scanline[row];
    col := 0;
    while col < w - 1 do
      with yuv^ do
      begin
        YUV2RGB(y0, u0, v0, px^);
        inc(px);
        YUV2RGB(y1, u0, v0, px^);
        inc(px);
        inc(col, 2);
        inc(yuv);
      end;
    inc(row, zinc);
  end;
end;

// Convert Y41P to Bitmap (24bit)
// YUV (4:1:1)
//
// xbits : image buffer
// fBitmap : TIEBaseBitmap object. PixelFormat, Height and Width must be assigned
// dirc : direction. True= Top->down  False=Down->Top

procedure _CopyY41PToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
type
  TY41P = packed record
    u0: byte;
    y0: byte;
    v0: byte;
    y1: byte;
    u4: byte;
    y2: byte;
    v4: byte;
    y3: byte;
    y4: byte;
    y5: byte;
    y6: byte;
    y7: byte;
  end;
  PY41P = ^TY41P;
var
  row, col, rr: Integer;
  yuv: PY41P;
  px: PRGB;
  zinc: Integer;
  w, h: Integer;
begin
  w := fBitmap.Width;
  h := fBitmap.Height;
  if dirc then
  begin
    zinc := 1;
    row  := 0;
  end
  else
  begin
    zinc := -1;
    row  := h - 1;
  end;
  yuv := PY41P(xbits);
  for rr := 0 to h - 1 do
  begin
    px := fBitmap.Scanline[row];
    col := 0;
    while col < w - 1 do
      with yuv^ do
      begin
        YUV2RGB(y0, u0, v0, px^);
        inc(px);
        YUV2RGB(y1, u0, v0, px^);
        inc(px);
        YUV2RGB(y2, u0, v0, px^);
        inc(px);
        YUV2RGB(y3, u0, v0, px^);
        inc(px);
        YUV2RGB(y4, u4, v4, px^);
        inc(px);
        YUV2RGB(y5, u4, v4, px^);
        inc(px);
        YUV2RGB(y6, u4, v4, px^);
        inc(px);
        YUV2RGB(y7, u4, v4, px^);
        inc(px);
        inc(col, 8);
        inc(yuv);
      end;
    inc(row, zinc);
  end;
end;

// Convert Y211 to Bitmap (24bit)
//
// xbits : image buffer
// fBitmap : TIEBaseBitmap object. PixelFormat, Height and Width must be assigned
// dirc : direction. True= Top->down  False=Down->Top

procedure _CopyY211ToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
type
  TY211 = packed record
    y0: byte;
    u0: byte;
    y2: byte;
    v0: byte;
  end;
  PY211 = ^TY211;
var
  row, col, rr: Integer;
  yuv: PY211;
  px: PRGB;
  zinc: Integer;
  w, h: Integer;
begin
  w := fBitmap.Width;
  h := fBitmap.Height;
  if dirc then
  begin
    zinc := 1;
    row  := 0;
  end
  else
  begin
    zinc := -1;
    row  := h - 1;
  end;
  yuv := PY211(xbits);
  for rr := 0 to h - 1 do
  begin
    px := fBitmap.Scanline[row];
    col := 0;
    while col < w - 1 do
      with yuv^ do
      begin
        YUV2RGB(y0, u0, v0, px^);
        inc(px);
        YUV2RGB(y0, u0, v0, px^);
        inc(px);
        YUV2RGB(y2, u0, v0, px^);
        inc(px);
        YUV2RGB(y2, u0, v0, px^);
        inc(px);
        inc(col, 4);
        inc(yuv);
      end;
    inc(row, zinc);
  end;
end;

// Convert CLJR to Bitmap (24bit)
//
// xbits : image buffer
// fBitmap : TIEBaseBitmap object. PixelFormat, Height and Width must be assigned
// dirc : direction. True= Top->down  False=Down->Top

procedure _CopyCLJRToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
var
  row, col, rr: Integer;
  u, v: Integer;
  yuv: PDWORD;
  px: PRGB;
  zinc: Integer;
  w, h: Integer;
begin
  w := fBitmap.Width;
  h := fBitmap.Height;
  if dirc then
  begin
    zinc := 1;
    row  := 0;
  end
  else
  begin
    zinc := -1;
    row  := h - 1;
  end;
  yuv := PDWORD(xbits);
  for rr := 0 to h - 1 do
  begin
    px := fBitmap.Scanline[row];
    col := 0;
    while col < w - 1 do
    begin
      v := yuv^ and $3F;
      u := (yuv^ shr 6) and $3F;
      YUV2RGB(((yuv^ shr 12) and $1F), u, v, px^);
      inc(px);
      YUV2RGB(((yuv^ shr 17) and $1F), u, v, px^);
      inc(px);
      YUV2RGB(((yuv^ shr 22) and $1F), u, v, px^);
      inc(px);
      YUV2RGB(((yuv^ shr 27) and $1F), u, v, px^);
      inc(px);
      inc(col, 4);
      inc(yuv);
    end;
    inc(row, zinc);
  end;
end;

// Convert YVU9 to Bitmap (24bit)
//
// xbits : image buffer
// fBitmap : TIEBaseBitmap object. PixelFormat, Height and Width must be assigned
// dirc : direction. True= Top->down  False=Down->Top

procedure _CopyYVU9ToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
var
  row, col, rr: Integer;
  y, u, v: pbyte;
  bu, bv: pbyte;
  px: PRGB;
  zinc: Integer;
  w, h: Integer;
begin
  w := fBitmap.Width;
  h := fBitmap.Height;
  if dirc then
  begin
    zinc := 1;
    row  := 0;
  end
  else
  begin
    zinc := -1;
    row  := h - 1;
  end;

  y := xbits;

  v := xbits;
  inc(v, h * w);

  u := xbits;
  inc(u, h * w + (h div 4) * (w div 4));

  for rr := 0 to h - 1 do
  begin
    px := fBitmap.Scanline[row];
    col := 0;
    bv := v;
    bu := u;
    while col < w - 1 do
    begin
      YUV2RGB(y^, u^, v^, px^);
      inc(px);
      inc(y);
      YUV2RGB(y^, u^, v^, px^);
      inc(px);
      inc(y);
      YUV2RGB(y^, u^, v^, px^);
      inc(px);
      inc(y);
      YUV2RGB(y^, u^, v^, px^);
      inc(px);
      inc(y);
      inc(u);
      inc(v);
      inc(col, 4);
    end;
    inc(row, zinc);
    if (row mod 4) <> 0 then
    begin
      v := bv;
      u := bu;
    end;
  end;
end;

// Converts YV12 to Bitmap (24bit)
//
// xbits : image buffer
// fBitmap : TIEBaseBitmap object. PixelFormat, Height and Width must be assigned
// dirc : direction. True= Top->down  False=Down->Top

procedure _CopyYV12ToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
var
  row, col, rr: Integer;
  y, u, v: pbyte;
  bu, bv: pbyte;
  px: PRGB;
  zinc: Integer;
  w, h: Integer;
begin
  w := fBitmap.Width;
  h := fBitmap.Height;
  if dirc then
  begin
    zinc := 1;
    row  := 0;
  end
  else
  begin
    zinc := -1;
    row  := h - 1;
  end;

  y := xbits;

  v := xbits;
  inc(v, h * w);

  u := xbits;
  inc(u, h * w + (h div 2) * (w div 2));

  for rr := 0 to h - 1 do
  begin
    px := fBitmap.Scanline[row];
    col := 0;
    bv := v;
    bu := u;
    while col < w - 1 do
    begin
      YUV2RGB(y^, u^, v^, px^);
      inc(px);
      inc(y);
      YUV2RGB(y^, u^, v^, px^);
      inc(px);
      inc(y);
      inc(u);
      inc(v);
      inc(col, 2);
    end;
    inc(row, zinc);
    if (row mod 2) <> 0 then
    begin
      v := bv;
      u := bu;
    end;
  end;
end;

// Convert I420 to Bitmap (24bit)
//
// xbits : image buffer
// fBitmap : TIEBaseBitmap object. PixelFormat, Height and Width must be assigned
// dirc : direction. True= Top->down  False=Down->Top

procedure _CopyI420ToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
var
  row, col, rr: Integer;
  y, u, v: pbyte;
  bu, bv: pbyte;
  px: PRGB;
  zinc: Integer;
  width, height: Integer;
begin
  width  := fBitmap.Width;
  height := fBitmap.Height;
  if dirc then
  begin
    zinc := 1;
    row  := 0;
  end
  else
  begin
    zinc := -1;
    row  := height - 1;
  end;

  y := xbits;

  u := xbits;
  inc(u, height * width);

  v := xbits;
  inc(v, height * width + (height div 2) * (width div 2));

  for rr := 0 to height - 1 do
  begin
    px := fBitmap.Scanline[row];
    col := 0;
    bv := v;
    bu := u;
    while col < width - 1 do
    begin
      YUV2RGB(y^, u^, v^, px^);
      inc(px);
      inc(y);
      YUV2RGB(y^, u^, v^, px^);
      inc(px);
      inc(y);
      inc(u);
      inc(v);
      inc(col, 2);
    end;
    inc(row, zinc);
    if (row mod 2) <> 0 then
    begin
      v := bv;
      u := bu;
    end;
  end;
end;


var
  YUY2CLAMP_R: array [-222..481] of byte;
  YUY2CLAMP_G: array [-170..432] of byte;
  YUY2CLAMP_B: array [-276..534] of byte;
  YUY2CLAMP_init: Boolean = false;

procedure IESetupYUVClamps();
var
  i: Integer;
begin
  if not YUY2CLAMP_init then
  begin
    for i := Low(YUY2CLAMP_R) to High(YUY2CLAMP_R) do
      if i < 0 then
        YUY2CLAMP_R[i] := 0
      else
      if i > 255 then
        YUY2CLAMP_R[i] := 255
      else
        YUY2CLAMP_R[i] := i;

    for i := Low(YUY2CLAMP_G) to High(YUY2CLAMP_G) do
      if i < 0 then
        YUY2CLAMP_G[i] := 0
      else
      if i > 255 then
        YUY2CLAMP_G[i] := 255
      else
        YUY2CLAMP_G[i] := i;

    for i := Low(YUY2CLAMP_B) to High(YUY2CLAMP_B) do
      if i < 0 then
        YUY2CLAMP_B[i] := 0
      else
      if i > 255 then
        YUY2CLAMP_B[i] := 255
      else
        YUY2CLAMP_B[i] := i;
    YUY2CLAMP_init := true;
  end;
end;


// Convert YUY2 to Bitmap (24bit)
// YUV (4:2:2)
//
// xbits : image buffer
// fBitmap : TIEBaseBitmap object. PixelFormat, Height and Width must be assigned
// dirc : direction. True= Top->down  False=Down->Top
procedure _CopyYUY2ToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
type
  TYUY2 = packed record
    y0: byte;
    u0: byte;
    y1: byte;
    v0: byte;
  end;
  PYUY2 = ^TYUY2;

var
  srcrow, dstrow, col: Integer;
  yuv: PYUY2;
  px: PRGB;
  C, D1, D2, E1, E2: Integer;
  width, height: Integer;
  zinc: Integer;
begin

  IESetupYUVClamps();

  width  := fBitmap.Width;
  height := fBitmap.Height;

  if dirc then
  begin
    zinc   := 1;
    dstrow := 0;
  end
  else
  begin
    zinc   := -1;
    dstrow := height - 1;
  end;

  yuv := PYUY2(xbits);
  for srcrow := 0 to height - 1 do
  begin
    px := fBitmap.Scanline[dstrow];
    col := 0;
    while col < width - 1 do
      with yuv^ do
      begin

        D1 := (u0 - 128) * 100;
        D2 := (u0 - 128) * 516;
        E1 := (v0 - 128) * 409;
        E2 := (v0 - 128) * 208;

        C := (y0 - 16) * 298 + 128;
        px^.r := YUY2CLAMP_R[(C + E1) div 256];
        px^.g := YUY2CLAMP_G[(C - D1 - E2 ) div 256];
        px^.b := YUY2CLAMP_B[(C + D2) div 256];
        inc(px);

        C := (y1 - 16) * 298 + 128;
        px^.r := YUY2CLAMP_R[(C + E1) div 256];
        px^.g := YUY2CLAMP_G[(C - D1 - E2 ) div 256];
        px^.b := YUY2CLAMP_B[(C + D2) div 256];
        inc(px);

        inc(col, 2);
        inc(yuv);
      end;
    inc(dstrow, zinc);
  end;
end;


// Convert NV12 to Bitmap (24bit)
// YUV (4:2:0)
//
// xbits : image buffer
// fBitmap : TIEBaseBitmap object. PixelFormat, Height and Width must be assigned
// dirc : direction. True= Top->down  False=Down->Top
procedure _CopyNV12ToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
var
  row, dstrow, col: Integer;
  y, u, v: pbyte;
  px: PRGB;
  C, D1, D2, E1, E2: Integer;
  width, height: Integer;
  zinc: Integer;
  y_stride: Integer;
  uv_stride: Integer;
begin

  IESetupYUVClamps();

  width  := fBitmap.Width;
  height := fBitmap.Height;

  y_stride  := IEBitmapRowLen(width, 8, 32);
  uv_stride := IEBitmapRowLen(width div 2, 16, 32);

  if dirc then
  begin
    zinc   := 1;
    dstrow := 0;
  end
  else
  begin
    zinc   := -1;
    dstrow := height - 1;
  end;

  for row := 0 to height - 1 do
  begin
    px := fBitmap.Scanline[dstrow];

    y := xbits;
    inc(y, y_stride * row);

    u := xbits;
    inc(u, y_stride * height + uv_stride * (row div 2));

    for col := 0 to width - 1 do
    begin
      v := u;
      inc(v);

      D1 := (u^ - 128) * 100;
      D2 := (u^ - 128) * 516;
      E1 := (v^ - 128) * 409;
      E2 := (v^ - 128) * 208;

      C := (y^ - 16) * 298 + 128;
      px^.r := YUY2CLAMP_R[(C + E1) div 256];
      px^.g := YUY2CLAMP_G[(C - D1 - E2 ) div 256];
      px^.b := YUY2CLAMP_B[(C + D2) div 256];

      inc(px);
      inc(y);
      inc(u, col mod 2 * 2);

    end;
    inc(dstrow, zinc);
  end;
end;



// Convert YUY2 to Bitmap (24bit)
// YUV (4:2:2)
//
// xbits : image buffer
// fBitmap : TIEBaseBitmap object. PixelFormat, Height and Width must be assigned
// dirc : direction. True= Top->down  False=Down->Top
{
procedure _CopyYUY2ToBitmap(xbits: pbyte; fBitmap: TIEBaseBitmap; dirc: Boolean);
type
  TYUY2 = packed record
    y0: byte;
    u0: byte;
    y1: byte;
    v0: byte;
  end;
  PYUY2 = ^TYUY2;
var
  row, col, rr: Integer;
  yuv: PYUY2;
  px: PRGB;
  zinc: Integer;
  width, height: Integer;
begin
  width := fBitmap.Width;
  height := fBitmap.Height;
  if dirc then
  begin
    zinc := 1;
    row := 0;
  end
  else
  begin
    zinc := -1;
    row := height - 1;
  end;
  yuv := PYUY2(xbits);
  for rr := 0 to height - 1 do
  begin
    px := fBitmap.Scanline[row];
    col := 0;
    while col < width - 1 do
      with yuv^ do
      begin
        YUV2RGB(y0, u0, v0, px^);
        inc(px);
        YUV2RGB(y1, u0, v0, px^);
        inc(px);
        inc(col, 2);
        inc(yuv);
      end;
    inc(row, zinc);
  end;
end;
}



// Copy a DIB in fBitmap (fBitmap must exists)
// fBitmap will be pf1bit or pf24bit
// NOTE: desn't process DIB's colormap for 1 bpp bitmaps
// xbits: bitmap pixels. If "nil" the pixels are inside hbi.
// return bitcount of hbi
// unlck: If true hbi represents a pointer (then doesn't call GlobalLock)
// NOTE: for YUV formats xbits must point to image data
function _CopyDIB2Bitmap(hbi: THandle; fBitmap: TBitmap; xbits: pbyte; unlck: Boolean): Integer;
var
  tbmp: TIEBitmap;
begin
  tbmp := TIEBitmap.Create;
  tbmp.EncapsulateTBitmap(fBitmap, true);
  result := _CopyDIB2BitmapEx(hbi, tbmp, xbits, unlck);
  FreeAndNil(tbmp);
end;

// assume that fBitmap is already allocated
// supports only BI_RGB, BI_RLE8, BI_RLE4, BI_BITFIELDS (not YUV...)
function _CopyDIB2BitmapEx(hbi: THandle; fBitmap: TIEBaseBitmap; xbits: pbyte; unlck: Boolean): Integer;
type
  TRGBQUADARRAY = array[0..Maxint div 16] of TRGBQUAD;
  PRGBQUADARRAY = ^TRGBQUADARRAY;
  TCardinalArray = array[0..8191] of Cardinal;
  PCardinalArray = ^TCardinalArray;
var
  pbi: PBITMAPINFO;
  lw: Integer; // row length in bytes
  Compression: DWORD; // compressino type
  Width, Height: Integer; // image width and height
  BitCount: Integer; // Bitcount
  y, x, z, zz, c: Integer;
  bits, bits2: pbyte;
  wbits: pword;
  px: PRGB;
  bfdw: array[0..2] of dword;
  gbitcount, rbitcount, bbitcount: Integer;
  rshift, gshift, bshift: Integer;
  ColorMap: PRGBQUADARRAY;
  pcarr: PCardinalArray;
  i, j: Integer;
begin
  result := 0;
  if unlck then
    pbi := pointer(hbi)
  else
    pbi := GlobalLock(hbi);
  if pbi=nil then
    exit;
  try
    Width := pbi^.bmiHeader.biWidth;
    Height := pbi^.bmiHeader.biHeight;
    BitCount := pbi^.bmiHeader.biBitCount;

    if ( fBitmap is TIEBitmap ) and TIEBitmap( fBitmap ).ParamsEnabled then
    begin
      if pbi^.bmiHeader.biXPelsPerMeter > 0 then
        TIEBitmap( fBitmap ).Params.DpiX := round(( pbi^.bmiHeader.biXPelsPerMeter / 100 ) * CM_per_Inch );
      if pbi^.bmiHeader.biYPelsPerMeter > 0 then
        TIEBitmap( fBitmap ).Params.DpiY := round(( pbi^.bmiHeader.biYPelsPerMeter / 100 ) * CM_per_Inch );
    end;

    result := BitCount;
    Compression := pbi^.bmiHeader.biCompression;
    lw := (((Width * BitCount) + 31) div 32) * 4;
    if BitCount = 1 then
      fBitmap.Allocate(Width, Height, ie1g)
    else
      fBitmap.Allocate(Width, Height, ie24RGB);
    case Compression of
      BI_RGB, BI_RLE8, BI_RLE4, BI_BITFIELDS:
        case BitCount of
          1:
            begin
              // 1 bit per pixel
              bits := pbyte(pbi);
              inc(bits, pbi^.bmiHeader.biSize); // inc(bits, sizeof(TBITMAPINFOHEADER));
              y := pbi^.bmiHeader.biClrUsed;
              if y = 0 then
                y := 2;
              inc(bits, sizeof(TRGBQUAD) * y); // salta colormap
              if xbits <> nil then
                bits := xbits;
              CopyMemory(fBitmap.Scanline[height - 1], bits, lw * fbitmap.height);
              // if 0 color set to 255 -> unset bit means white (image is negative) -> must flip all bits
              if pbi^.bmiColors[0].rgbRed = 255 then
              begin
                pcarr := PCardinalArray(fBitmap.Scanline[height - 1]);
                j := (lw shr 2) * fbitmap.height; // dl / 4
                for i := 0 to j - 1 do
                  pcarr^[i] := pcarr^[i] xor $FFFFFFFF;
              end;
            end;
          4:
            begin
              // 4 bit per pixel
              bits := pbyte(pbi);
              inc(bits, pbi^.bmiHeader.biSize); // inc(bits, sizeof(TBITMAPINFOHEADER));
              Colormap := PRGBQUADARRAY(bits);
              y := pbi^.bmiHeader.biClrUsed;
              if y = 0 then
                y := 16;
              inc(bits, sizeof(TRGBQUAD) * y); // salta colormap
              if xbits <> nil then
                bits := xbits;
              zz := Width div 2;
              z := zz + (Width and 1); // if odd inc of 1
              dec(zz);
              for y := Height - 1 downto 0 do
              begin
                px := fbitmap.Scanline[y];
                bits2 := bits;
                for x := 0 to z - 1 do
                begin
                  c := bits2^ shr 4;
                  px^.b := ColorMap^[c].rgbBlue;
                  px^.g := ColorMap^[c].rgbGreen;
                  px^.r := ColorMap^[c].rgbRed;
                  inc(px);
                  if x = zz then
                    break;
                  c := bits2^ and $0F;
                  px^.b := ColorMap^[c].rgbBlue;
                  px^.g := ColorMap^[c].rgbGreen;
                  px^.r := ColorMap^[c].rgbRed;
                  inc(px);
                  inc(bits2);
                end;
                inc(bits, lw);
              end;
            end;
          8:
            begin
              // 8 bit per pixel
              bits := pbyte(pbi);
              inc(bits, pbi^.bmiHeader.biSize); //inc(bits, sizeof(TBITMAPINFOHEADER));
              Colormap := PRGBQUADARRAY(bits);
              y := pbi^.bmiHeader.biClrUsed;
              if y = 0 then
                y := 256;
              inc(bits, sizeof(TRGBQUAD) * y); // salta colormap
              if xbits <> nil then
                bits := xbits;
              for y := Height - 1 downto 0 do
              begin
                px := fbitmap.Scanline[y];
                bits2 := bits;
                for x := 0 to Width - 1 do
                begin
                  px^.b := ColorMap^[bits2^].rgbBlue;
                  px^.g := ColorMap^[bits2^].rgbGreen;
                  px^.r := ColorMap^[bits2^].rgbRed;
                  inc(bits2);
                  inc(px);
                end;
                inc(bits, lw);
              end;
            end;
          16: // 16 bit per pixel
            begin
              bits := pbyte(pbi);
              inc(bits, pbi^.bmiHeader.biSize); // inc(bits, sizeof(TBITMAPINFOHEADER));
              if xbits <> nil then
                bits := xbits;
              if Compression = BI_RGB then
              begin
                // configurazione 5-5-5
                bfdw[0] := $7C00;
                bfdw[1] := $03E0;
                bfdw[2] := $001F;
              end
              else
              if Compression = BI_BITFIELDS then
              begin
                CopyMemory(@bfdw, bits, 3 * sizeof(dword));
                inc(bits, 3 * sizeof(dword)); // bypass bitfield
              end;
              rbitcount := _GetBitCount(bfdw[0]);
              gbitcount := _GetBitCount(bfdw[1]);
              bbitcount := _GetBitCount(bfdw[2]);
              rshift := (gbitCount + bbitCount) - (8 - rbitCount);
              gshift := bbitCount - (8 - gbitCount);
              bshift := 8 - bbitCount;
              for y := Height - 1 downto 0 do
              begin
                px := fbitmap.Scanline[y];
                wbits := pword(bits);
                for x := 0 to Width - 1 do
                begin
                  px^.r := (wbits^ and bfdw[0]) shr rshift;
                  px^.g := (wbits^ and bfdw[1]) shr gshift;
                  px^.b := (wbits^ and bfdw[2]) shl bshift;
                  inc(px);
                  inc(wbits);
                end;
                inc(bits, lw);
              end;
            end;
          24: // 24 bit per pixel
            begin
              if Compression = BI_RGB then
              begin
                bits := pbyte(pbi);
                inc(bits, pbi^.bmiHeader.biSize); // inc(bits, sizeof(TBITMAPINFOHEADER));
                if xbits <> nil then
                  bits := xbits;
                for y := Height - 1 downto 0 do
                begin
                  CopyMemory(fbitmap.Scanline[y], bits, lw);
                  inc(bits, lw);
                end;
              end;
            end;
          32: // 32 bit per pixel
            begin
              if Compression = BI_BITFIELDS then
              begin
                // BITFIELDS, bitfield must be FF,00FF and 0000FF
                bits := pbyte(pbi);
                inc(bits, pbi^.bmiHeader.biSize); // inc(bits, sizeof(TBITMAPINFOHEADER));
                inc(bits, 3 * sizeof(dword)); // bypass bitfield
              end
              else
              if Compression = BI_RGB then
              begin
                bits := pbyte(pbi);
                inc(bits, pbi^.bmiHeader.biSize); // inc(bits, sizeof(TBITMAPINFOHEADER));
              end
              else
              begin
                if not unlck then
                  GlobalUnLock(hbi);
                exit; // EXIT POINT!!
              end;
              if xbits <> nil then
                bits := xbits;
              for y := Height - 1 downto 0 do
              begin
                px := fbitmap.Scanline[y];
                bits2 := bits;
                for x := 0 to Width - 1 do
                begin
                  px^.b := bits2^;
                  inc(bits2);
                  px^.g := bits2^;
                  inc(bits2);
                  px^.r := bits2^;
                  inc(bits2, 2);
                  inc(px);
                end;
                inc(bits, lw);
              end;
            end;
        end; // Case of Bitcount
      IEBI_IYU1: _CopyIYU1ToBitmap(xbits, fBitmap, Height > 0);
      IEBI_IYU2: _CopyIYU2ToBitmap(xbits, fBitmap, Height > 0);
      IEBI_UYVY, IEBI_UYNV: _CopyUYVYToBitmap(xbits, fBitmap, Height > 0);
      IEBI_cyuv: _CopyUYVYToBitmap(xbits, fBitmap, Height < 0);
      IEBI_YUY2, IEBI_YUNV: _CopyYUY2ToBitmap(xbits, fBitmap, Height > 0);
      IEBI_YVYU: _CopyYVYUToBitmap(xbits, fBitmap, Height > 0);
      IEBI_Y41P: _CopyY41PToBitmap(xbits, fBitmap, Height < 0);
      IEBI_Y211: _CopyY211ToBitmap(xbits, fBitmap, Height > 0);
      IEBI_CLJR: _CopyCLJRToBitmap(xbits, fBitmap, Height > 0);
      IEBI_YVU9: _CopyYVU9ToBitmap(xbits, fBitmap, Height > 0);
      IEBI_YV12: _CopyYV12ToBitmap(xbits, fBitmap, Height > 0);
      IEBI_I420, IEBI_IYUV: _CopyI420ToBitmap(xbits, fBitmap, Height > 0);
      // not supported...
      IEBI_Y41T: ;
      IEBI_Y42T: ;
      IEBI_CLPL: ;
      IEBI_IF09: ;
    end;
  finally
    if not unlck then
      GlobalUnLock(hbi);
  end;
end;


procedure IEDIBGamma(hbi: THandle; gamma: Double);
const
  Inv255 = 1.0 / 255;
var
  pbi: PBITMAPINFO;
  lw: Integer; // row length in bytes
  Compression: DWORD; // compressino type
  Width, Height: Integer; // image width and height
  BitCount: Integer; // Bitcount
  y, x: Integer;
  bits: pbyte;
  px: PRGB;
  i: Integer;
  InvGamma: Double;
  lut: array[0..255] of byte;
begin
  pbi := GlobalLock(hbi);
  Width := pbi^.bmiHeader.biWidth;
  Height := pbi^.bmiHeader.biHeight;
  BitCount := pbi^.bmiHeader.biBitCount;
  Compression := pbi^.bmiHeader.biCompression;
  lw := (((Width * BitCount) + 31) div 32) * 4;
  // prepare LUT
  InvGamma := 1.0 / Gamma;
  for i := 0 to 255 do
    lut[i] := blimit(round(255 * Power(i * Inv255, InvGamma)));
  // apply LUT
  case Compression of
    BI_RGB, BI_RLE8, BI_RLE4, BI_BITFIELDS:
      case BitCount of
        24: // 24 bit per pixel
          begin
            if Compression = BI_RGB then
            begin
              bits := pbyte(pbi);
              inc(bits, pbi^.bmiHeader.biSize); // inc(bits, sizeof(TBITMAPINFOHEADER));
              for y := Height - 1 downto 0 do
              begin
                px := PRGB(bits);
                for x := 0 to Width-1 do
                begin
                  with px^ do      
                  begin
                    r := lut[r];
                    g := lut[g];
                    b := lut[b];
                  end;
                  inc(px);
                end;
                inc(bits, lw);
              end;
            end;
          end;
      end;
  end;
  GlobalUnLock(hbi);
end;

// Copy polygon "Polygon" of Source inside Position of Dest
procedure _CopyPolygonToPoint(Source: TBitmap; Polygon: PPointArray; PolygonLen: Integer; Dest: TBitmap; const Position: TPoint);
var
  hrgn: THandle;
  NewPoly: PPointArray;
  q: Integer;
  sx1, sy1, sx2, sy2: Integer;
  drect: TRect;
  p1, p2: Integer;
begin
  if PolygonLen < 3 then
    exit;
  // find sx1, sy1, sx2, sy2, source rectangle
  sx1 := Polygon^[0].x;
  sy1 := Polygon^[0].y;
  sx2 := Polygon^[1].x;
  sy2 := Polygon^[1].y;
  OrdCor(sx1, sy1, sx2, sy2);
  for q := 2 to PolygonLen - 1 do
  begin
    if Polygon^[q].x <> IESELBREAK then
    begin
      sx1 := imin(sx1, Polygon^[q].x);
      sy1 := imin(sy1, Polygon^[q].y);
      sx2 := imax(sx2, Polygon^[q].x);
      sy2 := imax(sy2, Polygon^[q].y);
    end;
  end;
  //
  GetMem(NewPoly, sizeof(TPoint) * PolygonLen);
  // translate Polygon, destination polygon
  for q := 0 to PolygonLen - 1 do
  begin
    if Polygon^[q].x = IESELBREAK then
      NewPoly^[q] := Polygon^[q]
    else
    begin
      NewPoly^[q].x := Polygon^[q].x - sx1 + Position.x;
      NewPoly^[q].y := Polygon^[q].y - sy1 + Position.y;
    end;
  end;
  //
  drect.Left := Position.x;
  drect.Top := Position.y;
  drect.Right := Position.x + sx2 - sx1;
  drect.Bottom := Position.y + sy2 - sy1;
  if Dest.Width <= drect.Right then
    Dest.Width := drect.Right;
  if Dest.Height <= drect.Bottom then
    Dest.Height := drect.bottom;
  p1 := 0;
  for q := 0 to PolygonLen do
    if (NewPoly^[q].x = IESELBREAK) or (q = PolygonLen) then
    begin
      p2 := q - p1;
      hrgn := CreatePolygonRgn(NewPoly^[p1], p2, ALTERNATE);
      SelectClipRgn(Dest.Canvas.Handle, hrgn);
      Dest.Canvas.CopyRect(drect, Source.Canvas, rect(sx1, sy1, sx2, sy2));
      SelectClipRgn(Dest.Canvas.Handle, 0);
      DeleteObject(hrgn);
      p1 := q + 1;
    end;
  freemem(NewPoly);
end;

// Copy rectangle that starts in Position of Source to polygon "Polygon" of Dest
procedure _CopyPointToPolygon(Source: TBitmap; Polygon: PPointArray; PolygonLen: Integer; Dest: TBitmap; const Position: TPoint);
var
  hrgn: THandle;
  q: Integer;
  sx1, sy1, sx2, sy2: Integer;
  p1, p2: Integer;
begin
  if PolygonLen < 3 then
    exit;
  // find sx1, sy1, sx2, sy2, destination rectangle
  sx1 := Polygon^[0].x;
  sy1 := Polygon^[0].y;
  sx2 := Polygon^[1].x;
  sy2 := Polygon^[1].y;
  OrdCor(sx1, sy1, sx2, sy2);
  for q := 2 to PolygonLen - 1 do
  begin
    if Polygon^[q].x <> IESELBREAK then
    begin
      sx1 := imin(sx1, Polygon^[q].x);
      sy1 := imin(sy1, Polygon^[q].y);
      sx2 := imax(sx2, Polygon^[q].x);
      sy2 := imax(sy2, Polygon^[q].y);
    end;
  end;
  //
  if Dest.Width < sx2 then
    Dest.Width := sx2;
  if Dest.Height < sy2 then
    Dest.Height := sy2;
  p1 := 0;
  for q := 0 to PolygonLen do
    if (Polygon^[q].x = IESELBREAK) or (q = PolygonLen) then
    begin
      p2 := q - p1;
      hrgn := CreatePolygonRgn(Polygon^[p1], p2, ALTERNATE);
      SelectClipRgn(Dest.Canvas.Handle, hrgn);
      Dest.Canvas.CopyRect(rect(sx1, sy1, sx2, sy2), Source.Canvas, rect(Position.x, Position.y, Position.x + sx2 - sx1, Position.y + sy2 - sy1));
      SelectClipRgn(Dest.Canvas.Handle, 0);
      DeleteObject(hrgn);
      p1 := q + 1;
    end;
end;



// copy a BGR row to RGB (and viceversa)
procedure _CopyBGR_RGB(dst: PRGB; src: PRGB; width: Integer);
var
  q: Integer;
begin
  CopyMemory(dst, src, width * 3);
  for q := 0 to width - 1 do
  begin
    bswap(dst^.r, dst^.b);
    inc(dst);
  end;
end;

procedure _CopyBGR_RGB48(dst: PRGB48; src: PRGB48; width: Integer);
var
  q: Integer;
  w: word;
begin
  CopyMemory(dst, src, width * 6);
  for q := 0 to width - 1 do
  begin
    with dst^ do
    begin
      w := r;
      r := b;
      b := w;
    end;
    inc(dst);
  end;
end;

procedure _BGR2RGB(buff: PRGB; width: Integer);
var
  q: Integer;
begin
  for q := 0 to width - 1 do
  begin
    bswap(buff^.r, buff^.b);
    inc(buff);
  end;
end;

procedure _BGR2RGB48(buff: PRGB48; width: Integer);
var
  q: Integer;
  w: word;
begin
  for q := 0 to width - 1 do
  begin
    with buff^ do
    begin
      w := r;
      r := b;
      b := w;
    end;
    inc(buff);
  end;
end;


// Swaps R and B in a TRGB array
// nc: number of colors to swap
procedure _RGB2BGR(var ColorMap: array of TRGB; nc: Integer);
var
  q: Integer;
begin
  for q := 0 to nc - 1 do
    BSwap(ColorMap[q].R, ColorMap[q].B);
end;


// op:
//   0=maximum (dilation)
//   1=minimum (erosion)
//   2=open (erosion+dilation)
//   3=close (dilation+erosion)
procedure IEMorphFilter(bitmap: TIEBitmap; WindowSize: Integer; op: Integer; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
begin
  case bitmap.PixelFormat of
    ie1g:    IEMorphFilter_ie1g(bitmap, WindowSize, op, fSelx1, fSely1, fSelx2, fSely2, fOnProgress, Sender);
    ie24RGB: IEMorphFilter_ie24RGB(bitmap, WindowSize, op, fSelx1, fSely1, fSelx2, fSely2, fOnProgress, Sender);
  end;
end;



// op:
//   0=maximum (dilation)
//   1=minimum (erosion)
//   2=open (erosion+dilation)
//   3=close (dilation+erosion)
procedure IEMorphFilter_ie24RGB(bitmap: TIEBitmap; WindowSize: Integer; op: Integer; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  col, row, x, y, w, xx, yy, q1, q2, xxx, yyy: Integer;
  ppx: pRGB;
  per1: Double;
  graypix, p_byte, eptr: pbyte;
  rgbpix, p_rgb: PRGB;
  ww, hh: Integer;
  mm: byte;
  subop: Integer; // 0=dilate 1=erode
  it: Integer;
  canexit: Boolean;
  RedToGrayCoef, GreenToGrayCoef, BlueToGrayCoef: Integer;
begin
  if Bitmap.Pixelformat <> ie24RGB then
    exit;
  RedToGrayCoef   := IEGlobalSettings().RedToGrayCoef;
  GreenToGrayCoef := IEGlobalSettings().GreenToGrayCoef;
  BlueToGrayCoef  := IEGlobalSettings().BlueToGrayCoef;
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  // alloc graypix and rgbpix
  ww := (fSelX2 - fSelX1 + 1);
  hh := (fSelY2 - fSelY1 + 1);
  getmem(graypix, (ww + 2) * hh);
  getmem(rgbpix, (ww + 2) * hh * 3);
  //
  q1 := -WindowSize;
  q2 := WindowSize;
  it := 0;
  canexit := false;
  repeat
    if op < 2 then
    begin
      subop := op;
      canexit := true;
      per1 := 100 / (fSelY2 - fSelY1 + 0.5);
    end
    else
    begin
      if op = 2 then
      begin
        // open (erosion(1) + dilation(0))
        per1 := 100 / (fSelY2 - fSelY1 + 0.5) / 2;
        if it = 0 then
          subop := 1
        else
        begin
          subop := 0;
          canexit := true;
        end;
      end
      else
      if op = 3 then
      begin
        // close (dilation(0) + erosion(1))
        per1 := 100 / (fSelY2 - fSelY1 + 0.5) / 2;
        if it = 0 then
          subop := 0
        else
        begin
          subop := 1;
          canexit := true;
        end;
      end
      else
        break;
    end;
    // fill graypix and rgbpix
    y := 0;
    for row := fSelY1 to fSelY2 do
    begin
      ppx := bitmap.ScanLine[row];
      inc(ppx, fSelX1);
      x := 0;
      for col := fSelX1 to fSelX2 do
      begin

        p_byte := graypix;
        inc (p_byte, y + x);
        with ppx^ do
          p_byte^ := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;

        p_rgb := rgbpix;
        inc(p_rgb, y + x);
        p_rgb^ := ppx^;

        inc(ppx);
        inc(x);
      end;
      inc(y, ww);
    end;
    //
    y := 0;
    for row := fsely1 to fsely2 do
    begin
      ppx := bitmap.ScanLine[row];
      inc(ppx, fSelX1);
      x := 0;
      case subop of
        0: // maximum
          for col := fselx1 to fselx2 do
          begin
            mm := 0;
            xxx := 0;
            yyy := 0;
            for yy := q1 to q2 do
            begin

              eptr := graypix;
              inc(eptr, ilimit(y + yy, 0, hh - 1) * ww);

              for xx := q1 to q2 do
              begin
                p_byte := eptr;
                inc(p_byte, ilimit(x + xx, 0, ww - 1));
                w := p_byte^;
                if w > mm then
                begin
                  xxx := xx;
                  yyy := yy;
                  mm := w;
                end;
              end;
            end;

            p_rgb := rgbpix;
            inc(p_rgb, ilimit(y + yyy, 0, hh - 1) * ww + ilimit(x + xxx, 0, ww - 1));
            ppx^ := p_rgb^;

            inc(x);
            inc(ppx);
          end;
        1: // minimum
          for col := fselx1 to fselx2 do
          begin
            mm := 255;
            xxx := 0;
            yyy := 0;
            for yy := q1 to q2 do
            begin

              eptr := graypix;
              inc(eptr, ilimit(y + yy, 0, hh - 1) * ww);

              for xx := q1 to q2 do
              begin
                p_byte := eptr;
                inc(p_byte, ilimit(xx + x, 0, ww - 1));
                w := p_byte^;
                if w < mm then
                begin
                  xxx := xx;
                  yyy := yy;
                  mm := w;
                end;
              end;
            end;

            p_rgb := rgbpix;
            inc(p_rgb, ilimit(y + yyy, 0, hh - 1) * ww + ilimit(x + xxx, 0, ww - 1));
            ppx^ := p_rgb^;

            inc(x);
            inc(ppx);
          end;
      end;
      inc(y);
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1 + it * hh)));
    end;
    inc(it);
  until canexit;
  //
  freemem(graypix);
  freemem(rgbpix);
end;


// op:
//   0=maximum (dilation)
//   1=minimum (erosion)
//   2=open (erosion+dilation)
//   3=close (dilation+erosion)
procedure IEMorphFilter_ie1g(bitmap: TIEBitmap; WindowSize: Integer; op: Integer; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  col, row, x, y, w, xx, yy, q1, q2, xxx, yyy: Integer;
  pb, p_byte, e_ptr: pbyte;
  per1: Double;
  graypix: pbyte;
  ww, hh: Integer;
  mm: byte;
  subop: Integer; // 0=dilate 1=erode
  it: Integer;
  canexit: Boolean;
begin
  if Bitmap.Pixelformat <> ie1g then
    exit;
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  // alloc graypix and rgbpix
  ww := (fSelX2 - fSelX1 + 1);
  hh := (fSelY2 - fSelY1 + 1);
  getmem(graypix, (ww + 2) * hh);
  //
  q1 := -WindowSize;
  q2 := WindowSize;
  it := 0;
  canexit := false;
  {$IFNDEF DelphiXE7orNewer} // avoids hints on older compilers
  subop := 0;
  per1 := 0;
  {$ENDIF}
  repeat
    if op < 2 then
    begin
      subop := op;
      canexit := true;
      per1 := 100 / (fSelY2 - fSelY1 + 0.5);
    end
    else
    begin
      if op = 2 then
      begin
        // open (erosion(1) + dilation(0))
        per1 := 100 / (fSelY2 - fSelY1 + 0.5) / 2;
        if it = 0 then
          subop := 1
        else
        begin
          subop := 0;
          canexit := true;
        end;
      end
      else
      if op = 3 then
      begin
        // close (dilation(0) + erosion(1))
        per1 := 100 / (fSelY2 - fSelY1 + 0.5) / 2;
        if it = 0 then
          subop := 0
        else
        begin
          subop := 1;
          canexit := true;
        end;
      end
      else
        break;
    end;
    // fill graypix and rgbpix
    y := 0;
    for row := fSelY1 to fSelY2 do
    begin
      pb := bitmap.Scanline[row];
      x := 0;
      for col := fSelX1 to fSelX2 do
      begin
        p_byte := graypix;
        inc(p_byte, y + x);
        if _GetPixelbw(pb, col) <> 0 then
          p_byte^ := 255
        else
          p_byte^ := 0;
        inc(x);
      end;
      inc(y, ww);
    end;
    //
    y := 0;
    for row := fsely1 to fsely2 do
    begin
      pb := bitmap.Scanline[row];
      x := 0;
      case subop of
        0: // maximum
          for col := fselx1 to fselx2 do
          begin
            mm := 0;
            xxx := 0;
            yyy := 0;
            for yy := q1 to q2 do
            begin

              e_ptr := graypix;
              inc(e_ptr, ilimit(y + yy, 0, hh - 1) * ww);

              for xx := q1 to q2 do
              begin

                p_byte := e_ptr;
                inc(p_byte, ilimit(x + xx, 0, ww - 1));
                w := p_byte^;

                if w > mm then
                begin
                  xxx := xx;
                  yyy := yy;
                  mm := w;
                end;
              end;
            end;

            p_byte := graypix;
            inc(p_byte, (ilimit(y + yyy, 0, hh - 1) * ww + ilimit(x + xxx, 0, ww - 1)));
            _SetPixelbw(pb, col, p_byte^);

            inc(x);
          end;
        1: // minimum
          for col := fselx1 to fselx2 do
          begin
            mm := 255;
            xxx := 0;
            yyy := 0;
            for yy := q1 to q2 do
            begin

              e_ptr := graypix;
              inc(e_ptr, ilimit(y + yy, 0, hh - 1) * ww);

              for xx := q1 to q2 do
              begin
                p_byte := e_ptr;
                inc(p_byte, ilimit(xx + x, 0, ww - 1));
                w := p_byte^;
                if w < mm then
                begin
                  xxx := xx;
                  yyy := yy;
                  mm := w;
                end;
              end;
            end;

            p_byte := graypix;
            inc(p_byte, (ilimit(y + yyy, 0, hh - 1) * ww + ilimit(x + xxx, 0, ww - 1)));
            _SetPixelbw(pb, col, p_byte^);

            inc(x);
          end;
      end;
      inc(y);
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1 + it * hh)));
    end;
    inc(it);
  until canexit;
  //
  freemem(graypix);
end;



// nIter = number of iterations to perform [1]
// opType = operation type (1=dilation, 2=erosion, 3=closing, 4=opening)
// size = structuring element size (must be odd) [3]
// invertFlag = invert input image before processing [true]
procedure IEmorph1bit(Bitmap: TIEBitmap; nIter: Integer; opType: Integer; size: Integer; invertFlag: Boolean; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  width, height: Integer;
  sizeD2: Integer;
  sum: Integer;
  sumAll: Integer;
  x, y, i, j, n, xx, yy: Integer;
  imgI: TIEBitmap;
  imgO: TIEBitmap;
  per1: Double;
begin
  sizeD2 := size div 2;

  height := Bitmap.Height;
  width := Bitmap.Width;

  imgI := Bitmap;
  imgO := TIEBitmap.Create();

  try

    imgO.Allocate(width, height, ie1g);

    if (invertFlag) then
      _Negative1BitEx(imgI);

    imgO.AssignImage(imgI);

    sumAll := size * size;
    per1 := 100 / (height);

    for n := 0 to nIter-1 do
    begin
      for y := 0 to height-1 do
      begin
        for x := 0 to width-1 do
        begin
          sum := 0;
          for i := -sizeD2 to sizeD2 do
          begin
            yy := y + i;
            if yy < 0 then
              yy := 0
            else
            if yy >= height then
              yy := height-1;
            for j := -sizeD2 to sizeD2 do
            begin
              xx := x + j;
              if xx < 0 then
                xx := 0
              else
              if xx >= width then
                xx := width-1;
              if imgI.Pixels_ie1g[xx, yy] then
                inc(sum);
            end;
          end;

          case (opType) of
            1:                // dilation
              if (sum > 0) then
                imgO.pixels_ie1g[x, y] := true;
            2:                // erosion
              if (sum < sumAll) then
                imgO.Pixels_ie1g[x, y] := false;
            3:                // dilation-erosion
              if (sum > 0) then
                imgO.Pixels_ie1g[x, y] := true;
            4:                // erosion-dilation
              if (sum < sumAll) then
                imgO.Pixels_ie1g[x, y] := false;
          end;
        end;
        if assigned(fOnProgress) then
          fOnProgress(Sender, trunc(per1 * y));

      end;

      imgI.AssignImage( imgO );
      if (opType = 4) then
        opType := 3
      else
      if (opType = 3) then
        opType := 4;
    end;

    if (invertFlag) then
      _Negative1BitEx(imgO);
    Bitmap.AssignImage(imgO);

  finally
    FreeAndNil(imgO);
  end;
end;

// Maximum (dilation)

{!!
<FS>TImageEnProc.Maximum

<FM>Declaration<FC>
procedure Maximum(WindowSize: Integer);

<FM>Description<FN>
Set each pixel in the image to the maximum value of all the current image pixel values in the neighborhood of size <FC>WindowSize<FN>.

The maximum filter is typically applied to an image to remove negative outlier noise.

<FM>See Also<FN>
- <A TImageEnProc.Minimum>
- <A TImageEnProc.Opening>
- <A TImageEnProc.Closing>
!!}
procedure TImageEnProc.Maximum(WindowSize: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie1g, ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_MAXIMUM, [WindowSize]),
                              {$ELSE}
                              IEMsg( IEMsg_MAXIMUM ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_MAXIMUM ) then
    exit;
  IEMorphFilter(ProcBitmap, WindowSize, 0, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


{!!
<FS>TImageEnProc.Minimum

<FM>Declaration<FC>
procedure Minimum(WindowSize: Integer);

<FM>Description<FN>
Set each pixel in the image to the minimum value of all the current image pixel values in the neighborhood of size <FC>WindowSize<FN>.

The minimum filter is typically applied to an image to remove positive outlier noise.

<FM>See Also<FN>
- <A TImageEnProc.Maximum>
- <A TImageEnProc.Opening>
- <A TImageEnProc.Closing>
!!}
procedure TImageEnProc.Minimum(WindowSize: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie1g, ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_MINIMUM, [WindowSize]),
                              {$ELSE}
                              IEMsg( IEMsg_MINIMUM ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_MINIMUM ) then
    exit;
  IEMorphFilter(ProcBitmap, WindowSize, 1, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


{!!
<FS>TImageEnProc.Opening

<FM>Declaration<FC>
procedure Opening(WindowSize: Integer);

<FM>Description<FN>
Performs an erosion (Minimum filter with <FC>WindowSize<FN> parameter) followed by a dilation (Maximum filter with <FC>WindowSize<FN> parameter).

The opening filter operation will reduce small positive oriented regions and positive noise regions.

<FM>See Also<FN>
- <A TImageEnProc.Maximum>
- <A TImageEnProc.Minimum>
- <A TImageEnProc.Closing>
!!}
// Open (erosion+dilation)
procedure TImageEnProc.Opening(WindowSize: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie1g, ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_OPENING, [WindowSize]),
                              {$ELSE}
                              IEMsg( IEMsg_OPEN ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_OPENING ) then
    exit;
  IEMorphFilter(ProcBitmap, WindowSize, 2, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


{!!
<FS>TImageEnProc.Closing

<FM>Declaration<FC>
procedure Closing(WindowSize: Integer);

<FM>Description<FN>
Performs a dilation (Maximum filter with <FC>WindowSize<FN> parameter) followed by an erosion (Minimum filter with <FC>WindowSize<FN> parameter).

The closing filter operation will reduce small negative oriented regions and negative noise regions.

<FM>See Also<FN>
- <A TImageEnProc.Maximum>
- <A TImageEnProc.Minimum>
- <A TImageEnProc.Opening>

!!}
//   close (dilation+erosion)
procedure TImageEnProc.Closing(WindowSize: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie1g, ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_CLOSING, [WindowSize]),
                              {$ELSE}
                              IEMsg( IEMsg_CLOSE ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_CLOSING ) then
    exit;
  IEMorphFilter(ProcBitmap, WindowSize, 3, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;



// Create a Fourier transformations of current image
// ImageType can be ieitRGB or ieitGrayscale
// NewWidth and NewHeight can be each -1 (autocalc) or the new image sizes

{!!
<FS>TImageEnProc.FTCreateImage

<FM>Declaration<FC>
function FTCreateImage(ImageType: <A TIEFtImageType>; NewWidth: Integer = -1; NewHeight: Integer = -1): TIEFtImage;

<FM>Description<FN>
Create an object containing the Fourier transformation of the current image.

<FC>ImageType<FN> specifies the kind of the output transformation either RGB (ieitRGB) or gray-scale (ieitGrayscale)
<FC>NewWidth<FN> and <FC>NewHeight<FN> resample the current image before applying the Fourier transformation (to speed up the job). Set -1 to disable resampling (original size).
TIEFtImage is an object and must be destroyed with the Free method.

To access the complex data of the transformed image use the TIEFtImage object as declared in the iefft unit.
TIEFtImage exports ComplexPixel[], ComplexWidth and ComplexHeight properties.
ComplexPixel[] is defined as:
  ComplexPixel[x, y: Integer]: TIEComplexColor;

ComplexPixel[] returns the complex pixel at x, y coordinate.
TIEComplexColor is defined as:
  TIEComplexColor=packed record
    // red channel
    real_Red: PIEsingle;
    imag_Red: PIEsingle;
    // blue channel
    real_Blue: PIEsingle;
    imag_Blue: PIEsingle;
    // green channel
    real_Green: PIEsingle;
    imag_Green: PIEsingle;
    // gray scale
    imag_gray: PIEsingle;
    real_gray: PIEsingle;
  end;
The fields *_Red, *_Blue and *_Green are filled if ImageType is ieitRGB.
The fields *_gray are filled if ImageType is ieitGrayscale.
ComplexWidth and ComplexHeight are the width and the height of complex image.

For example, to set complex pixel 0, 0 to 0.1 write (for ImageType=ieitRGB):
ftimage.ComplexPixel[0, 0].real_Red^ := 0.1;
ftimage.ComplexPixel[0, 0].imag_Red^ := 0.1;
ftimage.ComplexPixel[0, 0].real_Green^ := 0.1;
ftimage.ComplexPixel[0, 0].imag_Green^ := 0.1;
ftimage.ComplexPixel[0, 0].real_Blue^ := 0.1;
ftimage.ComplexPixel[0, 0].imag_Blue^ := 0.1;

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageAnalysis\FFT\FFT.dpr </C> </R>
</TABLE>

<FM>Example<FC>
// this code shows in ImageEnView2 the displayable Fourier transformation 
// of ImageEnView1 image
// notes: ImageEnProc1 attached with ImageEnView1 and ImageEnProc2 attached with
// ImageEnView2
var
  ftimage: TIEFtImage;
begin
  ftimage := ImageEnView1.Proc.FTCreateImage(ieitRGB, -1, -1);
  ImageEnView2.Proc.FTDisplayFrom(ftimage);
  ftimage.free;
end;

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.FTClearZone></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.FTConvertFrom></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.FTDisplayFrom></C> </R>
</TABLE>

!!}
{$ifdef IEINCLUDEFFT}
function TImageEnProc.FTCreateImage(ImageType: TIEFtImageType; NewWidth: Integer = -1; NewHeight: Integer = -1): TIEFtImage;
var
  newbitmap: TIEBitmap;
begin
  result := nil;
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  if (NewWidth < 0) and (NewHeight < 0) then
    newbitmap := fIEBitmap
  else
  begin
    if NewWidth < 0 then
      NewWidth := (fIEbitmap.width * NewHeight) div fIEbitmap.Height
    else
    if NewHeight < 0 then
      NewHeight := (fIEbitmap.Height * NewWidth) div fIEbitmap.Width;
    newbitmap := TIEBitmap.Create;
    newbitmap.Allocate(NewWidth, NewHeight, fIEBitmap.PixelFormat);
    // Resample (you can use _ResampleEx(fIEBitmap, newbitmap, rfFastLinear, nil, nil); )
    _IEBmpStretchEx(fIEBitmap, newbitmap, nil, nil);
  end;
  result := TIEFtImage.Create;
  result.OnProgress := fOnProgress;
  result.BuildFT(newbitmap, ImageType);
  if newbitmap <> fIEBitmap then
    FreeAndNil(newbitmap);
  DoFinishWork;
end;

{$endif}

{!!
<FS>TImageEnProc.FTConvertFrom

<FM>Declaration<FC>
procedure FTConvertFrom(ft: TIEftImage);

<FM>Description<FN>
Perform an inverse Fourier transformation of <FC>ft<FN> (a Fourier transformed image).
<FC>ft<FN> is created by <A TImageEnProc.FTCreateImage> method.

<FM>Example<FC>
// This example performs the Fourier transformation of image contained in ImageEnView1, 
// then an inverse Fourier transformation and store result image to ImageEnView2
// ImageEnView2 should be equal to ImageEnView2
// notes: ImageEnProc1 attached with ImageEnView1 and ImageEnProc2 attached with ImageEnView2
var
  ftimage: TIEFtImage;
begin
  ftimage := ImageEnView1.Proc.FTCreateImage(ieitRGB, -1, -1);
  ImageEnView2.Proc.FTConvertFrom(ftimage);
  ftimage.free;
end;

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.FTClearZone></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.FTCreateImage></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.FTDisplayFrom></C> </R>
</TABLE>

!!}
{$ifdef IEINCLUDEFFT}
procedure TImageEnProc.FTConvertFrom(ft: TIEftImage);
begin
  if not MakeConsistentBitmap([]) then
    exit;
  ft.BuildBitmap(fIEBitmap);
  Update;
  DoFinishWork;
end;
{$endif}


{!!
<FS>TImageEnProc.FTDisplayFrom

<FM>Declaration<FC>
procedure FTDisplayFrom(ft: TIEftImage);

<FM>Description<FN>
Build an image that is the "visible" representation of Fourier transformation <FC>ft<FN>.
<FC>ft<FN> is created by <A TImageEnProc.FTCreateImage> method.

<FM>Example<FC>
// this code shows in ImageEnView2 the displayable Fourier transformation 
// of ImageEnView1 image
// notes: ImageEnProc1 attached with ImageEnView1 and ImageEnProc2 attached with ImageEnView2
var
  ftimage: TIEFtImage;
begin
  ftimage := ImageEnView1.Proc.FTCreateImage(ieitRGB, -1, -1);
  ImageEnView2.Proc.FTDisplayFrom(ftimage);
  ftimage.free;
end;

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.FTClearZone></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.FTConvertFrom></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.FTCreateImage></C> </R>
</TABLE>

!!}
{$ifdef IEINCLUDEFFT}
procedure TImageEnProc.FTDisplayFrom(ft: TIEftImage);
begin
  if not MakeConsistentBitmap([]) then
    exit;
  ft.GetFTImage(fIEBitmap);
  Update;
  DoFinishWork;
end;
{$endif}

procedure addPt(var a, b, c: TPoint);
begin
  c.x := a.x + b.x;
  c.y := a.y + b.y;
end;

procedure subPt(var a, b, c: TPoint);
begin
  c.x := a.x - b.x;
  c.y := a.y - b.y;
end;

// Return a closed and non nested polygon from a flood-fill at (x, y)
function IEMakeMagicWandPoints(fBitmap: TIEBitmap; x, y: Integer; maxfilter: Boolean; tolerance: Integer): TIEArrayOfTPoint;
type
  TItem = record
    yy, xl, xr, dy: Integer;
  end;
  PItem = ^TItem;
const
  CONTOUR = 3; //'c'
  VISITED = 2; //'v'
  BLACK = 1; //'1'
  WHITE = 0; //'0'
  xcontour_dir: array[0..7] of TPoint = ((x: 1; y: 0), (x: 0; y: - 1), (x: - 1; y: 0), (x: 0; y: 1), 
    (x: 1; y: - 1), (x: - 1; y: - 1), (x: - 1; y: 1), (x: 1; y: 1));
  xdirection_code: array[0..7] of byte = (0, 2, 4, 6, 1, 3, 5, 7);
var
  BUFALLOC: Integer; // allocation cluster size
  Buffer: TIERecordList;
  dy, sp, start, x1, x2, y1, y2: Integer;
  c: Integer;
  seed_color: TRGB;
  outbmp: PPRGBArray;
  outbmpptr: pbyte;
  obmp: ppointerarray;
  fbmp: PBYTEROWS;
  fbmpptr: pbyte;
  fdx, fdy: Integer;
  fdx1, fdy1: Integer;
  j, i, v, u, q, w, row, col: Integer;
  enter: Boolean;
  xx1, yy1, xx2, yy2: Integer;
  xx, yy: Integer;
  dx: Integer;
  flag: Boolean;
  bbox: array[0..1] of TPoint;
  pixel, start_pixel, test_pixel: TPoint;
  distance, d, last_dir: Integer;
  code: TIEByteArray;
  rs: TIERecordList;
  pv: byte;
  pcode: pbyte;
  bitmapwidth, bitmapheight, opt1, opt2: Integer;
  contour_dir: array[0..7] of TPoint;
  direction_code: array[0..7] of byte;
  pcount: integer;

  function _PixelIsMatch : Boolean;
  begin
    if (x >= BitmapWidth) or (y >= BitmapHeight) then
      result := false
    else
      Result := IERGBColorsMatch(fBitmap.Pixels[x, y], seed_color, Tolerance);
  end;

begin
  SetLength(result, 0);
  for j := 0 to high(xcontour_dir) do
    contour_dir[j] := xcontour_dir[j];
  for j := 0 to high(xdirection_code) do
    direction_code[j] := xdirection_code[j];
  bitmapwidth := fbitmap.width;
  bitmapheight := fbitmap.height;
  // Makes a flood fill bitmap (B/W) in outbmp
  if (x < 0) or (x >= BitmapWidth) or (y < 0) or (y >= BitmapHeight) then
    exit;
  BUFALLOC := 2 * fBitmap.Width;
  Buffer := TIERecordList.Create(sizeof(TItem));
  Buffer.Count := BUFALLOC;
  // make outbmp and fill with 0
  getmem(outbmp, fbitmap.height * sizeof(pRGB));
  j := (fbitmap.width shr 3 + 1);
  outbmpptr := allocmem( j * bitmapHeight );  // zero filled
  for q := 0 to bitmapHeight - 1 do
  begin
    outbmp[q] := PRGB(outbmpptr);
    inc(outbmpptr, j);
  end;
  //
  seed_color := fBitmap.Pixels[x, y];
  start := 0;
  sp := 0;
  PItem(buffer[sp])^.yy := y;
  PItem(buffer[sp])^.xl := x;
  PItem(buffer[sp])^.xr := x;
  PItem(buffer[sp])^.dy := 1;
  inc(sp);
  PItem(buffer[sp])^.yy := y + 1;
  PItem(buffer[sp])^.xl := x;
  PItem(buffer[sp])^.xr := x;
  PItem(buffer[sp])^.dy := -1;
  inc(sp);
  xx1 := 2147483647;
  yy1 := 2147483647;
  xx2 := 0;
  yy2 := 0;
  while sp > 0 do
  begin
    dec(sp);
    if sp < 0 then
      break;
    if sp > buffer.Count - 1 then
      buffer.Count := buffer.Count + BUFALLOC;
    dy := PItem(buffer[sp])^.dy;
    y := PItem(buffer[sp])^.yy + dy;
    x1 := PItem(buffer[sp])^.xl;
    x2 := PItem(buffer[sp])^.xr;
    x := x1;
    if (y >= 0) and (y < BitmapHeight) then
    begin
      c := _GetPixelBw(pbyte(outbmp[y]), x);
      while (x >= 0) and (x < BitmapWidth) and _PixelIsMatch and (c = 0) do
      begin
        _SetPixelBw(pbyte(outbmp[y]), x, 1);
        if x < xx1 then
          xx1 := x;
        if x > xx2 then
          xx2 := x;
        if y < yy1 then
          yy1 := y;
        if y > yy2 then
          yy2 := y;
        dec(x);
        if x < 0 then
          break;
        c := _GetPixelBw(pbyte(outbmp[y]), x);
      end;
    end;
    if (y < 0) then
      continue;
    if (y >= BitmapHeight) then
      dy := -dy;
    enter := (x >= x1);
    if not enter then
    begin
      start := x + 1;
      if (start < x1) then
      begin
        PItem(buffer[sp])^.yy := y;
        PItem(buffer[sp])^.xl := start;
        PItem(buffer[sp])^.xr := x1 - 1;
        PItem(buffer[sp])^.dy := -dy;
        inc(sp);
        if (sp < 0) then
          break;
        if sp > buffer.Count - 1 then
          buffer.Count := buffer.Count + BUFALLOC;
      end;
      x := x1 + 1;
    end;
    repeat
      if not enter then
      begin
        if (y >= 0) and (y < BitmapHeight) then
        begin
          if x < bitmapwidth then
            c := _GetPixelBw(pbyte(outbmp[y]), x)
          else
            c := 0;
          while (x >= 0) and (x < BitmapWidth) and _PixelIsMatch and (c = 0) do
          begin
            _SetPixelBw(pbyte(outbmp[y]), x, 1);
            if x < xx1 then
              xx1 := x;
            if x > xx2 then
              xx2 := x;
            if y < yy1 then
              yy1 := y;
            if y > yy2 then
              yy2 := y;
            inc(x);
            if x = BitmapWidth then
              break;
            c := _GetPixelBw(pbyte(outbmp[y]), x);
          end;
        end;
        PItem(buffer[sp])^.yy := y;
        PItem(buffer[sp])^.xl := start;
        PItem(buffer[sp])^.xr := x - 1;
        PItem(buffer[sp])^.dy := dy;
        inc(sp);
        if sp < 0 then
          break;
        if sp > buffer.Count - 1 then
          buffer.Count := buffer.Count + BUFALLOC;
        if (x > (x2 + 1)) then
        begin
          PItem(buffer[sp])^.yy := y;
          PItem(buffer[sp])^.xl := x2 + 1;
          PItem(buffer[sp])^.xr := x - 1;
          PItem(buffer[sp])^.dy := -dy;
          inc(sp);
          if sp < 0 then
            break;
          if sp > buffer.Count - 1 then
            buffer.Count := buffer.Count + BUFALLOC;
        end;
      end
      else
        enter := false;
      inc(x);
      if (y >= 0) and (y < BitmapHeight) then
      begin
        if x < bitmapwidth then
          c := _GetPixelBw(pbyte(outbmp[y]), x)
        else
          c := 0;
        if (x2 >= bitmapWidth) then
          x2 := BitmapWidth - 1;
        while (x <= x2) and ((not _PixelIsMatch) or (c = 1)) do
        begin
          inc(x);
          if x = BitmapWidth then
            break;
          c := _GetPixelBw(pbyte(outbmp[y]), x);
        end;
      end;
      start := x;
    until not (x <= x2);
    if sp > buffer.Count - 1 then
      buffer.Count := buffer.Count + BUFALLOC;
  end;
  FreeAndNil(Buffer);
  // apply maximum filter in outbmp (result in obmp)
  dx := xx2 - xx1 + 1;
  dy := yy2 - yy1 + 1;
  getmem(obmp, sizeof(pointer) * dy);
  for q := 0 to dy - 1 do
    obmp[q] := allocmem(dx shr 3 + 1); // zero filled
  yy := 0;
  for row := yy1 to yy2 do
  begin
    y1 := imax(0, yy - 1);
    y2 := imin(dy - 1, yy + 1);
    xx := 0;
    for col := xx1 to xx2 do
    begin
      if _GetPixelBw(pbyte(outbmp[row]), col) <> 0 then
      begin
        if maxfilter then
        begin
          x1 := imax(0, xx - 1);
          x2 := imin(dx - 1, xx + 1);
          for q := y1 to y2 do
            for w := x1 to x2 do
            begin
              _SetPixelBw(obmp[q], w, 1)
            end;
        end
        else
        begin
          _SetPixelBw(obmp[yy], xx, 1)
        end;
      end;
      inc(xx);
    end;
    inc(yy);
  end;
  // free outbmp
  freemem(outbmp[0]);
  freemem(outbmp);
  // resample obmp to 4x4 (result in fbmp)
  fdx := 2 + 4 * dx + 2;
  fdy := 2 + 4 * dy + 2;
  getmem(fbmp, fdy * sizeof(PBYTEROW));
  fbmpptr := allocmem(fdx * fdy); // zero filled (WHITE)
  for q := 0 to fdy - 1 do
  begin
    fbmp[q] := PBYTEROW(fbmpptr);
    inc(fbmpptr, fdx);
  end;
  for j := 0 to dy - 1 do
  begin
    opt1 := 2 + (j shl 2);
    for i := 0 to dx - 1 do
    begin
      if pbytearray(obmp[j])^[i shr 3] and iebitmask1[i and $7] <> 0 then
      begin
        opt2 := 2 + (i shl 2);
        for v := 0 to 3 do
          for u := 0 to 3 do
            fbmp[opt1 + v][opt2 + u] := BLACK;
      end;
    end;
  end;
  // free obmp
  for q := 0 to dy - 1 do
    freemem(obmp[q]);
  freemem(obmp);

  fdx1 := fdx-1;
  fdy1 := fdy-1;

  // PASS 1: LEFTWARDS
  flag := false;
  for j := 0 to fdy1 do
  begin
    fbmpptr := pbyte(fbmp[j]); inc(fbmpptr);
    for i := 1 to fdx1 do
    begin
      if fbmpptr^ = BLACK then
      begin
        if not flag then
        begin
          fbmp[j, i - 1] := CONTOUR;
          flag := true;
        end;
      end
      else
        flag := false;
      inc(fbmpptr);
    end;
  end;
  // PASS 2: RIGHTWARDS
  for j := 0 to fdy1 do
    for i := fdx1 downto 0 do
      if (fbmp[j, i] = BLACK) then
      begin
        if not flag then
        begin
          fbmp[j, i + 1] := CONTOUR;
          flag := true;
        end;
      end
      else
        flag := false;
  // PASS 3: DOWNWARDS
  flag := false;
  for i := 0 to fdx1 do
    for j := 0 to fdy1 do
      if (fbmp[j, i] = BLACK) then
      begin
        if not flag then
        begin
          fbmp[j - 1, i] := CONTOUR;
          flag := true;
        end;
      end
      else
        flag := false;
  // PASS 4: UPWARDS
  flag := false;
  for i := 0 to fdx1 do
    for j := fdy1 downto 0 do
      if (fbmp[j, i] = BLACK) then
      begin
        if not flag then
        begin
          fbmp[j + 1, i] := CONTOUR;
          flag := true;
        end;
      end
      else
        flag := false;
  //
  (*
  bbox[0] := point(2147483647, 2147483647);
  bbox[1] := point(0, 0);
  for j := 0 to fdy1 do
    for i := 1 to fdx1 do
      if fbmp[j, i] = CONTOUR then
      begin
        if i < bbox[0].x then bbox[0].x := i;
        if j < bbox[0].y then bbox[0].y := j;
        if i > bbox[1].x then bbox[1].x := i;
        if j > bbox[1].y then bbox[1].y := j;
      end;
      *)
  bbox[0] := point(2147483647, 2147483647);
  bbox[1] := point(0, 0);
  for j := 0 to fdy1 do
  begin
    fbmpptr := pbyte(fbmp[j]); inc(fbmpptr);
    for i := 1 to fdx1 do
    begin
      if fbmpptr^ = CONTOUR then
      begin
        if i < bbox[0].x then bbox[0].x := i;
        if j < bbox[0].y then bbox[0].y := j;
        if i > bbox[1].x then bbox[1].x := i;
        if j > bbox[1].y then bbox[1].y := j;
      end;
      inc(fbmpptr);
    end;
  end;
  //
  distance := 2147483647;
  for j := 0 to fdy1 do
    for i := 1 to fdx1 do
      if (fbmp[j, i] = CONTOUR) then
      begin
        d := (i - bbox[0].x) * (i - bbox[0].x) + (j - bbox[0].y) * (j - bbox[0].y);
        if (d < distance) then
        begin
          distance := d;
          start_pixel.x := i;
          start_pixel.y := j;
        end;
      end;
  //
  code := TIEByteArray.Create;
  pixel.x := start_pixel.x;
  pixel.y := start_pixel.y;
  fbmp[pixel.y, pixel.x] := VISITED;
  last_dir := 4;
  while true do
  begin
    addPt(pixel, contour_dir[last_dir], test_pixel);
    if (fbmp[test_pixel.y, test_pixel.x] = CONTOUR) then
    begin
      pixel.x := test_pixel.x;
      pixel.y := test_pixel.y;
      fbmp[pixel.y, pixel.x] := VISITED;
      code.AddByte(direction_code[last_dir]);
    end;
    i := 0;
    while i<8 do
    begin
      addPt(pixel, contour_dir[i], test_pixel);
      if (fbmp[test_pixel.y, test_pixel.x] = CONTOUR) then
      begin
        pixel.x := test_pixel.x;
        pixel.y := test_pixel.y;
        fbmp[pixel.y, pixel.x] := VISITED;
        code.AddByte(direction_code[i]);
        last_dir := i;
        break;
      end;
      inc(i);
    end;
    if (i = 8) then
      break;
  end;
  for i := 0 to 7 do
  begin
    subPt(start_pixel, pixel, test_pixel);
    if (test_pixel.x = contour_dir[i].x) and (test_pixel.y = contour_dir[i].y) then
    begin
      code.AddByte(direction_code[i]);
      break;
    end;
  end;
  // free fbmp
  freemem(fbmp[0]);
  freemem(fbmp);
  //
  pixel.x := (start_pixel.x - 1) + xx1 * 4;
  pixel.y := (start_pixel.y - 1) + yy1 * 4;
  rs := TIERecordList.Create(sizeof(TPoint));
  rs.Add(@pixel);
  pcode := pbyte(code.Data);
  pv := pcode^;
  for q := 0 to code.Size - 1 do
  begin
    if pv <> pcode^ then
    begin
      rs.add(@pixel);
      pv := pcode^;
    end;
    case pcode^ of
      0: // right
        inc(pixel.x);
      2: // up
        dec(pixel.y);
      4: // left
        dec(pixel.x);
      6: // down
        inc(pixel.y);
      1:
        begin
          // up-right
          dec(pixel.y);
          inc(pixel.x);
        end;
      3:
        begin
          // up-left
          dec(pixel.y);
          dec(pixel.x);
        end;
      5:
        begin
          // down-left
          inc(pixel.y);
          dec(pixel.x);
        end;
      7:
        begin
          // down-right
          inc(pixel.y);
          inc(pixel.x);
        end;
    end;
    inc(pcode);
  end;
  FreeAndNil(code);
  for q := 0 to rs.count - 1 do
  begin
    with ppoint(rs[q])^ do
    begin
      x := x shr 2;
      y := y shr 2;
    end;
  end;
  //
  pcount := rs.Count;
  if pcount > 0 then
  begin
    SetLength(result, pcount);
    CopyMemory(@result[0], rs.Items[0], sizeof(TPoint) * pcount);
  end;
  FreeAndNil(rs);
end;

// Make a mask with a flood-fill at (x, y)
procedure _MakeMagicWandPointsEx(fBitmap: TIEBitmap; x, y: Integer; maxfilter: Boolean; tolerance: Integer; mask: TIEMask; selintensity: Integer);
type
  TItem = record
    yy, xl, xr, dy: Integer;
  end;
  PItem = ^TItem;
var
  BUFALLOC: Integer; // allocation cluster size
  Buffer: TIERecordList;
  dy, sp, start, x1, x2, y1, y2: Integer;
  c: Integer;
  seed_color: TRGB;
  outbmp: pPRGBArray;
  q, w, row, col: Integer;
  enter: Boolean;
  xx1, yy1, xx2, yy2: Integer;
  bitmapwidth, bitmapheight: Integer;

  function _PixelIsMatch : Boolean;
  begin
    if (x >= BitmapWidth) or (y >= BitmapHeight) then
      result := false
    else
      Result := IERGBColorsMatch(fBitmap.Pixels[x, y], seed_color, Tolerance);
  end;

begin
  bitmapwidth := fbitmap.width;
  bitmapheight := fbitmap.height;
  // Makes a flood fill bitmap (B/W) in outbmp
  if (x < 0) or (x >= BitmapWidth) or (y < 0) or (y >= BitmapHeight) then
    exit;
  BUFALLOC := 2 * fBitmap.Width;
  Buffer := TIERecordList.Create(sizeof(TItem));
  Buffer.Count := BUFALLOC;
  // make outbmp and fills with 0
  getmem(outbmp, fbitmap.height * sizeof(pRGB));
  for q := 0 to bitmapHeight - 1 do
    outbmp[q] := allocmem(fbitmap.width shr 3 + 1); // zero filled

  seed_color := fBitmap.Pixels[x, y];
  start := 0;
  sp := 0;
  PItem(buffer[sp])^.yy := y;
  PItem(buffer[sp])^.xl := x;
  PItem(buffer[sp])^.xr := x;
  PItem(buffer[sp])^.dy := 1;
  inc(sp);
  PItem(buffer[sp])^.yy := y + 1;
  PItem(buffer[sp])^.xl := x;
  PItem(buffer[sp])^.xr := x;
  PItem(buffer[sp])^.dy := -1;
  inc(sp);
  xx1 := 2147483647;
  yy1 := 2147483647;
  xx2 := 0;
  yy2 := 0;
  while sp > 0 do
  begin
    dec(sp);
    if sp < 0 then
      break;
    if sp > buffer.Count - 1 then
      buffer.Count := buffer.Count + BUFALLOC;
    dy := PItem(buffer[sp])^.dy;
    y := PItem(buffer[sp])^.yy + dy;
    x1 := PItem(buffer[sp])^.xl;
    x2 := PItem(buffer[sp])^.xr;
    x := x1;
    if (y >= 0) and (y < BitmapHeight) then
    begin
      c := _GetPixelBw(pbyte(outbmp[y]), x);
      while (x >= 0) and (x < BitmapWidth) and _PixelIsMatch and (c = 0) do
      begin
        _SetPixelBw(pbyte(outbmp[y]), x, 1);
        if x < xx1 then
          xx1 := x;
        if x > xx2 then
          xx2 := x;
        if y < yy1 then
          yy1 := y;
        if y > yy2 then
          yy2 := y;
        dec(x);
        if x < 0 then
          break;
        c := _GetPixelBw(pbyte(outbmp[y]), x);
      end;
    end;
    if (y < 0) then
      continue;
    if (y >= BitmapHeight) then
      dy := -dy;
    enter := (x >= x1);
    if not enter then
    begin
      start := x + 1;
      if (start < x1) then
      begin
        PItem(buffer[sp])^.yy := y;
        PItem(buffer[sp])^.xl := start;
        PItem(buffer[sp])^.xr := x1 - 1;
        PItem(buffer[sp])^.dy := -dy;
        inc(sp);
        if (sp < 0) then
          break;
        if sp > buffer.Count - 1 then
          buffer.Count := buffer.Count + BUFALLOC;
      end;
      x := x1 + 1;
    end;
    repeat
      if not enter then
      begin
        if (y >= 0) and (y < BitmapHeight) then
        begin
          if x < bitmapwidth then
            c := _GetPixelBw(pbyte(outbmp[y]), x)
          else
            c := 0;
          while (x >= 0) and (x < BitmapWidth) and _PixelIsMatch and (c = 0) do
          begin
            _SetPixelBw(pbyte(outbmp[y]), x, 1);
            if x < xx1 then
              xx1 := x;
            if x > xx2 then
              xx2 := x;
            if y < yy1 then
              yy1 := y;
            if y > yy2 then
              yy2 := y;
            inc(x);
            if x = BitmapWidth then
              break;
            c := _GetPixelBw(pbyte(outbmp[y]), x);
          end;
        end;
        PItem(buffer[sp])^.yy := y;
        PItem(buffer[sp])^.xl := start;
        PItem(buffer[sp])^.xr := x - 1;
        PItem(buffer[sp])^.dy := dy;
        inc(sp);
        if sp < 0 then
          break;
        if sp > buffer.Count - 1 then
          buffer.Count := buffer.Count + BUFALLOC;
        if (x > (x2 + 1)) then
        begin
          PItem(buffer[sp])^.yy := y;
          PItem(buffer[sp])^.xl := x2 + 1;
          PItem(buffer[sp])^.xr := x - 1;
          PItem(buffer[sp])^.dy := -dy;
          inc(sp);
          if sp < 0 then
            break;
          if sp > buffer.Count - 1 then
            buffer.Count := buffer.Count + BUFALLOC;
        end;
      end
      else
        enter := false;
      inc(x);
      if (y >= 0) and (y < BitmapHeight) then
      begin
        if x < bitmapwidth then
          c := _GetPixelBw(pbyte(outbmp[y]), x)
        else
          c := 0;
        if (x2 >= bitmapWidth) then
          x2 := BitmapWidth - 1;
        while (x <= x2) and ((not _PixelIsMatch) or (c = 1)) do
        begin
          inc(x);
          if x = BitmapWidth then
            break;
          c := _GetPixelBw(pbyte(outbmp[y]), x);
        end;
      end;
      start := x;
    until not (x <= x2);
    if sp > buffer.Count - 1 then
      buffer.Count := buffer.Count + BUFALLOC;
  end;
  FreeAndNil(Buffer);
  // apply maximum filter in outbmp (result in obmp)
  for row := yy1 to yy2 do
  begin
    y1 := imax(0, row - 1);
    y2 := imin(bitmapheight - 1, row + 1);
    for col := xx1 to xx2 do
    begin
      if _GetPixelBw(pbyte(outbmp[row]), col) <> 0 then
      begin
        if maxfilter then
        begin
          x1 := imax(0, col - 1);
          x2 := imin(bitmapwidth - 1, col + 1);
          for q := y1 to y2 do
            for w := x1 to x2 do
            begin
              mask.SetPixel(w, q, selintensity);
            end;
        end
        else
        begin
          mask.SetPixel(col, row, selintensity)
        end;
      end;
    end;
  end;
  // free outbmp
  for q := 0 to bitmapHeight - 1 do
    freemem(outbmp[q]);
  freemem(outbmp);
end;

// create a mask with all colors like (x, y)
// works only with pf24bit images
procedure _MakeMagicWandPointsEx2(fBitmap: TIEBitmap; x, y: Integer; tolerance: Integer; mask: TIEMask; selintensity: Integer);
var
  row, col: Integer;
  rowhi, colhi: Integer;
  seed_color: TRGB;
  dr, dg, db: Integer;
  v: TRGB;
begin
  rowhi := fBitmap.Height - 1;
  colhi := fBitmap.Width - 1;
  seed_color := fBitmap.Pixels[x, y];
  for row := 0 to rowhi do
  begin
    for col := 0 to colhi do
    begin
      v := fBitmap.Pixels[col, row];
      dr := abs(seed_color.r - v.r);
      dg := abs(seed_color.g - v.g);
      db := abs(seed_color.b - v.b);
      if (dr <= tolerance) and (dg <= tolerance) and (db <= tolerance) then
        mask.SetPixel(col, row, selintensity);
    end;
  end;
end;

// Stretch origBmp to width, height of destBmp
// Use DrawDib api functions
procedure _IEBmpStretch(origBmp, destBmp: TBitmap);
var
  hdb: HDRAWDIB;
  BitmapInfoHeader256: ^TBitmapInfoHeader256;
begin
  destBmp.PixelFormat := origBmp.PixelFormat;
  new(BitmapInfoHeader256);
  ZeroMemory(BitmapInfoHeader256, sizeof(TBitmapInfoHeader256));
  with BitmapInfoHeader256^ do
  begin
    biSize := sizeof(TBitmapInfoHeader);
    biWidth := origBmp.Width;
    biHeight := origBmp.Height;
    biPlanes := 1;
    if origBmp.pixelformat = pf1bit then
    begin
      biBitCount := 1;
      Palette[1].rgbRed := 255;
      Palette[1].rgbGreen := 255;
      Palette[1].rgbBlue := 255;
    end
    else
      biBitCount := 24;
    biCompression := BI_RGB;
  end;
  hdb := IEDrawDibOpen;
  if destBmp.PixelFormat = pf1bit then
    destBmp.HandleType := bmDDB;
  IEDrawDibDraw(hdb, destBmp.canvas.handle, 0, 0, destBmp.Width, destBmp.Height, PBitmapInfoHeader(BitmapInfoHeader256)^, origBmp.ScanLine[origBmp.height - 1], 
    0, 0, origBmp.Width, origBmp.Height, 0);
  if destBmp.HandleType = bmDDB then
    destBmp.HandleType := bmDIB;
  IEDrawDibClose(hdb);
  dispose(BitmapInfoHeader256);
end;

// origBmp.PixelFormat must be = detBmp.PixelFormat
procedure _IEBmpStretchEx(origBmp, destBmp: TIEBaseBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  x, y, sx: Integer;
  sxarr: array of Integer;
  d_rgb: PRGB;
  s_rgb: PRGBROW;
  d_rgb32: PRGBA;
  s_rgb32: PRGB32ROW;
  d_rgb48: PRGB48;
  s_rgb48: PRGB48ROW;
  d_cmyk: PCMYK;
  s_cmyk: PCMYKROW;
  d_cielab: PCIELAB;
  s_cielab: PCIELABROW;
  d_g, s_g, bp: pbyte;
  s_ga: pbytearray;
  d_w: pword;
  s_wa: pwordarray;
  d_f: psingle;
  s_fa: psinglearray;
  l1, l2: TIEDataAccess;
  per1: Double;
  lper: Integer;
  origBmpWidth, origBmpHeight: Integer;
  destBmpWidth, destBmpHeight: Integer;

  function _DestToSrcX(x, origBmpWidth, destBmpWidth: Integer) : integer; {$ifdef IESUPPORTINLINE} inline; {$endif}
  var
    zx: Double;
  begin
    zx := origBmpWidth / destBmpWidth;
    Result := imin( origBmpWidth - 1, round( x * zx ));
  end;

  function _DestToSrcY(y, origBmpHeight, destBmpHeight: Integer) : integer; {$ifdef IESUPPORTINLINE} inline; {$endif}
  var
    zy: Double;
  begin
    zy := origBmpHeight / destBmpHeight;
    Result := imin( origBmpHeight - 1, round( y * zy ));
  end;

begin
  if (not assigned(origBmp)) or (not assigned(destBmp)) then
    exit;

  destBmpWidth  := destBmp.Width;
  destBmpHeight := destBmp.Height;

  if (destBmpWidth = 0) or (destBmpHeight = 0) then
    exit;

  origBmpWidth  := origBmp.Width;
  origBmpHeight := origBmp.Height;

  lper := -1;
  per1 := 100 / (destBmpHeight + 0.5);
  l1 := origBmp.Access;
  l2 := destBmp.Access;
  origBmp.Access := [iedRead];
  destBmp.Access := [iedWrite];
  SetLength(sxarr, destBmpWidth);
  for x := 0 to destBmpWidth - 1 do
    sxarr[x] := _DestToSrcX( x, origBmpWidth, destBmpWidth );
  case origBmp.PixelFormat of
    ie1g:
      for y := 0 to destBmpHeight - 1 do
      begin
        s_g := origBmp.Scanline[_DestToSrcY( y, origBmpHeight, destBmpHeight )];
        d_g := destBmp.Scanline[y];
        for x := 0 to destBmpWidth - 1 do
        begin
          sx := sxarr[x];
          bp := pbyte(uint64(d_g) + (uint64(x) shr 3));
          if (pbytearray(s_g)^[sx shr 3] and iebitmask1[sx and $7]) <> 0 then
            bp^ := bp^ or iebitmask1[x and 7]
          else
            bp^ := bp^ and not iebitmask1[x and 7];
        end;
        if assigned(fOnProgress) and (trunc(per1 * y)<>lper) then
        begin
          lper := trunc(per1 * y);
          fOnProgress(Sender, lper);
        end;
      end;
    ie8p, ie8g:
      begin
        for y := 0 to destBmpHeight - 1 do
        begin
          s_ga := origBmp.Scanline[_DestToSrcY( y, origBmpHeight, destBmpHeight )];
          d_g := destBmp.Scanline[y];
          for x := 0 to destBmpWidth - 1 do
          begin
            d_g^ := s_ga[sxarr[x]];
            inc(d_g);
          end;
          if assigned(fOnProgress) and (trunc(per1 * y) <> lper) then
          begin
            lper := trunc(per1 * y);
            fOnProgress(Sender, lper);
          end;
        end;
        if origBmp.PixelFormat = ie8p then
          origBmp.CopyPaletteTo(destBmp);
      end;
    ie16g:
      // to optimize
      for y := 0 to destBmpHeight - 1 do
      begin
        s_wa := origBmp.Scanline[_DestToSrcY( y, origBmpHeight, destBmpHeight )];
        d_w := destBmp.Scanline[y];
        for x := 0 to destBmpWidth - 1 do
        begin
          d_w^ := s_wa[sxarr[x]];
          inc(d_w);
        end;
        if assigned(fOnProgress) and (trunc(per1 * y)<>lper) then
        begin
          lper := trunc(per1 * y);
          fOnProgress(Sender, lper);
        end;
      end;
    ie24RGB:
      for y := 0 to destBmpHeight - 1 do
      begin
        s_rgb := origBmp.Scanline[_DestToSrcY( y, origBmpHeight, destBmpHeight )];
        d_rgb := destBmp.Scanline[y];
        for x := 0 to destBmpWidth - 1 do
        begin
          d_rgb^ := s_rgb[sxarr[x]];
          inc(d_rgb);
        end;
        if assigned(fOnProgress) and (trunc(per1 * y) <> lper) then
        begin
          lper := trunc(per1 * y);
          fOnProgress(Sender, lper);
        end;
      end;
    ie32RGB:
      for y := 0 to destBmpHeight - 1 do
      begin
        s_rgb32 := origBmp.Scanline[_DestToSrcY( y, origBmpHeight, destBmpHeight )];
        d_rgb32 := destBmp.Scanline[y];
        for x := 0 to destBmpWidth - 1 do
        begin
          d_rgb32^ := s_rgb32[sxarr[x]];
          inc(d_rgb32);
        end;
        if assigned(fOnProgress) and (trunc(per1 * y) <> lper) then
        begin
          lper := trunc(per1 * y);
          fOnProgress(Sender, lper);
        end;
      end;
    ie32f:
      // to optimize
      for y := 0 to destBmpHeight - 1 do
      begin
        s_fa := origBmp.Scanline[_DestToSrcY( y, origBmpHeight, destBmpHeight )];
        d_f := destBmp.Scanline[y];
        for x := 0 to destBmpWidth - 1 do
        begin
          d_f^ := s_fa[sxarr[x]];
          inc(d_f);
        end;
        if assigned(fOnProgress) and (trunc(per1 * y) <> lper) then
        begin
          lper := trunc(per1 * y);
          fOnProgress(Sender, lper);
        end;
      end;
    ieCMYK:
      for y := 0 to destBmpHeight - 1 do
      begin
        s_cmyk := origBmp.Scanline[_DestToSrcY( y, origBmpHeight, destBmpHeight )];
        d_cmyk := destBmp.Scanline[y];
        for x := 0 to destBmpWidth - 1 do
        begin
          d_cmyk^ := s_cmyk[sxarr[x]];
          inc(d_cmyk);
        end;
        if assigned(fOnProgress) and (trunc(per1 * y) <> lper) then
        begin
          lper := trunc(per1 * y);
          fOnProgress(Sender, lper);
        end;
      end;
    ieCIELab:
      for y := 0 to destBmpHeight - 1 do
      begin
        s_cielab := origBmp.Scanline[_DestToSrcY( y, origBmpHeight, destBmpHeight )];
        d_cielab := destBmp.Scanline[y];
        for x := 0 to destBmpWidth - 1 do
        begin
          d_cielab^ := s_cielab[sxarr[x]];
          inc(d_cielab);
        end;
        if assigned(fOnProgress) and (trunc(per1 * y) <> lper) then
        begin
          lper := trunc(per1 * y);
          fOnProgress(Sender, lper);
        end;
      end;
    ie48RGB:
      for y := 0 to destBmpHeight - 1 do
      begin
        s_rgb48 := origBmp.Scanline[_DestToSrcY( y, origBmpHeight, destBmpHeight )];
        d_rgb48 := destBmp.Scanline[y];
        for x := 0 to destBmpWidth - 1 do
        begin
          d_rgb48^ := s_rgb48[sxarr[x]];
          inc(d_rgb48);
        end;
        if assigned(fOnProgress) and (trunc(per1 * y) <> lper) then
        begin
          lper := trunc(per1 * y);
          fOnProgress(Sender, lper);
        end;
      end;
  end;
  origBmp.Access := l1;
  destBmp.Access := l2;
end;

// Converts a row from a bit format to an other
// Allowed combinations:
//    "Xbits_to_Ybits"
//    1_to_1
//    1_to_4
//    1_to_8
//    1_to_24 (palette[2] required)
//    4_to_4
//    4_to_8
//    4_to_24 (palette[16] required)
//    8_to_1 (each byte in input must be 0 or 1. Compact input to output)
//    8_to_8
//    8_to_24 (palette[256] required)
//     24_to_4 (Quantizer required)
//    24_to_8 (Quantizer required)
//    24_to_24
//    32_to_24 (remove alpha channel)
// true color are in BGR (or BGRA)
// returns the byte width of Output
function _ConvertXBitsToYBits(var Input, Output: TBYTEROW; Xbits, Ybits, Width: Word; Palette: array of TRGB; Quantizer: TObject): Integer;
var
  X, Z, i: Integer;
  B1: Byte;
  Q: TIEQuantizer;
begin
  Q := TIEQuantizer(Quantizer);
  case Xbits of
    1: // from 1 bit...
      case Ybits of
        1: // ...to 1 bit
          copymemory(@Output[0], @Input[0], (Width + 7) div 8);
        4: // ...to 4 bit
          for X := 0 to Width - 1 do
          begin
            B1 := (Input[X shr 3] shr (7 - (X mod 8))) and 1;
            OutPut[X shr 1] := OutPut[X shr 1] or (B1 shl ((1 - (X mod 2)) * 4));
          end;
        8: // ...to 8 bit
          for X := 0 to Width - 1 do
          begin
            B1 := (Input[X shr 3] shr (7 - (X mod 8))) and 1;
            OutPut[X] := B1;
          end;
        24: // ...to 8*3 bit
          begin
            Z := 0;
            for X := 0 to Width - 1 do
            begin
              B1 := (Input[X shr 3] shr (7 - (X mod 8))) and 1;
              OutPut[Z + 0] := Palette[B1].b;
              OutPut[Z + 1] := Palette[B1].g;
              OutPut[Z + 2] := Palette[B1].r;
              inc(Z, 3);
            end;
          end;
      end;
    4: // from 4 bit to...
      case Ybits of
        4: // ...to 4 bit
          CopyMemory(@Output[0], @Input[0], (Width + 1) div 2);
        8: // ...to 8 bit
          for X := 0 to Width - 1 do
          begin
            B1 := (Input[X shr 1] shr ((1 - (X mod 2)) * 4)) and $0F;
            OutPut[X] := B1;
          end;
        24: // ...to 24 bit
          begin
            Z := 0;
            for X := 0 to Width - 1 do
            begin
              B1 := (Input[X shr 1] shr ((1 - (X mod 2)) * 4)) and $0F;
              OutPut[Z + 0] := Palette[B1].b;
              OutPut[Z + 1] := Palette[B1].g;
              OutPut[Z + 2] := Palette[B1].r;
              inc(Z, 3);
            end;
          end;
      end;
    8: // from 8 bit to...
      case Ybits of
        1: // ...to 1 bit (compact 8 bit to 1 bit)
          begin
            zeromemory(@Output[0], (Width + 7) div 8);
            for X := 0 to Width - 1 do
            begin
              B1 := InPut[X];
              OutPut[X shr 3] := OutPut[X shr 3] or (B1 shl (7 - (X mod 8)));
            end;
          end;
        8: // ...to 8 bit
          CopyMemory(@Output[0], @Input[0], Width);
        24: // ...to 24 bit
          begin
            Z := 0;
            for X := 0 to Width - 1 do
            begin
              B1 := Input[X];
              OutPut[Z + 0] := Palette[B1].b;
              OutPut[Z + 1] := Palette[B1].g;
              OutPut[Z + 2] := Palette[B1].r;
              inc(Z, 3);
            end;
          end;
      end;
    24: // from 24 bit...
      case Ybits of
        4: // ...to 4 bit
          begin
            Z := 0;
            for X := 0 to Width - 1 do
            begin
              B1 := Q.RGBIndex[CreateRGB(Input[Z + 2], Input[Z + 1], Input[Z])];
              OutPut[X shr 1] := OutPut[X shr 1] or (B1 shl ((1 - (X mod 2)) * 4));
              inc(Z, 3);
            end;
          end;
        8: // ...to 8 bit
          begin
            Z := 0;
            for X := 0 to Width - 1 do
            begin
              Output[X] := Q.RGBIndex[CreateRGB(Input[Z + 2], Input[Z + 1], Input[Z])];
              inc(Z, 3);
            end;
          end;
        24: // ...to 24 bit
          CopyMemory(@Output[0], @Input[0], Width * 3);
      end;
    32: // from 32 bit...
      case Ybits of
        24: //...to 24 bit (bypass alpha channel)
          begin
            X := 0;
            Z := 0;
            for i := 0 to Width - 1 do
            begin
              Output[X] := Input[Z];
              Output[X + 1] := Input[Z + 1];
              Output[X + 2] := Input[Z + 2];
              inc(X, 3);
              inc(Z, 4);
            end;
          end;
      end;
  end;
  case Ybits of
    1: result := (Width + 7) div 8;
    4: result := (Width + 1) div 2;
    8: result := Width;
    24: result := Width * 3;
  else
    result := 0;
  end;
end;

// Copy Source in Dest, inside area delimited by SelPoly
// x1, y1 up-left polygon limit
procedure _CopyPolygonBitmap(Dest: TBitmap; Source: TBitmap; x1, y1: Integer; SelPoly: PPointArray; SelPolyCount: Integer);
var
  hrgn: THandle;
  p1, p2, q: Integer;
begin
  p1 := 0;
  for q := 0 to SelPolyCount do
    if (q = SelPolyCount) or (SelPoly^[q].x = IESELBREAK) then
    begin
      p2 := q - p1;
      hrgn := CreatePolygonRgn(SelPoly^[p1], p2, ALTERNATE);
      SelectClipRgn(Dest.Canvas.Handle, hrgn);
      SetPolyFillMode(Dest.Canvas.Handle, ALTERNATE);
      Dest.Canvas.Draw(x1, y1, Source);
      SelectClipRgn(Dest.Canvas.Handle, 0);
      DeleteObject(hrgn);
      p1 := q + 1;
    end;
end;



// resamples 1x1 bitmap to dest size
procedure Resample1x1(SrcImg, DstImg: TIEBaseBitmap);
begin
  if (SrcImg is TIEBitmap) and (DstImg is TIEBitmap) then
  begin
    (DstImg as TIEBitmap).Fill( TRGB2TColor((SrcImg as TIEBitmap).Pixels[0, 0]) );
  end;
end;



type
  // Type of a filter for use with Stretch()
  TFilterProc = function(Value: Double): Double;
  // Contributor for a pixel
  TContributor = record
    pixel: Integer; // Source pixel
    weight: Integer; // Pixel weight
  end;
  PContributor = ^TContributor;
  TContributorList = array[0..0] of TContributor;
  PContributorList = ^TContributorList;
  TRGBList = packed array[0..0] of TRGB;
  PRGBList = ^TRGBList;
  TFRGB = packed record
    r, g, b: Double;
  end;
const
  ResampleFilters: array[0..7] of record
    Filter: TFilterProc;
    Width: Double;
  end = ((Filter: TriangleFilter; Width: 1.0), 
    (Filter: HermiteFilter; Width: 1.0),
    (Filter: BellFilter; Width: 1.5),
    (Filter: SplineFilter; Width: 2.0),
    (Filter: Lanczos3Filter; Width: 3.0),
    (Filter: MitchellFilter; Width: 2.0),
    (Filter: NearestFilter; Width: 1.0),
    (Filter: LinearFilter; Width: 1.0));

/////////////////////////////////////////////////////////////////////////////////////
// resample only specified bitmap (ie8g)
// The algorithms and methods used in this function are based on the article
// "General Filtered Image Rescaling" by Dale Schumacher which appeared in the
// book Graphics Gems III, published by Academic Press, Inc.
procedure _Resampleie8g(Src, Dst: TIEBitmap; FilterType: TResampleFilter);
type
  TContributorList = array[0..0] of TContributor;
  PContributorList = ^TContributorList;
  // List of source pixels contributing to a destination pixel
  TCList = record
    n: Integer;
    p: PContributorList;
  end;
  TCListList = array[0..0] of TCList;
  PCListList = ^TCListList;
  TByteList = array[0..0] of byte;
  PByteList = ^TByteList;
var
  filter: TFilterProc;
  fwidth: Double;
  xscale, yscale: Double; // Zoom scale factors
  i, j, k, cn: Integer; // Loop variables
  center: Double; // Filter calculation variables
  weight: Integer;
  width, fscale: Double; // Filter calculation variables
  left, right: Integer; // Filter calculation variables
  n: Integer; // Pixel number
  Work: TIEMask;
  contrib: PCListList;
  vv, tt: Integer;
  color: byte;
  SourceLine : pbytelist;
  SourcePixel, DestPixel: pbyte;
  //Delta, DestDelta: Integer;
  SrcWidth, SrcHeight, DstWidth, DstHeight: Integer;
  per1: Double;
  t: Integer;
  cl: TCList;
begin
  if FilterType in [rfBicubic, rfBilinear] then
  begin
    if Src.HasAlphaChannel then
      _ResampleEx(Src, Dst, Src.AlphaChannel, FilterType, nil, nil)
    else
      _ResampleEx(Src, Dst, nil, FilterType, nil, nil);
    exit;
  end;
  if FilterType in [rfFastLinear, rfProjectBW, rfProjectWB] then
  begin
    _ResampleLinear8g(Src, Dst, nil, nil);
    exit;
  end;
  {$IFDEF IEINCLUDEWIC}
  if FilterType in [rfWICNearestNeighbor, rfWICLinear, rfWICCubic, rfWICFant] then
  begin
    IEWICResample(Src, Dst, nil, FilterType, nil, nil);
    exit;
  end;
  {$ENDIF}
  filter := ResampleFilters[ord(FilterType) - 1].Filter;
  fwidth := ResampleFilters[ord(FilterType) - 1].Width;
  DstWidth := Dst.Width;
  DstHeight := Dst.Height;
  SrcWidth := Src.Width;
  SrcHeight := Src.Height;
  if (SrcWidth = 0) or (SrcHeight = 0) then
    exit;
  if (SrcWidth = 1) and (SrcHeight = 1) then
  begin
    Resample1x1(Src, Dst);
    exit;
  end;
  //
  per1 := 100 / (SrcHeight + DstWidth + 0.5);
  // Create intermediate image to hold horizontal zoom
  Work := TIEMask.Create;
  try
    Work.AllocateBits(DstWidth, SrcHeight, 8);
    if (SrcWidth = 1) or (DstWidth = 1) then
      xscale := DstWidth / SrcWidth
    else
      xscale := (DstWidth - 1) / (SrcWidth - 1);
    if (SrcHeight = 1) or (DstHeight = 1) then
      yscale := DstHeight / SrcHeight
    else
      yscale := (DstHeight - 1) / (SrcHeight - 1);
    // --------------------------------------------
    // Pre-calculate filter contributions for a row
    // -----------------------------------------------
    GetMem(contrib, DstWidth * sizeof(TCList));
    // Horizontal sub-sampling
    // Scales from bigger to smaller width
    if (xscale < 1.0) then
    begin
      width := fwidth / xscale;
      fscale := 1.0 / xscale;
      for i := 0 to DstWidth - 1 do
      begin
        contrib^[i].n := 0;
        GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor));
        center := i / xscale;
        left := Floor(center - width);
        right := Ceil(center + width);
        for j := left to right do
        begin
          weight := round(256 * filter((center - j) / fscale) / fscale);
          if (weight = 0) then
            continue;
          if (j < 0) then
            n := -j
          else
          if (j >= SrcWidth) then
            n := SrcWidth - j + SrcWidth - 1
          else
            n := j;
          k := contrib^[i].n;
          contrib^[i].n := contrib^[i].n + 1;
          contrib^[i].p^[k].pixel := n;
          contrib^[i].p^[k].weight := weight;
        end;
      end;
    end
    else
    begin
      // Horizontal super-sampling
        // Scales from smaller to bigger width
      for i := 0 to DstWidth - 1 do
      begin
        contrib^[i].n := 0;
        GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor));
        center := i / xscale;
        left := floor(center - fwidth);
        right := Ceil(center + fwidth);
        for j := left to right do
        begin
          weight := round(256 * filter(center - j));
          if (weight = 0) then
            continue;
          if (j < 0) then
            n := -j
          else
          if (j >= SrcWidth) then
            n := SrcWidth - j + SrcWidth - 1
          else
            n := j;
          k := contrib^[i].n;
          contrib^[i].n := contrib^[i].n + 1;
          contrib^[i].p^[k].pixel := n;
          contrib^[i].p^[k].weight := weight;
        end;
      end;
    end;
    // ----------------------------------------------------
    // Apply filter to sample horizontally from Src to Work
    // ----------------------------------------------------
    for k := 0 to SrcHeight - 1 do
    begin
      SourceLine := Src.ScanLine[k];
      DestPixel := Work.ScanLine[k];
      for i := 0 to DstWidth - 1 do
      begin
        vv := 0;
        tt := 0;
        for j := 0 to contrib^[i].n - 1 do
        begin
          t := contrib^[i].p^[j].pixel;
          if t >= SrcWidth then
            t := SrcWidth - 1
          else
          if t < 0 then
            t := 0;
          color := SourceLine^[t];
          weight := contrib^[i].p^[j].weight;
          inc(tt, weight);
          if (weight = 0) then
            continue;
          inc(vv, color * weight);
        end;
        if tt = 0 then
          color := blimit(vv shr 8)
        else
          color := blimit(vv div tt);
        // Set new pixel value
        DestPixel^ := color;
        // Move on to next column
        inc(DestPixel);
      end;
    end;
    // Free the memory allocated for horizontal filter weights
    for i := 0 to DstWidth - 1 do
      FreeMem(contrib^[i].p);
    FreeMem(contrib);
    // Pre-calculate filter contributions for a column
    GetMem(contrib, DstHeight * sizeof(TCList));
    // Vertical sub-sampling
    // Scales from bigger to smaller height
    if (yscale < 1.0) then
    begin
      width := fwidth / yscale;
      fscale := 1.0 / yscale;
      for i := 0 to DstHeight - 1 do
      begin
        contrib^[i].n := 0;
        GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor));
        center := i / yscale;
        left := Floor(center - width);
        right := Ceil(center + width);
        for j := left to right do
        begin
          weight := round(256 * filter((center - j) / fscale) / fscale);
          if (weight = 0) then
            continue;
          if (j < 0) then
            n := -j
          else
          if (j >= SrcHeight) then
            n := SrcHeight - j + SrcHeight - 1
          else
            n := j;
          k := contrib^[i].n;
          contrib^[i].n := contrib^[i].n + 1;
          contrib^[i].p^[k].pixel := n;
          contrib^[i].p^[k].weight := weight;
        end;
      end
    end
    else
    begin
      // Vertical super-sampling
        // Scales from smaller to bigger height
      for i := 0 to DstHeight - 1 do
      begin
        contrib^[i].n := 0;
        GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor));
        center := i / yscale;
        left := Floor(center - fwidth);
        right := Ceil(center + fwidth);
        for j := left to right do
        begin
          weight := round(256 * filter(center - j));
          if (weight = 0) then
            continue;
          if (j < 0) then
            n := -j
          else
          if (j >= SrcHeight) then
            n := SrcHeight - j + SrcHeight - 1
          else
            n := j;
          k := contrib^[i].n;
          contrib^[i].n := contrib^[i].n + 1;
          contrib^[i].p^[k].pixel := n;
          contrib^[i].p^[k].weight := weight;
        end;
      end;
    end;

    // Apply filter to sample vertically from Work to Dst
    // 3.0.1
    for i := 0 to DstHeight - 1 do
    begin
      DestPixel := Dst.Scanline[i];
      cl := contrib[i];
      cn := cl.n-1;
      for k := 0 to DstWidth - 1 do
      begin
        vv := 0;
        tt := 0;
        for j := 0 to cn do
        begin
          t := ilimit(cl.p[j].pixel, 0, SrcHeight - 1);
          SourcePixel := Work.Scanline[t];
          inc(SourcePixel, k);
          weight := cl.p^[j].weight;
          inc(tt, weight);
          inc(vv, SourcePixel^ * weight);
        end;
        if tt = 0 then
          DestPixel^ := blimit(vv shr 8)
        else
          DestPixel^ := blimit(vv div tt);
        inc(DestPixel);
      end;
      //Inc(SourceLine, 1);
      //Inc(DestLine, 1);
    end;

    // Free the memory allocated for vertical filter weights
    for i := 0 to DstHeight - 1 do
      FreeMem(contrib^[i].p);
    FreeMem(contrib);
  finally
    FreeAndNil(Work);
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////
// resample only specified bitmap (ie16g)
// The algorithms and methods used in this function are based on the article
// "General Filtered Image Rescaling" by Dale Schumacher which appeared in the
// book Graphics Gems III, published by Academic Press, Inc.
procedure _Resampleie16g(Src, Dst: TIEBitmap; FilterType: TResampleFilter);
type
  TContributorList = array[0..0] of TContributor;
  PContributorList = ^TContributorList;
  // List of source pixels contributing to a destination pixel
  TCList = record
    n: Integer;
    p: PContributorList;
  end;
  TCListList = array[0..0] of TCList;
  PCListList = ^TCListList;
  TWordList = array[0..0] of word;
  PWordList = ^TWordList;
var
  filter: TFilterProc;
  fwidth: Double;
  xscale, yscale: Double; // Zoom scale factors
  i, j, k, cn: Integer; // Loop variables
  center: Double; // Filter calculation variables
  weight: Integer;
  width, fscale: Double; // Filter calculation variables
  left, right: Integer; // Filter calculation variables
  n: Integer; // Pixel number
  Work: TIEWorkBitmap;
  contrib: PCListList;
  vv, tt: Integer;
  color: word;
  SourceLine : PWordList;
  SourcePixel, DestPixel: pword;
  SrcWidth, SrcHeight, DstWidth, DstHeight: Integer;
  per1: Double;
  t: Integer;
  cl: TCList;
begin
  if FilterType in [rfBicubic, rfBilinear] then
  begin
    _ResampleEx(Src, Dst, Src.AlphaChannelOpt, FilterType, nil, nil);
    exit;
  end;
  if FilterType in [rfFastLinear, rfProjectBW, rfProjectWB] then
  begin
    _ResampleLinear16g(Src, Dst, nil, nil);
    exit;
  end;
  {$IFDEF IEINCLUDEWIC}
  if FilterType in [rfWICNearestNeighbor, rfWICLinear, rfWICCubic, rfWICFant] then
  begin
    IEWICResample(Src, Dst, nil, FilterType, nil, nil);
    exit;
  end;
  {$ENDIF}
  filter := ResampleFilters[ord(FilterType) - 1].Filter;
  fwidth := ResampleFilters[ord(FilterType) - 1].Width;
  DstWidth := Dst.Width;
  DstHeight := Dst.Height;
  SrcWidth := Src.Width;
  SrcHeight := Src.Height;
  if (SrcWidth = 0) or (SrcHeight = 0) then
    exit;
  if (SrcWidth = 1) and (SrcHeight = 1) then
  begin
    Resample1x1(Src, Dst);
    exit;
  end;
  //
  per1 := 100 / (SrcHeight + DstWidth + 0.5);
  // Create intermediate image to hold horizontal zoom
  Work := TIEWorkBitmap.Create(DstWidth, SrcHeight, 16);
  try
    if (SrcWidth = 1) or (DstWidth = 1) then
      xscale := DstWidth / SrcWidth
    else
      xscale := (DstWidth - 1) / (SrcWidth - 1);
    if (SrcHeight = 1) or (DstHeight = 1) then
      yscale := DstHeight / SrcHeight
    else
      yscale := (DstHeight - 1) / (SrcHeight - 1);
    // --------------------------------------------
    // Pre-calculate filter contributions for a row
    // -----------------------------------------------
    GetMem(contrib, DstWidth * sizeof(TCList));
    // Horizontal sub-sampling
    // Scales from bigger to smaller width
    if (xscale < 1.0) then
    begin
      width := fwidth / xscale;
      fscale := 1.0 / xscale;
      for i := 0 to DstWidth - 1 do
      begin
        contrib^[i].n := 0;
        GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor));
        center := i / xscale;
        left := Floor(center - width);
        right := Ceil(center + width);
        for j := left to right do
        begin
          weight := round(256 * filter((center - j) / fscale) / fscale);
          if (weight = 0) then
            continue;
          if (j < 0) then
            n := -j
          else
          if (j >= SrcWidth) then
            n := SrcWidth - j + SrcWidth - 1
          else
            n := j;
          k := contrib^[i].n;
          contrib^[i].n := contrib^[i].n + 1;
          contrib^[i].p^[k].pixel := n;
          contrib^[i].p^[k].weight := weight;
        end;
      end;
    end
    else
    begin
      // Horizontal super-sampling
        // Scales from smaller to bigger width
      for i := 0 to DstWidth - 1 do
      begin
        contrib^[i].n := 0;
        GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor));
        center := i / xscale;
        left := Floor(center - fwidth);
        right := Ceil(center + fwidth);
        for j := left to right do
        begin
          weight := round(256 * filter(center - j));
          if (weight = 0) then
            continue;
          if (j < 0) then
            n := -j
          else
          if (j >= SrcWidth) then
            n := SrcWidth - j + SrcWidth - 1
          else
            n := j;
          k := contrib^[i].n;
          contrib^[i].n := contrib^[i].n + 1;
          contrib^[i].p^[k].pixel := n;
          contrib^[i].p^[k].weight := weight;
        end;
      end;
    end;
    // ----------------------------------------------------
    // Apply filter to sample horizontally from Src to Work
    // ----------------------------------------------------
    for k := 0 to SrcHeight - 1 do
    begin
      SourceLine := Src.ScanLine[k];
      DestPixel := Work.ScanLine[k];
      for i := 0 to DstWidth - 1 do
      begin
        vv := 0;
        tt := 0;
        for j := 0 to contrib^[i].n - 1 do
        begin
          t := contrib^[i].p^[j].pixel;
          if t >= SrcWidth then
            t := SrcWidth - 1
          else
          if t < 0 then
            t := 0;
          color := SourceLine^[t];
          weight := contrib^[i].p^[j].weight;
          inc(tt, weight);
          if (weight = 0) then
            continue;
          inc(vv, color * weight);
        end;
        if tt = 0 then
          color := wlimit(vv shr 8)
        else
          color := wlimit(vv div tt);
        // Set new pixel value
        DestPixel^ := color;
        // Move on to next column
        inc(DestPixel);
      end;
    end;
    // Free the memory allocated for horizontal filter weights
    for i := 0 to DstWidth - 1 do
      FreeMem(contrib^[i].p);
    FreeMem(contrib);
    // Pre-calculate filter contributions for a column
    GetMem(contrib, DstHeight * sizeof(TCList));
    // Vertical sub-sampling
    // Scales from bigger to smaller height
    if (yscale < 1.0) then
    begin
      width := fwidth / yscale;
      fscale := 1.0 / yscale;
      for i := 0 to DstHeight - 1 do
      begin
        contrib^[i].n := 0;
        GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor));
        center := i / yscale;
        left := Floor(center - width);
        right := Ceil(center + width);
        for j := left to right do
        begin
          weight := round(256 * filter((center - j) / fscale) / fscale);
          if (weight = 0) then
            continue;
          if (j < 0) then
            n := -j
          else
          if (j >= SrcHeight) then
            n := SrcHeight - j + SrcHeight - 1
          else
            n := j;
          k := contrib^[i].n;
          contrib^[i].n := contrib^[i].n + 1;
          contrib^[i].p^[k].pixel := n;
          contrib^[i].p^[k].weight := weight;
        end;
      end
    end
    else
    begin
      // Vertical super-sampling
        // Scales from smaller to bigger height
      for i := 0 to DstHeight - 1 do
      begin
        contrib^[i].n := 0;
        GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor));
        center := i / yscale;
        left := Floor(center - fwidth);
        right := Ceil(center + fwidth);
        for j := left to right do
        begin
          weight := round(256 * filter(center - j));
          if (weight = 0) then
            continue;
          if (j < 0) then
            n := -j
          else
          if (j >= SrcHeight) then
            n := SrcHeight - j + SrcHeight - 1
          else
            n := j;
          k := contrib^[i].n;
          contrib^[i].n := contrib^[i].n + 1;
          contrib^[i].p^[k].pixel := n;
          contrib^[i].p^[k].weight := weight;
        end;
      end;
    end;

    // Apply filter to sample vertically from Work to Dst
    for i := 0 to DstHeight - 1 do
    begin
      DestPixel := Dst.Scanline[i];
      cl := contrib[i];
      cn := cl.n-1;
      for k := 0 to DstWidth - 1 do
      begin
        vv := 0;
        tt := 0;
        for j := 0 to cn do
        begin
          t := ilimit(cl.p[j].pixel, 0, SrcHeight - 1);
          SourcePixel := Work.Scanline[t];
          inc(SourcePixel, k);
          weight := cl.p^[j].weight;
          inc(tt, weight);
          inc(vv, SourcePixel^ * weight);
        end;
        if tt = 0 then
          DestPixel^ := wlimit(vv shr 8)
        else
          DestPixel^ := wlimit(vv div tt);
        inc(DestPixel);
      end;
    end;

    // Free the memory allocated for vertical filter weights
    for i := 0 to DstHeight - 1 do
      FreeMem(contrib^[i].p);
    FreeMem(contrib);
  finally
    FreeAndNil(Work);
  end;
end;


// if FilterType=rfProjectBW or FilterType=rfProjectWB then Dst must be ie1g
procedure _Resample1bitEx(Src, Dst: TIEBitmap; FilterType: TResampleFilter);
type
  TContributorList = array[0..0] of TContributor;
  PContributorList = ^TContributorList;
  // List of source pixels contributing to a destination pixel
  TCList = record
    n: Integer;
    p: PContributorList;
  end;
  TCListList = array[0..0] of TCList;
  PCListList = ^TCListList;
  TByteList = array[0..0] of byte;
  PByteList = ^TByteList;
var
  filter: TFilterProc;
  fwidth: Double;
  xscale, yscale: Double; // Zoom scale factors
  i, j, k: Integer; // Loop variables
  center: Double; // Filter calculation variables
  weight: Integer;
  width, fscale: Double; // Filter calculation variables
  left, right: Integer; // Filter calculation variables
  n: Integer; // Pixel number
  Work: TIEMask;
  contrib: PCListList;
  tt, vv: Integer;
  color: byte;
  SourceLine: pbytelist;
  SourcePixel, DestPixel: pbyte;
  DestPixelRGB: PRGB;
  SrcWidth, SrcHeight, DstWidth, DstHeight: Integer;
  per1: Double;
  cl: TCList;
  t, cn: Integer;
begin
  if FilterType in [rfFastLinear, rfBicubic, rfBilinear] then
  begin
    _ResampleLinear1BitEx(Src, Dst, nil, nil);
    exit;
  end;
  if (FilterType = rfProjectBW) then
  begin
    _ResampleProject1Bit(Src, Dst, false, nil, nil);
    exit;
  end;
  if (FilterType = rfProjectWB) then
  begin
    _ResampleProject1Bit(Src, Dst, true, nil, nil);
    exit;
  end;
  {$IFDEF IEINCLUDEWIC}
  if FilterType in [rfWICNearestNeighbor, rfWICLinear, rfWICCubic, rfWICFant] then
  begin
    IEWICResample(Src, Dst, nil, FilterType, nil, nil);
    exit;
  end;
  {$ENDIF}
  filter := ResampleFilters[ord(FilterType) - 1].Filter;
  fwidth := ResampleFilters[ord(FilterType) - 1].Width;
  DstWidth := Dst.Width;
  DstHeight := Dst.Height;
  SrcWidth := Src.Width;
  SrcHeight := Src.Height;
  if (SrcWidth = 0) or (SrcHeight = 0) then
    exit;
  if (SrcWidth = 1) and (SrcHeight = 1) then
  begin
    Resample1x1(Src, Dst);
    exit;
  end;
  //
  per1 := 100 / (SrcHeight + DstWidth + 0.5);
  // Create intermediate image to hold horizontal zoom
  Work := TIEMask.Create;
  try
    Work.AllocateBits(DstWidth, SrcHeight, 8);
    if (SrcWidth = 1) or (DstWidth = 1) then
      xscale := DstWidth / SrcWidth
    else
      xscale := (DstWidth - 1) / (SrcWidth - 1);
    if (SrcHeight = 1) or (DstHeight = 1) then
      yscale := DstHeight / SrcHeight
    else
      yscale := (DstHeight - 1) / (SrcHeight - 1);
    // --------------------------------------------
    // Pre-calculate filter contributions for a row
    // -----------------------------------------------
    GetMem(contrib, DstWidth * sizeof(TCList));
    // Horizontal sub-sampling
    // Scales from bigger to smaller width
    if (xscale < 1.0) then
    begin
      width := fwidth / xscale;
      fscale := 1.0 / xscale;
      for i := 0 to DstWidth - 1 do
      begin
        contrib^[i].n := 0;
        GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor));
        center := i / xscale;
        left := Floor(center - width);
        right := Ceil(center + width);
        for j := left to right do
        begin
          weight := round(256 * filter((center - j) / fscale) / fscale);
          if (weight = 0) then
            continue;
          if (j < 0) then
            n := -j
          else
          if (j >= SrcWidth) then
            n := SrcWidth - j + SrcWidth - 1
          else
            n := j;
          k := contrib^[i].n;
          contrib^[i].n := contrib^[i].n + 1;
          contrib^[i].p^[k].pixel := n;
          contrib^[i].p^[k].weight := weight;
        end;
      end;
    end
    else
    begin
      // Horizontal super-sampling
        // Scales from smaller to bigger width
      for i := 0 to DstWidth - 1 do
      begin
        contrib^[i].n := 0;
        GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor));
        center := i / xscale;
        left := Floor(center - fwidth);
        right := Ceil(center + fwidth);
        for j := left to right do
        begin
          weight := round(256 * filter(center - j));
          if (weight = 0) then
            continue;
          if (j < 0) then
            n := -j
          else
          if (j >= SrcWidth) then
            n := SrcWidth - j + SrcWidth - 1
          else
            n := j;
          k := contrib^[i].n;
          contrib^[i].n := contrib^[i].n + 1;
          contrib^[i].p^[k].pixel := n;
          contrib^[i].p^[k].weight := weight;
        end;
      end;
    end;
    // ----------------------------------------------------
    // Apply filter to sample horizontally from Src to Work
    // ----------------------------------------------------
    for k := 0 to SrcHeight - 1 do
    begin
      SourceLine := Src.ScanLine[k];
      DestPixel := Work.ScanLine[k];
      for i := 0 to DstWidth - 1 do
      begin
        vv := 0;
        tt := 0;
        for j := 0 to contrib^[i].n - 1 do
        begin
          t := contrib^[i].p^[j].pixel;
          if t >= SrcWidth then
            t := SrcWidth - 1
          else
          if t < 0 then
            t := 0;
          if pbytearray(SourceLine)^[t shr 3] and iebitmask1[t and $7] = 0 then
            color := 0
          else
            color := 255;
          weight := contrib^[i].p^[j].weight;
          inc(tt, weight);
          if (weight = 0) then
            continue;
          inc(vv, color * weight);
        end;
        if tt = 0 then
          color := blimit(vv shr 8)
        else
          color := blimit(vv div tt);
        // Set new pixel value
        DestPixel^ := color;
        // Move on to next column
        inc(DestPixel);
      end;
    end;
    // Free the memory allocated for horizontal filter weights
    for i := 0 to DstWidth - 1 do
      FreeMem(contrib^[i].p);
    FreeMem(contrib);
    // Pre-calculate filter contributions for a column
    GetMem(contrib, DstHeight * sizeof(TCList));
    // Vertical sub-sampling
    // Scales from bigger to smaller height
    if (yscale < 1.0) then
    begin
      width := fwidth / yscale;
      fscale := 1.0 / yscale;
      for i := 0 to DstHeight - 1 do
      begin
        contrib^[i].n := 0;
        GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor));
        center := i / yscale;
        left := Floor(center - width);
        right := Ceil(center + width);
        for j := left to right do
        begin
          weight := round(256 * filter((center - j) / fscale) / fscale);
          if (weight = 0) then
            continue;
          if (j < 0) then
            n := -j
          else
          if (j >= SrcHeight) then
            n := SrcHeight - j + SrcHeight - 1
          else
            n := j;
          k := contrib^[i].n;
          contrib^[i].n := contrib^[i].n + 1;
          contrib^[i].p^[k].pixel := n;
          contrib^[i].p^[k].weight := weight;
        end;
      end
    end
    else
    begin
      // Vertical super-sampling
        // Scales from smaller to bigger height
      for i := 0 to DstHeight - 1 do
      begin
        contrib^[i].n := 0;
        GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor));
        center := i / yscale;
        left := Floor(center - fwidth);
        right := Ceil(center + fwidth);
        for j := left to right do
        begin
          weight := round(256 * filter(center - j));
          if (weight = 0) then
            continue;
          if (j < 0) then
            n := -j
          else
          if (j >= SrcHeight) then
            n := SrcHeight - j + SrcHeight - 1
          else
            n := j;
          k := contrib^[i].n;
          contrib^[i].n := contrib^[i].n + 1;
          contrib^[i].p^[k].pixel := n;
          contrib^[i].p^[k].weight := weight;
        end;
      end;
    end;

    // Apply filter to sample vertically from Work to Dst
    for i := 0 to DstHeight - 1 do
    begin
      DestPixelRGB := Dst.Scanline[i];
      cl := contrib[i];
      cn := cl.n-1;
      for k := 0 to DstWidth - 1 do
      begin
        vv := 0;
        tt := 0;
        for j := 0 to cn do
        begin
          t := ilimit(cl.p[j].pixel, 0, SrcHeight - 1);
          SourcePixel := Work.Scanline[t];
          inc(SourcePixel, k);
          weight := contrib^[i].p^[j].weight;
          inc(tt, weight);
          inc(vv, SourcePixel^ * weight);
        end;
        if tt = 0 then
          color := blimit(vv shr 8)
        else
          color := blimit(vv div tt);
        with DestPixelRGB^ do
        begin
          r := color;
          g := color;
          b := color;
        end;
        inc(DestPixelRGB);
      end;
    end;

    // Free the memory allocated for vertical filter weights
    for i := 0 to DstHeight - 1 do
      FreeMem(contrib^[i].p);
    FreeMem(contrib);
  finally
    FreeAndNil(Work);
  end;
end;



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

type

(*
  TContributorList = array[0..0] of TContributor;
  PContributorList = ^TContributorList;
  *)
  // List of source pixels contributing to a destination pixel
  TCList = record
    n: Integer;
    p: PContributorList;
  end;
  PCList = ^TCList;
  TCListList = array[0..0] of TCList;
  PCListList = ^TCListList;

  TResampleHorizSharedFields = record
    ThreadsCount: Integer;
    DstWidth: Integer;
    contrib: PCListList;
    Src: TIEBaseBitmap;
    Work: TIEWorkBitmap;
    per1: Double;
    OnProgress: TIEProgressEvent;
    Sender: TObject;
  end;

  TResampleHorizThread = class(TIEExecutor)
  private
    sharedFields: TResampleHorizSharedFields;
    startY, rowCount: Integer;
    threadIndex: Integer;
    percentage: Integer;
  public
    procedure Execute; override;
    constructor Create(useThread: Boolean; startY_, rowCount_: Integer; const sharedFields_: TResampleHorizSharedFields; threadIndex_: Integer);
    procedure DoProgress;
  end;

constructor TResampleHorizThread.Create(useThread: Boolean; startY_, rowCount_: Integer; const sharedFields_: TResampleHorizSharedFields; threadIndex_: Integer);
begin
  inherited Create(useThread);
  startY := startY_;
  rowCount := rowCount_;
  sharedFields := sharedFields_;
  threadIndex := threadIndex_;
end;

procedure TResampleHorizThread.DoProgress;
begin
  sharedFields.OnProgress(sharedFields.Sender, percentage);
end;

procedure TResampleHorizThread.Execute();
var
  k, i, j: Integer;
  SourceLine: PRGBList;
  DestPixel: PRGB;
  rr, gg, bb, tt: Integer;
  aper, lper: Integer;
  contributor: PContributor;
begin
  lper := -1;
  for k := startY to startY + rowCount - 1 do
  begin
    SourceLine := sharedFields.Src.ScanLine[k];
    DestPixel := sharedFields.Work.ScanLine[k];
    for i := 0 to sharedFields.DstWidth - 1 do
    begin
      rr := 0;
      gg := 0;
      bb := 0;
      tt := 0;
      contributor := @(sharedFields.contrib^[i].p^[0]);
      for j := 0 to sharedFields.contrib^[i].n - 1 do
      begin
        inc(tt, contributor^.weight);
        with SourceLine^[ contributor^.pixel ] do
        begin
          inc(rr, r * contributor^.weight);
          inc(gg, g * contributor^.weight);
          inc(bb, b * contributor^.weight);
        end;
        inc(contributor);
      end;
      if tt = 0 then
        tt := 256;
      rr := blimit(rr div tt);
      gg := blimit(gg div tt);
      bb := blimit(bb div tt);
      with DestPixel^ do
      begin
        r := rr;
        g := gg;
        b := bb;
      end;
      inc(DestPixel); // Move on to next column
    end;
    if (threadIndex = 0) and assigned(sharedFields.OnProgress) then
    begin
      aper := trunc(sharedFields.per1 * (k*sharedFields.ThreadsCount + 1));
      if aper<>lper then
      begin
        sharedFields.OnProgress(sharedFields.Sender, aper);
        lper := aper;
      end;
    end;
  end;
end;


// if FilterType=rfProjectBW or FilterType=rfProjectWB then Dst must be ie1g
procedure _ResampleEx(SrcImg, DstImg: TIEBaseBitmap; SrcAlpha: TIEBitmap; FilterType: TResampleFilter; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  Src: TIEBaseBitmap;
  filter: TFilterProc;
  fwidth: Double;
  xscale, yscale: Double; // Zoom scale factors
  i, j, k: Integer;       // Loop variables
  t, cn: Integer;
  center: Double;         // Filter calculation variables
  weight: Integer;
  width, fscale: Double;  // Filter calculation variables
  left, right: Integer;   // Filter calculation variables
  n: Integer;             // Pixel number
  Work: TIEWorkBitmap;
  contrib: PCListList;
  SourcePixel, DestPixel: PRGB;
  SrcWidth, SrcHeight, DstWidth, DstHeight: Integer;
  per1: Double;
  rr, gg, bb, tt: Integer;
  lper, aper: Integer;
  cl: TCList;
  horizSharedFields: TResampleHorizSharedFields;
  threads: TIEThreadPool;
  threadsCount: Integer;
  rowsPerThread: Integer;
  startY, rowCount: Integer;
begin

  if (SrcImg.Width = 0) or (SrcImg.Height = 0) then
    exit;

  if (SrcImg.Width = 1) and (SrcImg.Height = 1) then
  begin
    Resample1x1(SrcImg, DstImg);
    exit;
  end;

  case FilterType of
    rfBicubic:
      if ((SrcImg.PixelFormat = ie24RGB) or (SrcImg.PixelFormat = ie8g)) and (SrcImg.PixelFormat = DstImg.PixelFormat) then
      begin
        _IEQResampleBytes(SrcImg, DstImg, SrcAlpha, 1, fOnProgress, Sender);
        exit;
      end
      else
      if ((SrcImg.PixelFormat = ie48RGB) or (SrcImg.PixelFormat = ie16g))  and (SrcImg.PixelFormat = DstImg.PixelFormat) then
      begin
        _IEQResampleWords(SrcImg, DstImg, 1, fOnProgress, Sender);
        exit;
      end
      else
        FilterType := IEGlobalSettings().DefaultResampleFilter; // resample anyway
    rfBilinear:
      if ((SrcImg.PixelFormat = ie24RGB) or (SrcImg.PixelFormat = ie8g)) and (SrcImg.PixelFormat = DstImg.PixelFormat) then
      begin
        _IEQResampleBytes(SrcImg, DstImg, SrcAlpha, 0, fOnProgress, Sender);
        exit;
      end
      else
      if ((SrcImg.PixelFormat = ie48RGB) or (SrcImg.PixelFormat = ie16g)) and (SrcImg.PixelFormat = DstImg.PixelFormat)  then
      begin
        _IEQResampleWords(SrcImg, DstImg, 0, fOnProgress, Sender);
        exit;
      end
      else
        FilterType := IEGlobalSettings().DefaultResampleFilter; // resample anyway
    {$IFDEF IEINCLUDEWIC}
    rfWICNearestNeighbor, rfWICLinear, rfWICCubic, rfWICFant:
      begin
        IEWICResample(SrcImg, DstImg, SrcAlpha, FilterType, fOnProgress, Sender);
        exit;
      end;
    {$ENDIF}
  end;

  if (SrcImg.PixelFormat = ie8g) and (DstImg.PixelFormat = ie8g) then
  begin
    _Resampleie8g(SrcImg as TIEBitmap, DstImg as TIEBitmap, FilterType);
    exit;
  end;

  if (SrcImg.PixelFormat = ie16g) and (DstImg.PixelFormat = ie16g) then
  begin
    _Resampleie16g(SrcImg as TIEBitmap, DstImg as TIEBitmap, FilterType);
    exit;
  end;

  if SrcImg.Pixelformat <> ie24RGB then
  begin
    if (SrcImg is TIEBitmap) and (DstImg is TIEBitmap) then
    begin
      // create a temporary ie24RGB bitmap
      Src := TIEBitmap.Create(SrcImg.Width, SrcImg.Height, ie24RGB);
      TIEBitmap(Src).CopyAndConvertFormat(TIEBitmap(SrcImg));
      TIEBitmap(DstImg).PixelFormat := ie24RGB;
    end
    else
      exit; // fail, cannot convert non-TIEBitmap to TIEBitmap
  end
  else
    Src := SrcImg;

  try

    if (FilterType = rfFastLinear) then
    begin
      _ResampleLinearEx(Src, DstImg, fOnProgress, Sender);
      exit;
    end;
    if (FilterType = rfProjectBW) then
    begin
      _ResampleProject24Bit(Src, DstImg, false, fOnProgress, Sender);
      exit;
    end;
    if (FilterType = rfProjectWB) then
    begin
      _ResampleProject24Bit(Src, DstImg, true, fOnProgress, Sender);
      exit;
    end;

    lper := -1;

    filter := ResampleFilters[ord(FilterType) - 1].Filter;
    fwidth := ResampleFilters[ord(FilterType) - 1].Width;
    DstWidth  := DstImg.Width;
    DstHeight := DstImg.Height;
    SrcWidth  := Src.Width;
    SrcHeight := Src.Height;

    per1 := 100 / (SrcHeight + DstWidth + 0.5);

    // Create intermediate image to hold horizontal zoom
    work := nil;
    try
      if (SrcWidth = 1) or (DstWidth = 1) then
        xscale := DstWidth / SrcWidth
      else
        xscale := (DstWidth - 1) / (SrcWidth - 1);
      if (SrcHeight = 1) or (DstHeight = 1) then
        yscale := DstHeight / SrcHeight
      else
        yscale := (DstHeight - 1) / (SrcHeight - 1);

      // This implementation only works on 24-bit images
      Work := TIEWorkBitmap.Create(DstWidth, SrcHeight, 24);
      // --------------------------------------------
      // Pre-calculate filter contributions for a row
      // -----------------------------------------------
      GetMem(contrib, DstWidth * sizeof(TCList));

      // Horizontal sub-sampling
      // Scales from bigger to smaller width
      if (xscale < 1.0) then
      begin
        width := fwidth / xscale;
        fscale := 1.0 / xscale;
        for i := 0 to DstWidth - 1 do
        begin
          contrib^[i].n := 0;
          GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor));
          center := i / xscale;
          left := Floor(center - width);
          right := Ceil(center + width);
          for j := left to right do
          begin
            weight := round(256 * filter((center - j) / fscale) / fscale);
            if (weight = 0) then
              continue;
            if (j < 0) then
              n := -j
            else
            if (j >= SrcWidth) then
              n := SrcWidth - j + SrcWidth - 1
            else
              n := j;
            k := contrib^[i].n;
            inc(contrib^[i].n);
            if n < 0 then
              n := 0
            else
            if n>=SrcWidth then
              n := SrcWidth-1;
            contrib^[i].p^[k].pixel := n;
            contrib^[i].p^[k].weight := weight;
          end;
        end;
      end
      else
      begin
        // Horizontal super-sampling
        // Scales from smaller to bigger width
        for i := 0 to DstWidth - 1 do
        begin
          contrib^[i].n := 0;
          GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor));
          center := i / xscale;
          left := Floor(center - fwidth);
          right := Ceil(center + fwidth);
          for j := left to right do
          begin
            weight := round(256 * filter(center - j));
            if (weight = 0) then
              continue;
            if (j < 0) then
              n := -j
            else
            if (j >= SrcWidth) then
              n := SrcWidth - j + SrcWidth - 1
            else
              n := j;
            k := contrib^[i].n;
            inc(contrib^[i].n);
            if n < 0 then
              n := 0
            else
            if n>=SrcWidth then
              n := SrcWidth-1;
            contrib^[i].p^[k].pixel := n;
            contrib^[i].p^[k].weight := weight;
          end;
        end;
      end;

      // ----------------------------------------------------
      // Apply filter to sample horizontally from Src to Work
      // ----------------------------------------------------
      horizSharedFields.DstWidth := DstWidth;
      horizSharedFields.contrib := contrib;
      horizSharedFields.Src := Src;
      horizSharedFields.Work := Work;
      horizSharedFields.per1 := per1;
      horizSharedFields.OnProgress := fOnProgress;
      horizSharedFields.Sender := Sender;
      if (Src is TIEBitmap) and ((Src as TIEBitmap).Location = ieFile) then
        threadsCount := 1
      else
        threadsCount := IEGetRequiredThreads(Src.Width, Src.Height);
      horizSharedFields.ThreadsCount := threadsCount;
      threads := TIEThreadPool.Create();
      rowsPerThread := SrcHeight div threadsCount;
      startY := 0;
      rowCount := rowsPerThread;
      for i := 0 to threadsCount - 1 do
      begin
        threads.Add( TResampleHorizThread.Create(threadsCount > 1, startY, rowCount, horizSharedFields, i) );
        inc(startY, rowCount);
        if i = threadsCount-2 then
          rowCount := SrcHeight-startY; // last thread gets remaining rows
      end;
      threads.Join();
      threads.Free;

      // Free the memory allocated for horizontal filter weights
      for i := 0 to DstWidth - 1 do
        FreeMem(contrib^[i].p);
      FreeMem(contrib);

      // Pre-calculate filter contributions for a column
      GetMem(contrib, DstHeight * sizeof(TCList));
      // Vertical sub-sampling
      // Scales from bigger to smaller height
      if (yscale < 1.0) then
      begin
        width := fwidth / yscale;
        fscale := 1.0 / yscale;
        for i := 0 to DstHeight - 1 do
        begin
          contrib^[i].n := 0;
          GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor));
          center := i / yscale;
          left := Floor(center - width);
          right := Ceil(center + width);
          for j := left to right do
          begin
            weight := round(256 * filter((center - j) / fscale) / fscale);
            if (weight = 0) then
              continue;
            if (j < 0) then
              n := -j
            else
            if (j >= SrcHeight) then
              n := SrcHeight - j + SrcHeight - 1
            else
              n := j;
            k := contrib^[i].n;
            inc(contrib^[i].n);
            contrib^[i].p^[k].pixel := n;
            contrib^[i].p^[k].weight := weight;
          end;
        end
      end
      else
      begin
        // Vertical super-sampling
        // Scales from smaller to bigger height
        for i := 0 to DstHeight - 1 do
        begin
          contrib^[i].n := 0;
          GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor));
          center := i / yscale;
          left := Floor(center - fwidth);
          right := Ceil(center + fwidth);
          for j := left to right do
          begin
            weight := round(256 * filter(center - j));
            if (weight = 0) then
              continue;
            if (j < 0) then
              n := -j
            else
            if (j >= SrcHeight) then
              n := SrcHeight - j + SrcHeight - 1
            else
              n := j;
            k := contrib^[i].n;
            inc(contrib^[i].n);
            contrib^[i].p^[k].pixel := n;
            contrib^[i].p^[k].weight := weight;
          end;
        end;
      end;

      // Apply filter to sample vertically from Work to Dst
      for i := 0 to DstHeight - 1 do
      begin
        DestPixel := DstImg.Scanline[i];
        cl := contrib[i];
        cn := cl.n-1;
        for k := 0 to DstWidth - 1 do
        begin
          rr := 0;
          gg := 0;
          bb := 0;
          tt := 0;
          for j := 0 to cn do
          begin                
            t := ilimit(cl.p[j].pixel, 0, SrcHeight - 1);
            SourcePixel := Work.Scanline[t];
            inc(SourcePixel, k);
            weight := cl.p[j].weight;
            inc(tt, weight);
            with SourcePixel^ do
            begin
              inc(rr, r * weight);
              inc(gg, g * weight);
              inc(bb, b * weight);
            end;
          end;
          if tt = 0 then
            with DestPixel^ do
            begin
              r := blimit(rr shr 8);
              g := blimit(gg shr 8);
              b := blimit(bb shr 8);
            end
          else
            with DestPixel^ do
            begin
              r := blimit(rr div tt);
              g := blimit(gg div tt);
              b := blimit(bb div tt);
            end;
          inc(DestPixel);
        end;
        if assigned(fOnProgress) then
        begin
          aper := trunc(per1 * (i + SrcHeight + 1));
          if aper<>lper then
          begin
            fOnProgress(Sender, aper);
            lper := aper;
          end;
        end;
      end;

      // Free the memory allocated for vertical filter weights
      for i := 0 to DstHeight - 1 do
        FreeMem(contrib^[i].p);
      FreeMem(contrib);
    finally
      FreeAndNil(Work);
    end;
  finally
    if Src<>SrcImg then
      Src.Free;
  end;
end;


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



/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
// Shen-Castan edge detector

// Create TIEWorkBitmap filled with gray scale of the original bitmap (pf24bit)

function sh_CreateGrayPixMap(Source: TIEBitmap): TIEWorkBitmap;
var
  x, y, width, height: Integer;
  px: pbyte;
  rgb: PRGB;
  RedToGrayCoef, GreenToGrayCoef, BlueToGrayCoef: Integer;
begin
  RedToGrayCoef   := IEGlobalSettings().RedToGrayCoef;
  GreenToGrayCoef := IEGlobalSettings().GreenToGrayCoef;
  BlueToGrayCoef  := IEGlobalSettings().BlueToGrayCoef;
  width := Source.Width;
  height := Source.Height;
  result := TIEWorkBitmap.Create(width, height, 8);
  for y := 0 to height - 1 do
  begin
    px := result.Scanline[y];
    rgb := Source.Scanline[y];
    for x := 0 to width - 1 do
    begin
      with rgb^ do
        px^ := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;
      inc(px);
      inc(rgb);
    end;
  end;
end;

const
  sh_OUTLINE = 25;

type
  tsh_rc = record
    imwidth, imheight: Integer;
    b: Double;
    high_thresh, low_thresh: Double;
    ratio: Double;
    window_size: Integer;
    do_hysteresis: Boolean;
    lap: TIEWorkBitmap;
    nr, nc: Integer;
    edges: TIEWorkBitmap;
    thinFactor: Integer;
    Progress: TProgressRec;
  end;

procedure sh_embed(var im: TIEWorkBitmap; width: Integer; var rc: tsh_rc);
var
  i, j, _I, _J: Integer;
  xnew: TIEWorkBitmap;
  xnewWidth, xnewHeight: Integer;
  imWidth, imHeight: Integer;
  pb: pbyte;
begin
  imWidth  := im.Width;
  imHeight := im.Height;
  inc(width, 2);
  xnewWidth  := imWidth + width + width;
  xnewHeight := imHeight + width + width;
  xnew := TIEWorkBitmap.Create(xnewWidth, xnewHeight, 8);
  for i := 0 to xnewHeight - 1 do
  begin
    pb := xnew.Scanline[i];
    _I := (i - width + imHeight) mod imHeight;
    for j := 0 to xnewWidth - 1 do
    begin
      _J := (j - width + imWidth) mod imWidth;
      pb^ := im.GetPByte(_I, _J)^;
      inc(pb);
    end;
  end;
  FreeAndNil(im);
  im := xnew;
end;

procedure sh_apply_ISEF_vertical(var x: TIEWorkBitmap; var y: TIEWorkBitmap; var A: TIEWorkBitmap; var B: TIEWorkBitmap; nrows, ncols: Integer; var rc: tsh_rc);
var
  row, col: Integer;
  b1, b2: Double;
  ps1, ps2, ps3: psingle;
begin
  b1 := (1.0 - rc.b) / (1.0 + rc.b);
  b2 := rc.b * b1;
  for col := 0 to ncols - 1 do
  begin
    A.GetPSingle(0, col)^ := b1 * x.GetPSingle(0, col)^;
    B.GetPSingle(nrows - 1, col)^ := b2 * x.GetPSingle(nrows - 1, col)^;
  end;
  for row := 1 to nrows - 1 do
  begin
    ps1 := A.Scanline[row];
    ps2 := A.Scanline[row - 1];
    ps3 := x.Scanline[row];
    for col := 0 to ncols - 1 do
    begin
      ps1^ := b1 * ps3^ + rc.b * ps2^;
      inc(ps1);
      inc(ps2);
      inc(ps3);
    end;
  end;
  for row := nrows - 2 downto 0 do
  begin
    ps1 := B.Scanline[row];
    ps2 := x.Scanline[row];
    ps3 := B.Scanline[row + 1];
    for col := 0 to ncols - 1 do
    begin
      ps1^ := b2 * ps2^ + rc.b * ps3^;
      inc(ps1);
      inc(ps2);
      inc(ps3);
    end;
  end;
  ps1 := y.Scanline[nrows - 1];
  ps2 := A.Scanline[nrows - 1];
  for col := 0 to ncols - 1 do
  begin
    ps1^ := ps2^;
    inc(ps1);
    inc(ps2);
  end;
  for row := 0 to nrows - 2 do
  begin
    ps1 := y.Scanline[row];
    ps2 := A.Scanline[row];
    ps3 := B.Scanline[row + 1];
    for col := 0 to ncols - 1 do
    begin
      ps1^ := ps2^ + ps3^;
      inc(ps1);
      inc(ps2);
      inc(ps3);
    end;
  end;
end;

procedure sh_apply_ISEF_horizontal(var x: TIEWorkBitmap; var y: TIEWorkBitmap; var A: TIEWorkBitmap; var B: TIEWorkBitmap; nrows, ncols: Integer; var rc: tsh_rc);
var
  row, col: Integer;
  b1, b2: Double;
  ps1, ps2, ps3: psingle;
  rlA, rlx, rlB: Integer;
begin
  b1 := (1.0 - rc.b) / (1.0 + rc.b);
  b2 := rc.b * b1;
  for row := 0 to nrows - 1 do
  begin
    A.GetPSingle(row, 0)^ := b1 * x.GetPSingle(row, 0)^;
    B.GetPSingle(row, ncols - 1)^ := b2 * x.GetPSingle(row, ncols - 1)^;
  end;
  rlA := A.Rowlen div 4;
  rlx := x.Rowlen div 4;
  rlB := B.Rowlen div 4;
  for col := 1 to ncols - 1 do
  begin
    ps1 := A.GetPSingle(0, col);
    ps2 := x.GetPSingle(0, col);
    ps3 := A.GetPSingle(0, col - 1);
    for row := 0 to nrows - 1 do
    begin
      ps1^ := b1 * ps2^ + rc.b * ps3^;
      dec(ps1, rlA);
      dec(ps2, rlx);
      dec(ps3, rlA);
    end;
  end;
  for col := ncols - 2 downto 0 do
  begin
    ps1 := B.GetPSingle(0, col);
    ps2 := x.GetPSingle(0, col);
    ps3 := B.GetPSingle(0, col + 1);
    for row := 0 to nrows - 1 do
    begin
      ps1^ := b2 * ps2^ + rc.b * ps3^;
      dec(ps1, rlB);
      dec(ps2, rlx);
      dec(ps3, rlB);
    end;
  end;
  for row := 0 to nrows - 1 do
    y.GetPSingle(row, ncols - 1)^ := A.GetPSingle(row, ncols - 1)^;
  for row := 0 to nrows - 1 do
  begin
    ps1 := y.Scanline[row];
    ps2 := A.Scanline[row];
    ps3 := B.Scanline[row];
    inc(ps3);
    for col := 0 to ncols - 2 do
    begin
      ps1^ := ps2^ + ps3^;
      inc(ps1);
      inc(ps2);
      inc(ps3);
    end;
  end;
end;

//  Recursive filter realization of the ISEF (Shen and Castan CVIGP March 1992)

procedure sh_compute_ISEF(var x: TIEWorkBitmap; y: TIEWorkBitmap; nrows, ncols: Integer; var rc: tsh_rc);
var
  A, B: TIEWorkBitmap;
begin
  A := TIEWorkBitmap.Create(ncols, nrows, 32);
  B := TIEWorkBitmap.Create(ncols, nrows, 32);
  sh_apply_ISEF_vertical(x, y, A, B, nrows, ncols, rc);
  sh_apply_ISEF_horizontal(y, y, A, B, nrows, ncols, rc);
  FreeAndNil(B);
  FreeAndNil(A);
end;

// compute the band-limited laplacian of the input image

function sh_compute_bli(var buff1: TIEWorkBitmap; var buff2: TIEWorkBitmap; nrows, ncols: Integer; var rc: tsh_rc): TIEWorkBitmap;
var
  row, col: Integer;
  bli_buffer: TIEWorkBitmap;
  ps1: pbyte;
  ps2, ps3: psingle;
begin
  bli_buffer := TIEWorkBitmap.Create(ncols, nrows, 8);
  zeromemory(bli_buffer.Bits, bli_buffer.Rowlen * bli_buffer.Height);
  for row := 0 to nrows - 1 do
  begin
    ps1 := bli_buffer.Scanline[row];
    ps2 := buff1.Scanline[row];
    ps3 := buff2.Scanline[row];
    for col := 0 to ncols - 1 do
    begin
      if (row < sh_OUTLINE) or (row >= nrows - sh_OUTLINE) or (col < sh_OUTLINE) or (col >= ncols - sh_OUTLINE) then
      begin
        inc(ps1);
        inc(ps2);
        inc(ps3);
        continue;
      end;
      ps1^ := byte((ps2^ - ps3^) > 0);
      inc(ps1);
      inc(ps2);
      inc(ps3);
    end;
  end;
  result := bli_buffer;
end;

function sh_compute_adaptive_gradient(var BLI_buffer: TIEWorkBitmap; var orig_buffer: TIEWorkBitmap; row, col: Integer; var rc: tsh_rc): Double;
var
  i, j: Integer;
  sum_on, sum_off: Double;
  avg_on, avg_off: Double;
  num_on, num_off: Integer;
  wd2: Integer;
  ps1: pbyte;
  ps2: psingle;
begin
  sum_on := 0;
  sum_off := 0;
  num_on := 0;
  num_off := 0;
  wd2 := rc.window_size div 2;
  for i := -wd2 to wd2 do
  begin
    ps1 := BLI_buffer.Scanline[row + i];
    inc(ps1, col - wd2);
    ps2 := orig_buffer.Scanline[row + i];
    inc(ps2, col - wd2);
    for j := -wd2 to wd2 do
    begin
      if ps1^ <> 0 then
      begin
        sum_on := sum_on + ps2^;
        inc(num_on);
      end
      else
      begin
        sum_off := sum_off + ps2^;
        inc(num_off);
      end;
      inc(ps1);
      inc(ps2);
    end;
  end;
  if (sum_off <> 0) then
    avg_off := sum_off / num_off
  else
    avg_off := 0;
  if (sum_on <> 0) then
    avg_on := sum_on / num_on
  else
    avg_on := 0;
  result := (avg_off - avg_on);
end;

// finds zero-crossings in laplacian (buff)  orig is the smoothed image

function sh_is_candidate_edge(var buff: TIEWorkBitmap; var orig: TIEWorkBitmap; row, col: Integer; var rc: tsh_rc): Boolean;
begin
  if (buff.GetPByte(row, col)^ = 1) and (buff.GetPByte(row + 1, col)^ = 0) then
  begin
    result := (orig.GetPSingle(row + 1, col)^ - orig.GetPSingle(row - 1, col)^) > 0;
  end
  else
  if (buff.GetPByte(row, col)^ = 1) and (buff.GetPByte(row, col + 1)^ = 0) then
  begin
    result := (orig.GetPSingle(row, col + 1)^ - orig.GetPSingle(row, col - 1)^) > 0;
  end
  else
  if (buff.GetPByte(row, col)^ = 1) and (buff.GetPByte(row - 1, col)^ = 0) then
  begin
    result := (orig.GetPSingle(row + 1, col)^ - orig.GetPSingle(row - 1, col)^) < 0;
  end
  else
  if (buff.GetPByte(row, col)^ = 1) and (buff.GetPByte(row, col - 1)^ = 0) then
  begin
    result := (orig.GetPSingle(row, col + 1)^ - orig.GetPSingle(row, col - 1)^) < 0;
  end
  else
    result := false;
end;

procedure sh_locate_zero_crossings(var orig: TIEWorkBitmap; var smoothed: TIEWorkBitmap; var bli: TIEWorkBitmap; nrows, ncols: Integer; var rc: tsh_rc);
var
  row, col: Integer;
  ps1: psingle;
begin
  for row := 0 to nrows - 1 do
  begin
    ps1 := orig.Scanline[row];
    zeromemory(ps1, orig.rowlen);
    inc(ps1, sh_OUTLINE);
    if (row >= sh_OUTLINE) and (row < nrows - sh_OUTLINE) then
      for col := sh_OUTLINE to ncols - 1 - sh_OUTLINE do
      begin
        if (sh_is_candidate_edge(bli, smoothed, row, col, rc)) then
          ps1^ := sh_compute_adaptive_gradient(bli, smoothed, row, col, rc);
        inc(ps1);
      end;
  end;
end;

procedure sh_estimate_thresh(low: pdouble; hi: pdouble; nr, nc: Integer; var rc: tsh_rc);
var
  vmax, vmin, scale, x: Double;
  i, j, k, count: Integer;
  hist: array[0..255] of integer;
  ps1: psingle;
begin
  vmax := abs(rc.lap.GetPSingle(20, 20)^);
  vmin := vmax;
  for i := 0 to nr - 1 do
  begin
    ps1 := rc.lap.Scanline[i];
    for j := 0 to nc - 1 do
    begin
      if (i < sh_OUTLINE) or (i >= nr - sh_OUTLINE) or (j < sh_OUTLINE) or (j >= nc - sh_OUTLINE) then
      begin
        inc(ps1);
        continue;
      end;
      x := ps1^;
      if (vmin > x) then
        vmin := x;
      if (vmax < x) then
        vmax := x;
      inc(ps1);
    end;
  end;
  for k := 0 to 255 do
    hist[k] := 0;
  scale := 256 / (vmax - vmin + 1);
  for i := 0 to nr - 1 do
  begin
    ps1 := rc.lap.Scanline[i];
    for j := 0 to nc - 1 do
    begin
      if (i < sh_OUTLINE) or (i >= nr - sh_OUTLINE) or (j < sh_OUTLINE) or (j >= nc - sh_OUTLINE) then
      begin
        inc(ps1);
        continue;
      end;
      x := ps1^;
      k := trunc(((x - vmin) * scale));
      hist[k] := hist[k] + 1;
      inc(ps1);
    end;
  end;
  k := 255;
  j := trunc(rc.ratio * nr * nc);
  count := hist[255];
  while (count < j) do
  begin
    dec(k);
    if (k < 0) then
      break;
    inc(count, hist[k]);
  end;
  hi^ := k / scale + vmin;
  low^ := (hi^) / 2;
end;

//  return true if it marked something

function sh_mark_connected(i, j, level: Integer; var rc: tsh_rc): Boolean;
var
  notChainEnd: Boolean;
begin
  if (i >= rc.nr) or (i < 0) or (j >= rc.nc) or (j < 0) then
  begin
    result := false;
    exit;
  end;
  if (rc.edges.GetPByte(i, j)^ <> 0) then
  begin
    result := false;
    exit;
  end;
  if (rc.lap.GetPSingle(i, j)^ = 0) then
  begin
    result := false;
    exit;
  end;
  if rc.lap.GetPSingle(i, j)^ > rc.low_thresh then
  begin
    rc.edges.GetPByte(i, j)^ := 1;
  end
  else
  begin
    rc.edges.GetPByte(i, j)^ := 255;
  end;
  notChainEnd := false;
  notChainEnd := notChainEnd or sh_mark_connected(i, j + 1, level + 1, rc);
  notChainEnd := notChainEnd or sh_mark_connected(i, j - 1, level + 1, rc);
  notChainEnd := notChainEnd or sh_mark_connected(i + 1, j + 1, level + 1, rc);
  notChainEnd := notChainEnd or sh_mark_connected(i + 1, j, level + 1, rc);
  notChainEnd := notChainEnd or sh_mark_connected(i + 1, j - 1, level + 1, rc);
  notChainEnd := notChainEnd or sh_mark_connected(i - 1, j - 1, level + 1, rc);
  notChainEnd := notChainEnd or sh_mark_connected(i - 1, j, level + 1, rc);
  notChainEnd := notChainEnd or sh_mark_connected(i - 1, j + 1, level + 1, rc);
  if (notChainEnd and (level > 0)) then
  begin
    if (rc.thinFactor > 0) then
      if ((level mod rc.thinFactor) <> 0) then
      begin
        rc.edges.GetPByte(i, j)^ := 255;
      end;
  end;
  result := true;
end;

procedure sh_threshold_edges(var xin: TIEWorkbitmap; var xout: TIEWorkBitmap; nrows, ncols: Integer; var rc: tsh_rc);
var
  i, j: Integer;
  pb1: pbyte;
  ps1: psingle;
begin
  rc.lap := xin;
  rc.edges := xout;
  rc.nr := nrows;
  rc.nc := ncols;
  sh_estimate_thresh(@rc.low_thresh, @rc.high_thresh, rc.nr, rc.nc, rc);
  if (not rc.do_hysteresis) then
    rc.low_thresh := rc.high_thresh;
  for i := 0 to nrows - 1 do
  begin
    pb1 := rc.edges.Scanline[i];
    for j := 0 to ncols - 1 do
    begin
      //rc.edges.GetPByte(i, j)^ := 0;
      pb1^ := 0;
      inc(pb1);
    end;
  end;
  for i := 0 to nrows - 1 do
  begin
    ps1 := rc.lap.Scanline[i];
    for j := 0 to ncols - 1 do
    begin
      if (i < sh_OUTLINE) or (i >= nrows - sh_OUTLINE) or (j < sh_OUTLINE) or (j >= ncols - sh_OUTLINE) then
      begin
        inc(ps1);
        continue;
      end;
      //if ((rc.lap.GetPSingle(i, j)^) > rc.high_thresh) then
      if ((ps1^) > rc.high_thresh) then
        sh_mark_connected(i, j, 0, rc);
      inc(ps1);
    end;
  end;
  for i := 0 to nrows - 1 do
  begin
    pb1 := rc.edges.Scanline[i];
    for j := 0 to ncols - 1 do
    begin
      if (pb1^ = 255) then
        pb1^ := 0;
      inc(pb1);
    end;
  end;
end;

procedure sh_shen(var im: TIEWorkBitmap; var res: TIEWorkBitmap; var rc: tsh_rc);
var
  i, j: Integer;
  buffer: TIEWorkBitmap;
  smoothed_buffer: TIEWorkBitmap;
  bli_buffer: TIEWorkBitmap;
  ps1: psingle;
  pb1: pbyte;
  imWidth, imHeight: Integer;
begin
  rc.Progress.per1 := 100 / 6;
  imWidth  := im.Width;
  imHeight := im.Height;
  buffer := TIEWorkBitmap.Create(imWidth, imHeight, 32); // bitmap of floating points
  for i := 0 to imHeight - 1 do
  begin
    ps1 := buffer.scanline[i];
    pb1 := im.scanline[i];
    for j := 0 to imWidth - 1 do
    begin
      ps1^ := pb1^;
      inc(ps1);
      inc(pb1);
    end;
  end;
  with rc.Progress do
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (1)));
  // 1
  smoothed_buffer := TIEWorkBitmap.Create(imWidth, imHeight, 32);
  sh_compute_ISEF(buffer, smoothed_buffer, imHeight, imWidth, rc);
  with rc.Progress do
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (2)));
  // 2
  bli_buffer := sh_compute_bli(smoothed_buffer, buffer, imHeight, imWidth, rc);
  with rc.Progress do
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (3)));
  // 3
  sh_locate_zero_crossings(buffer, smoothed_buffer, bli_buffer, imHeight, imWidth, rc);
  with rc.Progress do
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (4)));
  // 4
  FreeAndNil(smoothed_buffer);
  FreeAndNil(bli_buffer);
  sh_threshold_edges(buffer, res, imHeight, imWidth, rc);
  with rc.Progress do
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (5)));
  // 5
  for i := 0 to imHeight - 1 do
  begin
    pb1 := res.scanline[i];
    for j := 0 to imWidth - 1 do
    begin
      if (pb1^ > 0) then
        pb1^ := 0
      else
        pb1^ := 255;
      inc(pb1);
    end;
  end;
  FreeAndNil(buffer);
  with rc.Progress do
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (6)));
end;

procedure sh_debed2(var im: TIEWorkBitmap; Bitmap: TIEBitmap; width: Integer; var rc: tsh_rc);
var
  i, j: Integer;
  hh, ww: Integer;
  pb: pbyte;
begin
  inc(width, 2);
  ww := im.Width - width - width;
  hh := im.Height - width - width;
  Bitmap.Allocate(ww, hh, ie1g);
  for i := 0 to hh - 2 do
  begin
    pb := Bitmap.Scanline[i];
    for j := 1 to ww - 1 do
      _SetPixelbw(pb, j, im.GetPByte(i + width, j + width)^);
    _SetPixelbw(pb, 0, 255);
  end;
  pb := Bitmap.Scanline[hh - 1];
  for j := 0 to ww - 1 do
    _SetPixelbw(pb, j, 255);
end;

// SrcBitmap and DstBitmap can refer to some bitmap object

procedure _IEEdgeDetect_ShenCastan(SrcBitmap, DstBitmap: TIEBitmap; Ratio: Double; Smooth: Double; WindowSize: Integer; ThinFactor: Integer; DoHysteresis: Boolean; var Progress: TProgressRec);
var
  rc: tsh_rc;
  im, res: TIEWorkBitmap;
begin
  fillchar(rc, sizeof(tsh_rc), 0);
  with rc do
  begin
    imwidth := SrcBitmap.Width;
    imheight := SrcBitmap.Height;
    b := Smooth;
    low_thresh := 20;
    high_thresh := 22;
    window_size := imin(WindowSize, sh_OUTLINE * 2);
    do_hysteresis := DoHysteresis;
  end;
  rc.Progress := Progress;
  rc.Ratio := Ratio;
  rc.thinFactor := ThinFactor;
  im := sh_CreateGrayPixMap(SrcBitmap);
  sh_embed(im, sh_OUTLINE, rc);
  res := TIEWorkBitmap.Create(im.Width, im.Height, 8);
  sh_shen(im, res, rc);
  sh_debed2(res, DstBitmap, sh_OUTLINE, rc);
  FreeAndNil(res);
  FreeAndNil(im);
end;

{!!
<FS>TImageEnProc.EdgeDetect_ShenCastan

<FM>Declaration<FC>
procedure EdgeDetect_ShenCastan(Ratio: Double; Smooth: Double; WindowSize: Integer; ThinFactor: Integer; DoHysteresis: Boolean);

<FM>Description<FN>
Converts the current color image to black & white (1 bit) using a Shen-Castan (ISEF) edge detection algorithm.
The Shen-Castan algorithm convolves the image with the Infinite Symmetric Exponential Filter, computes the binary Laplacian image, suppresses false zero crossing, performs adaptive gradient thresholding, and, finally, also applies hysteresis thresholding. (Algorithms for Image Processing and Computer Vision - J.R.Parker).

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>Ratio<FN></C> <C>Percent of pixels to be above High threshold (recommended: 0.99)</C> </R>
<R> <C><FC>Smooth<FN></C> <C>Smoothing factor (recommended: 0.9)</C> </R>
<R> <C><FC>WindowSize<FN></C> <C>Size of window for adaptive gradient (recommended: 7, max: 50)</C> </R>
<R> <C><FC>ThinFactor<FN></C> <C>Thinning factor (recommended: 0)</C> </R>
<R> <C><FC>DoHysteresis<FN></C> <C>If True tun on the hysteresis thresholding (recommended: True)</C> </R>
</TABLE>

<FM>Example<FC>
ImageEnView1.Proc.EdgeDetect_ShenCastan(0.99, 0.9, 7, 0, true);

!!}
procedure TImageEnProc.EdgeDetect_ShenCastan(Ratio: Double; Smooth: Double; WindowSize: Integer; ThinFactor: Integer; DoHysteresis: Boolean);
var
  Progress: TProgressRec;
begin
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  if fAutoUndo then
    SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
              IERS_EDGEDETECT,
              {$ELSE}
              IEMsg( IEMsg_EDGEDETECT ),
              {$ENDIF}
              ieuImage, True, IEOP_EDGEDETECT );
  Progress.fOnProgress := fOnProgress;
  Progress.Sender := Self;
  _IEEdgeDetect_ShenCastan(fIEBitmap, fIEBitmap, Ratio, Smooth, WindowSize, ThinFactor, DoHysteresis, Progress);
  Update;
  DoFinishWork;
end;

// end of Shen-Castan edge detector
/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////

/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
// Skew Detection

function _iehough(image: TIEBitmap; var Progress: TProgressRec; anglerange: Integer; Precision: Double): Double;
const
  conv: Double = 3.1415926535 / 180;
  ar: array[-1..1] of integer = (-1, 1, -1);
var
  z: TIEWorkBitmap;
  r1, r2, center_x, center_y, i, j, jj, jj8, rl, rmax, rmax2, tmax: Integer;
  oc: Double;
  tmval: Integer;
  nc, nr, om, omi, omr: Integer;
  row: pbyte;
  pf: pinteger;
  precmul: Integer;
  s1, s2, totaldegrees: Integer;
  px: pinteger;
  ksin, kcos: pintegerarray;
  dsin, dcos: pdoublearray;
begin
  result := 0;
  if image.pixelformat <> ie1g then
    exit;
  Precision := trunc(Precision * 10) / 10; // allow only first decimal digit
  if (Precision < 0.1) or (Precision > 1) then
    exit;
  if (AngleRange < 0) or (AngleRange > 180) then
    exit;
  precmul := round(1 / Precision);
  Precision := (1 / PrecMul) * conv; // now is in radians
  totaldegrees := 180 * precmul;
  nc := image.Width;
  nr := image.Height;
  center_x := nc div 2;
  center_y := nr div 2;
  rmax := trunc(sqrt(nc * nc + nr * nr) / 2);
  z := TIEWorkBitmap.Create(2 * rmax + 1, totaldegrees, 32);
  ZeroMemory(z.Bits, z.Height * z.RowLen);
  omr := (anglerange * precmul) div 2;
  omi := (totaldegrees div 2);
  Progress.per1 := 100 / (nr);
  getmem(ksin, sizeof(integer) * 1800);
  getmem(kcos, sizeof(integer) * 1800);
  getmem(dsin, sizeof(double) * 1800);
  getmem(dcos, sizeof(double) * 1800);
  oc := 0;
  for om := 0 to 1799 do
  begin
    ksin[om] := trunc(sin(oc) * 131072);
    kcos[om] := trunc(cos(oc) * 131072);
    dsin[om] := sin(oc);
    dcos[om] := cos(oc);
    oc := oc + Precision;
  end;
  rl := IEBitmapRowLen(image.width, 1, 32);
  for i := 0 to nr - 1 do
  begin
    row := image.Scanline[i];
    jj := 0;
    while jj < rl do
    begin
      if (row^ < 255) then
      begin
        jj8 := jj * 8;
        for j := 0 to 7 do
          if row^ and iebitmask1[j] = 0 then
          begin // found a "black"
            om := omi - omr;
            while om < omi + omr - 1 do
            begin
              r1 := (i - center_y) * ksin[om];
              if r1 < 0 then
              begin
                r1 := -r1;
                s1 := r1 and $1FFFF;
                r1 := -(r1 shr 17);
                if s1 > 65535 then
                  dec(r1);
              end
              else
              begin
                s1 := r1 and $1FFFF;
                r1 := r1 shr 17;
                if s1 > 65535 then
                  inc(r1);
              end;
              r2 := (jj8 + j - center_x) * kcos[om];
              if r2 < 0 then
              begin
                r2 := -r2;
                s2 := r2 and $1FFFF;
                r2 := -(r2 shr 17);
                if s2 > 65535 then
                  dec(r2);
              end
              else
              begin
                s2 := r2 and $1FFFF;
                r2 := r2 shr 17;
                if s2 > 65535 then
                  inc(r2);
              end;

              with z do
                px := pinteger(uint64(Bits) + uint64((Height - om - 1) * Rowlen + (rmax + r1 + r2) * 4));
              inc(px^);
              inc(om);
            end;
          end;
      end;
      inc(jj);
      inc(row);
    end;
    with Progress do
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * (i)));
  end;
  tmax := 0;
  tmval := 0;
  rmax2 := 2 * rmax;
  for i := (omi - omr) to omi + omr - 1 do
  begin
    pf := z.Scanline[i];
    for j := 0 to rmax2 do
    begin
      if pf^ > tmval then
      begin
        tmval := pf^;
        tmax := i;
      end;
      inc(pf);
    end;
  end;
  result := tmax / PrecMul - 90;
  FreeAndNil(z);
  freemem(ksin);
  freemem(kcos);
  freemem(dsin);
  freemem(dcos);
end;

function _IESkewDetection(Bitmap: TIEBitmap; ResampleWidth: Integer; AngleRange: Integer; Precision: Double; EdgeDetect: Boolean; fOnProgress: TIEProgressEvent; Sender: TObject): Double;
var
  tmpbmp: TIEBitmap;
  NullProgress: TProgressRec;
  Progress: TProgressRec;
begin
  NullProgress := NullProgressRec( nil );
  Progress.fOnProgress := fOnProgress;
  Progress.Sender := Sender;
  if (ResampleWidth > 0) and (ResampleWidth <> Bitmap.Width) then
  begin
    tmpbmp := TIEBitmap.Create;
    tmpbmp.Allocate(ResampleWidth, (Bitmap.Height * ResampleWidth) div Bitmap.Width, Bitmap.pixelformat);
    if tmpbmp.Pixelformat = ie1g then
    begin
      if EdgeDetect then
      begin
        tmpbmp.Allocate(tmpbmp.Width, tmpbmp.Height, ie24RGB);
        _Resample1BitEx(Bitmap, tmpbmp, IEGlobalSettings().DefaultResampleFilter);
      end
      else
        _IEBmpStretchEx(Bitmap, tmpbmp, nil, nil);
    end
    else
      _ResampleEx(Bitmap, tmpbmp, nil, IEGlobalSettings().DefaultResampleFilter, nil, nil);
    if EdgeDetect then
      _IEEdgeDetect_ShenCastan(tmpbmp, tmpbmp, 0.99, 0.9, 7, 0, true, NullProgress);
  end
  else
  begin
    if Bitmap.PixelFormat = ie1g then
    begin
      if EdgeDetect then
      begin
        tmpbmp := TIEBitmap.Create;
        _Conv1To24Ex(Bitmap, tmpbmp, NullProgress);
        _IEEdgeDetect_ShenCastan(tmpbmp, tmpbmp, 0.99, 0.9, 7, 0, true, NullProgress);
      end
      else
        tmpbmp := Bitmap;
    end
    else
    begin
      tmpbmp := TIEBitmap.Create;
      _IEEdgeDetect_ShenCastan(Bitmap, tmpbmp, 0.99, 0.9, 7, 0, true, NullProgress);
    end;
  end;
  result := _iehough(tmpbmp, Progress, AngleRange, Precision);
  if tmpbmp <> Bitmap then
    FreeAndNil(tmpbmp);
end;

// If ResampleWidth is Zero (0) doesn't resample original image (more slow)

{!!
<FS>TImageEnProc.SkewDetection

<FM>Declaration<FC>
function SkewDetection(ResampleWidth: Integer; AngleRange: Integer; Precision: Double; EdgeDetect: Boolean): Double;

<FM>Description<FN>
Estimates the orientation angle (in degrees) of lines of text. Apply this method only to images that contain printed text.
If an area is selected, SkewDetection will work only on the selection.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>ResampleWidth<FN></C> <C>The width of the analysis image (set to 0 to analyze the image at its full size). SkewDetection can be very slow on large images, so it is recommended that images are resampled to a smaller size by setting ResampleWidth (e.g. specifying 800 will reduce the image to a width of 800 for analysis)</C> </R>
<R> <C><FC>AngleRange<FN></C> <C>The maximum working range in degrees. For example, if you specify 30, SkewDetection will scan the image within the range of -15 to 15 degrees. A low value will enhance performance and accuracy. Permitted values are 1 to 180</C> </R>
<R> <C><FC>Precision<FN></C> <C>The level of precision of the angle detection. Permitted range is 0.0 to 0.9 with only one decimal digit. Typical value is 0.1</C> </R>
<R> <C><FC>EdgeDetect<FN></C> <C>Whether to apply and edge detect algorithm before detecting the orientation</C> </R>
</TABLE>

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageAnalysis\Orientator\Orientator.dpr </C> </R>
</TABLE>

<FM>Example<FC>
// this example adjust image orientation with range -15 to 15 and 0.1 degrees of precision
Var
  angle: Double;
begin
  angle := ImageEnView1.Proc.SkewDetection( ImageEnView1.Bitmap.Width div 4, 30, 0.1, false );
  ImageEnView1.Proc.Rotate( angle, true );
End;

!!}
function TImageEnProc.SkewDetection(ResampleWidth: Integer; AngleRange: Integer; Precision: Double; EdgeDetect: Boolean): Double;
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  result := 0;
  if not BeginImageAnalysis([ie24RGB, ie1g], x1, y1, x2, y2, ProcBitmap, mask) then
    exit;
  result := _IESkewDetection(ProcBitmap, ResampleWidth, AngleRange, Precision, EdgeDetect, fOnProgress, Self);
  EndImageAnalysis(ProcBitmap);
  DoFinishWork;
end;

// Skew Detection
/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////

{!!
<FS>TImageEnProc.Fill

<FM>Declaration<FC>
procedure Fill(FillColor: <A TRGB>);
procedure Fill(FillColor: TColor);

<FM>Description<FN>
Replaces the selected region with a solid color.

Note: For black & white images FillColor can be only (0, 0, 0) for black and (255, 255, 255) for white.

<FM>Example<FC>
ImageEnView1.Proc.Fill( CreateRGB(127, 50, 200) );

!!}
procedure TImageEnProc.Fill(FillColor: TRGB);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_FILL, [FillColor.r, FillColor.g, FillColor.b]),
                              {$ELSE}
                              IEMsg( IEMsg_FILL ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_FILL ) then
    exit;
  _Fill(ProcBitmap, x1, y1, x2, y2, FillColor, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

procedure TImageEnProc.Fill(FillColor: TColor);
begin
  Fill( TColor2TRGB(FillColor) );
end;

// on ie1g images FillColor can be only (0, 0, 0) for black and (255, 255, 255) for white
procedure _Fill(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; FillColor: TRGB; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  col, row: Integer;
  ppx: pRGB;
  per1: Double;
  bx: pbyte;
  tb: byte;
  bb: Integer;
  bw: Boolean;
begin
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  case bitmap.Pixelformat of
    ie24RGB:
      begin
        // ie24RGB
        for row := fSelY1 to fSelY2 do
        begin
          ppx := bitmap.ScanLine[row];
          inc(ppx, fSelX1);
          for col := fSelX1 to fSelX2 do
          begin
            ppx^.r := FillColor.r;
            ppx^.g := FillColor.g;
            ppx^.b := FillColor.b;
            inc(ppx);
          end;
          if assigned(fOnProgress) then
            fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1)));
        end;
      end;
    ie8g:
      begin
        // ie8g
        with FillColor do
          bb := (r * IEGlobalSettings().RedToGrayCoef + g * IEGlobalSettings().GreenToGrayCoef + b * IEGlobalSettings().BlueToGrayCoef) div 100;
        for row := fSelY1 to fSelY2 do
        begin
          bx := bitmap.ScanLine[row];
          inc(bx, fSelX1);
          for col := fSelX1 to fSelX2 do
          begin
            bx^ := bb;
            inc(bx);
          end;
          if assigned(fOnProgress) then
            fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1)));
        end;
      end;
    ie1g:
      begin
        // ie1g
        bw := (FillColor.r <> 0);
        for row := fSelY1 to fSelY2 do
        begin
          bx := Bitmap.Scanline[row];
          inc(bx, fSelX1 shr 3);
          bb := 7 - (fSelX1 and 7);
          tb := bx^;
          for col := fSelX1 to fSelX2 do
          begin
            if bw then
              tb := tb or (1 shl bb)
            else
              tb := tb and not (1 shl bb);
            dec(bb);
            if bb = -1 then
            begin
              bx^ := tb;
              inc(bx);
              tb := bx^;
              bb := 7;
            end;
          end;
          if bb < 7 then
            bx^ := tb;
          if assigned(fOnProgress) then
            fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1)));
        end;
      end;
    else
      Bitmap.FillRect(fSelX1, fSelY1, fSelX2, fSelY2, TRGB2TColor(FillColor));
  end;  // end case
end;


procedure _ResampleLinearEx(Src, Dst: TIEBaseBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
type
  TIntRGB = record
    r, g, b: integer;
  end;
var
  zx, zy, rold, d, diff: Double;
  iold, iold2, x, y, xx, yy: Integer;
  a, mm_r, mm_g, mm_b, mc: Integer;
  OldWidth, OldHeight, NewWidth, NewHeight: Integer;
  OldImRow: PRGBROW;
  darr1: array of double;
  iarr1, iarr2: array of integer;
  per1: Double;
  tempBmp: array of TIntRGB;
  destIntRGBPtr, srcIntRGBPtr, srcIntRGBPtr2: ^TIntRGB;
  destRGBPtr: PRGB;
begin
  if (Src.Width = 0) or (Src.Height = 0) or (Dst.Width = 0) or (Dst.Height = 0) then
    exit;
  OldWidth := Src.Width;
  OldHeight := Src.Height;
  NewWidth := Dst.Width;
  NewHeight := Dst.Height;
  zx := NewWidth / OldWidth;
  zy := NewHeight / OldHeight;
  if (zx = 1) and (zy = 1) then
  begin
    Dst.Assign(Src);
    exit;
  end;
  SetLength(darr1, NewWidth);
  SetLength(iarr1, NewWidth);
  SetLength(iarr2, NewWidth);
  for x := 0 to NewWidth - 1 do
  begin
    d := x / zx;
    iarr1[x] := round(d);
    darr1[x] := d - iarr1[x];
    iarr2[x] := round(imin(x + 1, NewWidth - 1) / zx + 0.0000000001); // the 0.0000000001 avoids a Delphi math bug
  end;
  SetLength(tempBmp, NewWidth * OldHeight);
  ////// horizontal
  per1 := 100 / (OldHeight + NewHeight + 0.5);
  if zx > 1 then
  begin
    // zoom-in (linear interpolation)
    for y := 0 to OldHeight - 1 do
    begin
      OldImRow := Src.Scanline[y];
      destIntRGBPtr := @tempBmp[y * newWidth];
      for x := 0 to NewWidth - 1 do
      begin
        iold := iarr1[x];
        diff := darr1[x];
        iold2 := imin(iold + 1, OldWidth - 1);
        // r
        a := OldImRow[iold].r;
        destIntRGBPtr^.r := round(a + (((OldImRow[iold2].r - a) * diff)));
        // g
        a := OldImRow[iold].g;
        destIntRGBPtr^.g := round(a + (((OldImRow[iold2].g - a) * diff)));
        // b
        a := OldImRow[iold].b;
        destIntRGBPtr^.b := round(a + (((OldImRow[iold2].b - a) * diff)));

        inc(destIntRGBPtr);
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * y));
    end;
  end
  else
  begin
    // zoom-out (average)
    for y := 0 to OldHeight - 1 do
    begin
      OldImRow := Src.Scanline[y];
      destIntRGBPtr := @tempBmp[y * newWidth];
      for x := 0 to NewWidth - 1 do
      begin
        iold := iarr1[x];
        iold2 := iarr2[x];
        mm_r := 0;
        mm_g := 0;
        mm_b := 0;
        mc := 0;
        for xx := iold to iold2 do
        begin
          with OldImRow[xx] do
          begin
            inc(mm_r, r);
            inc(mm_g, g);
            inc(mm_b, b);
          end;
          inc(mc);
        end;
        destIntRGBPtr^.r := mm_r div mc;
        destIntRGBPtr^.g := mm_g div mc;
        destIntRGBPtr^.b := mm_b div mc;
        inc(destIntRGBPtr);
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * y));
    end;
  end;
  // vertical
  if zy > 1 then
  begin
    // zoom-in (linear interpolation)
    for y := 0 to NewHeight - 1 do
    begin
      rold := y / zy;
      iold := trunc(rold);
      diff := rold - iold;
      srcIntRGBPtr := @tempBmp[iold * newWidth];
      destRGBPtr := Dst.Scanline[y];
      if iold + 1 < OldHeight then
        srcIntRGBPtr2 := @tempBmp[(iold + 1) * newWidth]
      else
        srcIntRGBPtr2 := srcIntRGBPtr;
      for x := 0 to NewWidth - 1 do
      begin
        // r
        destRGBPtr.r := blimit(round(srcIntRGBPtr^.r + (((srcIntRGBPtr2^.r - srcIntRGBPtr^.r) * diff))));
        // g
        destRGBPtr.g := blimit(round(srcIntRGBPtr^.g + (((srcIntRGBPtr2^.g - srcIntRGBPtr^.g) * diff))));
        // b
        destRGBPtr.b := blimit(round(srcIntRGBPtr^.b + (((srcIntRGBPtr2^.b - srcIntRGBPtr^.b) * diff))));

        inc(srcIntRGBPtr);
        inc(srcIntRGBPtr2);

        inc(destRGBPtr);
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * (y + OldHeight)));
    end;
  end
  else
  begin
    // zoom-out (average)
    for y := 0 to NewHeight - 1 do
    begin
      iold := round(y / zy);
      iold2 := round(imin(y + 1, NewHeight - 1) / zy);
      destRGBPtr := Dst.Scanline[y];
      for x := 0 to NewWidth - 1 do
      begin
        mm_r := 0;
        mm_g := 0;
        mm_b := 0;
        mc := 0;
        srcIntRGBPtr := @tempBmp[x + iold * newWidth];
        for yy := iold to iold2 do
        begin
          inc(mm_r, srcIntRGBPtr^.r);
          inc(mm_g, srcIntRGBPtr^.g);
          inc(mm_b, srcIntRGBPtr^.b);
          inc(mc);
          inc(srcIntRGBPtr, newWidth);
        end;
        with destRGBPtr^ do
        begin
          r := blimit(mm_r div mc);
          g := blimit(mm_g div mc);
          b := blimit(mm_b div mc);
        end;
        inc(destRGBPtr);
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * (y + OldHeight)));
    end;
  end;
end;


// destBmp must be ie1g
procedure _ResampleProject1Bit(OrigBmp, DestBmp: TIEBaseBitmap; Negative: Boolean; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  x, y, sx, sy, psx, psy: Integer;
  zx, zy: Double;
  l1, l2: TIEDataAccess;
  per1: Double;
  dst: pbyte;
  xx, yy: Integer;
  arx: array of Integer;
  brk: Boolean;
  row, bp: pbyte;
  DestBmpWidth, DestBmpHeight: Integer;
begin
  DestBmpWidth  := DestBmp.Width;
  DestBmpheight := DestBmp.Height;

  if DestBmp.PixelFormat <> ie1g then
    DestBmp.Allocate(DestBmpWidth, DestBmpHeight, ie1g);

  per1 := 100 / (DestBmpHeight + 0.5);
  l1 := OrigBmp.Access;
  l2 := DestBmp.Access;
  OrigBmp.Access := [iedRead];
  DestBmp.Access := [iedWrite];
  zx := OrigBmp.Width / DestBmpWidth;
  zy := OrigBmp.Height / DestBmpHeight;

  SetLength(arx, DestBmpWidth);
  for x := 0 to DestBmpWidth - 1 do
    arx[x] := trunc(x * zx);

  if Negative then
  begin

    for y := 0 to DestBmpHeight - 1 do
    begin
      dst := DestBmp.Scanline[y];
      fillchar(dst^, DestBmp.RowLen, 0);
      if y > 0 then
      begin
        psy := trunc((y-1) * zy);
        sy := trunc(y * zy);
      end
      else
      begin
        psy := 0;
        sy := 0;
      end;
      for x := 0 to DestBmpWidth - 1 do
      begin
        if x > 0 then
        begin
          psx := arx[x-1];
          sx  := arx[x];
        end
        else
        begin
          psx := 0;
          sx := 0;
        end;
        brk := false;
        for yy := psy to sy do
        begin
          row := OrigBmp.Scanline[yy];
          for xx := psx to sx do
          begin
            if pbytearray(row)^[xx shr 3] and iebitmask1[xx and $7] <> 0 then
            begin
              bp := pbyte(uint64(dst) + (uint64(x) shr 3));
              bp^ := bp^ or iebitmask1[x and 7];  // set to 1
              brk := true;
              break;
            end;
          end;
          if brk then
            break;
        end;
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * y));
    end

  end
  else
  begin

    for y := 0 to DestBmpHeight - 1 do
    begin
      dst := DestBmp.Scanline[y];
      fillchar(dst^, DestBmp.RowLen, 255);
      if y > 0 then
      begin
        psy := trunc((y-1) * zy);
        sy := trunc(y * zy);
      end
      else
      begin
        psy := 0;
        sy := 0;
      end;
      for x := 0 to DestBmpWidth - 1 do
      begin
        if x > 0 then
        begin
          psx := arx[x-1];
          sx  := arx[x];
        end
        else
        begin
          psx := 0;
          sx := 0;
        end;
        brk := false;
        for yy := psy to sy do
        begin
          row := OrigBmp.Scanline[yy];
          for xx := psx to sx do
          begin
            if pbytearray(row)^[xx shr 3] and iebitmask1[xx and $7] = 0 then
            begin
              bp := pbyte(uint64(dst) + (uint64(x) shr 3));
              bp^ := bp^ and not iebitmask1[x and 7]; // set to 0
              brk := true;
              break;
            end;
          end;
          if brk then
            break;
        end;
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * y));
    end;

  end;

  OrigBmp.Access := l1;
  DestBmp.Access := l2;
end;

// destBmp must be ie1g
procedure _ResampleProject24Bit(OrigBmp, DestBmp: TIEBaseBitmap; Negative: Boolean; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  x, y, sx, sy, psx, psy: Integer;
  zx, zy: Double;
  l1, l2: TIEDataAccess;
  per1: Double;
  dst: pbyte;
  xx, yy: Integer;
  arx: array of Integer;
  row: PRGB;
  bp: pbyte;
  DestBmpWidth, DestBmpHeight: Integer;
begin
  DestBmpWidth  := DestBmp.Width;
  DestBmpHeight := DestBmp.Height;

  if DestBmp.PixelFormat <> ie1g then
    DestBmp.Allocate(DestBmpWidth, DestBmpHeight, ie1g);

  per1 := 100 / (DestBmpHeight + 0.5);
  l1 := OrigBmp.Access;
  l2 := DestBmp.Access;
  OrigBmp.Access := [iedRead];
  DestBmp.Access := [iedWrite];
  zx := OrigBmp.Width / DestBmpWidth;
  zy := OrigBmp.Height / DestBmpHeight;

  SetLength(arx, DestBmpWidth);
  for x := 0 to DestBmpWidth - 1 do
    arx[x] := trunc(x * zx);

  if Negative then
  begin

    for y := 0 to DestBmpHeight - 1 do
    begin
      dst := DestBmp.Scanline[y];
      fillchar(dst^, DestBmp.RowLen, 0);
      if y > 0 then
      begin
        psy := trunc((y-1) * zy);
        sy := trunc(y * zy);
      end
      else
      begin
        psy := 0;
        sy := 0;
      end;
      for x := 0 to DestBmpWidth - 1 do
      begin
        if x > 0 then
        begin
          psx := arx[x-1];
          sx  := arx[x];
        end
        else
        begin
          psx := 0;
          sx := 0;
        end;
        for yy := psy to sy do
        begin
          row := OrigBmp.Scanline[yy]; inc(row, psx);
          for xx := psx to sx do
          begin
            if (row^.r>128) and (row^.g>128) and (row^.b>128) then
            begin
              bp := pbyte(uint64(dst) + (uint64(x) shr 3));
              bp^ := bp^ or iebitmask1[x and 7];  // set to 1
            end;
            inc(row);
          end;
        end;
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * y));
    end;


  end
  else
  begin

    for y := 0 to DestBmpHeight - 1 do
    begin
      dst := DestBmp.Scanline[y];
      fillchar(dst^, DestBmp.RowLen, 255);
      if y > 0 then
      begin
        psy := trunc((y-1) * zy);
        sy := trunc(y * zy);
      end
      else
      begin
        psy := 0;
        sy := 0;
      end;
      for x := 0 to DestBmpWidth - 1 do
      begin
        if x > 0 then
        begin
          psx := arx[x-1];
          sx  := arx[x];
        end
        else
        begin
          psx := 0;
          sx := 0;
        end;
        for yy := psy to sy do
        begin
          row := OrigBmp.Scanline[yy]; inc(row, psx);
          for xx := psx to sx do
          begin
            if (row^.r<128) and (row^.g<128) and (row^.b<128) then
            begin
              bp := pbyte(uint64(dst) + (uint64(x) shr 3));
              bp^ := bp^ and not iebitmask1[x and 7]; // set to 0
            end;
            inc(row);
          end;
        end;
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * y));
    end;

  end;

  OrigBmp.Access := l1;
  DestBmp.Access := l2;
end;


// for zoom-out call _SubResample1bitFilteredEx
// Src must be 1bit
// Dst must be 24bit
procedure _ResampleLinear1BitEx(Src, Dst: TIEBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  zx, zy, rold, d: Double;
  iold, iold2, x, y, idiff: Integer;
  OldWidth, OldHeight, NewWidth, NewHeight: Integer;
  SrcImRow: pbyte;
  OldImRow, NewImRow, OldImRow2: PRGBROW;
  bmp1: TIEWorkBitmap;
  darr1: array of integer;
  iarr1: array of integer;
  per1: Double;
  v1, v2: Integer;
begin
  OldWidth := Src.Width;
  OldHeight := Src.Height;
  NewWidth := Dst.Width;
  NewHeight := Dst.Height;
  zx := NewWidth / OldWidth;
  zy := NewHeight / OldHeight;
  if (zx = 1) and (zy = 1) then
  begin
    Dst.Assign(Src);
    exit;
  end;
  if (zx < 1) and (zy < 1) then
  begin
    _SubResample1bitFilteredEx(Src, 0, 0, Src.Width - 1, Src.Height - 1, Dst);
    exit;
  end;
  SetLength(darr1, NewWidth);
  SetLength(iarr1, NewWidth);
  for x := 0 to NewWidth - 1 do
  begin
    d := x / zx;
    iarr1[x] := trunc(d);
    darr1[x] := trunc((d - iarr1[x]) * 131072); // 2^17
  end;
  bmp1 := TIEWorkBitmap.Create(NewWidth, OldHeight, 24);
  ////// horizontal
  per1 := 100 / (OldHeight + NewHeight + 0.5);
  for y := 0 to OldHeight - 1 do
  begin
    SrcImRow := Src.Scanline[y];
    NewImRow := bmp1.Scanline[y];
    for x := 0 to NewWidth - 1 do
    begin
      iold := iarr1[x];
      idiff := darr1[x];
      iold2 := imin(iold + 1, OldWidth - 1);
      v1 := pbytearray(SrcImRow)^[iold2 shr 3] and iebitmask1[iold2 and $7];
      if v1 <> 0 then
        v1 := 255
      else
        v1 := 0;
      v2 := pbytearray(SrcImRow)^[iold shr 3] and iebitmask1[iold and $7];
      if v2 <> 0 then
        v2 := 255
      else
        v2 := 0;
      with NewImRow[x] do
      begin
        r := v2 + (((v1 - v2) * idiff) shr 17);
        b := r;
        g := r;
      end;
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * y));
  end;
  // vertical
  for y := 0 to NewHeight - 1 do
  begin
    rold := y / zy;
    iold := trunc(rold);
    idiff := trunc((rold - iold) * 131072); // 2^17
    OldImRow := bmp1.Scanline[iold];
    NewImRow := Dst.Scanline[y];
    if iold + 1 < OldHeight then
      OldImRow2 := bmp1.Scanline[iold + 1]
    else
      OldImRow2 := OldImRow;
    for x := 0 to NewWidth - 1 do
    begin
      v1 := OldImRow[x].r;
      with NewImRow[x] do
      begin
        r := v1 + (((OldImRow2[x].r - v1) * idiff) shr 17);
        g := r;
        b := r;
      end;
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (y + OldHeight)));
  end;
  FreeAndNil(bmp1);
end;


// Src and Dst must 8 bit
procedure _ResampleLinear8g(Src, Dst: TIEBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  zx, zy, rold, d, diff: Double;
  iold, iold2, x, y, xx, yy: Integer;
  a, mm, mc: Integer;
  OldWidth, OldHeight, NewWidth, NewHeight: Integer;
  OldImRow: PByteArray;
  darr1: array of Double;
  iarr1, iarr2: array of Integer;
  per1: Double;
  tempBmp: array of Integer;
  destIntPtr, srcIntPtr, srcIntPtr2: PInteger;
  destPtr: PByte;
begin
  if (Src.Width = 0) or (Src.Height = 0) or (Dst.Width = 0) or (Dst.Height = 0) then
    exit;
  OldWidth := Src.Width;
  OldHeight := Src.Height;
  NewWidth := Dst.Width;
  NewHeight := Dst.Height;
  zx := NewWidth / OldWidth;
  zy := NewHeight / OldHeight;
  if (zx = 1) and (zy = 1) then
  begin
    Dst.Assign(Src);
    exit;
  end;
  SetLength(darr1, NewWidth);
  SetLength(iarr1, NewWidth);
  SetLength(iarr2, NewWidth);
  for x := 0 to NewWidth - 1 do
  begin
    d := x / zx;
    iarr1[x] := round(d);
    darr1[x] := d - iarr1[x];
    iarr2[x] := round(imin(x + 1, NewWidth - 1) / zx + 0.0000000001); // the 0.0000000001 avoids a Delphi math bug
  end;
  SetLength(tempBmp, NewWidth * OldHeight);
  ////// horizontal
  per1 := 100 / (OldHeight + NewHeight + 0.5);
  if zx > 1 then
  begin
    // zoom-in (linear interpolation)
    for y := 0 to OldHeight - 1 do
    begin
      OldImRow := Src.Scanline[y];
      destIntPtr := @tempBmp[y * newWidth];
      for x := 0 to NewWidth - 1 do
      begin
        iold := iarr1[x];
        diff := darr1[x];
        iold2 := imin(iold + 1, OldWidth - 1);
        a := OldImRow[iold];
        destIntPtr^ := round(a + (((OldImRow[iold2] - a) * diff)));
        inc(destIntPtr);
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * y));
    end;
  end
  else
  begin
    // zoom-out (average)
    for y := 0 to OldHeight - 1 do
    begin
      OldImRow := Src.Scanline[y];
      destIntPtr := @tempBmp[y * newWidth];
      for x := 0 to NewWidth - 1 do
      begin
        iold := iarr1[x];
        iold2 := iarr2[x];
        mm := 0;
        mc := 0;
        for xx := iold to iold2 do
        begin
          inc(mm, OldImRow[xx]);
          inc(mc);
        end;
        destIntPtr^ := mm div mc;
        inc(destIntPtr);
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * y));
    end;
  end;
  // vertical
  if zy > 1 then
  begin
    // zoom-in (linear interpolation)
    for y := 0 to NewHeight - 1 do
    begin
      rold := y / zy;
      iold := trunc(rold);
      diff := rold - iold;
      srcIntPtr := @tempBmp[iold * newWidth];
      destPtr := Dst.Scanline[y];
      if iold + 1 < OldHeight then
        srcIntPtr2 := @tempBmp[(iold + 1) * newWidth]
      else
        srcIntPtr2 := srcIntPtr;
      for x := 0 to NewWidth - 1 do
      begin
        destPtr^ := blimit(round(srcIntPtr^ + (((srcIntPtr2^ - srcIntPtr^) * diff))));
        inc(srcIntPtr);
        inc(srcIntPtr2);

        inc(destPtr);
        
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * (y + OldHeight)));
    end;
  end
  else
  begin
    // zoom-out (average)
    for y := 0 to NewHeight - 1 do
    begin
      iold := round(y / zy);
      iold2 := round(imin(y + 1, NewHeight - 1) / zy);
      destPtr := Dst.Scanline[y];
      for x := 0 to NewWidth - 1 do
      begin
        mm := 0;
        mc := 0;
        srcIntPtr := @tempBmp[x + iold * newWidth];
        for yy := iold to iold2 do
        begin
          inc(mm, srcIntPtr^);
          inc(mc);
          inc(srcIntPtr, newWidth);
        end;
        destPtr^ := blimit(mm div mc);
        inc(destPtr);
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * (y + OldHeight)));
    end;
  end;
end;


// Src and Dst must 16 bit
procedure _ResampleLinear16g(Src, Dst: TIEBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  zx, zy, rold, d, diff: Double;
  iold, iold2, x, y, xx, yy: Integer;
  a, mm, mc: Integer;
  OldWidth, OldHeight, NewWidth, NewHeight: Integer;
  OldImRow: PWordArray;
  darr1: array of Double;
  iarr1, iarr2: array of Integer;
  per1: Double;
  tempBmp: array of Integer;
  destIntPtr, srcIntPtr, srcIntPtr2: PInteger;
  destPtr: PWord;
begin
  if (Src.Width = 0) or (Src.Height = 0) or (Dst.Width = 0) or (Dst.Height = 0) then
    exit;
  OldWidth := Src.Width;
  OldHeight := Src.Height;
  NewWidth := Dst.Width;
  NewHeight := Dst.Height;
  zx := NewWidth / OldWidth;
  zy := NewHeight / OldHeight;
  if (zx = 1) and (zy = 1) then
  begin
    Dst.Assign(Src);
    exit;
  end;
  SetLength(darr1, NewWidth);
  SetLength(iarr1, NewWidth);
  SetLength(iarr2, NewWidth);
  for x := 0 to NewWidth - 1 do
  begin
    d := x / zx;
    iarr1[x] := round(d);
    darr1[x] := d - iarr1[x];
    iarr2[x] := round(imin(x + 1, NewWidth - 1) / zx + 0.0000000001); // the 0.0000000001 avoids a Delphi math bug
  end;
  SetLength(tempBmp, NewWidth * OldHeight);
  ////// horizontal
  per1 := 100 / (OldHeight + NewHeight + 0.5);
  if zx > 1 then
  begin
    // zoom-in (linear interpolation)
    for y := 0 to OldHeight - 1 do
    begin
      OldImRow := Src.Scanline[y];
      destIntPtr := @tempBmp[y * newWidth];
      for x := 0 to NewWidth - 1 do
      begin
        iold := iarr1[x];
        diff := darr1[x];
        iold2 := imin(iold + 1, OldWidth - 1);
        a := OldImRow[iold];
        destIntPtr^ := round(a + (((OldImRow[iold2] - a) * diff)));
        inc(destIntPtr);
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * y));
    end;
  end
  else
  begin
    // zoom-out (average)
    for y := 0 to OldHeight - 1 do
    begin
      OldImRow := Src.Scanline[y];
      destIntPtr := @tempBmp[y * newWidth];
      for x := 0 to NewWidth - 1 do
      begin
        iold := iarr1[x];
        iold2 := iarr2[x];
        mm := 0;
        mc := 0;
        for xx := iold to iold2 do
        begin
          inc(mm, OldImRow[xx]);
          inc(mc);
        end;
        destIntPtr^ := mm div mc;
        inc(destIntPtr);
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * y));
    end;
  end;
  // vertical
  if zy > 1 then
  begin
    // zoom-in (linear interpolation)
    for y := 0 to NewHeight - 1 do
    begin
      rold := y / zy;
      iold := trunc(rold);
      diff := rold - iold;
      srcIntPtr := @tempBmp[iold * newWidth];
      destPtr := Dst.Scanline[y];
      if iold + 1 < OldHeight then
        srcIntPtr2 := @tempBmp[(iold + 1) * newWidth]
      else
        srcIntPtr2 := srcIntPtr;
      for x := 0 to NewWidth - 1 do
      begin
        destPtr^ := wlimit(round(srcIntPtr^ + (((srcIntPtr2^ - srcIntPtr^) * diff))));
        inc(srcIntPtr);
        inc(srcIntPtr2);

        inc(destPtr);
        
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * (y + OldHeight)));
    end;
  end
  else
  begin
    // zoom-out (average)
    for y := 0 to NewHeight - 1 do
    begin
      iold := round(y / zy);
      iold2 := round(imin(y + 1, NewHeight - 1) / zy);
      destPtr := Dst.Scanline[y];
      for x := 0 to NewWidth - 1 do
      begin
        mm := 0;
        mc := 0;
        srcIntPtr := @tempBmp[x + iold * newWidth];
        for yy := iold to iold2 do
        begin
          inc(mm, srcIntPtr^);
          inc(mc);
          inc(srcIntPtr, newWidth);
        end;
        destPtr^ := wlimit(mm div mc);
        inc(destPtr);
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * (y + OldHeight)));
    end;
  end;
end;


// Subsample with filter sx? area of src to dst sizes
// note: works only with 1 bpp images
// the dst bitmap MUST BE ie24RGB
procedure _SubResample1bitFilteredEx(src: TIEBaseBitmap; sx1, sy1, sx2, sy2: Integer; dst: TIEBitmap);
var
  x, y: Integer;
  zdx, zdy, zdx1, zdy1: Double;
  pxx: PRGB;
  wx, wy, t, tt, wy1, wy2, wx1, wx2: Integer;
  rzdy: Integer;
  px2: pbytearray;
  twy1, twy2: array of Integer;
  twx1, twx2: array of Integer;
  bmask: array of Byte;
  dww1, dhh1: Integer;
  srcWidth, srcHeight: Integer;
  dstWidth, dstHeight: Integer;
begin
  srcWidth  := src.Width;
  srcHeight := src.Height;
  dstWidth  := dst.Width;
  dstHeight := dst.Height;

  if (srcWidth = 0) or (srcHeight = 0) or (dstWidth = 0) or (dstHeight = 0) then
    exit;
  dhh1 := dstHeight - 1;
  dww1 := dstWidth - 1;
  // subsample horizontal rate
  zdx := (sx2 - sx1 + 1) / dstWidth;
  // subsample vertical rate
  zdy := (sy2 - sy1 + 1) / dstHeight;
  rzdy := trunc(zdy);
  // precalculate x and y coef
  SetLength(twy1, dstHeight);
  SetLength(twy2, dstHeight);
  for y := 0 to dhh1 do
  begin
    zdy1 := y * zdy;
    twy1[y] := trunc(zdy1 - zdy / 2);
    if twy1[y] < 0 then
      twy1[y] := 0;
    if twy1[y] >= srcHeight then
      twy1[y] := srcHeight - 1;
    twy2[y] := trunc(zdy1 + rzdy / 2);
    if twy2[y] < 0 then
      twy2[y] := 0;
    if twy2[y] >= srcHeight then
      twy2[y] := srcHeight - 1;
  end;
  SetLength(twx1, dstWidth);
  SetLength(twx2, dstWidth);
  for x := 0 to dww1 do
  begin
    zdx1 := x * zdx;
    twx1[x] := trunc(zdx1 - zdx / 2) + sx1;
    if twx1[x] < 0 then
      twx1[x] := 0;
    if (twx1[x] - sx1) > srcWidth then
      twx1[x] := srcWidth - 1;
    twx2[x] := trunc(zdx1 + zdx / 2) + sx1;
    if twx2[x] < 0 then
      twx2[x] := 0;
    if (twx2[x] - sx1) > srcWidth then
      twx2[x] := srcWidth - 1;
  end;
  // precalculate bitmask
  SetLength(bmask, srcWidth);
  for x := 0 to srcWidth - 1 do
    bmask[x] := iebitmask1[x mod 8];
  // subsample
  for y := 0 to dhh1 do
  begin
    pxx := PRGB(dst.Scanline[y]);
    wy1 := twy1[y];
    wy2 := twy2[y];
    for x := 0 to dww1 do
    begin
      wx1 := twx1[x];
      wx2 := twx2[x];
      t := 0;
      tt := 0;
      for wy := wy1 to wy2 do
      begin
        px2 := pbytearray(src.Scanline[wy + sy1]);
        for wx := wx1 to wx2 do
        begin
          if (px2^[wx shr 3] and bmask[wx]) <> 0 then
            inc(tt, 255);
          inc(t);
        end;
      end;
      with pxx^ do
      begin
        r := tt div t;
        g := r;
        b := r;
      end;
      inc(pxx);
    end;
  end;
end;

{
Improved by Michal Smiechowski, DSA Polska Sp. z o.o.. Do not include until actual speed provement is well verified. 
procedure _SubResample1bitFilteredEx(src: TIEBaseBitmap; sx1, sy1, sx2, sy2: Integer; dst: TIEBitmap);
const
  // mask for proper value of bits left
  masklookup: array[1..8] of byte = ($80, $C0, $E0, $F0, $F8, $FC, $FE, $FF);  // bytes reversed
  // bitcount in every byte
  cntlookup: array[0..255] of integer =  (0, 1, 1, 2, 1, 2, 2, 3, 1, 2,
                                          2, 3, 2, 3, 3, 4, 1, 2, 2, 3,
                                          2, 3, 3, 4, 2, 3, 3, 4, 3, 4,
                                          4, 5, 1, 2, 2, 3, 2, 3, 3, 4,
                                          2, 3, 3, 4, 3, 4, 4, 5, 2, 3,
                                          3, 4, 3, 4, 4, 5, 3, 4, 4, 5,
                                          4, 5, 5, 6, 1, 2, 2, 3, 2, 3,
                                          3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
                                          2, 3, 3, 4, 3, 4, 4, 5, 3, 4,
                                          4, 5, 4, 5, 5, 6, 2, 3, 3, 4,
                                          3, 4, 4, 5, 3, 4, 4, 5, 4, 5,
                                          5, 6, 3, 4, 4, 5, 4, 5, 5, 6,
                                          4, 5, 5, 6, 5, 6, 6, 7, 1, 2,
                                          2, 3, 2, 3, 3, 4, 2, 3, 3, 4,
                                          3, 4, 4, 5, 2, 3, 3, 4, 3, 4,
                                          4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
                                          2, 3, 3, 4, 3, 4, 4, 5, 3, 4,
                                          4, 5, 4, 5, 5, 6, 3, 4, 4, 5,
                                          4, 5, 5, 6, 4, 5, 5, 6, 5, 6,
                                          6, 7, 2, 3, 3, 4, 3, 4, 4, 5,
                                          3, 4, 4, 5, 4, 5, 5, 6, 3, 4,
                                          4, 5, 4, 5, 5, 6, 4, 5, 5, 6,
                                          5, 6, 6, 7, 3, 4, 4, 5, 4, 5,
                                          5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
                                          4, 5, 5, 6, 5, 6, 6, 7, 5, 6,
                                          6, 7, 6, 7, 7, 8);
var
  x, y: Integer;
  zdx, zdy, zdx1, zdy1: single;
  pxx: PRGB;
  wx, wy, t, tt, wy1, wy2, wx1, wx2: Integer;
  rzdy: Integer;
  px2: pbytearray;
  twy1, twy2: pintegerarray;
  twx1, twx2: pintegerarray;
  dww1, dhh1: Integer;

  tblsum, tblt: pintegerarray; // sums in row and cell size in row
  currxlen, bleft: Integer;
  mask: Integer;
  xindex: Integer;
  srcborder: Integer;
  b: byte;
  b2: byte;
begin
  if (src.Width = 0) or (src.Height = 0) or (dst.Width = 0) or (dst.Height = 0) then
    exit;
  dhh1 := dst.height - 1;
  dww1 := dst.width - 1;
  // subsample horizontal rate
  zdx := (sx2 - sx1 + 1) / dst.width;
  // subsample vertical rate
  zdy := (sy2 - sy1 + 1) / dst.height;
  rzdy := trunc(zdy);
  // precalculate x and y coef
  getmem(twy1, dst.height * sizeof(integer));
  getmem(twy2, dst.height * sizeof(integer));
  for y := 0 to dhh1 do
  begin
    zdy1 := y * zdy;
    twy1^[y] := trunc(zdy1 - zdy / 2);
    if twy1^[y] < 0 then
      twy1^[y] := 0;
    if twy1^[y] >= src.Height then
      twy1^[y] := src.Height - 1;
    twy2^[y] := trunc(zdy1 + rzdy / 2);
    if twy2^[y] < 0 then
      twy2^[y] := 0;
    if twy2^[y] >= src.Height then
      twy2^[y] := src.Height - 1;
  end;
  getmem(twx1, dst.width * sizeof(integer));
  getmem(twx2, dst.width * sizeof(integer));
  x := 0;
  begin
    zdx1 := x * zdx;
    twx1^[x] := trunc(zdx1 - zdx / 2) + sx1;
    if twx1^[x] < 0 then
      twx1^[x] := 0;
    if (twx1^[x] - sx1) > src.Width then
      twx1^[x] := src.Width - 1;
    twx2^[x] := trunc(zdx1 + zdx / 2) + sx1;
    if twx2^[x] < 0 then
      twx2^[x] := 0;
    if (twx2^[x] - sx1) > src.Width then
      twx2^[x] := src.Width - 1;
  end;
  for x := 1 to dww1 do
  begin
    zdx1 := x * zdx;
    twx1^[x] := twx2^[x - 1];
    twx2^[x] := trunc(zdx1 + zdx / 2) + sx1;
    if twx2^[x] < 0 then
      twx2^[x] := 0;
    if (twx2^[x] - sx1) > src.Width then
      twx2^[x] := src.Width - 1;
  end;

  // subsample
  getmem(tblsum, dst.Width * sizeof(integer));
  getmem(tblt, dst.Width * sizeof(integer));
  for y := 0 to dhh1 do
  begin
    ZeroMemory(tblsum, dst.Width * sizeof(integer));  // cleanup for every row
    ZeroMemory(tblt, dst.Width * sizeof(integer));

    pxx := PRGB(dst.scanline[y]);
    wy1 := twy1^[y];
    wy2 := twy2^[y];

    for wy := wy1 to wy2 do
    begin
      px2 := pbytearray(src.scanline[wy + sy1]);  // current row

      // init - read first required byte
      xindex := twx1^[0] shr 3;        // first byte address
      bleft := 8 - (twx1^[0] and $7);  // numbers of bits left in first byte
      b := px2^[xindex];
      b := b shl (8 - bleft);

      // counting in cells in whole row
      // last bit is left for next cell
      for x := 0 to dww1 do // cells
      begin
        currxlen := twx2^[x] - twx1^[x] + 1;  // cell length
        tblt^[x] := tblt^[x] + currxlen;
        t := 0;
        // last bit left for another cell
        while currxlen > 0 do
        begin
          if bleft < currxlen then
          begin // left < length
            mask := masklookup[bleft];
            t := t + cntlookup[b and mask];
            currxlen := currxlen - bleft;
            bleft := 8;
            inc(xindex);
            b := px2^[xindex];
          end
          else  // if bleft >= currxlen then
          begin // left >= length
            mask := masklookup[currxlen];
            t := t + cntlookup[b and mask];
            bleft := bleft - currxlen + 1;
            b := b shl (currxlen - 1);
            currxlen := 0;
          end;
        end;
        tblsum^[x] := tblsum^[x] + t;
      end;
    end;

    // dest points
    for x := 0 to dww1 do
    begin
      with pxx^ do
      begin
        b2 := (255 * tblsum^[x]) div tblt^[x]; // writing to r and then g := r; b := r generated very strange asm code in D7
        r := b2;
        g := b2; // r;
        b := b2; // r;
      end;
      inc(pxx);
    end;
  end;
  freemem(tblt);
  freemem(tblsum);

  freemem(twy1);
  freemem(twy2);
  freemem(twx1);
  freemem(twx2);
end; }

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

/////////////////////////////////////////////////////////////////////////////////////
// VertHist and HorizHist are outputs
// norm_vert, norm_horiz are inputs

{!!
<FS>TImageEnProc.CalcDensityHistogram

<FM>Declaration<FC>
procedure CalcDensityHistogram(VertHist, HorizHist: Pointer; norm_vert, norm_horiz: Integer);

<FM>Description<FN>
Calculates the vertical horizontal density histograms.

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageAnalysis\DensityAnalysis\DensityAnalysis.dpr </C> </R>
</TABLE>

<IMG help_images\Density.jpg>
!!}
procedure TImageEnProc.CalcDensityHistogram(VertHist, HorizHist: pointer; norm_vert, norm_horiz: Integer);
var
  fSX1, fSY1, fSX2, fSY2: Integer;
  fPolyS: PPointArray;
  fPolySCount: Integer;
  tmpbmp: TIEBitmap;
  mask: TIEMask;
begin
  if not MakeConsistentBitmap([]) then
    exit;
  GetReSel(fSX1, fSY1, fSX2, fSY2, fPolyS, fPolySCount, mask);
  if assigned(mask) and (not mask.IsEmpty) then
  begin
    tmpbmp := TIEBitmap.Create;
    tmpbmp.Allocate(mask.x2 - mask.x1 + 1, mask.y2 - mask.y1 + 1, fIEBitmap.PixelFormat);
    fIEBitmap.CopyRectTo(tmpbmp, mask.x1, mask.y1, 0, 0, tmpbmp.Width, tmpbmp.Height, false);
    _CalcDensityHistogram(tmpbmp, 0, 0, tmpbmp.width, tmpbmp.height, fOnProgress, self, VertHist, HorizHist, norm_vert, norm_horiz);
    FreeAndNil(tmpbmp);
  end
  else
    _CalcDensityHistogram(fiebitmap, fSx1, fSy1, fSx2, fSy2, fOnProgress, self, VertHist, HorizHist, norm_vert, norm_horiz);
  DoFinishWork;
end;

// for ie24RGB and ie1g
// VertHist and HorizHist are outputs
// norm_vert, norm_horiz are inputs

procedure _CalcDensityHistogram(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject; VertHist, HorizHist: pintegerarray; norm_vert, norm_horiz: Integer);
var
  col, row, pp: Integer;
  ppx: pRGB;
  per1: Double;
  bx: pbyte;
  tb: byte;
  bb, i, vmax, hmax, ww, hh: Integer;
  RedToGrayCoef, GreenToGrayCoef, BlueToGrayCoef: Integer;
begin
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  if Bitmap.Pixelformat = ie24RGB then
  begin
    // ie24RGB
    RedToGrayCoef   := IEGlobalSettings().RedToGrayCoef;
    GreenToGrayCoef := IEGlobalSettings().GreenToGrayCoef;
    BlueToGrayCoef  := IEGlobalSettings().BlueToGrayCoef;
    for col := fSelX1 to fSelX2 do
      HorizHist[col - fSelX1] := 0;
    for row := fSelY1 to fSelY2 do
    begin
      ppx := bitmap.ScanLine[row];
      inc(ppx, fSelX1);
      VertHist[row - fSelY1] := 0;
      for col := fSelX1 to fSelX2 do
      begin
        with ppx^ do
          pp := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;
        inc(VertHist[row - fSelY1], pp);
        inc(HorizHist[col - fSelX1], pp);
        inc(ppx);
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1)));
    end;
  end
  else
  if Bitmap.Pixelformat = ie1g then
  begin
    // ie1g
    for col := fSelX1 to fSelX2 do
      HorizHist[col - fSelX1] := 0;
    for row := fSelY1 to fSelY2 do
    begin
      bx := Bitmap.Scanline[row];
      inc(bx, fSelX1 shr 3);
      bb := 7 - (fSelX1 and 7);
      tb := bx^;
      VertHist[row - fSelY1] := 0;
      for col := fSelX1 to fSelX2 do
      begin
        if (bx^ and (1 shl bb)) <> 0 then
        begin
          inc(VertHist[row - fSelY1]);
          inc(HorizHist[col - fSelX1]);
        end;
        dec(bb);
        if bb = -1 then
        begin
          bx^ := tb;
          inc(bx);
          tb := bx^;
          bb := 7;
        end;
      end;
      if bb < 7 then
        bx^ := tb;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1)));
    end;
  end;
  // normalize outputs
  ww := fSelX2 - fSelX1 + 1;
  hh := fSelY2 - fSelY1 + 1;
  vmax := VertHist[0];
  for i := 1 to hh - 1 do
    if VertHist[i] > vmax then
      vmax := VertHist[i];
  hmax := HorizHist[0];
  for i := 1 to ww - 1 do
    if HorizHist[i] > hmax then
      hmax := HorizHist[i];
  if vmax <> 0 then
    for i := 0 to hh - 1 do
      VertHist[i] := trunc((VertHist[i] / vmax) * norm_vert);
  if hmax <> 0 then
    for i := 0 to ww - 1 do
      HorizHist[i] := trunc((HorizHist[i] / hmax) * norm_horiz);
end;

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

{!!
<FS>TImageEnProc.RemoveIsolatedPixels

<FM>Declaration<FC>
procedure RemoveIsolatedPixels(NoiseColor: Integer; PixelsCount: Integer);

<FM>Description<FN>
Removes all groups of isolated pixels within a black and white image.
<FC>NoiseColor<FN> specifies the "text" color, 0 is black and 1 is white (for example if you have a document where the text is black NoiseColor must be 0, otherwise it must be 1).
<FC>PixelsCount<FN> specifies the isolated pixel block size to remove (e.g. 1 for single pixels, 2 for a pair of isolated pixels, etc.)

Note: Only works with black & white images (1bit).

<FM>Example<FC>
// removes single isolated pixels (black pixels)
ImageEnProc.RemoveIsolatedPixels(0, 1);

// removes groups of two isolated pixels (black pixels)
ImageEnProc.RemoveIsolatedPixels(0, 2);

!!}
procedure TImageEnProc.RemoveIsolatedPixels(NoiseColor: Integer; PixelsCount: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if PixelsCount = 0 then
    exit;
  if not BeginImageProcessing([ie1g], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_REMOVEISOLATEDPIXELS, [NoiseColor, PixelsCount]),
                              {$ELSE}
                              IEMsg( IEMsg_REMOVEISOLATEDPIXELS ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_REMOVEISOLATEDPIXELS ) then
    exit;
  IERemoveIsolatedPixels1Bit(ProcBitmap, x1, y1, x2, y2, NoiseColor <> 0, PixelsCount, fOnProgress, Self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

type TIEBlackWhiteFloodFillItem = record
  yy, xl, xr, dy: Integer;
end;

// black/white flood fill
// if invertFoundPixels=true, then all found pixels become inverted in "bitmap" (useful to mark explored pixels)
// pixelCount = out value which counts how many pixels has been found
type TIEBlackWhiteFloodFill = class
private
  m_bitmap: TIEBitmap;
  m_pixelCount: integer;
  m_map: TIEArrayOfByte;
  m_rect: TRect;
  m_buffer: array of TIEBlackWhiteFloodFillItem;
public
  constructor Create(Bitmap: TIEBitmap);
  procedure Process(x, y: Integer; invertFoundPixels: boolean);
  property PixelCount: integer read m_pixelCount;
  property Map: TIEArrayOfByte read m_map;
  property Rect: TRect read m_rect;
end;

constructor TIEBlackWhiteFloodFill.Create(Bitmap: TIEBitmap);
begin
  m_bitmap := Bitmap;
  SetLength(m_map, m_bitmap.Width * m_bitmap.Height);
  SetLength(m_buffer, 2 * m_bitmap.Width);
end;

procedure TIEBlackWhiteFloodFill.Process(x, y: Integer; invertFoundPixels: boolean);
var
  dy, sp, start, x1, x2: Integer;
  c: Integer;
  seed_color: boolean;
  enter: Boolean;
  bitmapWidth, bitmapHeight: Integer;

  function PixelIsMatch(): Boolean;
  begin
    if (x >= BitmapWidth) or (y >= bitmapHeight) then
      result := false
    else
      result := m_bitmap.Pixels_ie1g[x, y] = seed_color;  // if optimization is required check if works with inverted images
  end;

begin
  bitmapWidth  := m_bitmap.Width;
  bitmapHeight := m_bitmap.Height;
  m_pixelCount := 0;
  if (x < 0) or (x >= bitmapWidth) or (y < 0) or (y >= bitmapHeight) then
    exit;
  FillChar(m_map[0], bitmapWidth * bitmapHeight, 0);
  seed_color := m_bitmap.Pixels_ie1g[x, y];
  start := 0;
  sp := 0;
  m_buffer[sp].yy := y;
  m_buffer[sp].xl := x;
  m_buffer[sp].xr := x;
  m_buffer[sp].dy := 1;
  inc(sp);
  m_buffer[sp].yy := y + 1;
  m_buffer[sp].xl := x;
  m_buffer[sp].xr := x;
  m_buffer[sp].dy := -1;
  inc(sp);
  m_rect.Left   := 2147483647;
  m_rect.Top    := 2147483647;
  m_rect.Right  := 0;
  m_rect.Bottom := 0;
  while sp > 0 do
  begin
    dec(sp);
    if sp < 0 then
      break;
    if sp > length(m_buffer) - 1 then
      SetLength(m_buffer, length(m_buffer) * 2);
    dy := m_buffer[sp].dy;
    y  := m_buffer[sp].yy + dy;
    x1 := m_buffer[sp].xl;
    x2 := m_buffer[sp].xr;
    x := x1;
    if (y >= 0) and (y < bitmapHeight) then
    begin
      c := m_map[y * bitmapWidth + x];
      while (x >= 0) and (x < bitmapWidth) and PixelIsMatch() and (c = 0) do
      begin
        m_map[y * bitmapWidth + x] := 1;
        inc(m_pixelCount);
        if invertFoundPixels then
          m_bitmap.Pixels_ie1g[x, y] := not seed_color;
        if x < m_rect.Left then
          m_rect.Left := x;
        if x > m_rect.Right then
          m_rect.Right := x;
        if y < m_rect.Top then
          m_rect.Top := y;
        if y > m_rect.Bottom then
          m_rect.Bottom := y;
        dec(x);
        if x < 0 then
          break;
        c := m_map[y * bitmapWidth + x];
      end;
    end;
    if (y < 0) then
      continue;
    if (y >= bitmapHeight) then
      dy := -dy;
    enter := (x >= x1);
    if not enter then
    begin
      start := x + 1;
      if (start < x1) then
      begin
        m_buffer[sp].yy := y;
        m_buffer[sp].xl := start;
        m_buffer[sp].xr := x1 - 1;
        m_buffer[sp].dy := -dy;
        inc(sp);
        if (sp < 0) then
          break;
        if sp > length(m_buffer) - 1 then
          SetLength(m_buffer, length(m_buffer) * 2);
      end;
      x := x1 + 1;
    end;
    repeat
      if not enter then
      begin
        if (y >= 0) and (y < bitmapHeight) then
        begin
          if x < bitmapWidth then
            c := m_map[y * bitmapWidth + x]
          else
            c := 0;
          while (x >= 0) and (x < bitmapWidth) and PixelIsMatch() and (c = 0) do
          begin
            m_map[y * bitmapWidth + x] := 1;
            inc(m_pixelCount);
            if invertFoundPixels then
              m_bitmap.Pixels_ie1g[x, y] := not seed_color;
            if x < m_rect.Left then
              m_rect.Left := x;
            if x > m_rect.Right then
              m_rect.Right := x;
            if y < m_rect.Top then
              m_rect.Top := y;
            if y > m_rect.Bottom then
              m_rect.Bottom := y;
            inc(x);
            if x = bitmapWidth then
              break;
            c := m_map[y * bitmapWidth + x];
          end;
        end;
        m_buffer[sp].yy := y;
        m_buffer[sp].xl := start;
        m_buffer[sp].xr := x - 1;
        m_buffer[sp].dy := dy;
        inc(sp);
        if sp < 0 then
          break;
        if sp > length(m_buffer) - 1 then
          SetLength(m_buffer, length(m_buffer) * 2);
        if (x > (x2 + 1)) then
        begin
          m_buffer[sp].yy := y;
          m_buffer[sp].xl := x2 + 1;
          m_buffer[sp].xr := x - 1;
          m_buffer[sp].dy := -dy;
          inc(sp);
          if sp < 0 then
            break;
          if sp > length(m_buffer) - 1 then
            SetLength(m_buffer, length(m_buffer) * 2);
        end;
      end
      else
        enter := false;
      inc(x);
      if (y >= 0) and (y < bitmapHeight) then
      begin
        if x < bitmapWidth then
          c := m_map[y * bitmapWidth + x]
        else
          c := 0;
        if (x2 >= bitmapWidth) then
          x2 := bitmapWidth - 1;
        while (x <= x2) and ((not PixelIsMatch()) or (c = 1)) do
        begin
          inc(x);
          if x = bitmapWidth then
            break;
          c := m_map[y * bitmapWidth + x];
        end;
      end;
      start := x;
    until not (x <= x2);
    if sp > length(m_buffer) - 1 then
      SetLength(m_buffer, length(m_buffer) * 2);
  end;
end;

procedure IERemoveIsolatedPixels1Bit(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; NoiseColor: boolean; IsolationMax: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  col, row: integer;
  workbmp: TIEBitmap;
  x, y: integer;
  bitmapWidth: integer;
  floodFill: TIEBlackWhiteFloodFill;
  per1: Double;
begin
  if (IsolationMax = 0) or (Bitmap.Pixelformat <> ie1g) then
    exit;
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  bitmapWidth := bitmap.Width;
  if Bitmap.Pixelformat = ie1g then
  begin
    workbmp := TIEBitmap.Create(bitmap);
    floodFill := TIEBlackWhiteFloodFill.Create(workbmp);
    for row := fSelY1 to fSelY2 do
    begin
      for col := fSelX1 to fSelX2 do
      begin
        if workbmp.Pixels_ie1g[col, row] = NoiseColor then
        begin
          floodFill.Process(col, row, true);
          if floodFill.PixelCount <= IsolationMax then
            for y := floodFill.Rect.Top to floodFill.Rect.Bottom do
              for x := floodFill.Rect.Left to floodFill.Rect.Right do
                if floodFill.Map[y * bitmapWidth + x] <> 0 then
                  bitmap.Pixels_ie1g[x, y] := not NoiseColor;
        end;
      end;

      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1)));
    end;
    floodFill.Free();
    workbmp.Free();
  end;
end;


/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// Kfill - binary noise removal from "Practical Algorithms for Image Analysis" - Seul - O'Gorman - J.Sammon
const
  kf_MAXKMAX = 21;
  kf_DFLTDIRTY = 0;
  kf_MIN0RUN = 5;
  kf_FILLINITIAL = false;

type
  tpintegerarray = array[0..maxint div 16] of pintegerarray;
  ppintegerarray = ^tpintegerarray;
  tpbyte = array[0..maxint div 16] of pbytearray;
  ppbyte = ^tpbyte;

  kf_rec = record
    _OFF, _ON: Integer; // initial/final values of pixels
    FILL0, FILL1: byte; // values of OFF fill, ON fill
    fDiff: Integer; // fNum difference from default
    cFlag: Boolean; // if =1, retain connectivity; if 0, don't
    eFlag: Boolean; // if =1, retain endpoint; if 0, don't
    imgSizex, imgSizey: Integer;
    ySizeM1, xSizeM1: Integer; // y, x lengths minus 1
    xRun: ppintegerarray; // no., then x locns of 1/0 runs for each y
    image: TIEWorkBitmap;
  end;

function kf_GetPByte(image: TIEWorkBitmap; row, col: Integer): pbyte;
begin
  if col >= image.Width then // no need to check for all row,col ranges
    col := image.Width - 1;
  with image do
    result := pbyte(uint64(Bits) + uint64((Height - row - 1) * Rowlen + col));
end;

function kf_ksize(x, y, kMax: Integer; fillFlag: Boolean; var rc: kf_rec): Integer;
var
  xMask, yMask, xEnd, yEnd, k: Integer;
  upHalf, downHalf, xStart, yStart: Integer;
  px: pbyte;
begin
  with rc do
  begin
    if (fillFlag = false) then
    begin
      if (kf_GetPByte(image, y, x)^ <= FILL0) then
      begin
        result := 0;
        exit;
      end
      else
      if (kMax = 3) then
      begin
        result := 3;
        exit;
      end;
    end
    else
    begin
      if (kf_GetPByte(image, y, x)^ >= FILL1) then
      begin
        result := 0;
        exit;
      end
      else
      if (kMax = 3) then
      begin
        result := 3;
        exit;
      end;
    end;
    for k := 4 to kMax do
    begin
      if (k and 1 = 1) then
      begin
        upHalf := (k - 3) shr 1;
        downHalf := upHalf;
      end
      else
      begin
        upHalf := (k - 2) shr 1;
        downHalf := (k - 4) shr 1;
      end;
      xStart := x - downHalf;
      xEnd := x + upHalf;
      yStart := y - downHalf;
      yEnd := y + upHalf;
      if ((xStart <= 0) or (yStart <= 0) or (xEnd >= (imgSizex - 1)) or (yEnd >= ySizeM1)) then
      begin
        result := (k - 1);
        exit;
      end;
      for yMask := yStart to yEnd do
      begin
        px := image.scanline[yMask];
        inc(px, xStart);
        for xMask := xStart to xEnd do
        begin
          if (fillFlag = false) then
          begin
            if (px^ < FILL0) then
            begin
              result := (k - 1);
              exit;
            end;
          end
          else
          if (px^ > FILL1) then
          begin
            result := (k - 1);
            exit;
          end;
          inc(px);
        end;
      end;
    end;
    result := kMax;
  end;
end;

function kf_getring(x, y, k: Integer; fillFlag: Boolean; ring: pinteger; var rc: kf_rec): Integer;
var
  xEnd, yEnd, i, xStart, yStart: Integer;
  upHalf, downHalf: Integer;
  px: pbyte;
begin
  with rc do
  begin
    if (k and 1 = 1) then
    begin
      upHalf := (k - 1) shr 1;
      downHalf := upHalf;
    end
    else
    begin
      upHalf := k shr 1;
      downHalf := (k - 2) shr 1;
    end;
    xStart := x - downHalf;
    xEnd := x + upHalf;
    yStart := y - downHalf;
    yEnd := y + upHalf;
    i := 0;
    ring^ := 0;
    if (fillFlag = false) then
    begin
      px := image.scanline[yStart];
      inc(px, xStart);
      for x := xStart to xEnd do
      begin
        if (px^ >= FILL0) then
          ring^ := ring^ or (01 shl i);
        inc(i);
        inc(px);
      end;
      px := kf_GetPByte(image, yStart + 1, xEnd);
      for y := yStart + 1 to yEnd do
      begin
        if (px^ >= FILL0) then
          ring^ := ring^ or (01 shl i);
        inc(i);
        dec(px, image.rowlen);
      end;
      px := image.scanline[yEnd];
      inc(px, xEnd - 1);
      for x := xEnd - 1 downto xStart do
      begin
        if (px^ >= FILL0) then
          ring^ := ring^ or (01 shl i);
        inc(i);
        dec(px);
      end;
      px := kf_GetPByte(image, yEnd - 1, xStart);
      for y := yEnd - 1 downto yStart + 1 do
      begin
        if (px^ >= FILL0) then
          ring^ := ring^ or (01 shl i);
        inc(i);
        inc(px, image.rowlen);
      end;
    end
    else
    begin
      px := image.scanline[yStart];
      inc(px, xStart);
      for x := xStart to xEnd do
      begin
        if (px^ > FILL1) then
          ring^ := ring^ or (01 shl i);
        inc(i);
        inc(px);
      end;
      px := kf_GetPByte(image, yStart + 1, xEnd);
      for y := yStart + 1 to yEnd do
      begin
        if (px^ > FILL1) then
          ring^ := ring^ or (01 shl i);
        inc(i);
        dec(px, image.rowlen);
      end;
      px := image.scanline[yEnd];
      inc(px, xEnd - 1);
      for x := xEnd - 1 downto xStart do
      begin
        if (px^ > FILL1) then
          ring^ := ring^ or (01 shl i);
        inc(i);
        dec(px);
      end;
      px := kf_GetPByte(image, yEnd - 1, xStart);
      for y := yEnd - 1 downto yStart + 1 do
      begin
        if (px^ > FILL1) then
          ring^ := ring^ or (01 shl i);
        inc(i);
        inc(px, image.rowlen);
      end;
    end;
    result := 0;
  end;
end;

function kf_fillsqr(x, y, k: Integer; fillFlag: Boolean; nFill: pinteger; var rc: kf_rec): Integer;
var
  xEnd, yEnd: Integer;
  upHalf, downHalf, yStart, xStart: Integer;
  px: pbyte;
begin
  with rc do
  begin
    if (k = 3) then
    begin
      if (fillFlag = false) then
      begin
        if (kf_GetPByte(image, y, x)^ > FILL0) then
        begin
          inc(nFill^);
          kf_GetPByte(image, y, x)^ := FILL0;
        end;
      end
      else
      begin
        if (kf_GetPByte(image, y, x)^ < FILL1) then
        begin
          inc(nFill^);
          kf_GetPByte(image, y, x)^ := FILL1;
        end;
      end;
    end
    else
    begin
      if (k and 1 = 1) then
      begin
        upHalf := (k - 3) shr 1;
        downHalf := upHalf;
      end
      else
      begin
        upHalf := (k - 2) shr 1;
        downHalf := (k - 4) shr 1;
      end;
      xStart := x - downHalf;
      xEnd := x + upHalf;
      yStart := y - downHalf;
      yEnd := y + upHalf;
      for y := yStart to yEnd do
      begin
        px := image.scanline[y];
        inc(px, xStart);
        for x := xStart to xEnd do
        begin
          if (fillFlag = false) then
          begin
            if (px^ > FILL0) then
            begin
              inc(nFill^);
              px^ := FILL0;
            end;
          end
          else
          if (px^ < FILL1) then
          begin
            inc(nFill^);
            px^ := FILL1;
          end;
          inc(px);
        end;
      end;
    end;
    result := 0;
  end;
end;

function kf_fill(f0Table, f1Table: ppbyte; fillFlag: Boolean; kMax: Integer; change: pintegerarray; nFill: pinteger; var rc: kf_rec): Integer;
var
  x, y, xStart, xEnd, iXRun, k, kM1: Integer;
  ring, nChange, fillValue: Integer;
begin
  with rc do
  begin
    nChange := 0;
    for y := 1 to ySizeM1 - 1 do
    begin
      iXRun := 1;
      x := 1;
      while iXRun <= xRun[y][0] do
      begin
        xStart := xRun[y][iXRun] - kMax + 2;
        if (xStart > x) then
          xStart := xStart
        else
          xStart := x;
        xEnd := xRun[y][iXRun + 1] + kMax - 2;
        if (xEnd > xSizeM1) then
          xEnd := xSizeM1;
        x := xStart;
        while x <= xEnd do
        begin
          k := kf_ksize(x, y, kMax, fillFlag, rc);
          if (k > 3) then
            kM1 := k - 1
          else
            kM1 := 3;
          while (k >= kM1) do
          begin
            kf_getring(x, y, k, fillFlag, @ring, rc);
            if (fillFlag = false) then
              fillValue := f0Table[k - 3][ring]
            else
              fillValue := f1Table[k - 3][ring];
            if (fillValue = 1) then
            begin
              inc(nChange);
              inc(change[k]);
              kf_fillsqr(x, y, k, fillFlag, nFill, rc);
              break;
            end;
            dec(k);
          end;
          inc(x);
        end;
        inc(iXRun, 2);
      end;
    end;
    result := nChange;
  end;
end;

function kf_filltest(pack, k, fill01: Integer; var rc: kf_rec): Integer;
var
  nRing, n, i: Integer;
  ring: pbytearray;
  fNum, cNum, m: Integer;
  lower, upper: Integer;
  nCornerOn, fNumThresh: Integer;
begin
  with rc do
  begin
    getmem(ring, 4 * (k - 1));
    try
      // unpack ring from word to array
      nRing := 4 * k - 4;
      for i := 0 to nRing - 1 do
        ring[i] := (pack shr i) and 01;
      // calculate CNUM, first skipping corners
      cNum := 0;
      i := 2;
      while i < nRing do
      begin
        lower := ring[i - 1];
        if ((i mod (k - 1)) = 0) then
          inc(i); // skip the corner pixels
        upper := ring[i];
        if ((upper <> 0) and (lower = 0)) then
          inc(cNum);
        inc(i);
      end;
      if ((ring[1] <> 0) and (ring[nRing - 1] = 0)) then
        inc(cNum);
      // CNUM at corners
      nCornerOn := 0;
      for n := 1 to 4 - 1 do
      begin
        m := n * (k - 1);
        if (ring[m] <> 0) then
        begin
          if ((ring[m - 1] = 0) and (ring[m + 1] = 0)) then
            inc(cNum);
          inc(nCornerOn);
        end;
      end;
      if (ring[0] <> 0) then
      begin
        if ((ring[1] = 0) and (ring[nRing - 1] = 0)) then
          inc(cNum);
        inc(nCornerOn);
      end;
      // calculate FNUM
      if (fill01 = FILL1) then
      begin
        fNum := 0;
        for i := 0 to nRing - 1 do
          if (ring[i] <> 0) then
            inc(fNum);
      end
      else
      begin
        fNum := 0;
        for i := 0 to nRing - 1 do
          if (ring[i] = 0) then
            inc(fNum);
      end;
      // to fill or not to fill
      if ((cFlag = false) or ((cFlag) and (cNum <= 1))) then
      begin
        fNumThresh := 3 * (k - 1) - 1 + fDiff;
        if ((fill01 = FILL1) or (eFlag = false)) then
        begin
          if (fNum > fNumThresh) then
          begin
            result := 1;
            exit;
          end;
          if ((fNum = fNumThresh) and (nCornerOn = 2)) then
          begin
            result := 1;
            exit;
          end;
        end
        else
        begin
          if (fNum = nRing) then
          begin
            result := 1;
            exit;
          end;
          if ((fNum = fNumThresh) and (nCornerOn = 2)) then
          begin
            result := 1;
            exit;
          end;
        end;
      end;
      result := 0;
    finally
      freemem(ring);
    end;
  end; // end with
end;

function kf_fill0(f0Table, f1Table: ppbyte; fillFlag: Boolean; kMax: Integer; change: pintegerarray; nONs, nFill: pinteger; var rc: kf_rec): Integer;
var
  x, y, iXRun, k, kM1: Integer;
  ring, nChange, fillValue, onRun: Integer;
  image_px: pbyte;
begin
  with rc do
  begin
    nChange := 0;
    nONs^ := 0;
    for y := 1 to ySizeM1 - 1 do
    begin
      getmem(xRun[y], (imgSizex + 1) * sizeof(integer));
      xRun[y][0] := -kf_MIN0RUN;
      iXRun := 1;
      onRun := 0;
      x := 1;
      image_px := image.scanline[y];
      inc(image_px);
      while x < xSizeM1 do
      begin
        if (image_px^ <= FILL0) then
        begin
          if (onRun = 1) then
          begin
            onRun := 0;
            if (x - 1 >= imgSizex) then
              xRun[y][iXRun] := xSizeM1
            else
              xRun[y][iXRun] := x - 1;
            inc(iXRun);
          end;
        end
        else
        begin
          if (onRun = 0) then
          begin
            onRun := 1;
            if ((x - xRun[y][iXRun - 1]) < kf_MIN0RUN) then
              dec(iXRun)
            else
            begin
              if (x < 0) then
                xRun[y][iXRun] := 1
              else
                xRun[y][iXRun] := x;
              inc(iXRun);
            end;
          end;
          inc(nONs^);
        end;
        k := kf_ksize(x, y, kMax, fillFlag, rc);
        if (k > 3) then
          kM1 := k - 1
        else
          kM1 := 3;
        while (k >= kM1) do
        begin
          kf_getring(x, y, k, fillFlag, @ring, rc);
          if (fillFlag = false) then
            fillValue := f0Table[k - 3][ring]
          else
            fillValue := f1Table[k - 3][ring];
          if (fillValue = 1) then
          begin
            inc(nChange);
            inc(change[k]);
            kf_fillsqr(x, y, k, fillFlag, nFill, rc);
            break;
          end;
          dec(k);
        end;
        inc(x);
        inc(image_px);
      end;
      dec(iXRun);
      if (iXRun and 1 = 1) then
        inc(iXRun);
      xRun[y][iXRun] := x;
      xRun[y][0] := iXRun;
      reallocmem(xRun[y], sizeof(integer) * (iXRun + 1));
    end;
    result := nChange;
  end; // end with
end;

// accepts ie1g and ie8g (for ieg8 a binarized image is built)
procedure _kf_kfill(bitmap: TIEBitmap; RetainConnectivity: Boolean; RetainEndpoints: Boolean; MaxIterations: Integer; WindowSize: Integer; InvertImage: Boolean);
var
  x, y, i, k: Integer;
  f0Table: ppbyte;
  f1Table: ppbyte;
  kMax, maxIter, nTable, nIter, 
    pctDirty, nChange, nChangeB4, 
    nChangeMax, nChangeThresh, 
    nONs, nFill: Integer;
  invertFlag: Boolean;
  fillflag: Boolean;
  change: array[0..kf_MAXKMAX - 1] of integer;
  rc: kf_rec;
  ps, pd: pbyte;
begin
  with rc do
  begin
    // inputs
    fDiff := 0;
    cFlag := RetainConnectivity;
    eFlag := RetainEndpoints;
    maxIter := MaxIterations;
    pctDirty := kf_DFLTDIRTY;
    kMax := WindowSize;
    fillFlag := kf_FILLINITIAL;
    invertFlag := InvertImage;
    //
    imgSizex := bitmap.Width;
    imgSizey := bitmap.Height;
    ySizeM1 := imgSizey - 1;
    xSizeM1 := imgSizex - 1;
    // invert image
    if invertFlag then
      _Negative(bitmap, 0, 0, bitmap.Width, bitmap.Height, nil, nil);
    // create image (working bitmap)
    image := TIEWorkBitmap.Create(bitmap.Width, bitmap.Height, 8);
    fillchar(pbyte(image.Scanline[image.Height - 1])^, image.RowLen * image.Height, 255);
    for y := 0 to image.Height - 1 do
    begin
      ps := bitmap.ScanLine[y];
      pd := image.Scanline[y];
      if bitmap.PixelFormat = ie8g then
      begin
        for x := 0 to image.Width - 1 do
        begin
          if ps^ > 128 then
            pd^ := 255
          else
            pd^ := 0;
          inc(ps);
          inc(pd);
        end;
      end
      else
      begin
        for x := 0 to image.Width - 1 do
        begin
          if (pbytearray(ps)^[x shr 3] and iebitmask1[x and $7]) = 0 then
            pd^ := 0;
          inc(pd);
        end;
      end;
    end;
    //
    getmem(xRun, imgSizey * sizeof(pointer));
    _OFF := 0;
    FILL0 := _OFF + 1;
    _ON := 255;
    FILL1 := _ON - 1;
    // make table of fill-values for FILL0 and FILL1
    getmem(f0Table, (kMax - 2) * sizeof(pointer));
    getmem(f1Table, (kMax - 2) * sizeof(pointer));
    for k := 3 to kMax do
    begin
      nTable := trunc(Power(2.0, 4.0 * (k - 1.0)));
      getmem(f0Table[k - 3], nTable * sizeof(byte));
      getmem(f1Table[k - 3], nTable * sizeof(byte));
      for i := 0 to nTable - 1 do
      begin
        f0Table[k - 3][i] := kf_filltest(i, k, FILL0, rc);
        f1Table[k - 3][i] := kf_filltest(i, k, FILL1, rc);
      end;
    end;
    // zero image borders
    for y := 0 to imgSizey - 1 do
    begin
      kf_GetPByte(image, y, imgSizex - 1)^ := _OFF;
      kf_GetPByte(image, y, 0)^ := _OFF;
    end;
    for x := 0 to imgSizex - 1 do
    begin
      kf_GetPByte(image, ySizeM1, x)^ := _OFF;
      kf_GetPByte(image, 0, x)^ := _OFF;
    end;
    for k := 0 to kMax do
      change[k] := 0;
    // iteratively convolve through image until filled
    // on first iteration, perform filling and accumulate x-run info
    nChange := kf_fill0(f0Table, f1Table, fillFlag, kMax, @change[0], @nONs, @nFill, rc);
    nChangeMax := nChange;
    nChangeThresh := 0;
    nChangeB4 := nChangeThresh + 1;
    for i := 3 to kMax do
      change[i] := 0;
    if (fillFlag = true) then
    begin
      fillFlag := false;
      inc(FILL0);
    end
    else
    begin
      fillFlag := true;
      dec(FILL1);
    end;
    // on subsequent iterations, perform filling
    nIter := 1;
    while (nIter < maxIter) and ((nChange > nChangeThresh) or (nChangeB4 > nChangeThresh)) do
    begin
      nChangeB4 := nChange;
      nChange := kf_fill(f0Table, f1Table, fillFlag, kMax, @change[0], @nFill, rc);
      for i := 3 to kMax do
        change[i] := 0;
      if (fillFlag = true) then
      begin
        inc(FILL0);
        if (nChangeB4 <> 0) then
          fillFlag := false;
      end
      else
      begin
        dec(FILL1);
        if (nChangeB4 <> 0) then
          fillFlag := true;
      end;
      if (nChange > nChangeMax) then
        nChangeMax := nChange;
      nChangeThresh := (pctDirty * nChangeMax) div 100;
      inc(nIter);
    end;
    for y := 1 to ySizeM1 - 1 do
    begin
      pd := image.scanline[y];
      inc(pd);
      for x := 1 to imgSizex - 2 do
      begin
        if (pd^ <= FILL0) then
          pd^ := _OFF
        else
        if (pd^ >= FILL1) then
          pd^ := _ON;
        inc(pd);
      end;
    end;
    // finish, get bitmap from image
    for y := 1 to image.Height - 2 do
    begin
      ps := bitmap.ScanLine[y];
      pd := image.Scanline[y];
      inc(pd);
      if bitmap.PixelFormat = ie8g then
      begin
        inc(ps);
        CopyMemory(ps, pd, bitmap.Width - 2);
      end
      else
      begin
        for x := 1 to image.Width - 2 do
        begin
          _setpixelbw(ps, x, pd^);
          inc(pd);
        end;
      end;
    end;
    //
    for y := 1 to ySizeM1 - 1 do
      freemem(xRun[y]);
    freemem(xRun);
    for k := 3 to kMax do
    begin
      freemem(f0Table[k - 3]);
      freemem(f1Table[k - 3]);
    end;
    freemem(f0Table);
    freemem(f1Table);
    //
    FreeAndNil(image);
  end; // end with
  if invertFlag then
    _Negative(bitmap, 0, 0, bitmap.Width, bitmap.Height, nil, nil);
end;



{!!
<FS>TImageEnProc.RemoveNoise

<FM>Declaration<FC>
procedure RemoveNoise(Iterations: Integer; InvertImage: Boolean);

<FM>Description<FN>
Removes noise pixels using the "Kfill" algorithm from a black & white image.
<FC>Iterations<FN> is the maximum number of processing iterations (1 or more).
If <FC>InvertImage<FN> is True, the image is inverted (negative) during processing.

Note: Only works with black & white images (1bit).

<FM>Example<FC>
ImageEnProc.RemoveNoise(2, false);

!!}
procedure TImageEnProc.RemoveNoise(Iterations: Integer; InvertImage: Boolean);
var
  fSX1, fSY1, fSX2, fSY2: Integer;
  fPolyS: PPointArray;
  fPolySCount: Integer;
  tmpbmp: TIEBitmap;
  mask: TIEMask;
begin
  CheckHaveValidBitmap();

  if Iterations = 0 then
    exit;
  if fAutoUndo then
    SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
              IERS_REMOVENOISE,
              {$ELSE}
              IEMsg( IEMSG_REMOVENOISE ),
              {$ENDIF}
              ieuImage, True, IEOP_REMOVENOISE );
  if not MakeConsistentBitmap([ie1g]) then
    exit;
  GetReSel(fSX1, fSY1, fSX2, fSY2, fPolyS, fPolySCount, mask);
  if assigned(mask) and (not mask.IsEmpty) then
  begin
    tmpbmp := TIEBitmap.Create;
    tmpbmp.Allocate(mask.x2 - mask.x1 + 1, mask.y2 - mask.y1 + 1, fIEBitmap.PixelFormat);
    fIEBitmap.CopyRectTo(tmpbmp, mask.x1, mask.y1, 0, 0, tmpbmp.Width, tmpbmp.Height, false);
    _kf_kfill(tmpbmp, true, true, Iterations, 3, InvertImage);
    mask.CopyIEBitmap(fIEBitmap, tmpbmp, false, true, false);
    FreeAndNil(tmpbmp);
  end
  else
    _kf_kfill(fIEBitmap, true, true, Iterations, 3, InvertImage);
  Update;
  DoFinishWork;
end;

// end of kfill
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////

procedure _IEPaintMark(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; frequency: Integer; color: TRGB; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  col, row: Integer;
  frx, fry: Integer;
  px: PRGB;
  per1: Double;
begin
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  if Bitmap.Pixelformat = ie24RGB then
  begin
    fry := 0;
    for row := fSelY1 to fSelY2 do
    begin
      if fry = 0 then
      begin
        frx := 0;
        px := Bitmap.Scanline[row];
        for col := fSelX1 to fSelX2 do
        begin
          if frx = 0 then
            px^ := color;
          inc(frx);
          if frx > frequency then
            frx := 0;
          inc(px);
        end;
      end;
      inc(fry);
      if fry > frequency then
        fry := 0;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1)));
    end;
  end;
end;

{!!
<FS>TImageEnProc.PaintMark

<FM>Declaration<FC>
procedure PaintMark(Frequency: Integer; Color: <A TRGB>);

<FM>Description<FN>
Draws a pixel of the specified <FC>Color<FN> every <FC>Frequency pixels<FN>, within the selected area.

<FM>Example<FC>
ImageEnProc.PaintMark(1, CreateRGB(0, 0, 0));  // a black marker

Which will have the following effect upon the selected area:
<IMG help_images\67.bmp>

<FM>See Also<FN>
- <A CreateRGB>
- <A TRGB2TColor>
- <A TColor2TRGB>
!!}
procedure TImageEnProc.PaintMark(Frequency: Integer; Color: TRGB);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_PAINTMARK, [Frequency, Color.r, Color.g, Color.b]),
                              {$ELSE}
                              IEMsg( IEMsg_PAINTMARK ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_PAINTMARK ) then
    exit;
  _IEPaintMArk(ProcBitmap, x1, y1, x2, y2, frequency, color, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

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

// images must have some size

{!!
<FS>TImageEnProc.ComputeImageEquality

<FM>Declaration<FC>
function ComputeImageEquality(SecondImage: <A TIEBitmap>; var psnr_min, psnr_max: Double; var mse_min, mse_max: Double; var rmse_min, rmse_max: Double; var pae_min, pae_max: Double; var mae_min, mae_max: Double): Boolean;

<FM>Description<FN>
Calculates the level of similarity between the current image and <FC>SecondImage<FN>. Returns True if the images are identical.

Returned values:
<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>psnr_min, psnr_max<FN></C> <C>Minimum and maximum peak signal to noise ratio</C> </R>
<R> <C><FC>mse_min, mse_max<FN></C> <C>Minimum and maximum mean squared error</C> </R>
<R> <C><FC>rmse_min, rmse_max<FN></C> <C>Minimum and maximum root mean squared error</C> </R>
<R> <C><FC>pae_min, pae_max <FN></C> <C>Minimum and maximum peak absolute error</C> </R>
<R> <C><FC>mae_min, mae_max<FN></C> <C>Minimum and maximum mean absolute error</C> </R>
</TABLE>

Note: The images must be teh same size and of PixelFormat ie24RGB.

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageAnalysis\Compare\Compare.dpr </C> </R>
</TABLE>

<FM>Example<FC>
Var
  psnr_min, psnr_max: Double;
  mse_min, mse_max: Double;
  rmse_min, rmse_max: Double;
  pae_min, pae_max: Double;
  mae_min, mae_max: Double;
..
  if ImageEnView1.Proc.ComputeImageEquality(ImageEnView2.Bitmap, psnr_min, psnr_max, mse_min, mse_max, rmse_min, rmse_max, pae_min, pae_max, mae_min, mae_max) then
    showmessage('Images are equals')
  else
  begin
  // shows the similitude values
  end;

!!}
function TImageEnProc.ComputeImageEquality(SecondImage: TIEBitmap; var psnr_min, psnr_max: Double; var mse_min, mse_max: Double; var rmse_min, rmse_max: Double; var pae_min, pae_max: Double; var mae_min, mae_max: Double): Boolean;
begin
  result := false;
  if not MakeConsistentBitmap([]) then
    exit;
  if (fIEBitmap.PixelFormat <> ie24RGB) or (SecondImage.PixelFormat <> ie24RGB) then
    exit;
  if (fIEBitmap.Width <> SecondImage.Width) or (fIEBitmap.Height <> SecondImage.Height) then
    exit;
  _IEComputeDiff(fIEBitmap, SecondImage, psnr_min, psnr_max, mse_min, mse_max, rmse_min, rmse_max, pae_min, pae_max, mae_min, mae_max, result);
  DoFinishWork;
end;

// must be x.width=y.width and x.height=y.height and x.pixelformat=y.pixelformat
// psnr .... peak signal to noise ratio
// mse ..... mean squared error
// rmse .... root mean squared error
// pae ..... peak absolute error
// mae ..... mean absolute error
// equal ... equality (boolean)
procedure _IEComputeDiff(x, y: TIEBitmap; var psnr_min, psnr_max: Double; var mse_min, mse_max: Double;
  var rmse_min, rmse_max: Double; var pae_min, pae_max: Double;
  var mae_min, mae_max: Double; var equal: Boolean);
var
  compno: Integer;
  msen1, msen2, pae, psnr: Double;
  d: Double;
  i, j: Integer;
  px, py: pbyte;
  xWidth, xHeight: Integer;
begin
  xWidth  := x.Width;
  xHeight := x.Height;
  psnr_min := 1000000000;
  psnr_max := 0;
  mse_min := 1000000000;
  mse_max := 0;
  rmse_min := 1000000000;
  rmse_max := 0;
  pae_min := 1000000000;
  pae_max := 0;
  mae_min := 1000000000;
  mae_max := 0;
  equal := true;
  for compno := 0 to 2 do
  begin
    msen1 := 0;
    msen2 := 0;
    pae := 0;
    for i := 0 to xHeight - 1 do
    begin
      px := x.Scanline[i];
      inc(px, compno);
      py := y.Scanline[i];
      inc(py, compno);
      for j := 0 to xWidth - 1 do
      begin
        d := py^ - px^;
        msen1 := msen1 + abs(d);
        msen2 := msen2 + (d * d);
        if (d > pae) then
          pae := d;
        inc(px, 3);
        inc(py, 3);
      end;
    end;
    msen1 := msen1 / (xHeight * xWidth);
    msen2 := msen2 / (xHeight * xWidth);
    if msen2 <> 0 then
      psnr := 20 * log10(255 / sqrt(msen2))
    else
      psnr := 0;
    //
    if psnr > psnr_max then
      psnr_max := psnr;
    if psnr < psnr_min then
      psnr_min := psnr;
    if msen2 > mse_max then
      mse_max := msen2;
    if msen2 < mse_min then
      mse_min := msen2;
    d := sqrt(msen2);
    if d < rmse_min then
      rmse_min := d;
    if d > rmse_max then
      rmse_max := d;
    if pae < pae_min then
      pae_min := pae;
    if pae > pae_max then
      pae_max := pae;
    if msen1 < mae_min then
      mae_min := msen1;
    if msen1 > mae_max then
      mae_max := msen1;
    if pae <> 0 then
      equal := false;
  end;
end;

{!!
<FS>TImageEnProc.CompareWith

<FM>Declaration<FC>
function CompareWith(SecondImage: <A TIEBitmap>; DiffBitmap: <A TIEBitmap>): Double;

<FM>Description<FN>
Compares the current image with <FC>SecondImage<FN> and returns a floating point value (0 to 1) specifying the percentage of equality. 1 means that two images are equal.
The algorithm compares only the intensity of the pixels, not the colors.

The DiffBitmap can be nil, otherwise it must be an 8 bit bitmap (ie8g or ie8p PixelFormat) which will contain a bitmap with the differences.

Note: The images must be the same size and have a <A TIEBitmap.PixelFormat> of ie24RGB.
        
<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageAnalysis\ImagesDiff\ImagesDiff.dpr </C> </R>
</TABLE>

<FM>Example<FC>
Eq := ImageEnView1.CompareWith( ImageEnView2.IEBitmap, nil );

!!}
function TImageEnProc.CompareWith(SecondImage: TIEBitmap; DiffBitmap: TIEBitmap): Double;
begin
  result := 0;
  if not MakeConsistentBitmap([]) then
    exit;
  result := IECompareImages(fIEBitmap, SecondImage, DiffBitmap);
  DoFinishWork;
end;

// diffmap must be ie8g or ie8p
function IECompareImages(image1, image2: TIEBitmap; diffmap: TIEBitmap): Double;
var
  x, y: Integer;
  w, h: Integer;
  prgb1, prgb2: PRGB;
  i1, i2: Integer;
  di: Integer;
  d: Double;
  dm: pbyte;
  RedToGrayCoef, GreenToGrayCoef, BlueToGrayCoef: Integer;
begin
  if assigned(diffmap) and (diffmap.PixelFormat <> ie8g) and (diffmap.PixelFormat <> ie8p) then
    diffmap := nil;
  w := imin(image1.Width, image2.Width);
  h := imin(image1.Height, image2.Height);
  if assigned(diffmap) then
  begin
    diffmap.Allocate(w, h, diffmap.PixelFormat);
    diffmap.Fill(255);
  end;

  RedToGrayCoef   := IEGlobalSettings().RedToGrayCoef;
  GreenToGrayCoef := IEGlobalSettings().GreenToGrayCoef;
  BlueToGrayCoef  := IEGlobalSettings().BlueToGrayCoef;

  d := 0;
  dm := nil;

  if (image1.PixelFormat = ie24RGB) and (image2.PixelFormat = ie24RGB) then
  begin
    // both images have RGB pixel format, compare directly
    for y := 0 to h - 1 do
    begin
      prgb1 := image1.Scanline[y];
      prgb2 := image2.Scanline[y];
      if assigned(diffmap) then
        dm := diffmap.Scanline[y];
      for x := 0 to w - 1 do
      begin

        with prgb1^ do
          i1 := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;
        with prgb2^ do
          i2 := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;

        di := abs(i1 - i2);
        d := d + di / 255;

        inc(prgb1);
        inc(prgb2);
        if assigned(dm) then
        begin
          dm^ := di;
          inc(dm);
        end;
      end;
    end;
  end
  else
  begin
    // different pixel formats (slow)
    for y := 0 to h - 1 do
    begin
      if assigned(diffmap) then
        dm := diffmap.Scanline[y];
      for x := 0 to w - 1 do
      begin

        with image1.Pixels[x, y] do
          i1 := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;
        with image2.Pixels[x, y] do
          i2 := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;

        di := abs(i1 - i2);
        d := d + di / 255;

        if assigned(dm) then
        begin
          dm^ := di;
          inc(dm);
        end;
      end;
    end;
  end;
  d := d / (w * h);
  result := 1 - d;
end;

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

procedure _IEGammaCorrect_RGB8(ABitmap: TIEBitmap; AGamma: Double; AChannel: TIEChannels; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  LUT: array[byte] of byte;
  C1, C2: Integer;
  px: PRGB;
  per1: Double;
  procedure BuildLUT(AValue: Double); // Build Look-Up-Table
  var
    C1: Integer;
  begin
    for C1 := 0 to 255 do
      LUT[C1] := blimit(Round(Power(C1 / 255, 1 / AValue) * 255));
  end;
  //
begin
  per1 := 100 / ABitmap.Height;
  BuildLUT(AGamma);
  with ABitmap do
    for C1 := 0 to (Height - 1) do
    begin
      px := ScanLine[C1];
      if AChannel = [iecRed, iecGreen, iecBlue] then
      begin
        for C2 := 0 to (width - 1) do
        begin
          with px^ do
          begin
            r := LUT[r];
            g := LUT[g];
            b := LUT[b];
          end;
          inc(px);
        end;
      end
      else
      begin
        for C2 := 0 to (width - 1) do
        begin
          with px^ do
          begin
            if iecRed in AChannel then
              r := LUT[r];
            if iecGreen in AChannel then
              g := LUT[g];
            if iecBlue in AChannel then
              b := LUT[b];
          end;
          inc(px);
        end;
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * C1));
    end;
end;

procedure _IEGammaCorrect_RGB16(ABitmap: TIEBitmap; AGamma: Double; AChannel: TIEChannels; fOnProgress: TIEProgressEvent; Sender: TObject);
type
  TLUT16 = array [0..65535] of word;
  PLUT16 = ^TLUT16;
var
  LUT: PLUT16;
  C1, C2, v: Integer;
  px: PRGB48;
  per1: Double;
  procedure BuildLUT(AValue: Double); // Build Look-Up-Table
  var
    C1: Integer;
  begin
    for C1 := 0 to 65535 do
    begin
      v := Round(Power(C1 / 65535, 1 / AValue) * 65535);
      if v < 0 then
        v := 0
      else
      if v>65535 then
        v := 65535;
      LUT[C1] := v;
    end;
  end;
  //
begin
  getmem(LUT, sizeof(TLUT16));
  per1 := 100 / ABitmap.Height;
  BuildLUT(AGamma);
  with ABitmap do
    for C1 := 0 to (Height - 1) do
    begin
      px := ScanLine[C1];
      if AChannel = [iecRed, iecGreen, iecBlue] then
      begin
        for C2 := 0 to (width - 1) do
        begin
          with px^ do
          begin
            r := LUT[r];
            g := LUT[g];
            b := LUT[b];
          end;
          inc(px);
        end;
      end
      else
      begin
        for C2 := 0 to (width - 1) do
        begin
          with px^ do
          begin
            if iecRed in AChannel then
              r := LUT[r];
            if iecGreen in AChannel then
              g := LUT[g];
            if iecBlue in AChannel then
              b := LUT[b];
          end;
          inc(px);
        end;
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * C1));
    end;
  freemem(LUT);
end;


{!!
<FS>TImageEnProc.GammaCorrect

<FM>Declaration<FC>
procedure GammaCorrect(Gamma: Double; Channel: <A TIEChannels>);

<FM>Description<FN>
Performs a gamma correction.
<FC>Gamma<FN> is the gamma correction value. A value of 1.0 causes no gamma correction processing.
<FC>Channel<FN> is the channel to apply the gamma.

<FM>Example<FC>
// Apply a gamma correction over all channels (RGB)
ImageEnProc.GammaCorrect( 2, [iecRed, iecGreen, iecBlue] );

!!}
procedure TImageEnProc.GammaCorrect(Gamma: Double; Channel: TIEChannels);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB, ie48RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_GAMMACORRECT,
                              {$ELSE}
                              IEMsg( IEMSG_GAMMACORRECTION ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_GAMMACORRECT ) then
    exit;
  case ProcBitmap.PixelFormat of
    ie24RGB: _IEGammaCorrect_RGB8(ProcBitmap, Gamma, Channel, fOnProgress, Self);
    ie48RGB: _IEGammaCorrect_RGB16(ProcBitmap, Gamma, Channel, fOnProgress, Self);
  end;
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

procedure TImageEnProc.SetIEBitmap(bmp: TIEBitmap);
begin
  fBitmap := nil;
  if fIEBitmapCreated then
    FreeAndNil(fIEBitmap);
  fIEBitmapCreated := false;
  fIEBitmap := bmp;
end;

{!!
<FS>TImageEnProc.AttachedIEBitmap

<FM>Declaration<FC>
property AttachedIEBitmap: <A TIEBitmap>;

<FM>Description<FN>
Attach a TImageEnProc to a TIEBitmap to perform image modification and analysis functions on an image.

Note: Using TIEBitmap instead of TBitmap allows TImageEnProc to be thread safe and handle large images.

<FM>Example<FC>
// Load an image with a TIEBitmap, make it negative then save it
var
  iebmp: TIEBitmap;
begin
  iebmp := TIEBitmap.Create;
  ImageEnProc.AttachedIEBitmap := iebmp;
  ImageEnIO.AttachedIEBitmap := iebmp;

  ImageEnIO.LoadFromFile('animage.tif');
  ImageEnProc.Negative;
  ImageEnIO.SaveToFile('output.tif');

  ImageEnIO.Free;
  ImageEnProc.Free;
  iebmp.Free;
end;
!!}
procedure TImageEnProc.SetAttachedIEBitmap(bmp: TIEBitmap);
begin
  if assigned(fImageEnView) then
    fImageEnView.RemoveBitmapChangeEvent(fImageEnViewBitmapChangeHandle); // remove previous if exists
  if (not assigned(bmp)) and (assigned(fImageEnView) or assigned(fTImage)) then
    exit; // error
  SetIEBitmap(bmp);
  if assigned(bmp) then
  begin
    fImageEnView := nil;
    fTImage := nil;
  end;
end;

{!!
<FS>TImageEnProc.AttachedBitmap

<FM>Declaration<FC>
property AttachedBitmap: TBitmap;

<FM>Description<FN>
Attach a TImageEnProc to a TBitmap to perform image modification and analysis functions on an image.

Note: This property is mutually exclusive with <A TImageEnProc.AttachedTImage> and <A TImageEnProc.AttachedImageEn>.

<FM>Example<FC>
// Prompt the user to perform image modification effects on an image in a TImage
ImageEnView1.Proc.AttachedBitmap := Image1.Picture.Bitmap;
ImageEnView1.Proc.DoPreviews([peAll]);
!!}
procedure TImageEnProc.SetAttachedBitmap(atBitmap: TBitmap);
begin
  if assigned(fImageEnView) then
    fImageEnView.RemoveBitmapChangeEvent(fImageEnViewBitmapChangeHandle); // rimuove precedente
  if (not assigned(atBitmap)) and (assigned(fImageEnView) or assigned(fTImage)) then
    exit; // error
  fBitmap := atBitmap;
  fIEBitmap.EncapsulateTBitmap(fBitmap, true);
  if assigned(fBitmap) then
  begin
    fImageEnView := nil;
    fTImage := nil;
  end;
end;

{!!
<FS>TImageEnProc.AttachedImageEn

<FM>Declaration<FC>
property AttachedImageEn: <A TIEView>;

<FM>Description<FN>
Attach <A TImageEnProc> to a <A TImageEnView>, <A TImageEnDBView> or <A TImageEnVect> control.

Notes:
- This property is mutually exclusive with <A TImageEnProc.AttachedTImage> and <A TImageEnProc.AttachedBitmap>.
- Use of this property is not normally required as TImageEnView and descendents already offer a <A TImageEnView.Proc> property

<FM>Example<FC>
ImageEnView1.Proc.AttachedImageEn := ImageEnView1;
!!}
procedure TImageEnProc.SetAttachedImageEn(atImageEn: TIEView);
begin
  if assigned(fImageEnView) then
    fImageEnView.RemoveBitmapChangeEvent(fImageEnViewBitmapChangeHandle);
  fImageEnView := atImageEn;
  if assigned(fImageEnView) then
  begin // fImageEnView now could be nil
    if fIEBitmapCreated then
    begin
      fIEBitmapCreated := false;
      FreeAndNil(fIEBitmap);
    end;
    fIEBitmap := fImageEnView.IEBitmap;
    if assigned(fIEBitmap) then
      // use TIEBitmap
      fBitmap := nil // both fBitmap and fIEBitmap not allowed
    else
    begin
      // use TBitmap
      fBitmap := fImageEnView.Bitmap;
      fIEBitmapCreated := true;
      fIEBitmap := TIEBitmap.Create;
      fIEBitmap.EncapsulateTBitmap(fBitmap, true);
    end;
    fImageEnView.FreeNotification(self);
    fTImage := nil;
    fImageEnViewBitmapChangeHandle := fImageEnView.RegisterBitmapChangeEvent(OnBitmapChange);
  end
  else
  begin
    fIEBitmap := TIEBitmap.Create;
    fIEBitmapCreated := true; // we create fIEBitmap
  end;
end;

{!!
<FS>TImageEnProc.AttachedTImage

<FM>Declaration<FC>
property AttachedTImage: TImage;

<FM>Description<FN>
Use this property to attach TImageEnProc to a TImage (or any other inherited object).

Note: This property is mutually exclusive with <A TImageEnProc.AttachedImageEn> and <A TImageEnProc.AttachedBitmap>.

<FM>Example<FC>
ImageEnView1.Proc.AttachedTImage := Image1;
!!}
procedure TImageEnProc.SetTImage(v: TImage);
begin
  if assigned(fImageEnView) then
    fImageEnView.RemoveBitmapChangeEvent(fImageEnViewBitmapChangeHandle);
  fTImage := v;
  if assigned(fTImage) then
  begin
    fBitmap := fTImage.Picture.Bitmap;
    fIEBitmap.EncapsulateTBitmap(fBitmap, true);
    fTImage.FreeNotification(self);
    fImageEnView := nil;
  end
  else
    fIEBitmap.FreeImage(true);
end;

// this function doesn't SaveUndo
// call UpdateRect if connected to TImageEnView
// just draw a circle at x, y of "Width" size

{!!
<FS>TImageEnProc.PaintPenMarker

<FM>Declaration<FC>
procedure PaintPenMarker(x, y: Integer; Width: Integer = 20; Color: TColor = clYellow; BackgroundColor: TColor = clWhite; Tolerance: Integer = 10);

<FM>Description<FN>
Emulates a pen marker over the image (which must be in true color).

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>x and y<FN></C> <C>Position of the pen in bitmap coordinates</C> </R>
<R> <C><FC>Width<FN></C> <C>The size of the circle</C> </R>
<R> <C><FC>BackgroundColor<FN></C> <C>The background color to change</C> </R>
<R> <C><FC>Color<FN></C> <C>The color that replaces <FC>BackgroundColor<FN></C> </R>
<R> <C><FC>Tolerance<FN></C> <C>The maximum difference from BackgroundColor to allow drawing the marker</C> </R>
</TABLE>

Note: PaintPenMarker doesn't save the previous image into the <A TImageEnProc.Undo> stack.

!!}
procedure TImageEnProc.PaintPenMarker(x, y: Integer; Width: Integer; Color: TColor; BackgroundColor: TColor; Tolerance: Integer);
var
  rgbColor, rgbBack: TRGB;
  //
  procedure DrawPix(px, py: Integer);
  var
    bk: TRGB;
    max, v: Integer;
  begin
    bk := fIEBitmap.Pixels_ie24RGB[px, py];
    max := abs(bk.r - rgbBack.r);
    v := abs(bk.g - rgbBack.g);
    if v > max then
      max := v;
    v := abs(bk.b - rgbBack.b);
    if v > max then
      max := v;
    if max <= Tolerance then
    begin
      fIEBitmap.Pixels_ie24RGB[px, py] := rgbColor;
      if fIEBitmap.HasAlphaChannel then
        fIEBitmap.Alpha[px, py] := 255;
    end;
  end;
  //
var
  p, xx, yy, g, w: Integer;
  a, p2: Double;
  iv: TImageEnView;
begin
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  if (x < 0) or (y < 0) or (x >= fIEBitmap.Width) or (y >= fIEBitmap.Height) then
    exit;
  rgbColor := TColor2TRGB(Color);
  rgbBack := TColor2TRGB(BackgroundColor);
  DrawPix(x, y); // draw central pixel
  Width := Width div 2;
  for w := 1 to Width do
  begin
    p := round(2 * pi * w) shl 1;
    p2 := (2 * pi / p);
    for g := 0 to p - 1 do
    begin
      a := p2 * g;
      xx := ilimit(round(x + cos(a) * w), 0, fIEBitmap.Width - 1);
      yy := ilimit(round(y + sin(a) * w), 0, fIEBitmap.Height - 1);
      DrawPix(xx, yy);
    end;
  end;
  // update rect if attached to TImageEnView
  if assigned(AttachedImageEn) and (AttachedImageEn is TImageEnView) then
  begin
    iv := AttachedImageEn as TImageEnView;
    xx := iv.XBmp2Scr(x, false);
    yy := iv.YBmp2Scr(y, false);
    w := round((Width + 1) * (iv.Zoom / 100));
    iv.UpdateRect(rect(xx - w, yy - w, xx + w + 1, yy + w + 1));
  end;
end;

// fills the hist array (256 elements) with the gray levels histogram
// accept all TIEPixelFormat values
procedure _IEGetHistogram(Bitmap: TIEBitmap; hist: pintegerarray);
const
  cntmask: array[0..15] of byte = (0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4);  // bitcount in 4bits
var
  y, x, v: Integer;
  p_byte: pbyte;
  p_word: pword;
  p_rgb: PRGB;
  p_rgb32: PRGBA;
  p_rgb48: PRGB48;
  p_single: psingle;
  p_cmyk: PCMYK;
  p_cielab: PCIELAB;
  rgb: TRGB;
  RedToGrayCoef, GreenToGrayCoef, BlueToGrayCoef: Integer;
  bytewidth, bytewidthlast: Integer;
  b: byte;
  i, temphist: Integer;
  BitmapWidth, BitmapHeight: Integer;
begin
  BitmapWidth  := Bitmap.Width;
  BitmapHeight := Bitmap.Height;
  RedToGrayCoef   := IEGlobalSettings().RedToGrayCoef;
  GreenToGrayCoef := IEGlobalSettings().GreenToGrayCoef;
  BlueToGrayCoef  := IEGlobalSettings().BlueToGrayCoef;
  ZeroMemory(hist, 256 * sizeof(integer));
  bytewidth := BitmapWidth shr 3;
  bytewidthlast := BitmapWidth and $7;
  temphist := 0;
  for y := 0 to BitmapHeight - 1 do
  begin
    case Bitmap.PixelFormat of
      ie1g: // black & white
        begin
          p_byte := Bitmap.Scanline[y];
          for x := 0 to bytewidth - 1 do  // whole bytes
          begin
            b := pbytearray(p_byte)^[x];
            temphist := temphist + cntmask[b and $F] + cntmask[b shr 4]; // first and second 4bits part
          end;
          if bytewidthlast > 0 then //last bits if exists
          begin
            b := ierevertbyte[ pbytearray(p_byte)^[bytewidth] ];  // revert last byte for proper bits check
            for i := 0 to bytewidthlast - 1 do
            begin
              inc( hist[b and 1] );
              b := b shr 1;
            end;
          end;
        end;
      ie8p: // color (palette)
        begin
          p_byte := Bitmap.Scanline[y];
          for x := 0 to BitmapWidth - 1 do
          begin
            with Bitmap.Palette[p_byte^] do
              v := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;
            inc(hist[v]);
            inc(p_byte);
          end;
        end;
      ie8g: // gray scale (256 levels)
        begin
          p_byte := Bitmap.Scanline[y];
          for x := 0 to BitmapWidth - 1 do
          begin
            inc(hist[p_byte^]);
            inc(p_byte);
          end;
        end;
      ie16g: //  gray scale (65536 levels), the array is always 256 levels
        begin
          p_word := Bitmap.Scanline[y];
          for x := 0 to BitmapWidth - 1 do
          begin
            inc(hist[p_word^ shr 8]);
            inc(p_word);
          end;
        end;
      ie24RGB: // color (true color)
        begin
          p_rgb := Bitmap.ScanLine[y];
          for x := 0 to BitmapWidth - 1 do
          begin
            with p_rgb^ do
              v := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;
            inc(hist[v]);
            inc(p_rgb);
          end;
        end;
      ie32RGB: // color (true color)
        begin
          p_rgb32 := Bitmap.ScanLine[y];
          for x := 0 to BitmapWidth - 1 do
          begin
            with p_rgb32^ do
              v := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;
            inc(hist[v]);
            inc(p_rgb32);
          end;
        end;
      ie32f: //  32bit floating point gray scale, the array is always 256 levels
        begin
          p_single := Bitmap.Scanline[y];
          for x := 0 to BitmapWidth - 1 do
          begin
            inc(hist[trunc(p_single^ * 255)]);
            inc(p_single);
          end;
        end;
      ieCMYK: // CMYK
        begin
          p_cmyk := Bitmap.ScanLine[y];
          for x := 0 to BitmapWidth - 1 do
          begin
            rgb := IECMYK2RGB(p_cmyk^);
            with rgb do
              v := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;
            inc(hist[v]);
            inc(p_cmyk);
          end;
        end;
      ieCIELab: // CIELab
        begin
          p_cielab := Bitmap.ScanLine[y];
          for x := 0 to BitmapWidth - 1 do
          begin
            rgb := IECIELAB2RGB(p_cielab^);
            with rgb do
              v := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;
            inc(hist[v]);
            inc(p_cielab);
          end;
        end;
      ie48RGB: // 48 bit color
        begin
          p_rgb48 := Bitmap.ScanLine[y];
          for x := 0 to BitmapWidth - 1 do
          begin
            with p_rgb48^ do
              v := ( (r shr 8) * RedToGrayCoef + trunc(g shr 8) * GreenToGrayCoef + trunc(b shr 8) * BlueToGrayCoef) div 100;
            inc(hist[v]);
            inc(p_rgb48);
          end;
        end;
    end;
  end;
  // fill histogram values for 1bpp
  if Bitmap.PixelFormat = ie1g then
  begin
    hist[1] := hist[1] + temphist;
    hist[0] := BitmapWidth * BitmapHeight - hist[1];
  end;
end;

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// binarization

// If Threshold is:
// > = 0 : apply just specified threshold
// -1  : autocalculated using media
// -2 : calc Threshold, maximum entropy mode
// origbitmap and destbitmap must have some size
// destbitmap must be ie1g
// origbitmap: Accept all TIEPixelFormat values
procedure _ConvertToBWThresholdEx(OrigBitmap, DestBitmap: TIEBitmap; Threshold: Integer; var Progress: TProgressRec);
var
  i, j, n: Integer;
  x, y, v, b, mR, mG, mB: Integer;
  rgb: TRGB;
  p_rgb: PRGB;
  p_rgb32: PRGBA;
  p_byte: pbyte;
  p_word: pword;
  p_single: psingle;
  p_cmyk: PCMYK;
  p_cielab: PCIELAB;
  p_rgb48: PRGB48;
  p2: pbyte;
  hist: pintegerarray;
  prob: pdoublearray;
  hn, psiMax, Ps, Hs, psi: Double;
  RedToGrayCoef, GreenToGrayCoef, BlueToGrayCoef: Integer;
  OrigBitmapWidth, OrigBitmapHeight: Integer;
  //
  procedure ConvPixel(Color: TRGB);
  begin
    b := x and 7;
    with Color do
      v := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;
    if v >= Threshold then
      p2^ := p2^ or iebitmask1[b]
    else
      p2^ := p2^ and (not iebitmask1[b]);
    if b = 7 then
      inc(p2);
  end;
begin
  if OrigBitmap.PixelFormat = ie1g then
  begin
    // already black & white, just copy
    DestBitmap.AssignImage(OrigBitmap);
    exit;
  end;
  OrigBitmapWidth  := OrigBitmap.Width;
  OrigBitmapHeight := OrigBitmap.Height;
  RedToGrayCoef   := IEGlobalSettings().RedToGrayCoef;
  GreenToGrayCoef := IEGlobalSettings().GreenToGrayCoef;
  BlueToGrayCoef  := IEGlobalSettings().BlueToGrayCoef;
  progress.per1 := 100 / (OrigBitmapHeight + 0.5);
  hist := nil;
  prob := nil;
  case Threshold of
    -1:
      begin
        // calc Threshold, media mode
        _GetMediaContrastRGB(origBitmap, mR, mG, mB);
        Threshold := (mR * RedToGrayCoef + mG * GreenToGrayCoef + mB * BlueToGrayCoef) div 100;
      end;
    -2:
      begin
        // calc Threshold, maximum entropy mode
        getmem(hist, 256 * sizeof(integer));
        _IEGetHistogram(origBitmap, hist);
        getmem(prob, 256 * sizeof(double));
        n := OrigBitmapWidth * OrigBitmapHeight;
        for i := 0 to 255 do
          prob[i] := hist[i] / n;
        hn := 0;
        psi := 0;
        for i := 0 to 255 do
          if prob[i] <> 0 then
            hn := hn - prob[i] * ln(prob[i]);
        psiMax := 0;
        for i := 1 to 255 do
        begin
          Ps := 0;
          Hs := 0;
          for j := 0 to i - 1 do
          begin
            Ps := Ps + prob[j];
            if prob[j] > 0 then
              Hs := Hs - prob[j] * ln(prob[j]);
          end;
          if (Ps > 0) and (Ps < 1) then
            psi := ln(Ps - Ps * Ps) + Hs / Ps + (Hn - Hs) / (1.0 - Ps);
          if psi > psiMax then
          begin
            psiMax := psi;
            Threshold := i;
          end;
        end;
      end;
  end;
  if hist <> nil then
    freemem(hist);
  if prob <> nil then
    freemem(prob);
  for y := 0 to OrigBitmapHeight - 1 do
  begin
    p2 := DestBitmap.ScanLine[y];
    case OrigBitmap.PixelFormat of
      ie8p: // color (palette)
        begin
          p_byte := OrigBitmap.Scanline[y];
          for x := 0 to OrigBitmapWidth - 1 do
          begin
            ConvPixel(OrigBitmap.Palette[p_byte^]);
            inc(p_byte);
          end;
        end;
      ie8g: // gray scale (256 levels)
        begin
          p_byte := OrigBitmap.Scanline[y];
          for x := 0 to OrigBitmapWidth - 1 do
          begin
            ConvPixel(CreateRGB(p_byte^, p_byte^, p_byte^));
            inc(p_byte);
          end;
        end;
      ie16g: //  gray scale (65536 levels)
        begin
          p_word := OrigBitmap.Scanline[y];
          for x := 0 to OrigBitmapWidth - 1 do
          begin
            ConvPixel(CreateRGB(p_word^ shr 8, p_word^ shr 8, p_word^ shr 8));
            inc(p_word);
          end;
        end;
      ie24RGB: // color (true color)
        begin
          p_rgb := OrigBitmap.ScanLine[y];
          for x := 0 to OrigBitmapWidth - 1 do
          begin
            ConvPixel(p_rgb^);
            inc(p_rgb);
          end;
        end;
      ie32RGB: // color (true color)
        begin
          p_rgb32 := OrigBitmap.ScanLine[y];
          for x := 0 to OrigBitmapWidth - 1 do
          begin
            with p_rgb32^ do
              ConvPixel(CreateRGB(r, g, b));
            inc(p_rgb32);
          end;
        end;
      ie32f: //  32bit floating point gray scale
        begin
          p_single := OrigBitmap.Scanline[y];
          for x := 0 to OrigBitmapWidth - 1 do
          begin
            ConvPixel(CreateRGB(trunc(p_single^ * 255), trunc(p_single^ * 255), trunc(p_single^ * 255)));
            inc(p_single);
          end;
        end;
      ieCMYK: // CMYK
        begin
          p_cmyk := OrigBitmap.ScanLine[y];
          for x := 0 to OrigBitmapWidth - 1 do
          begin
            ConvPixel(IECMYK2RGB(p_cmyk^));
            inc(p_cmyk);
          end;
        end;
      ieCIELab: // CIELab
        begin
          p_cielab := OrigBitmap.ScanLine[y];
          for x := 0 to OrigBitmapWidth - 1 do
          begin
            ConvPixel(IECIELAB2RGB(p_cielab^));
            inc(p_cielab);
          end;
        end;
      ie48RGB: // RGB48
        begin
          p_rgb48 := OrigBitmap.ScanLine[y];
          for x := 0 to OrigBitmapWidth - 1 do
          begin
            rgb.r := p_rgb48^.r;
            rgb.g := p_rgb48^.g;
            rgb.b := p_rgb48^.b;
            ConvPixel(rgb);
            inc(p_rgb48);
          end;
        end;
    end;
    with Progress do
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * (y + 1)));
  end;
end;

// binarization
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// blur
// thanks to Roy Magne Klever for optimized code

const
  IEMaxGaussKernelSize = 100; // New Gaussian Blur optimized
  IEKernelScale        = 16;
  IEKernelMultiplier   = 1 shl IEKernelScale;
  IEKernelMultiplierd2 = IEKernelMultiplier div 2;

type
  TIEGaussKernelSize = -IEMaxGaussKernelSize..IEMaxGaussKernelSize;
  TIEGaussKernel = record
    Size:        TIEGaussKernelSize;
    RealWeights: array[TIEGaussKernelSize] of double;
    IntWeights:  array[TIEGaussKernelSize] of integer;
  end;

procedure _IEMakeGaussKernel(var Kernel: TIEGaussKernel; Radius: Double);
var
  j: Integer;
  Temp: Double;
begin
  for j := Low(Kernel.RealWeights) to High(Kernel.RealWeights) do
  begin
    Temp := j / Radius;
    // warning! values of divisor less than 2 could make floating point exception on Windows 98 (!?)
    Kernel.RealWeights[j] := Exp(-Temp * Temp / 2);
  end;
  // normalize kernel
  Temp := 0;
  for j := Low(Kernel.RealWeights) to High(Kernel.RealWeights) do
    Temp := Temp + Kernel.RealWeights[j];
  for j := Low(Kernel.RealWeights) to High(Kernel.RealWeights) do
    Kernel.IntWeights[j] := round(Kernel.RealWeights[j] * IEKernelMultiplier / Temp);
  // optimize size
  Kernel.Size := IEMaxGaussKernelSize;
  while (Kernel.Size > 1) and (Kernel.IntWeights[Kernel.Size] = 0) and (Kernel.IntWeights[-Kernel.Size] = 0) do
    dec(Kernel.Size);
end;

procedure _IEBlurRow24Bit(const Kernel: TIEGaussKernel; SourcePtr, DestPtr: PRGBROW; RowLen: Integer);
var
  RowIndex, LoopIndex, KernelIndex, StopIndex: Integer;
  Src, Dst: PRGB;
  MaxLen: Integer;
  RR, GG, BB: Integer;
  W: Integer;
begin
  MaxLen := RowLen - 1;
  Dst := @DestPtr^[0];
  for RowIndex := 0 to MaxLen do
  begin
    KernelIndex := -Kernel.Size;
    LoopIndex := RowIndex - Kernel.Size;
    StopIndex := RowIndex + Kernel.Size;
    if StopIndex > MaxLen then
      StopIndex := MaxLen;
    // start values
    RR := IEKernelMultiplierd2;
    GG := IEKernelMultiplierd2;
    BB := IEKernelMultiplierd2;
    // left part
    W := 0;
    while LoopIndex < 0 do
    begin
      inc(W, Kernel.IntWeights[KernelIndex]);
      inc(KernelIndex);
      inc(LoopIndex);
    end;
    with PRGB(SourcePtr)^ do
    begin
      inc(RR, W * r);
      inc(GG, W * g);
      inc(BB, W * b);
    end;
    Src := @SourcePtr^[LoopIndex];
    // center part
    while LoopIndex <= StopIndex do
    begin
      W := Kernel.IntWeights[KernelIndex];
      with Src^ do
      begin
        inc(RR, W * r);
        inc(GG, W * g);
        inc(BB, W * b);
      end;
      inc(KernelIndex);
      inc(LoopIndex);
      inc(Src);
    end;
    W := 0;
    while KernelIndex <= Kernel.Size do
    begin
      inc(W, Kernel.IntWeights[KernelIndex]);
      inc(KernelIndex);
    end;
    with SourcePtr^[MaxLen] do
    begin
      inc(RR, W * r);
      inc(GG, W * g);
      inc(BB, W * b);
    end;
    // set pixel
    with Dst^ do
    begin
      r := RR shr IEKernelScale;
      g := GG shr IEKernelScale;
      b := BB shr IEKernelScale;
    end;
    inc(Dst);
  end;
end;

procedure _IEBlurRow8Bit(const Kernel: TIEGaussKernel; SourcePtr, DestPtr: pbytearray; RowLen: Integer);
var
  RowIndex, LoopIndex, StopIndex: Integer;
  KernelPt, KernelEnd: pinteger;
  KernelSize: Integer;
  Src, Dst, Stp: pbyte;
  MaxLen: Integer;
  GR: Integer;
  W: Integer;
begin
  MaxLen := RowLen - 1;
  Dst := @DestPtr^[0];
  KernelEnd := @Kernel.IntWeights[Kernel.Size];
  KernelSize := Kernel.Size;
  for RowIndex := 0 to MaxLen do
  begin
    GR := IEKernelMultiplierd2;
    KernelPt := @Kernel.IntWeights[-KernelSize];
    LoopIndex := RowIndex - KernelSize;
    StopIndex := RowIndex + KernelSize;
    if StopIndex > MaxLen then
      StopIndex := MaxLen;
    W := 0;
    while LoopIndex < 0 do
    begin
      inc(W, KernelPt^);
      inc(KernelPt);
      inc(LoopIndex);
    end;
    inc(GR, W * SourcePtr[0]);
    Src := @SourcePtr^[LoopIndex];
    Stp := @SourcePtr^[StopIndex];
    while longword(Src) <= longword(Stp) do
    begin
      W := KernelPt^;
      inc(GR, W * Src^);
      inc(KernelPt);
      inc(Src);
    end;
    W := 0;
    while longword(KernelPt) <= longword(KernelEnd) do
    begin
      inc(W, KernelPt^);
      inc(KernelPt);
    end;
    inc(GR, W * SourcePtr^[MaxLen]);
    // set pixel
    Dst^ := GR shr IEKernelScale;
    inc(Dst);
  end;
end;

procedure _IEGBlur(Bitmap: TIEBitmap; radius: Double; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  X, Y: Integer;
  RowPtr, ColPtr: PRGBROW;
  RowPtr8, ColPtr8: pbytearray;
  Kernel: TIEGaussKernel;
  per: Double;
  BitmapWidth, BitmapHeight: Integer;
begin
  if Radius > 0 then
  begin
    BitmapWidth  := Bitmap.Width;
    BitmapHeight := Bitmap.Height;
    // calculate kernel
    per := 100 / (BitmapHeight + BitmapWidth);
    _IEMakeGaussKernel(Kernel, Radius);
    case Bitmap.PixelFormat of
      ie24RGB:
        begin
          if BitmapWidth > BitmapHeight then
            GetMem(RowPtr, BitmapWidth * SizeOf(TRGB))
          else
            GetMem(RowPtr, BitmapHeight * SizeOf(TRGB));
          // blur rows
          for Y := 0 to BitmapHeight - 1 do
          begin
            _IEBlurRow24Bit(Kernel, Bitmap.ScanLine[y], RowPtr, BitmapWidth);
            copymemory(Bitmap.ScanLine[Y], RowPtr, BitmapWidth * SizeOf(TRGB));
            if assigned(fOnProgress) then
              fOnProgress(Sender, trunc(per * Y));
          end;
          // blur columns
          GetMem(ColPtr, BitmapHeight * SizeOf(TRGB));
          for X := 0 to BitmapWidth - 1 do
          begin
            for Y := 0 to BitmapHeight - 1 do
              RowPtr[Y] := PRGBROW(Bitmap.Scanline[y])[x];
            _IEBlurRow24Bit(Kernel, RowPtr, ColPtr, BitmapHeight);
            for Y := 0 to BitmapHeight - 1 do
              PRGBROW(Bitmap.Scanline[y])[x] := ColPtr[Y];
            if assigned(fOnProgress) then
              fOnProgress(Sender, trunc(per * (X + BitmapHeight)));
          end;
          FreeMem(ColPtr);
          FreeMem(RowPtr);
        end;
      ie8g:
        begin
          if BitmapWidth > BitmapHeight then
            GetMem(RowPtr8, BitmapWidth)
          else
            GetMem(RowPtr8, BitmapHeight);
          // blur rows
          for Y := 0 to BitmapHeight - 1 do
          begin
            _IEBlurRow8Bit(Kernel, Bitmap.ScanLine[y], RowPtr8, BitmapWidth);
            CopyMemory(Bitmap.ScanLine[Y], RowPtr8, BitmapWidth);
            if assigned(fOnProgress) then
              fOnProgress(Sender, trunc(per * Y));
          end;
          // blur columns
          GetMem(ColPtr8, BitmapHeight);
          for X := 0 to BitmapWidth - 1 do
          begin
            for Y := 0 to BitmapHeight - 1 do
              RowPtr8[Y] := pbytearray(Bitmap.Scanline[Y])[X];
            _IEBlurRow8Bit(Kernel, RowPtr8, ColPtr8, BitmapHeight);
            for Y := 0 to BitmapHeight - 1 do
              pbytearray(Bitmap.Scanline[Y])[X] := ColPtr8[Y];
            if assigned(fOnProgress) then
              fOnProgress(Sender, trunc(per * (X + BitmapHeight)));
          end;
          FreeMem(ColPtr8);
          FreeMem(RowPtr8);
        end;
    end;
  end;
end;

procedure _IEGBlurRect8(Bitmap: TIEBitmap; x1, y1, x2, y2: Integer; radius: Double);
var
  X, Y, ww, hh: Integer;
  RowPtr8, ColPtr8: pbytearray;
  Kernel: TIEGaussKernel;
  p: pbyte;
begin
  if Bitmap.PixelFormat <> ie8g then
    exit;
  x1 := ilimit(x1, 0, Bitmap.Width - 1);
  y1 := ilimit(y1, 0, Bitmap.Height - 1);
  x2 := ilimit(x2, 0, Bitmap.Width - 1);
  y2 := ilimit(y2, 0, Bitmap.Height - 1);
  if Radius > 0 then
  begin
    // calculate kernel
    _IEMakeGaussKernel(Kernel, Radius);
    ww := x2 - x1 + 1;
    hh := y2 - y1 + 1;
    if ww > hh then
      GetMem(RowPtr8, ww)
    else
      GetMem(RowPtr8, hh);
    // blur rows
    for Y := y1 to y2 do
    begin
      p := Bitmap.ScanLine[y];
      inc(p, x1);
      _IEBlurRow8Bit(Kernel, pointer(p), RowPtr8, ww);
      copymemory(p, RowPtr8, ww);
    end;
    // blur columns
    GetMem(ColPtr8, hh);
    for X := x1 to x2 do
    begin
      for Y := y1 to y2 do
        RowPtr8[Y - y1] := pbytearray(Bitmap.Scanline[y])[x];
      _IEBlurRow8Bit(Kernel, RowPtr8, ColPtr8, hh);
      for Y := y1 to y2 do
        pbytearray(Bitmap.Scanline[y])[x] := ColPtr8[Y - y1];
    end;
    FreeMem(ColPtr8);
    FreeMem(RowPtr8);
  end;
end;

// make gaussian blur
// PixelFormat can be: ie8g and ie24RGB

{!!
<FS>TImageEnProc.Blur

<FM>Declaration<FC>
procedure Blur(radius: Double);

<FM>Description<FN>
Apply a Gaussian Blur filter of specified radius (> 0) to reduce image noise and reduce detail.

<FM>Example<FC>
ImageEnProc.Blur( 4 );

!!}
procedure TImageEnProc.Blur(radius: Double);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB, ie8g], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_BLUR, [radius]),
                              {$ELSE}
                              IEMsg( IEMSG_BLUR ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_BLUR ) then
    exit;
  _IEGBlur(ProcBitmap, radius, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

// blur
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////


// Return the extra pixels that the soft shadow will add to a bitmap width and height (same in both dimensions regardless of offsets)
function IESoftShadowSize(Radius: Double; OffSetX: Integer; OffSetY: Integer) : Integer;
var
  omax : Integer;
begin           
  omax := imax(abs(OffSetX), abs(OffsetY)) * 2;
  Result := imax(trunc(radius * 5) + omax, 1);
end;



// intensity 0..100
procedure _IEAddSoftShadow(bitmap: TIEBitmap; radius: Double; OffSetX: Integer; OffSetY: Integer; Intensity: Integer; AdaptBitmap: Boolean; ShadowColor: TRGB; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  oldalpha: TIEBitmap;
  x, y, sz: Integer;
  po, pn, pb: pbyte;
  px: PRGB;
  dint: Double;
  bint: Boolean;
  dd, ao, an: Double;
  s: TRGB;
  w, h: Integer;
begin
  bitmap.AlphaChannel.Full := false; // here we also create the alphachannel if doesn't exists
  if AdaptBitmap then
  begin
    // enlarge bitmap
    sz := IESoftShadowSize(Radius, OffSetX, OffSetY);
    bitmap.Resize(bitmap.Width + sz, bitmap.Height + sz, 0, 0, iehCenter, ievCenter);
  end;

  oldalpha := TIEBitmap.Create();

  try

    oldalpha.Assign(bitmap.AlphaChannel);
    _IEGBlur(bitmap.AlphaChannel, radius, fOnProgress, Sender);

    if (offsetx <> 0) or (offsety <> 0) then
      bitmap.AlphaChannel.MoveRegion(0, 0, bitmap.AlphaChannel.Width - 1, bitmap.AlphaChannel.Height - 1, offsetx, offsety, 0);

    dint := 3 - (ilimit(Intensity, 0, 100) / 100 * 2); // 1=max 3=min
    bint := dint <> 1;

    w := bitmap.AlphaChannel.Width;
    h := bitmap.AlphaChannel.Height;

    case bitmap.PixelFormat of
      ie24RGB:
        for y := 0 to h - 1 do
        begin
          po := oldalpha.Scanline[y];
          pn := bitmap.AlphaChannel.scanline[y];
          px := bitmap.Scanline[y];
          for x := 0 to w - 1 do
          begin

            if (po^ = 0) and (po^ <> pn^) then
            begin
              px^ := ShadowColor;
              if bint then
                pn^ := trunc(pn^ / dint);
            end
            else
            begin
              if (po^ < 255) and (po^ > 0) then
              begin
                ao := po^/255;
                an := pn^/255;
                dd := ao + an*(1-ao);
                s.r := trunc( ShadowColor.r*an + (1-an)*px^.r );
                s.g := trunc( ShadowColor.g*an + (1-an)*px^.g );
                s.b := trunc( ShadowColor.b*an + (1-an)*px^.b );
                px^.r :=  trunc( px^.r*ao + (1-ao)*s.r );
                px^.g :=  trunc( px^.g*ao + (1-ao)*s.g );
                px^.b :=  trunc( px^.b*ao + (1-ao)*s.b );
                pn^ := trunc(dd*255);
              end
              else
                pn^ := po^;
            end;

            inc(po);
            inc(pn);
            inc(px);
          end;
        end;
      ie1g:
        for y := 0 to h - 1 do
        begin
          po := oldalpha.Scanline[y];
          pn := bitmap.AlphaChannel.scanline[y];
          pb := bitmap.Scanline[y];
          for x := 0 to w - 1 do
          begin
            if (po^ = 0) and (po^ <> pn^) then
            begin
              _SetPixelbw(pb, x, 0);
              if bint then
                pn^ := trunc(pn^ / dint);
            end
            else
            begin
              pn^ := po^;
            end;
            inc(po);
            inc(pn);
          end;
        end;
    end;
  finally
    oldalpha.Free();
  end;
end;

procedure _IEAddInnerShadow(bitmap: TIEBitmap; radius: Double; OffSetX: Integer; OffSetY: Integer; ShadowColor: TRGB; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  tmpalpha: TIEBitmap;
  omax, sz, x, y, a: Integer;
  px: PRGB;
  pb: pbyte;
  w, h: Integer;
begin
  bitmap.AlphaChannel.Full := false; // here we also create the alphachannel if doesn't exists

  tmpalpha := TIEBitmap.Create();
  try
    tmpalpha.Assign(bitmap.AlphaChannel);

    omax := imax(abs(OffSetX), abs(OffsetY)) * 2;
    sz := imax(trunc(radius * 5) + omax, 1);
    tmpalpha.Resize(tmpalpha.Width + sz, tmpalpha.Height + sz, 0, 0, iehCenter, ievCenter);

    _IEGBlur(tmpalpha, radius, fOnProgress, Sender);

    if (offsetx <> 0) or (offsety <> 0) then
      tmpalpha.MoveRegion(0, 0, tmpalpha.Width - 1, tmpalpha.Height - 1, offsetx, offsety, 0);

    w := bitmap.Width;
    h := bitmap.Height;

    case bitmap.PixelFormat of
      ie24RGB:
        begin
          for y := 0 to h - 1 do
          begin
            px := bitmap.Scanline[y];
            pb := tmpalpha.Scanline[sz div 2 +y]; inc(pb, sz div 2);
            for x := 0 to w - 1 do
            begin

              a := (255 - pb^) shl 10;
              with px^ do
              begin
                r := (a * (ShadowColor.r - r) shr 18 + r);
                g := (a * (ShadowColor.g - g) shr 18 + g);
                b := (a * (ShadowColor.b - b) shr 18 + b);
              end;

              inc(px);
              inc(pb);
            end;
          end;
        end;
    end;
  finally
    tmpalpha.Free();
  end;
end;

{!!
<FS>TImageEnProc.AddSoftShadow

<FM>Declaration<FC>
procedure AddSoftShadow(Radius : Double = 4; OffSetX : Integer = 4; OffSetY : Integer = 4; AdaptSize : Boolean = true; ShadowColor: TColor = clBlack; Intensity : Integer = 100);

<FM>Description<FN>
Adds a soft shadow (Gaussian Shadow) to the image. The image's alpha channel is used for the shadow effect (it will be added if it does not exist).

<IMG help_images\SoftShadow.gif>

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C>Radius</C> <C>The width of the shadow</C> </R>
<R> <C>OffSetX</C> <C>The offset from the image of the shadow horizontally</C> </R>
<R> <C>OffSetY</C> <C>The offset from the image of the shadow vertically</C> </R>
<R> <C>AdaptSize</C> <C>If enabled (default) then the dimensions of your image will be enlarged so that the content does not change when the shadow is added (You can use <A IESoftShadowSize> to calculate how much larger the image will become)</C> </R>
<R> <C>ShadowColor</C> <C>Color of the shadow (default is clBlack)</C> </R>
<R> <C>Intensity</C> <C>The shadow intensity in the range of 0 and 100 (default is 100)</C> </R>
</TABLE>

Notes:
- The effect will not be visible unless <A TImageEnView.EnableAlphaChannel> = True
- The offset values determine the position of the shadow. Positive values make the shadow appear on the right/bottom, whereas negative values place it at the left/top. Values of zero give the image a "Glow" effect

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\SoftShadow\SoftShadow.dpr </C> </R>
</TABLE>

<FM>Example<FC>
// Add a shadow to the bottom-right of the image (i.e. light appears to come from top-left)
ImageEnProc.AddSoftShadow(5, 4, 4);

// Add a shadow to the top-left of the image
ImageEnProc.AddSoftShadow(5, -4, -4);  

// Add a yellow glow to the image
ImageEnProc.AddSoftShadow(5, 0, 0, True, clYellow);

// Add a soft shadow to image in a TBitmap
iBlurRadius := 5;
iOffSet := 4;
ie := TImageEnView.Create(nil);
try
  ie.Background := clWhite;
  ie.Bitmap.assign(MyBitmap);
  ie.update;
  ie.Proc.AddSoftShadow(iBlurRadius, iOffSet, iOffSet, True, cShadowColor);
  ie.RemoveAlphaChannel(True);
  MyBitmap.assign(ie.bitmap);
finally
  ie.Free;
end;

!!}
// radius is the half of the shadow (ex radius = 2, the shadow is 4 pixels)
procedure TImageEnProc.AddSoftShadow(radius: Double; OffSetX: Integer; OffSetY: Integer; AdaptSize: Boolean; ShadowColor: TColor; Intensity: Integer);
begin
  if not MakeConsistentBitmap([]) then
    exit;
  if fAutoUndo then
    SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
              IERS_ADDSOFTSHADOW,
              {$ELSE}
              IEMsg( IEMSG_ADDSOFTSHADOW ),
              {$ENDIF}
              ieuImage, True, IEOP_ADDSOFTSHADOW );
  _IEAddSoftShadow(fIEBitmap, radius, OffSetX, OffSetY, Intensity, AdaptSize, TColor2TRGB(ShadowColor), fOnProgress, self);
  Update;
  DoFinishWork;
end;

{!!
<FS>TImageEnProc.AddInnerShadow

<FM>Declaration<FC>
procedure AddInnerShadow(radius: Double; OffSetX: Integer; OffSetY: Integer; ShadowColor: TColor = clBlack);

<FM>Description<FN>
Adds a shadow to the inner border of the image.

!!}
procedure TImageEnProc.AddInnerShadow(radius: Double; OffSetX: Integer; OffSetY: Integer; ShadowColor: TColor);
begin
  if not MakeConsistentBitmap([]) then
    exit;
  if fAutoUndo then
    SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
              IERS_ADDINNERSHADOW,
              {$ELSE}
              IEMsg( IEMSG_ADDINNERSHADOW ),
              {$ENDIF}
              ieuImage, True, IEOP_ADDINNERSHADOW );
  _IEAddInnerShadow(fIEBitmap, radius, OffSetX, OffSetY, TColor2TRGB(ShadowColor), fOnProgress, self);
  Update;
  DoFinishWork;
end;

// radius is 0 use a 3x3 filter (fast)
// intensity 0..100
function _IEAddSoftShadowRect(bitmap: TIEBitmap; radius: Double; OffSetX: Integer; OffSetY: Integer; Intensity: Integer; ShadowColor: TRGB; x1, y1, x2, y2: Integer): Integer;
var
  oldalpha: TIEBitmap;
  x, y: Integer;
  po, pn, pb: pbyte;
  px: PRGB;
  sz, omax, sz2: Integer;
  xx1, yy1, xx2, yy2: Integer;
  filt: Boolean;
  dint: Double;
  bint: Boolean;
  dd, ao, an: Double;
  s: TRGB;
begin
  filt := radius = 0;
  if filt then
    radius := 2;
  omax := imax(abs(OffSetX), abs(OffsetY)) * 2;
  sz := imax(trunc(radius * 5) + omax, 1);
  sz2 := sz div 2;
  result := sz;

  bitmap.AlphaChannel.Full := false; // here we also create the alphachannel if doesn't exists

  oldalpha := TIEBitmap.Create;
  oldalpha.Assign(bitmap.AlphaChannel);
  xx1 := x1 - sz2;
  yy1 := y1 - sz2;
  xx2 := x2 + sz2;
  yy2 := y2 + sz2;
  xx1 := imin(imax(0, xx1), Bitmap.Width - 1);
  yy1 := imin(imax(0, yy1), Bitmap.Height - 1);
  xx2 := imin(imax(0, xx2), Bitmap.Width - 1);
  yy2 := imin(imax(0, yy2), Bitmap.Height - 1);
  if filt then
  begin
    _ApplyFilter8g(Bitmap.AlphaChannel, PIEGraphFilter(IEFiltPres[1])^, xx1, yy1, xx2, yy2);
  end
  else
    _IEGBlurRect8(Bitmap.AlphaChannel, xx1, yy1, xx2, yy2, radius);
  //
  if (offsetx <> 0) or (offsety <> 0) then
    bitmap.AlphaChannel.MoveRegion(xx1, yy1, xx2, yy2, xx1 + offsetx, yy1 + offsety, 0);
  //
  dec(x1, sz);
  inc(x2, sz);
  dec(y1, sz);
  inc(y2, sz);
  x1 := imin(imax(x1, 0), bitmap.Width - 1);
  y1 := imin(imax(y1, 0), bitmap.Height - 1);
  x2 := imin(imax(x2, 0), bitmap.Width - 1);
  y2 := imin(imax(y2, 0), bitmap.Height - 1);

  dint := 3-(ilimit(Intensity, 0, 100)/100*2); // 1=max 3=min
  bint := dint<>1;

  case bitmap.PixelFormat of
    ie24RGB:
      for y := y1 to y2 do
      begin
        po := oldalpha.Scanline[y];
        inc(po, x1);
        pn := bitmap.AlphaChannel.Scanline[y];
        inc(pn, x1);
        px := bitmap.Scanline[y];
        inc(px, x1);
        for x := x1 to x2 do
        begin
          if (po^ = 0) and (po^ <> pn^) then
          begin
            px^ := ShadowColor;
            if bint then
              pn^ := trunc(pn^ / dint);
          end
          else
          begin
            if (po^<255) and (po^ > 0) then
            begin
              ao := po^/255;
              an := pn^/255;
              dd := ao + an*(1-ao);
              s.r := trunc( ShadowColor.r*an + (1-an)*px^.r );
              s.g := trunc( ShadowColor.g*an + (1-an)*px^.g );
              s.b := trunc( ShadowColor.b*an + (1-an)*px^.b );
              px^.r :=  trunc( px^.r*ao + (1-ao)*s.r );
              px^.g :=  trunc( px^.g*ao + (1-ao)*s.g );
              px^.b :=  trunc( px^.b*ao + (1-ao)*s.b );
              pn^ := trunc(dd*255);
            end
            else
              pn^ := po^;
          end;

          inc(po);
          inc(pn);
          inc(px);
        end;
      end;
    ie1g:
      for y := y1 to y2 do
      begin
        po := oldalpha.Scanline[y];
        pn := bitmap.AlphaChannel.scanline[y];
        pb := bitmap.Scanline[y];
        for x := x1 to x2 do
        begin
          if (po^ = 0) and (po^ <> pn^) then
            _SetPixelbw(pb, x, 0)
          else
            pn^ := po^;
          inc(po);
          inc(pn);
        end;
      end;
  end;
  FreeAndNil(oldalpha);
end;

(*
procedure _IEAddSoftShadowRect2(bitmap: TIEBitmap; size: Integer; Intensity: Double; OffsetX, OffsetY: Integer; rx1, ry1, rx2, ry2: Integer);
var
  x, y: Integer;
  outbitmap: TIEBitmap;
  halfsize: Integer;
  kk: pdoublearray;
  p0, p1, p2, 
    p3, p4, 
    p5, p6, p7: Integer;
  x1, x2: Integer;
  y1, y2: Integer;
  k2d: ppointerarray;
  pym1, py, pyp1: pbyte;
  inp, oup: pbyte;
  width, height: Integer;
  rrx1, rrx2: Integer;
  rry1, rry2: Integer;
  prgb1: PRGB;
  //
  procedure MakeGaussKernel1D(Kernel: pdoublearray; KernelLen: Integer; Radius: Double);
  var
    J: Integer;
    Temp: Double;
    d: Integer;
  begin
    d := KernelLen div 2;
    for J := 0 to KernelLen - 1 do
    begin
      Temp := (J - d) / Radius;
      Kernel[J] := Exp(-Intensity - Temp * Temp / 2);
    end;
  end;
  //
  procedure IEDrawSpot8g;
  var
    xx, yy: Integer;
    px: pbyte;
    pi: pinteger;
  begin
    for yy := y1 to y2 do
    begin
      px := outbitmap.Scanline[yy - ry1];
      inc(px, x1 - rx1);
      pi := k2d[yy - (y + OffsetY) + halfsize];
      inc(pi, x1 - (x + OffsetX) + halfsize);
      for xx := x1 to x2 do
      begin
        px^ := imax(px^, pi^ * inp^ shr 16);
        inc(px);
        inc(pi);
      end;
    end;
  end;
  //
begin
  Intensity := (100 - Intensity) / 100;
  halfsize := size div 2;
  getmem(kk, sizeof(double) * size);

  MakeGaussKernel1D(kk, size, size / 5);

  getmem(k2d, sizeof(pointer) * size);
  for y := 0 to size - 1 do
  begin
    getmem(k2d[y], sizeof(integer) * size);
    for x := 0 to size - 1 do
      pintegerarray(k2d[y])[x] := trunc(kk[x] * kk[y] * 65536);
  end;
  freemem(kk);

  rx1 := imax(rx1 - halfsize, 0);
  ry1 := imax(ry1 - halfsize, 0);
  rx2 := imin(rx2 + halfsize, bitmap.width - 1);
  ry2 := imin(ry2 + halfsize, bitmap.height - 1);

  width := rx2 - rx1 + 1;
  height := ry2 - ry1 + 1;
  outbitmap := TIEBitmap.Create;
  outbitmap.Allocate(width, height, ie8g);
  outbitmap.Fill(0);
  //
  rrx1 := imax(rx1, 1);
  rrx2 := imin(rx2, bitmap.width - 2);
  rry1 := imax(ry1, 1);
  rry2 := imin(ry2, bitmap.height - 2);
  for y := rry1 to rry2 do
  begin
    y1 := imax(y + OffsetY - halfsize, 0);
    y2 := imin(y + OffsetY + halfsize - 1, bitmap.height - 1);
    pym1 := bitmap.alphachannel.GetRow(y - 1);
    py := bitmap.alphachannel.GetRow(y);
    pyp1 := bitmap.alphachannel.GetRow(y + 1);
    inp := py;
    oup := outbitmap.GetRow(y - ry1);
    inc(oup, rrx1 - rx1);
    inc(inp, rrx1);
    for x := rrx1 to rrx2 do
    begin
      if inp^ > 0 then
      begin
        p0 := pbytearray(pym1)[x - 1];
        p1 := pbytearray(pym1)[x];
        p2 := pbytearray(pym1)[x + 1];
        //
        p3 := pbytearray(py)[x - 1];
        p4 := pbytearray(py)[x + 1];
        //
        p5 := pbytearray(pyp1)[x - 1];
        p6 := pbytearray(pyp1)[x];
        p7 := pbytearray(pyp1)[x + 1];
        if p0 + p1 + p2 + p3 + p4 + p5 + p6 + p7 < 2040 then
        begin
          x1 := imax(x + OffsetX - halfsize, 0);
          x2 := imin(x + OffsetX + halfsize - 1, bitmap.width - 1);
          IEDrawSpot8g;
        end;
        oup^ := inp^;
      end;
      inc(inp);
      inc(oup);
    end;
    bitmap.alphachannel.FreeRow(y - 1);
    bitmap.alphachannel.FreeRow(y);
    bitmap.alphachannel.FreeRow(y + 1);
    outbitmap.FreeRow(y);
  end;
  //
  for y := ry1 to ry2 do
  begin
    prgb1 := bitmap.Scanline[y];
    inc(prgb1, rx1);
    inp := outbitmap.Scanline[y - ry1];
    oup := bitmap.alphachannel.Scanline[y];
    inc(oup, rx1);
    for x := rx1 to rx2 do
    begin
      if oup^ = 0 then
        with prgb1^ do
        begin
          r := 0;
          g := 0;
          b := 0;
        end;
      oup^ := inp^;
      inc(inp);
      inc(oup);
      inc(prgb1);
    end;
  end;
  //
  for y := 0 to size - 1 do
    freemem(k2d[y]);
  freemem(k2d);
end;
*)

////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// QRotate

// for AntialiasMode supports only Bilinear and Bicubic


procedure IEQRotate(src: TIEBitmap; angle: Double; Background: TColor; Filter: TIEAntialiasMode; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  dest: TIEBitmap;
begin
  dest := TIEBitmap.Create;
  try
    IEQRotateTo(src, dest, angle, Background, Filter, fOnProgress, Sender);
    src.AssignImage(dest);
  finally
    dest.Free();
  end;
end;


procedure IEQRotateTo(src: TIEBitmap; dst: TIEBitmap; angle: Double; Background: TColor; Filter: TIEAntialiasMode; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  tmpBmp: TIEBitmap;
begin
  case src.PixelFormat of
    ie8p,
    ie8g:
      begin
        IEQRotateTo8(src, dst, angle, Background, Filter);
      end;
    ie24RGB:
      begin
        IEQRotateTo24(src, dst, angle, Background, Filter, fOnProgress, Sender);
      end;
    else
      begin
        tmpBmp := TIEBitmap.Create(src.Width, src.Height, ie24RGB);
        try
          tmpBmp.CopyAndConvertFormat(src);
          IEQRotateTo24(tmpBmp, dst, angle, Background, Filter, fOnProgress, Sender);
        finally
          tmpBmp.Free();
        end;
      end;
  end;
end;


procedure IEQRotateTo24(src: TIEBitmap; dst: TIEBitmap; angle: Double; Background: TColor; Filter: TIEAntialiasMode; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  fx, fy, a, tsin, tcos, cxSrc, cySrc, cxDest, cyDest: Double;
  dw, dh, width, height, x, y: Integer;
  bColor: TRGB;

  procedure RC(x, y: Integer; var rgb: TRGB);
  begin
    if (x < 0) or (x >= width) or (y < 0) or (y >= height) then
      rgb := bColor
    else
      rgb := PRGBROW(src.Scanline[y])^[x];
  end;

  function Bilinear(x, y: Double): TRGB;
  var
    j, k, rr, gg, bb: Integer;
    cx, cy, m0, m1: Double;
    p0, p1, p2, p3: TRGB;
  begin
    j := floor(x);
    k := floor(y);
    cx := x - floor(x);
    cy := y - floor(y);
    RC(j, k, p0);
    RC(j + 1, k, p1);
    RC(j, k + 1, p2);
    RC(j + 1, k + 1, p3);
    with p0 do
      m0 := r + cx * (p1.r - r);
    with p2 do
      m1 := r + cx * (p3.r - r);
    rr := trunc(m0 + cy * (m1 - m0));
    with p0 do
      m0 := g + cx * (p1.g - g);
    with p2 do
      m1 := g + cx * (p3.g - g);
    gg := trunc(m0 + cy * (m1 - m0));
    with p0 do
      m0 := b + cx * (p1.b - b);
    with p2 do
      m1 := b + cx * (p3.b - b);
    bb := trunc(m0 + cy * (m1 - m0));
    with result do
    begin
      r := rr;
      g := gg;
      b := bb;
    end;
  end;

  function Bicubic(x, y: Double): TRGB;
  var
    cr, cg, cb, j, k: Integer;
    a, aa, b, bb, cc, dd, ee, ff, gg, hh, fr, fg, fb: Double;
    t1, t2, t3, t4: Double;
    p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12, p13, p14, p15, p16: TRGB;
  begin
    j := floor(x);
    k := floor(y);
    a := x - j;
    b := y - k;
    aa := -a * (1 - a) * (1 - a);
    bb := (1 - 2 * a * a + a * a * a);
    cc := a * (1 + a - a * a);
    dd := a * a * (1 - a);
    ee := -b * (1 - b) * (1 - b);
    ff := (1 - 2 * b * b + b * b * b);
    gg := b * (1 + b - b * b);
    hh := b * b * (b - 1);
    RC(j - 1, k - 1, p1);
    RC(j, k - 1, p2);
    RC(j + 1, k - 1, p3);
    RC(j + 2, k - 1, p4);
    RC(j - 1, k, p5);
    RC(j, k, p6);
    RC(j + 1, k, p7);
    RC(j + 2, k, p8);
    RC(j - 1, k + 1, p9);
    RC(j, k + 1, p10);
    RC(j + 1, k + 1, p11);
    RC(j + 2, k + 1, p12);
    RC(j - 1, k + 2, p13);
    RC(j, k + 2, p14);
    RC(j + 1, k + 2, p15);
    RC(j + 2, k + 2, p16);
    t1 := aa * p1.r + bb * p2.r + cc * p3.r - dd * p4.r;
    t2 := aa * p5.r + bb * p6.r + cc * p7.r - dd * p8.r;
    t3 := aa * p9.r + bb * p10.r + cc * p11.r - dd * p12.r;
    t4 := aa * p13.r + bb * p14.r + cc * p15.r - dd * p16.r;
    fr := ee * t1 + ff * t2 + gg * t3 + hh * t4;
    t1 := aa * p1.g + bb * p2.g + cc * p3.g - dd * p4.g;
    t2 := aa * p5.g + bb * p6.g + cc * p7.g - dd * p8.g;
    t3 := aa * p9.g + bb * p10.g + cc * p11.g - dd * p12.g;
    t4 := aa * p13.g + bb * p14.g + cc * p15.g - dd * p16.g;
    fg := ee * t1 + ff * t2 + gg * t3 + hh * t4;
    t1 := aa * p1.b + bb * p2.b + cc * p3.b - dd * p4.b;
    t2 := aa * p5.b + bb * p6.b + cc * p7.b - dd * p8.b;
    t3 := aa * p9.b + bb * p10.b + cc * p11.b - dd * p12.b;
    t4 := aa * p13.b + bb * p14.b + cc * p15.b - dd * p16.b;
    fb := ee * t1 + ff * t2 + gg * t3 + hh * t4;
    
    cr := round(fr);
    cg := round(fg);
    cb := round(fb);
    with result do
    begin
      r := blimit(cr);
      g := blimit(cg);
      b := blimit(cb);
    end;
  end;

var
  px: PRGB;
  arx1, arx2: array of double;
  ary1, ary2: Double;
  per: Double;
begin
  bColor := TColor2TRGB(Background);
  width := src.Width;
  height := src.Height;
  a := IEDegreesToRadians( angle );

  IECalcRotatedBitmapSizes(width, height, IE2DPoint((width - 1) / 2, (height - 1) / 2), -angle, dw, dh);

  dst.Allocate(dw, dh, ie24RGB);

  cxSrc := (src.Width - 1) / 2;
  cySrc := (src.Height - 1) / 2;
  cxDest := (dst.Width - 1) / 2;
  cyDest := (dst.Height - 1) / 2;

  tsin := sin(a);
  tcos := cos(a);

  SetLength(arx1, dst.Width);
  SetLength(arx2, dst.Width);
  for x := 0 to dw - 1 do
  begin
    arx1[x] := cxSrc + (x - cxDest) * tcos;
    arx2[x] := cySrc + (x - cxDest) * tsin;
  end;
  
  per := 100 / (dst.Height);
  for y := 0 to dh - 1 do
  begin
    px := dst.Scanline[y];
    ary1 := (y - cyDest) * tsin;
    ary2 := (y - cyDest) * tcos;
    for x := 0 to dw - 1 do
    begin
      fx := arx1[x] - ary1;
      fy := arx2[x] + ary2;
      case Filter of
        ierBilinear: px^ := Bilinear(fx, fy);
        ierBicubic:  px^ := BiCubic(fx, fy);
      end;
      inc(px);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per * y));
  end;
end;

// accept ie8g and ie8p
procedure IEQRotate8(src: TIEBitmap; angle: Double; Background: Integer; Filter: TIEAntialiasMode);
var
  dest: TIEBitmap;
begin
  dest := TIEBitmap.Create;
  try
    IEQRotateTo8(src, dest, angle, Background, Filter);
    src.AssignImage(dest);
  finally
    dest.Free();
  end;
end;


// accept ie8g and ie8p
procedure IEQRotateTo8(src: TIEBitmap; dst: TIEBitmap; angle: Double; Background: Integer; Filter: TIEAntialiasMode);
var
  fx, fy, a, tsin, tcos, cxSrc, cySrc, cxDest, cyDest: Double;
  dw, dh, width, height, x, y: Integer;
  bColor: Integer;

  procedure RC(x, y: Integer; var col: Integer);
  begin
    // note: do not consider near-borders like part of the image, otherwise the resulting image will seem clipped
    if (x < width) and (x >= 0) and (y < height) and (y >= 0) then
      col := pbytearray(src.Scanline[y])^[x]
    else
      col := bColor;
  end;

  function Bilinear(x, y: Double): Integer;
  var
    j, k: Integer;
    cx, cy, m0, m1: Double;
    p0, p1, p2, p3: Integer;
  begin
    j := floor(x);
    k := floor(y);
    cx := x - floor(x);
    cy := y - floor(y);
    RC(j, k, p0);
    RC(j + 1, k, p1);
    RC(j, k + 1, p2);
    RC(j + 1, k + 1, p3);
    m0 := p0 + cx * (p1 - p0);
    m1 := p2 + cx * (p3 - p2);
    result := trunc(m0 + cy * (m1 - m0));
  end;

  function Bicubic(x, y: Double): Integer;
  var
    j, k: Integer;
    a, aa, b, bb, cc, dd, ee, ff, gg, hh, fr: Double;
    t1, t2, t3, t4: Double;
    p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12, p13, p14, p15, p16: Integer;
  begin
    j := floor(x);
    k := floor(y);
    a := x - j;
    b := y - k;
    aa := -a * (1 - a) * (1 - a);
    bb := (1 - 2 * a * a + a * a * a);
    cc := a * (1 + a - a * a);
    dd := a * a * (1 - a);
    ee := -b * (1 - b) * (1 - b);
    ff := (1 - 2 * b * b + b * b * b);
    gg := b * (1 + b - b * b);
    hh := b * b * (b - 1);
    RC(j - 1, k - 1, p1);
    RC(j, k - 1, p2);
    RC(j + 1, k - 1, p3);
    RC(j + 2, k - 1, p4);
    RC(j - 1, k, p5);
    RC(j, k, p6);
    RC(j + 1, k, p7);
    RC(j + 2, k, p8);
    RC(j - 1, k + 1, p9);
    RC(j, k + 1, p10);
    RC(j + 1, k + 1, p11);
    RC(j + 2, k + 1, p12);
    RC(j - 1, k + 2, p13);
    RC(j, k + 2, p14);
    RC(j + 1, k + 2, p15);
    RC(j + 2, k + 2, p16);
    t1 := aa * p1 + bb * p2 + cc * p3 - dd * p4;
    t2 := aa * p5 + bb * p6 + cc * p7 - dd * p8;
    t3 := aa * p9 + bb * p10 + cc * p11 - dd * p12;
    t4 := aa * p13 + bb * p14 + cc * p15 - dd * p16;
    fr := ee * t1 + ff * t2 + gg * t3 + hh * t4;
    result := blimit(round(fr));
  end;

var
  px: pbyte;
  arx1, arx2: pdoublearray;
  ary1, ary2: Double;
begin
  bColor := Background;
  width := src.Width;
  height := src.Height;
  a := IEDegreesToRadians( angle );

  IECalcRotatedBitmapSizes(width, height, IE2DPoint((width - 1) / 2, (height - 1) / 2), -angle, dw, dh);

  dst.Allocate(dw, dh, src.PixelFormat);

  cxSrc := (src.Width - 1) / 2;
  cySrc := (src.Height - 1) / 2;
  cxDest := (dst.Width - 1) / 2;
  cyDest := (dst.Height - 1) / 2;

  tsin := sin(a);
  tcos := cos(a);

  getmem(arx1, sizeof(double) * dst.Width);
  getmem(arx2, sizeof(double) * dst.Width);
  for x := 0 to dw - 1 do
  begin
    arx1[x] := cxSrc + (x - cxDest) * tcos;
    arx2[x] := cySrc + (x - cxDest) * tsin;
  end;
  
  for y := 0 to dh - 1 do
  begin
    px := dst.Scanline[y];
    ary1 := (y - cyDest) * tsin;
    ary2 := (y - cyDest) * tcos;
    for x := 0 to dw - 1 do
    begin
      fx := arx1[x] - ary1;
      fy := arx2[x] + ary2;
      case Filter of
        ierBilinear: px^ := Bilinear(fx, fy);
        ierBicubic:  px^ := BiCubic(fx, fy);
      end;
      inc(px);
    end;
  end;
  freemem(arx1);
  freemem(arx2);
end;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// generic rotate

procedure IEGRotate(src: TIEBitmap; angle: Double; Background: TColor; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  a: Double;
  dw, dh, width, height: Integer;
  dest: TIEBitmap;
begin
  width := src.Width;
  height := src.Height;
  a := IEDegreesToRadians( angle );
  dw := round(abs(width * cos(a)) + abs(height * sin(a)));
  dh := round(abs(width * sin(a)) + abs(height * cos(a)));
  dest := TIEBitmap.Create;
  dest.Allocate(dw, dh, src.PixelFormat);
  dest.Fill(Background);
  IEGRotateTo(src, dest, angle, Background, fOnProgress, Sender);
  src.AssignImage(dest);
  FreeAndNil(dest);
end;


procedure IEGRotateTo(src, dst: TIEBitmap; angle: Double; Background: TColor; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  a, tsin, tcos, cxSrc, cySrc, cxDest, cyDest: Double;
  fx, fy: Integer;
  dw, dh, width, height, x, y: Integer;
  px: pbyte;
  arx1, arx2: array of double;
  ary1, ary2: double;
  per: Double;
  bytesPerPixel: Integer;
  ps, pd: pbyte;
  c: Integer;
  dw1, dh1: Integer;
  prgb_s, prgb_d: PRGB;
  srcrows: ppointerarray;
  iangle: Integer;
  prog, lprog: Integer;

  procedure Rot90(inv: Boolean);
  var
    x, y, c: Integer;
    mulx, muly, addx, addy: Integer;
  begin
    dw := height; dw1 := dw-1;
    dh := Width;  dh1 := dh-1;
    dst.Allocate(dw, dh, src.PixelFormat);
    if src.PixelFormat=ie8p then
      src.CopyPaletteTo(dst);
    if bytesPerPixel = 0 then
      dst.Fill(0);
    if inv then
    begin
      mulx := -1;
      muly := 1;
      addx := dw1;
      addy := 0;
    end
    else
    begin
      mulx := 1;
      muly := -1;
      addx := 0;
      addy := dh1;
    end;
    for x := 0 to dw1 do
    begin
      ps := src.ScanLine[addx+x*mulx];
      case bytesPerPixel of
        0 : // black & white (1bit)
          for y := 0 to dh1 do
          begin
            if pbytearray(ps)^[y shr 3] and iebitmask1[y and $7] <> 0 then
            begin
              pd := dst.Scanline[addy+y*muly];
              inc(pd, x shr 3);
              pd^ := pd^ or iebitmask1[x and 7];
            end;
          end;
        1 : // 1 byte
          for y := 0 to dh1 do
          begin
            pd := dst.Scanline[addy+y*muly];
            inc(pd, x);
            pd^ := ps^;
            inc(ps);
          end;
        3 : // 3 channels
          begin
            prgb_s := PRGB(ps);
            for y := 0 to dh1 do
            begin
              prgb_d := dst.Scanline[addy+y*muly];
              inc(prgb_d, x);
              prgb_d^ := prgb_s^;
              inc(prgb_s);
            end;
          end;
        else // other cases
          for y := 0 to dh1 do
          begin
            pd := dst.Scanline[addy+y*muly];
            inc(pd, x*bytesPerPixel);
            for c := 1 to bytesPerPixel do
            begin
              pd^ := ps^;
              inc(ps);
              inc(pd);
            end;
          end;

      end;
    end;
  end;

  procedure Rot180;
  var
    x, y, c: Integer;
  begin
    dw := width; dw1 := dw-1;
    dh := height;  dh1 := dh-1;
    dst.Allocate(dw, dh, src.PixelFormat);
    if src.PixelFormat=ie8p then
      src.CopyPaletteTo(dst);
    if bytesPerPixel = 0 then
      dst.Fill(0);
    for y := 0 to dh1 do
    begin
      pd := dst.ScanLine[dh1 - y];
      ps := src.Scanline[y];
      case bytesPerPixel of
        0 : // black & white (1bit)
          for x := 0 to dw1 do
          begin
            if pbytearray(ps)^[x shr 3] and iebitmask1[x and $7] <> 0 then
            begin
              px := pd;
              inc(px, (dw1-x) shr 3);
              px^ := px^ or iebitmask1[(dw1-x) and 7];
            end;
          end;
        1 : // 1 byte
          begin
            inc(ps, dw1);
            for x := 0 to dw1 do
            begin
              pd^ := ps^;
              inc(pd);
              dec(ps);
            end;
          end;
        3 : // 3 channels
          begin
            prgb_d := PRGB(pd);
            prgb_s := PRGB(ps);
            inc(prgb_s, dw1);
            for x := 0 to dw1 do
            begin
              prgb_d^ := prgb_s^;
              inc(prgb_d);
              dec(prgb_s);
            end;
          end;
        else  // other cases
          begin
            inc(ps, dw1*bytesPerPixel);
            for x := 0 to dw1 do
            begin
              for c := 1 to bytesPerPixel do
              begin
                pd^ := ps^;
                inc(pd);
                inc(ps);
              end;
              dec(ps, 2*bytesPerPixel);
            end;
          end;
      end;
    end;
  end;

var
  parx1, parx2: pdouble;
begin

  width := src.Width;
  height := src.Height;
  bytesPerPixel := src.BitCount div 8;

  lprog := -1;

  if (Frac(angle) = 0) and ((trunc(angle) mod 90) = 0) then
  begin
    iangle := trunc(angle) mod 360;
    case iangle of
      90 : Rot90(false);
      180 : Rot180;
      270 : Rot90(true);
      -90 : Rot90(true);
      -180 : Rot180;
      -270 : Rot90(false);
      else
        dst.Assign( src );
    end;
    exit;
  end;

  a := IEDegreesToRadians( angle );
  dw := round(abs(width * cos(a)) + abs(height * sin(a)));
  dh := round(abs(width * sin(a)) + abs(height * cos(a)));
  dw1 := dw-1;
  dh1 := dh-1;
  dst.Allocate(dw, dh, src.PixelFormat);
  if src.PixelFormat=ie8p then
    src.CopyPaletteTo(dst);

  if bytesPerPixel = 0 then
    dst.Fill(0)
  else
    dst.Fill(Background);
  tsin := sin(a);
  tcos := cos(a);
  cxSrc := (src.Width - 1) / 2;
  cySrc := (src.Height - 1) / 2;
  cxDest := (dst.Width - 1) / 2;
  cyDest := (dst.Height - 1) / 2;

  SetLength(arx1, dst.Width);
  SetLength(arx2, dst.Width);
  for x := 0 to dst.Width - 1 do
  begin
    arx1[x] := cxSrc + (x - cxDest) * tcos;
    arx2[x] := cySrc + (x - cxDest) * tsin;
  end;
  
  per := 100 / (dst.Height);

  getmem(srcrows, height*sizeof(pointer));
  for y := 0 to height-1 do
    srcrows[y] := src.GetRow(y);

  for y := 0 to dh1 do
  begin
    px := dst.Scanline[y];
    ary1 := (y - cyDest) * tsin;
    ary2 := (y - cyDest) * tcos;

    parx1 := @arx1[0];
    parx2 := @arx2[0];

    case bytesPerPixel of

      0:  // black & white (1bit)
        for x := 0 to dw1 do
        begin
          fx := round(parx1^ - ary1);
          fy := round(parx2^ + ary2);
          if (fx < width ) and (fx >= 0) and (fy < height) and (fy >= 0) then
            if pbytearray(srcrows[fy])^[fx shr 3] and iebitmask1[fx and $7] <> 0 then
            begin
              pd := px;
              inc(pd, x shr 3);
              pd^ := pd^ or iebitmask1[x and 7];
            end;
          inc(parx1);
          inc(parx2);
        end;

      1:  // gray scale 8 bit
        for x := 0 to dw1 do
        begin
          fx := round(parx1^ - ary1);
          if (fx < width ) and (fx >= 0) then
          begin
            fy := round(parx2^ + ary2);
            if (fy < height) and (fy >= 0) then
            begin
              ps := srcrows[fy];
              inc(ps, fx);
              px^ := ps^;
            end;
          end;
          inc(px, bytesPerPixel);
          inc(parx1);
          inc(parx2);
        end;

      3:  // 3 channels
        begin
          prgb_d := prgb(px);
          for x := 0 to dw1 do
          begin
            fx := round(parx1^ - ary1);
            if (fx >= 0) and (fx < width )then
            begin
              fy := round(parx2^ + ary2);
              if (fy >= 0) and (fy < height) then
              begin
                prgb_s := srcrows[fy];
                inc(prgb_s, fx);
                prgb_d^ := prgb_s^;
              end;
            end;
            inc(prgb_d);
            inc(parx1);
            inc(parx2);
          end;
        end

      else

        // other cases
        for x := 0 to dw1 do
        begin
          fx := round(parx1^ - ary1);
          fy := round(parx2^ + ary2);
          if (fy < height) and (fy >= 0) and (fx < width ) and (fx >= 0) then
          begin
            ps := srcrows[fy]; inc(ps, fx*bytesPerPixel);
            pd := px;
            for c := 1 to bytesPerPixel do
            begin
              pd^ := ps^;
              inc(pd);
              inc(ps);
            end;
          end;
          inc(px, bytesPerPixel);
          inc(parx1);
          inc(parx2);
        end;
    end;

    if assigned(fOnProgress) then
    begin
      prog := trunc(per * y);
      if prog <> lprog then
      begin
        fOnProgress(Sender, prog);
        lprog := prog;
      end;
    end;
  end;

  for y := 0 to height-1 do
    src.FreeRow(y);
  freemem(srcrows);
end;



// end of generic rotate
////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////



////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// Bicubic and Bilinear resample

function Cubic(dx: Double; jm1, j, jp1, jp2: Integer; min, max: Double): Double;
var
  dx1, dx2, dx3: Double;
  h1, h2, h3, h4: Double;
begin
  dx1 := abs(dx);
  dx2 := dx1 * dx1;
  dx3 := dx2 * dx1;
  h1 := dx3 - 2 * dx2 + 1;
  result := h1 * j;
  dx1 := abs(dx - 1.0);
  dx2 := dx1 * dx1;
  dx3 := dx2 * dx1;
  h2 := dx3 - 2 * dx2 + 1;
  result := result + h2 * jp1;
  dx1 := abs(dx - 2.0);
  dx2 := dx1 * dx1;
  dx3 := dx2 * dx1;
  h3 := -dx3 + 5 * dx2 - 8 * dx1 + 4;
  result := result + h3 * jp2;
  dx1 := abs(dx + 1.0);
  dx2 := dx1 * dx1;
  dx3 := dx2 * dx1;
  h4 := -dx3 + 5 * dx2 - 8 * dx1 + 4;
  result := result + h4 * jm1;
  if (result < min) then
    result := min;
  if (result > max) then
    result := max;
end;

// filter 0=bilinear 1=bicubic
// works with ie24RGB and ie8g
procedure _IEQResampleBytes(SrcImg, DstImg: TIEBaseBitmap; SrcAlpha: TIEBitmap; filter: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  src_m1, src, src_p1, src_p2, s_m1, s, s_p1, s_p2: PByteArray;
  alpha_src_m1, alpha_src, alpha_src_p1, alpha_src_p2, alpha_s_m1, alpha_s, alpha_s_p1, alpha_s_p2: PDoubleArray;
  d, dest: PByteArray;
  r, row: PDoubleArray;
  src_row, src_col: Integer;
  bytes, b: Integer;
  width, height: Integer;
  orig_width, orig_height: Integer;
  x_rat, y_rat: Double;
  x_cum, y_cum: Double;
  x_last, y_last: Double;
  x_frac: PDoubleArray;
  y_frac, tot_frac: Double;
  dx, dy: Double;
  i, j: Integer;
  frac: Integer;
  advance_dest_x, advance_dest_y: Boolean;
  ix, minus_x, plus_x, plus2_x: Integer;
  scale_type: (MAX_MAY, MAX_MIY, MIX_MAY, MIX_MIY);
  v: array [0..3] of double;
  a: array [0..3] of double;
  ii, jj: Integer;
  mx: Integer;

  procedure CopyAlpha(Dst: PDoubleArray; Src: pbyte; count: Integer);
  var
    i: Integer;
  begin
    for i := 0 to count-1 do
    begin
      Dst[i] := Src^ / 255;
      inc(Src);
    end;
  end;

  procedure FillAlpha(Dst: PDoubleArray; count: Integer);
  var
    i: Integer;
  begin
    for i := 0 to count-1 do
      Dst[i] := 1.0;
  end;

begin
  orig_width := SrcImg.width;
  orig_height := SrcImg.height;
  width := DstImg.width;
  height := DstImg.height;

  case SrcImg.PixelFormat of
    ie24RGB: bytes := 3;
    ie8g: bytes := 1;
  else
    exit;
  end;

  x_rat := orig_width / width;
  y_rat := orig_height / height;
  if (x_rat < 1.0) and (y_rat < 1.0) then
    scale_type := MAX_MAY
  else
  if (x_rat < 1.0) and (y_rat >= 1.0) then
    scale_type := MAX_MIY
  else
  if (x_rat >= 1.0) and (y_rat < 1.0) then
    scale_type := MIX_MAY
  else
    scale_type := MIX_MIY;

  GetMem(src_m1, orig_width * bytes);
  GetMem(src,    orig_width * bytes);
  GetMem(src_p1, orig_width * bytes);
  GetMem(src_p2, orig_width * bytes);

  GetMem(alpha_src_m1, orig_width * sizeof(double));
  GetMem(alpha_src,    orig_width * sizeof(double));
  GetMem(alpha_src_p1, orig_width * sizeof(double));
  GetMem(alpha_src_p2, orig_width * sizeof(double));

  GetMem(dest, width * bytes);
  GetMem(row, sizeof(double) * width * bytes);
  GetMem(x_frac, sizeof(double) * (width + orig_width));

  src_col := 0;
  x_cum := src_col;
  x_last := x_cum;
  for i := 0 to (width + orig_width - 1) do
  begin
    if (x_cum + x_rat) <= (src_col + 1 + 0.0001) then
    begin
      x_cum := x_cum + x_rat;
      x_frac[i] := x_cum - x_last;
    end
    else
    begin
      inc(src_col);
      x_frac[i] := src_col - x_last;
    end;
    x_last := x_last + x_frac[i];
  end;
  FillChar(row^, sizeof(double) * width * bytes, 0);
  src_row := 0;
  y_cum := src_row;
  y_last := y_cum;

  CopyMemory(src, SrcImg.Scanline[0], orig_width * bytes);
  if src_row < (orig_height - 1) then
    CopyMemory(src_p1, SrcImg.ScanLine[1], orig_width * bytes);
  if (src_row + 1) < (orig_height - 1) then
    CopyMemory(src_p2, SrcImg.Scanline[2], orig_width * bytes);

  if assigned(SrcAlpha) then
  begin
    CopyAlpha(alpha_src, SrcAlpha.Scanline[0], orig_width);
    if src_row < (orig_height - 1) then
      CopyAlpha(alpha_src_p1, SrcAlpha.ScanLine[1], orig_width);
    if (src_row + 1) < (orig_height - 1) then
      CopyAlpha(alpha_src_p2, SrcAlpha.Scanline[2], orig_width);
  end
  else
  begin
    FillAlpha(alpha_src, orig_width);
    if src_row < (orig_height - 1) then
      FillAlpha(alpha_src_p1, orig_width);
    if (src_row + 1) < (orig_height - 1) then
      FillAlpha(alpha_src_p2, orig_width);
  end;

  i := height;
  while i > 0 do
  begin
    src_col := 0;
    x_cum := src_col;
    if ((y_cum + y_rat) <= (src_row + 1 + 0.0001)) then
    begin
      y_cum := y_cum + y_rat;
      dy := y_cum - src_row;
      y_frac := y_cum - y_last;
      advance_dest_y := true;
    end
    else
    begin
      y_frac := (src_row + 1) - y_last;
      dy := 1.0;
      advance_dest_y := false;
    end;
    y_last := y_last + y_frac;

    s := src;
    alpha_s := alpha_src;
    if src_row > 0 then
    begin
      s_m1 := src_m1;
      alpha_s_m1 := alpha_src_m1;
    end
    else
    begin
      s_m1 := src;
      alpha_s_m1 := alpha_src;
    end;
    if src_row < (orig_height - 1) then
    begin
      s_p1 := src_p1;
      alpha_s_p1 := alpha_src_p1;
    end
    else
    begin
      s_p1 := src;
      alpha_s_p1 := alpha_src;
    end;
    if (src_row + 1) < (orig_height - 1) then
    begin
      s_p2 := src_p2;
      alpha_s_p2 := alpha_src_p2;
    end
    else
    begin
      s_p2 := s_p1;
      alpha_s_p2 := alpha_s_p1;
    end;

    r := row;
    frac := 0;
    j := width;
    while j <> 0 do
    begin
      if (x_cum + x_rat) <= (src_col + 1 + 0.0001) then
      begin
        x_cum := x_cum + x_rat;
        dx := x_cum - src_col;
        advance_dest_x := true;
      end
      else
      begin
        dx := 1.0;
        advance_dest_x := false;
      end;

      tot_frac := x_frac[frac] * y_frac;
      inc(frac);

      if src_col > 0 then
        minus_x := -bytes
      else
        minus_x := 0;
      if src_col < (orig_width - 1) then
        plus_x := bytes
      else
        plus_x := 0;
      if (src_col + 1) < (orig_width - 1) then
        plus2_x := bytes * 2
      else
        plus2_x := plus_x;

      if filter = 1 then
      begin
        // bicubic
        case scale_type of
          MAX_MAY:
            for b := 0 to bytes - 1 do
            begin
              r[b] := r[b] + cubic(dy, round(cubic(dx, s_m1[b + minus_x], s_m1[b], s_m1[b + plus_x], s_m1[b + plus2_x], 0, 255)), 
                round(cubic(dx, s[b + minus_x], s[b], s[b + plus_x], s[b + plus2_x], 0, 255)), 
                round(cubic(dx, s_p1[b + minus_x], s_p1[b], s_p1[b + plus_x], s_p1[b + plus2_x], 0, 255)), 
                round(cubic(dx, s_p2[b + minus_x], s_p2[b], s_p2[b + plus_x], s_p2[b + plus2_x], 0, 255)), 0, 255) * tot_frac;  // 3.0.2
            end;
          MAX_MIY:
            for b := 0 to bytes - 1 do
              r[b] := r[b] + cubic(dx, s[b + minus_x], s[b], s[b + plus_x], s[b + plus2_x], 0, 255) * tot_frac;
          MIX_MAY:
            for b := 0 to bytes - 1 do
              r[b] := r[b] + cubic(dy, s_m1[b], s[b], s_p1[b], s_p2[b], 0, 255) * tot_frac;
          MIX_MIY:
            for b := 0 to bytes - 1 do
              r[b] := r[b] + s[b] * tot_frac;
        end;
      end
      else
      begin
        // bilinear
        case scale_type of
          MAX_MAY:
            begin
              b := 0;
              if bytes = 3 then
                for b := 0 to bytes - 1 do
                begin
                  v[0] := s[b];
                  v[1] := s[b + plus_x];
                  v[2] := s_p1[b];
                  v[3] := s_p1[b + plus_x];
                  a[0] := alpha_s[0];
                  a[1] := alpha_s[plus_x div 3];
                  a[2] := alpha_s_p1[0];
                  a[3] := alpha_s_p1[plus_x div 3];
                  mx := -1;
                  for ii := 0 to 3 do
                    for jj := 0 to 3 do
                      if a[ii] > a[jj] then
                        mx := ii;
                  if mx > -1 then
                  begin
                    v[0] := v[mx];
                    v[1] := v[mx];
                    v[2] := v[mx];
                    v[3] := v[mx];
                    r[b] := r[b] + ((1 - dy) * ((1 - dx) * v[0] + dx * v[1]) + dy * ((1 - dx) * v[2] + dx * v[3])) * tot_frac;
                  end
                  else
                    r[b] := r[b] + ((1 - dy) * ((1 - dx) * s[b] + dx * s[b + plus_x]) + dy * ((1 - dx) * s_p1[b] + dx * s_p1[b + plus_x])) * tot_frac;
                end
              else
                r[b] := r[b] + ((1 - dy) * ((1 - dx) * s[b] + dx * s[b + plus_x]) + dy * ((1 - dx) * s_p1[b] + dx * s_p1[b + plus_x])) * tot_frac;
            end;
          MAX_MIY:
            for b := 0 to bytes - 1 do
              r[b] := r[b] + (s[b] * (1 - dx) + s[b + plus_x] * dx) * tot_frac;
          MIX_MAY:
            for b := 0 to bytes - 1 do
              r[b] := r[b] + (s[b] * (1 - dy) + s_p1[b] * dy) * tot_frac;
          MIX_MIY:
            for b := 0 to bytes - 1 do
              r[b] := r[b] + s[b] * tot_frac;
        end;
      end;
      if (advance_dest_x) then
      begin
        inc(pbyte(r), bytes * sizeof(double));
        dec(j);
      end
      else
      begin
        inc(pbyte(s_m1), bytes);
        inc(pbyte(s), bytes);
        inc(pbyte(s_p1), bytes);
        inc(pbyte(s_p2), bytes);

        inc(pdouble(alpha_s_m1));
        inc(pdouble(alpha_s));
        inc(pdouble(alpha_s_p1));
        inc(pdouble(alpha_s_p2));

        inc(src_col);
      end;
    end;
    if advance_dest_y then
    begin
      tot_frac := 1.0 / (x_rat * y_rat);
      d := dest;
      r := row;
      ix := 0;
      for j := 0 to width - 1 do
      begin
        for b := 1 to bytes do
        begin
          d[ix] := blimit(round(r[ix] * tot_frac)); // 3.0.2
          inc(ix);
        end;
      end;
      CopyMemory(DstImg.scanline[height - i], dest, width * bytes);
      FillChar(row^, sizeof(double) * width * bytes, 0);
      dec(i);
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc((height - i) / height * 100));
    end
    else
    begin
      s := src_m1;
      src_m1 := src;
      src := src_p1;
      src_p1 := src_p2;
      src_p2 := s;

      alpha_s := alpha_src_m1;
      alpha_src_m1 := alpha_src;
      alpha_src := alpha_src_p1;
      alpha_src_p1 := alpha_src_p2;
      alpha_src_p2 := alpha_s;

      inc(src_row);
      if (src_row + 1) < (orig_height - 1) then
      begin
        CopyMemory(src_p2, SrcImg.Scanline[src_row + 2], orig_width * bytes);

        if assigned(SrcAlpha) then
          CopyAlpha(alpha_src_p2, SrcAlpha.Scanline[src_row + 2], orig_width)
        else
          FillAlpha(alpha_src_p2, orig_width);
      end;
    end;
  end;

  FreeMem(src_m1);
  FreeMem(src);
  FreeMem(src_p1);
  FreeMem(src_p2);

  FreeMem(alpha_src_m1);
  FreeMem(alpha_src);
  FreeMem(alpha_src_p1);
  FreeMem(alpha_src_p2);

  FreeMem(dest);
  FreeMem(row);
  FreeMem(x_frac);
end;

(*
procedure _IEQResampleBytes(SrcImg, DstImg: TIEBaseBitmap; filter: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  src_m1, src, src_p1, src_p2, s_m1, s, s_p1, s_p2: PByteArray;
  d, dest: PByteArray;
  r, row: PDoubleArray;
  src_row, src_col: Integer;
  bytes, b: Integer;
  width, height: Integer;
  orig_width, orig_height: Integer;
  x_rat, y_rat: Double;
  x_cum, y_cum: Double;
  x_last, y_last: Double;
  x_frac: PDoubleArray;
  y_frac, tot_frac: Double;
  dx, dy: Double;
  i, j: Integer;
  frac: Integer;
  advance_dest_x, advance_dest_y: Boolean;
  ix, minus_x, plus_x, plus2_x: Integer;
  scale_type: (MAX_MAY, MAX_MIY, MIX_MAY, MIX_MIY);
  cancel: Boolean;
  lp: Integer;
begin

  lp := 0;
  cancel := false;

  orig_width := SrcImg.width;
  orig_height := SrcImg.height;
  width := DstImg.width;
  height := DstImg.height;

  case SrcImg.PixelFormat of
    ie24RGB: bytes := 3;
    ie8g: bytes := 1;
  else
    exit;
  end;

  x_rat := orig_width / width;
  y_rat := orig_height / height;
  if (x_rat < 1.0) and (y_rat < 1.0) then
    scale_type := MAX_MAY
  else
  if (x_rat < 1.0) and (y_rat >= 1.0) then
    scale_type := MAX_MIY
  else
  if (x_rat >= 1.0) and (y_rat < 1.0) then
    scale_type := MIX_MAY
  else
    scale_type := MIX_MIY;

  GetMem(src_m1, orig_width * bytes);
  GetMem(src,    orig_width * bytes);
  GetMem(src_p1, orig_width * bytes);
  GetMem(src_p2, orig_width * bytes);

  GetMem(alpha_src_m1, orig_width * sizeof(double));
  GetMem(alpha_src,    orig_width * sizeof(double));
  GetMem(alpha_src_p1, orig_width * sizeof(double));
  GetMem(alpha_src_p2, orig_width * sizeof(double));

  GetMem(dest, width * bytes);
  GetMem(row, sizeof(double) * width * bytes);
  GetMem(x_frac, sizeof(double) * (width + orig_width));

  src_col := 0;
  x_cum := src_col;
  x_last := x_cum;
  for i := 0 to (width + orig_width - 1) do
  begin
    if (x_cum + x_rat) <= (src_col + 1 + 0.0001) then
    begin
      x_cum := x_cum + x_rat;
      x_frac[i] := x_cum - x_last;
    end
    else
    begin
      inc(src_col);
      x_frac[i] := src_col - x_last;
    end;
    x_last := x_last + x_frac[i];
  end;
  FillChar(row^, sizeof(double) * width * bytes, 0);
  src_row := 0;
  y_cum := src_row;
  y_last := y_cum;

  CopyMemory(src, SrcImg.Scanline[0], orig_width * bytes);
  if src_row < (orig_height - 1) then
    CopyMemory(src_p1, SrcImg.ScanLine[1], orig_width * bytes);
  if (src_row + 1) < (orig_height - 1) then
    CopyMemory(src_p2, SrcImg.Scanline[2], orig_width * bytes);

  if

  i := height;
  while i > 0 do
  begin
    src_col := 0;
    x_cum := src_col;
    if ((y_cum + y_rat) <= (src_row + 1 + 0.0001)) then
    begin
      y_cum := y_cum + y_rat;
      dy := y_cum - src_row;
      y_frac := y_cum - y_last;
      advance_dest_y := true;
    end
    else
    begin
      y_frac := (src_row + 1) - y_last;
      dy := 1.0;
      advance_dest_y := false;
    end;
    y_last := y_last + y_frac;

    s := src;
    if src_row > 0 then
    begin
      s_m1 := src_m1;
    end
    else
    begin
      s_m1 := src;
    end;
    if src_row < (orig_height - 1) then
    begin
      s_p1 := src_p1;
    end
    else
    begin
      s_p1 := src;
    end;
    if (src_row + 1) < (orig_height - 1) then
    begin
      s_p2 := src_p2;
    end
    else
    begin
      s_p2 := s_p1;
    end;

    r := row;
    frac := 0;
    j := width;
    while j <> 0 do
    begin
      if (x_cum + x_rat) <= (src_col + 1 + 0.0001) then
      begin
        x_cum := x_cum + x_rat;
        dx := x_cum - src_col;
        advance_dest_x := true;
      end
      else
      begin
        dx := 1.0;
        advance_dest_x := false;
      end;
      tot_frac := x_frac[frac] * y_frac;
      inc(frac);
      if src_col > 0 then
        minus_x := -bytes
      else
        minus_x := 0;
      if src_col < (orig_width - 1) then
        plus_x := bytes
      else
        plus_x := 0;
      if (src_col + 1) < (orig_width - 1) then
        plus2_x := bytes * 2
      else
        plus2_x := plus_x;
      if filter = 1 then
      begin
        // bicubic
        case scale_type of
          MAX_MAY:
            for b := 0 to bytes - 1 do
              r[b] := r[b] + cubic(dy, round(cubic(dx, s_m1[b + minus_x], s_m1[b], s_m1[b + plus_x], s_m1[b + plus2_x], 0, 255)),
                round(cubic(dx, s[b + minus_x], s[b], s[b + plus_x], s[b + plus2_x], 0, 255)),
                round(cubic(dx, s_p1[b + minus_x], s_p1[b], s_p1[b + plus_x], s_p1[b + plus2_x], 0, 255)),
                round(cubic(dx, s_p2[b + minus_x], s_p2[b], s_p2[b + plus_x], s_p2[b + plus2_x], 0, 255)), 0, 255) * tot_frac;  // 3.0.2
          MAX_MIY:
            for b := 0 to bytes - 1 do
              r[b] := r[b] + cubic(dx, s[b + minus_x], s[b], s[b + plus_x], s[b + plus2_x], 0, 255) * tot_frac;
          MIX_MAY:
            for b := 0 to bytes - 1 do
              r[b] := r[b] + cubic(dy, s_m1[b], s[b], s_p1[b], s_p2[b], 0, 255) * tot_frac;
          MIX_MIY:
            for b := 0 to bytes - 1 do
              r[b] := r[b] + s[b] * tot_frac;
        end;
      end
      else
      begin
        // bilinear
        case scale_type of
          MAX_MAY:
            for b := 0 to bytes - 1 do
              r[b] := r[b] + ((1 - dy) * ((1 - dx) * s[b] + dx * s[b + plus_x]) + dy * ((1 - dx) * s_p1[b] + dx * s_p1[b + plus_x])) * tot_frac;
          MAX_MIY:
            for b := 0 to bytes - 1 do
              r[b] := r[b] + (s[b] * (1 - dx) + s[b + plus_x] * dx) * tot_frac;
          MIX_MAY:
            for b := 0 to bytes - 1 do
              r[b] := r[b] + (s[b] * (1 - dy) + s_p1[b] * dy) * tot_frac;
          MIX_MIY:
            for b := 0 to bytes - 1 do
              r[b] := r[b] + s[b] * tot_frac;
        end;
      end;
      if (advance_dest_x) then
      begin
        inc(pbyte(r), bytes * sizeof(double));
        dec(j);
      end
      else
      begin
        inc(pbyte(s_m1), bytes);
        inc(pbyte(s), bytes);
        inc(pbyte(s_p1), bytes);
        inc(pbyte(s_p2), bytes);

        inc(src_col);
      end;
    end;
    if advance_dest_y then
    begin
      tot_frac := 1.0 / (x_rat * y_rat);
      d := dest;
      r := row;
      ix := 0;
      for j := 0 to width - 1 do
      begin
        for b := 1 to bytes do
        begin
          d[ix] := blimit(round(r[ix] * tot_frac)); // 3.0.2
          inc(ix);
        end;
      end;
      CopyMemory(DstImg.scanline[height - i], dest, width * bytes);
      FillChar(row^, sizeof(double) * width * bytes, 0);
      dec(i);
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc((height - i) / height * 100));
    end
    else
    begin
      s := src_m1;
      src_m1 := src;
      src := src_p1;
      src_p1 := src_p2;
      src_p2 := s;

      inc(src_row);
      if (src_row + 1) < (orig_height - 1) then
      begin
        CopyMemory(src_p2, SrcImg.Scanline[src_row + 2], orig_width * bytes);
      end;
    end;
  end;

  FreeMem(src_m1);
  FreeMem(src);
  FreeMem(src_p1);
  FreeMem(src_p2);

  FreeMem(dest);
  FreeMem(row);
  FreeMem(x_frac);
end;
*)


// filter 0=bilinear 1=bicubic
// works with ie48RGB and ie16g
procedure _IEQResampleWords(SrcImg, DstImg: TIEBaseBitmap; filter: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  src_m1, src, src_p1, src_p2, s_m1, s, s_p1, s_p2: PWordArray;
  d, dest: PWordArray;
  r, row: PDoubleArray;
  src_row, src_col: Integer;
  words, b: Integer;
  width, height: Integer;
  orig_width, orig_height: Integer;
  x_rat, y_rat: Double;
  x_cum, y_cum: Double;
  x_last, y_last: Double;
  x_frac: PDoubleArray;
  y_frac, tot_frac: Double;
  dx, dy: Double;
  i, j: Integer;
  frac: Integer;
  advance_dest_x, advance_dest_y: Boolean;
  ix, minus_x, plus_x, plus2_x: Integer;
  scale_type: (MAX_MAY, MAX_MIY, MIX_MAY, MIX_MIY);
begin
  orig_width := SrcImg.width;
  orig_height := SrcImg.height;
  width := DstImg.width;
  height := DstImg.height;
  case SrcImg.PixelFormat of
    ie48RGB: words := 3;
    ie16g: words := 1;
  else
    exit;
  end;
  x_rat := orig_width / width;
  y_rat := orig_height / height;
  if (x_rat < 1.0) and (y_rat < 1.0) then
    scale_type := MAX_MAY
  else
  if (x_rat < 1.0) and (y_rat >= 1.0) then
    scale_type := MAX_MIY
  else
  if (x_rat >= 1.0) and (y_rat < 1.0) then
    scale_type := MIX_MAY
  else
    scale_type := MIX_MIY;
  GetMem(src_m1, orig_width * words*2);
  GetMem(src, orig_width * words*2);
  GetMem(src_p1, orig_width * words*2);
  GetMem(src_p2, orig_width * words*2);
  GetMem(dest, width * words*2);
  GetMem(row, sizeof(double) * width * words);
  GetMem(x_frac, sizeof(double) * (width + orig_width));
  src_col := 0;
  x_cum := src_col;
  x_last := x_cum;
  for i := 0 to (width + orig_width - 1) do
  begin
    if (x_cum + x_rat) <= (src_col + 1 + 0.0001) then
    begin
      x_cum := x_cum + x_rat;
      x_frac[i] := x_cum - x_last;
    end
    else
    begin
      inc(src_col);
      x_frac[i] := src_col - x_last;
    end;
    x_last := x_last + x_frac[i];
  end;
  FillChar(row^, sizeof(double) * width * words, 0);
  src_row := 0;
  y_cum := src_row;
  y_last := y_cum;
  CopyMemory(src, SrcImg.Scanline[0], orig_width * words*2);
  if src_row < (orig_height - 1) then
    CopyMemory(src_p1, SrcImg.ScanLine[1], orig_width * words*2);
  if (src_row + 1) < (orig_height - 1) then
    CopyMemory(src_p2, SrcImg.Scanline[2], orig_width * words*2);
  i := height;
  while i > 0 do
  begin
    src_col := 0;
    x_cum := src_col;
    if ((y_cum + y_rat) <= (src_row + 1 + 0.0001)) then
    begin
      y_cum := y_cum + y_rat;
      dy := y_cum - src_row;
      y_frac := y_cum - y_last;
      advance_dest_y := true;
    end
    else
    begin
      y_frac := (src_row + 1) - y_last;
      dy := 1.0;
      advance_dest_y := false;
    end;
    y_last := y_last + y_frac;
    s := src;
    if src_row > 0 then
      s_m1 := src_m1
    else
      s_m1 := src;
    if src_row < (orig_height - 1) then
      s_p1 := src_p1
    else
      s_p1 := src;
    if (src_row + 1) < (orig_height - 1) then
      s_p2 := src_p2
    else
      s_p2 := s_p1;
    r := row;
    frac := 0;
    j := width;
    while j <> 0 do
    begin
      if (x_cum + x_rat) <= (src_col + 1 + 0.0001) then
      begin
        x_cum := x_cum + x_rat;
        dx := x_cum - src_col;
        advance_dest_x := true;
      end
      else
      begin
        dx := 1.0;
        advance_dest_x := false;
      end;
      tot_frac := x_frac[frac] * y_frac;
      inc(frac);
      if src_col > 0 then
        minus_x := -words
      else
        minus_x := 0;
      if src_col < (orig_width - 1) then
        plus_x := words
      else
        plus_x := 0;
      if (src_col + 1) < (orig_width - 1) then
        plus2_x := words * 2
      else
        plus2_x := plus_x;
      if filter = 1 then
      begin
        // bicubic
        case scale_type of
          MAX_MAY:
            for b := 0 to words - 1 do
              r[b] := r[b] + cubic(dy, round(cubic(dx, s_m1[b + minus_x], s_m1[b], s_m1[b + plus_x], s_m1[b + plus2_x], 0, 65535)), 
                round(cubic(dx, s[b + minus_x], s[b], s[b + plus_x], s[b + plus2_x], 0, 65535)),
                round(cubic(dx, s_p1[b + minus_x], s_p1[b], s_p1[b + plus_x], s_p1[b + plus2_x], 0, 65535)),
                round(cubic(dx, s_p2[b + minus_x], s_p2[b], s_p2[b + plus_x], s_p2[b + plus2_x], 0, 65535)), 0, 65535) * tot_frac;  // 3.0.2
          MAX_MIY:
            for b := 0 to words - 1 do
              r[b] := r[b] + cubic(dx, s[b + minus_x], s[b], s[b + plus_x], s[b + plus2_x], 0, 65535) * tot_frac;
          MIX_MAY:
            for b := 0 to words - 1 do
              r[b] := r[b] + cubic(dy, s_m1[b], s[b], s_p1[b], s_p2[b], 0, 65535) * tot_frac;
          MIX_MIY:
            for b := 0 to words - 1 do
              r[b] := r[b] + s[b] * tot_frac;
        end;
      end
      else
      begin
        // bilinear
        case scale_type of
          MAX_MAY:
            for b := 0 to words - 1 do
              r[b] := r[b] + ((1 - dy) * ((1 - dx) * s[b] + dx * s[b + plus_x]) + dy * ((1 - dx) * s_p1[b] + dx * s_p1[b + plus_x])) * tot_frac;
          MAX_MIY:
            for b := 0 to words - 1 do
              r[b] := r[b] + (s[b] * (1 - dx) + s[b + plus_x] * dx) * tot_frac;
          MIX_MAY:
            for b := 0 to words - 1 do
              r[b] := r[b] + (s[b] * (1 - dy) + s_p1[b] * dy) * tot_frac;
          MIX_MIY:
            for b := 0 to words - 1 do
              r[b] := r[b] + s[b] * tot_frac;
        end;
      end;
      if (advance_dest_x) then
      begin
        inc(pbyte(r), words * sizeof(double));
        dec(j);
      end
      else
      begin
        inc(pbyte(s_m1), words*2);
        inc(pbyte(s), words*2);
        inc(pbyte(s_p1), words*2);
        inc(pbyte(s_p2), words*2);
        inc(src_col);
      end;
    end;
    if advance_dest_y then
    begin
      tot_frac := 1.0 / (x_rat * y_rat);
      d := dest;
      r := row;
      ix := 0;
      for j := 0 to width - 1 do
      begin
        for b := 1 to words do
        begin
          d[ix] := ilimit(round(r[ix] * tot_frac), 0, 65535); // 3.0.2
          inc(ix);
        end;
      end;
      copymemory(DstImg.scanline[height - i], dest, width * words*2);
      FillChar(row^, sizeof(double) * width * words, 0);
      dec(i);
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc((height - i) / height * 100));
    end
    else
    begin
      s := src_m1;
      src_m1 := src;
      src := src_p1;
      src_p1 := src_p2;
      src_p2 := s;
      inc(src_row);
      if (src_row + 1) < (orig_height - 1) then
        CopyMemory(src_p2, SrcImg.Scanline[src_row + 2], orig_width * words*2);
    end;
  end;
  FreeMem(src_m1);
  FreeMem(src);
  FreeMem(src_p1);
  FreeMem(src_p2);
  FreeMem(dest);
  FreeMem(row);
  FreeMem(x_frac);
end;



////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////
       
// RGB->CbCr (CCIR Recommendation 601-1)
procedure RGBToCbCr(RGB: TRGB; out Cb, Cr: double);
begin
  Cb := -0.000661725490196 * RGB.R - 0.00129905882353 * RGB.G + 0.00196078431373  * RGB.B  + 0.5;  // Cb = 0..1
  Cr :=  0.00196078431373  * RGB.R - 0.00164192156863 * RGB.G - 0.000318862745098 * RGB.B  + 0.5;  // Cr = 0..1
end;

function IEGuessTolerance(Bitmap: TIEBitmap; mask: TIEMask; KeyColorRGB: TRGB; x1, y1, x2, y2 : integer): double;
var
  row, col: integer;
  px: PRGB;
  dist: double;
  Cb, Cr: double;
  normKeyCb, normKeyCr: double;
  keyHue, keySat, keyVal: integer;
  hue, sat, val: integer;
  Tolerance : Double;
begin
  Tolerance := 0;
  
  x2 := imin(x2, bitmap.Width); dec(x2);
  y2 := imin(y2, bitmap.Height); dec(y2);

  // RGB->CbCr
  RGBToCbCr( KeyColorRGB, normKeyCb, normKeyCr );
  // RGB->HSV
  RGB2HSV( KeyColorRGB, keyHue, keySat, keyVal );

  for row := y1 to y2 do
  begin
    px := Bitmap.ScanLine[ row ];
    inc(px, x1);
    for col := x1 to x2 do
    begin                           
      if not assigned(mask) or mask.IsEmpty or mask.IsPointInside(col + mask.X1, row + mask.Y1) then
      begin
        // RGB->CbCr
        RGBToCbCr( px^, Cb, Cr );
        // RGB->HSV
        RGB2HSV( px^, hue, sat, val );

        // calc normalized Euclidean distance
        dist := sqrt( sqr( Cb - normKeyCb ) / 2.0 + sqr( Cr - normKeyCr ) / 2.0 );
        if dist > Tolerance then
          Tolerance := dist;
      end;

      inc( px );
    end;
  end;

  Result := Tolerance * 3.0;
end;


// Sample nine regions of the image and return the one with the least hue variance
procedure IEGuessChromaKeyColor(Bitmap: TIEBitmap; out KeyColor : TRGB; bGetTolerance : Boolean; out Tolerance: Double);
const
  DEBUGGING_FILL_SAMPLE_AREA = False; // Enable for debugging only
const
  SAMPLES_COUNT_X = 3;  // # of Samples across (Should be odd so there is a central analysis)
  SAMPLES_COUNT_Y = 3;  // # of Samples down
  SAMPLE_COVERAGE = 66; // 66% of each region is analyzed
  SAMPLE_EDGE_MARGIN = 10; // Along the edge the sample is aligned this close to the side
  Sample_Analysis_Count  = 225;
var
  iCurrHueVariance : Integer;
  iNewHueVariance : Integer;
  aNewColor : TRGB;
  iSampleWidth, iSampleHeight: Integer;
  iSampleX, iSampleY : Integer;
  iX, iY : Integer;
  iCurrX1, iCurrY1, iCurrX2, iCurrY2 : Integer;
  iRegionWidth, iRegionHeight: Integer;
  iMarginLeft, iMarginTop: Integer;
begin
  Tolerance := 210;
  iCurrX1 := -1; iCurrY1 := -1;
  iCurrX2 := -1; iCurrY2 := -1;

  iCurrHueVariance := MAXINT;
  iRegionWidth  := Bitmap.Width  div SAMPLES_COUNT_X;
  iRegionHeight := Bitmap.Height div SAMPLES_COUNT_Y;
  iSampleWidth  := MulDiv( iRegionWidth , SAMPLE_COVERAGE, 100 );
  iSampleHeight := MulDiv( iRegionHeight, SAMPLE_COVERAGE, 100  );

  for iY := 0 to SAMPLES_COUNT_Y - 1 do
  begin
    if iY = 0 then
      // Align sample to top
      iMarginTop := MulDiv( iRegionHeight, SAMPLE_EDGE_MARGIN, 100 )
    else
    if iY = SAMPLES_COUNT_Y - 1 then
      // Align sample to bottom
      iMarginTop := iRegionHeight - MulDiv( iRegionHeight, SAMPLE_EDGE_MARGIN, 100 ) - iSampleHeight
    else
      // Align sample to vert centre
      iMarginTop := ( iRegionHeight - iSampleHeight ) div 2;

    for iX := 0 to SAMPLES_COUNT_X - 1 do
    begin
      if iX = 0 then
        // Align sample to left
        iMarginLeft := MulDiv( iRegionWidth, SAMPLE_EDGE_MARGIN, 100 )
      else
      if iX = SAMPLES_COUNT_X - 1 then
        // Align sample to right
        iMarginLeft := iRegionWidth - MulDiv( iRegionWidth, SAMPLE_EDGE_MARGIN, 100 ) - iSampleWidth
      else
        // Align sample to horz centre
        iMarginLeft := ( iRegionWidth - iSampleWidth ) div 2;

      iSampleX := iX * iRegionWidth  + iMarginLeft;
      iSampleY := iY * iRegionHeight + iMarginTop;
      aNewColor := IEAverageRGB_Sample( Bitmap, nil,
                                        iSampleX, iSampleY, iSampleX + iSampleWidth, iSampleY + iSampleHeight,
                                        iNewHueVariance,
                                        Sample_Analysis_Count );

      if iNewHueVariance < iCurrHueVariance then
      begin
        KeyColor := aNewColor;
        iCurrHueVariance := iNewHueVariance;
        iCurrX1 := iSampleX;
        iCurrY1 := iSampleY;
        iCurrX2 := iSampleX + iSampleWidth;
        iCurrY2 := iSampleY + iSampleHeight;
      end;
    end;
  end;

  if bGetTolerance and ( iCurrX1 > -1 ) then
    Tolerance := IEGuessTolerance( Bitmap, nil, KeyColor, iCurrX1, iCurrY1, iCurrX2, iCurrY2 );

  if DEBUGGING_FILL_SAMPLE_AREA then
     Bitmap.FillRect( iCurrX1, iCurrY1, iCurrX2, iCurrY2, clRed );
end;


{!!
<FS>TImageEnProc.GuessChromaKeyColor

<FM>Declaration<FC>
function GuessChromaKeyColor : <A TRGB>; overload;
function GuessChromaKeyColor(out Tolerance: Double) : <A TRGB>; overload;

<FM>Description<FN>
Analyzes a ChromaKey image to guess its key color (by examining nine areas of the image and using the one with the least hue variance). If a selection is active it only analyzes the selection.

The second overload will return a level of Tolerance that would remove all the background color from the selection. If this is used without a selection it is likely to return a level that is too low (a default tolerance of 0.21 is usually better).

A ChromaKey image contains a solid color block that is removed so that it can be applied to a background. E.g. in the following image the key color is neon green (R=0/G=254/B=0).

<IMG help_images\Chromakey.jpg>

<FM>Example<FC>
// Get the key color of the current layer
ImageEnView1.LayersCurrent := 1;
KeyColor := ImageEnView1.Proc.GuessChromaKeyColor;
clsKeyColor.Color := TRGB2TColor( KeyColor );

// Guess the key color and tolerance of the area selected by the user
procedure TMainForm.ImageEnView1SelectionChange(Sender: TObject);
var
  Tolerance: Double;
  KeyColor : TRGB;
begin
  if ImageEnView1.Selected then
  begin
    KeyColor := ImageEnView1.Proc.GuessChromaKeyColor( Tolerance );
    clsKeyColor.Color := TRGB2TColor( KeyColor );
    trkTolerance.Position := Trunc( Tolerance * 1000 );
    ApplyChromaKey();
  end;
end;

<FM>See Also<FN>
- <A CreateRGB>
- <A TRGB2TColor>
- <A TColor2TRGB>
!!}               
procedure TImageEnProc.GuessChromaKeyColorEx(out KeyColor : TRGB; bGetTolerance : Boolean; out Tolerance: Double);
const
  Sample_Analysis_Count  = 225;
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
  iHueVariance : Integer;
begin
  KeyColor := CreateRGB(0, 0, 0);
  Tolerance := 210;
  if MakeConsistentBitmap([]) = False then
    exit;

  if assigned( fImageEnView ) and
     ( fImageEnView is TImageEnView ) and
     TImageEnView( fImageEnView ).Selected then
  begin
    // Analyze just selection
    if not BeginImageAnalysis([ie24RGB], x1, y1, x2, y2, ProcBitmap, mask) then
      exit;
    KeyColor := IEAverageRGB_Sample(ProcBitmap, mask, x1, y1, x2, y2, iHueVariance, Sample_Analysis_Count);
    if bGetTolerance then
      Tolerance := IEGuessTolerance(ProcBitmap, mask, KeyColor, x1, y1, x2, y2);
    EndImageAnalysis(ProcBitmap);
    DoFinishWork;
  end
  else
  begin
    // Multiple samples of whole image
    IEGuessChromaKeyColor( fIEBitmap, KeyColor, bGetTolerance, Tolerance );
  end;
end;

function TImageEnProc.GuessChromaKeyColor : TRGB;
var
  Tolerance: Double;
begin
  GuessChromaKeyColorEx( Result, False, Tolerance );
end;


function TImageEnProc.GuessChromaKeyColor(out Tolerance: Double) : TRGB;
begin
  GuessChromaKeyColorEx( Result, True, Tolerance );
end;




procedure IERemoveChromaKey(Bitmap: TIEBitmap; KeyColorRGB: TRGB; Tolerance: double; Saturation: integer;
                            FeatherEdges: Integer; HueReduction : Integer = 0; RemoveNoise: boolean = False;
                            OnProgress: TIEProgressEvent = nil; Sender: TObject = nil);
const
  DEBUGGING_SHOW_HUE_DISTANCE = False; // Enable for debugging only
var
  width, height: integer;
  row, col: integer;
  palpha: pbyte;
  px: PRGB;
  dist: double;
  alpha: double;
  Cb, Cr: double;
  normKeyCb, normKeyCr: double;
  keyHue, keySat, keyVal: integer;
  hue, sat, val: integer;
  intAlpha: integer;
  hueDist : double;
  iPower: Integer;
  iMult: Integer;
begin
  Tolerance := Tolerance / 3.0; // we don't need full Tolerance range, so reduce
  if ( KeyColorRGB.R = 255 ) and
     ( KeyColorRGB.G = 255 ) and
     ( KeyColorRGB.B = 255 ) then
    Saturation := 0; // White pixels have 0 saturation
    
  // RGB->CbCr
  RGBToCbCr( KeyColorRGB, normKeyCb, normKeyCr );
  // RGB->HSV
  RGB2HSV( KeyColorRGB, keyHue, keySat, keyVal );

  case HueReduction of
    1      : begin iPower := 8; iMult := 1; end;
    2      : begin iPower := 4; iMult := 1; end;
    3      : begin iPower := 2; iMult := 1; end;
    4      : begin iPower := 2; iMult := 2; end;
    else {5} begin iPower := 2; iMult := 3; end;
  end;

  width  := Bitmap.Width;
  height := Bitmap.Height;
  for row := 0 to height - 1 do
  begin
    px := Bitmap.ScanLine[ row ];
    palpha := Bitmap.AlphaChannel.ScanLine[ row ];
    for col := 0 to width - 1 do
    begin
      // RGB->CbCr
      RGBToCbCr( px^, Cb, Cr );
      // RGB->HSV
      RGB2HSV( px^, hue, sat, val );

      // calc normalized Euclidean distance
      dist := sqrt( sqr( Cb - normKeyCb ) / 2.0 + sqr( Cr - normKeyCr ) / 2.0 );
      hueDist :=  1 - ( abs( hue - keyHue )  / 180 );
      if hueDist > 1 then
        hueDist := 1;

      alpha := 1.0;
      if DEBUGGING_SHOW_HUE_DISTANCE then
      begin
        px^.r := Trunc( 255 * hueDist );
        px^.g := 0;
        px^.b := 0;
      end
      else
      if ( dist <= Tolerance ) and ( sat >= Saturation ) then
      begin
        alpha := 0;
        px^.r := 0;
        px^.g := 0;
        px^.b := 0;
      end
      else
      if ( HueReduction > 0 ) and ( hueDist > 0 ) then
      begin
        sat := sat - Trunc( sat * Power( hueDist, iPower ) * iMult );
        HSV2RGB( px^, hue, sat, val );
      end;

      intAlpha := round( alpha * 255 );
      if intAlpha <= 0 then
        palpha^ := 0
      else
      if intAlpha >= 255 then
        palpha^ := 255
      else
        palpha^ := intAlpha;

      inc( palpha );
      inc( px );
    end;
    if assigned( OnProgress ) then
      OnProgress( Sender, trunc( row / height * 100 ));
  end;
  Bitmap.AlphaChannel.Full := false;

  if RemoveNoise then
    _kf_kfill( Bitmap.AlphaChannel, false, false, 6, 6, false );

  if FeatherEdges > 0 then
    Bitmap.FeatherAlphaEdges( FeatherEdges );
end;




{!!
<FS>TImageEnProc.RemoveChromaKey

<FM>Declaration<FC>
procedure RemoveChromaKey(KeyColorRGB: <A TRGB>; Tolerance: double; Saturation: integer; FeatherEdges: Integer;
                          HueReduction : Integer = 0; RemoveNoise: boolean = False); overload;
procedure RemoveChromaKey(KeyPixelX, KeyPixelY: integer; Tolerance: double; Saturation: integer; FeatherEdges: Integer;
                          HueReduction : Integer = 0; RemoveNoise: boolean = False); overload;

<FM>Description<FN>
ChromaKey is the removal of a background for a source image so it can be replaced by an alternative image.

<FM>ChromaKey Source Image<FN>
<IMG help_images\Chromakey.jpg>

<FM>ChromaKey Image on Background<FN>
<IMG help_images\ChromakeyAfter.jpg>


<FC>RemoveChromaKey<FN> removes the <FC>KeyColor<FN> of an image and sets it to transparent. Although <FC>KeyColor<FN> is a single color, <FC>RemoveChromaKey<FN> will remove a range of colors that are similar to cope with light variance in photography.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>KeyColorRGB<FN> (Overload 1)</C> <C>A typical color within the Chromakey background, e.g. as returned by <A TImageEnProc.GuessChromaKeyColor> or <A TImageEnProc.CalcAverageRGB></C> </R>
<R> <C><FC>KeyPixelX, KeyPixelY<FN> (Overload 2)</C> <C>A pixel within the Chromakey background to be used as the key color. If both are set to -1 then <A TImageEnProc.GuessChromaKeyColor> is used to guess the key color</C> </R>
<R> <C><FC>Tolerance<FN></C> <C>The level of tolerance when seeking similar colors to our key color. Range: 0.0 to 1.0. Typical value: 0.21</C> </R>
<R> <C><FC>Saturation<FN></C> <C>If a pixel is of a hue within our keycolor range, limit removal to the specified saturation. Range: 0 to 100. Typical value: 30</C> </R>
<R> <C><FC>FeatherEdges<FN></C> <C>Blurs the edge of the image to smooth the result and remove trace ChromaKey pixels (uses <A TImageEnProc.FeatherAlphaEdges>. Typical value: 2</C> </R>
<R> <C><FC>HueReduction<FN></C> <C>Pixels of a similar hue to our key color but outside the level of tolerance will be reduced in saturation (color intensity). 0 is no hue reduction, 1 is minimal, 5 is maximum. Settings of 0, 2 or 3 are best</C> </R>
<R> <C><FC>RemoveNoise<FN></C> <C>Removes stray pixels missed by the removal</C> </R>
</TABLE>

For more information on ChromaKey: <L http://en.wikipedia.org/wiki/Chroma_key>en.wikipedia.org/wiki/Chroma_key</L>

Typically ChromaKey removal is performed as follows:

1. Select a region of the background and use <A TImageEnProc.CalcAverageRGB> to determine the Key color
2. Adjust <FC>Tolerance<FN> until foreground subject is fully visible
3. Adjust <FC>Saturation<FN> to remove any remaining background
4. If necessary, adjust <FC>FeatherEdges<FN>, <FC>HueReduction<FN> or <FC>RemoveNoise<FN>
             
<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\ChromaKey\ChromaKey.dpr </C> </R>
</TABLE>

<FM>Example<FC>
// Load background
ImageEnView1.IO.LoadFromFile( sBackgroundFile );

// Load our ChromaKey (foreground) image as a foreground layer
ImageEnView1.LayersAdd( sChromaKeyFile );

// Get the average color of the selection (if the user has selected a background region) or guess the background color
if ImageEnView1.Selected then                  
  KeyColorRGB := ImageEnView1.Proc.CalcAverageRGB( 100 );
else
  KeyColorRGB := ImageEnView1.Proc.GuessChromaKeyColor();

// Remove Chromakey from foreground layer (will become transparent)
ImageEnView1.Proc.RemoveChromaKey( KeyColorRGB, 0.21, 30, 2, 0 );

// Refresh our view
ImageEnView1.Update();

<FM>See Also<FN>
- <A CreateRGB>
- <A TRGB2TColor>
- <A TColor2TRGB>
!!}
// Pass Key pixels or -1,-1 to guess Key color
procedure TImageEnProc.RemoveChromaKey(KeyPixelX, KeyPixelY: integer; Tolerance: double; Saturation: integer; FeatherEdges: Integer;
                                       HueReduction : Integer = 0; RemoveNoise: boolean = False);
var
  KeyColorRGB: TRGB;
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
  DummyTolerance: Double;
begin
  if not BeginImageProcessing( [ ie1g, ie24RGB ], x1, y1, x2, y2,
                               {$IFDEF IEUseLegacyUndoCaptions}
                               IERS_REMOVECHROMAKEY,
                               {$ELSE}
                               IEMsg( IEMSG_REMOVECHROMAKEY ),
                               {$ENDIF}
                               ProcBitmap, mask , IEOP_REMOVECHROMAKEY ) then
    exit;
  if ( KeyPixelX = -1 ) and ( KeyPixelY = -1 ) then
    IEGuessChromaKeyColor( ProcBitmap, KeyColorRGB, False, DummyTolerance )
  else
    KeyColorRGB := ProcBitmap.Pixels[ KeyPixelX, KeyPixelY ];
  IERemoveChromaKey( ProcBitmap, KeyColorRGB, Tolerance, Saturation, FeatherEdges, HueReduction, RemoveNoise, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


// Tolerance 0..1
// BlurRadius = 0 -> disable blur
procedure TImageEnProc.RemoveChromaKey(KeyColorRGB: TRGB; Tolerance: double; Saturation: integer; FeatherEdges: Integer;
                                       HueReduction : Integer = 0; RemoveNoise: boolean = False);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing( [ ie1g, ie24RGB ], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_REMOVECHROMAKEY,
                              {$ELSE}
                              IEMsg( IEMSG_REMOVECHROMAKEY ),
                              {$ENDIF}
                              ProcBitmap, mask , IEOP_REMOVECHROMAKEY ) then
    exit;
  IERemoveChromaKey( ProcBitmap, KeyColorRGB, Tolerance, Saturation, FeatherEdges, HueReduction, RemoveNoise, fOnProgress, self );
  EndImageProcessing( ProcBitmap, mask );
  DoFinishWork;
end;


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

{!!
<FS>TImageEnProc.SetTransparentColors

<FM>Declaration<FC>
procedure SetTransparentColors(MinColor, MaxColor: <A TRGB>; Alpha: Integer);

<FM>Description<FN>
Sets all pixels within the MinColor and MaxColor range as transparent. The level of transparency is specified by <FC>Alpha<FN> (0=fully transparent, 255=fully visible).
If you are sure of the RGB value of the transparent colors, you can set MinColor and MaxColor to the same value. To specify all colors from gray (128, 128, 128) to white (255, 255, 255) as transparent, write SetTransparentColors(CreateRGB(128, 128, 128), CreateRGB(255, 255, 255), 0).

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\MakeTransparent\MakeTransparent.dpr </C> </R>
</TABLE>

<FM>Example<FC>
// this example draws a text with soft shadow over a background image
ImageEnView1.IO.LoadFromfile('background.jpg');  // load background image
ImageEnView1.LayersAdd;  // add a new layer
ImageEnView1.Bitmap.Canvas.Font.Name := 'Times New Roman';
ImageEnView1.Bitmap.Canvas.Font.Height := 45;
ImageEnView1.Bitmap.Canvas.Font.Color := clYellow;
ImageEnView1.Bitmap.Canvas.TextOut(0, 250, 'Hello World!');  // draw text on second layer
ImageEnView1.Proc.SetTransparentColors(CreateRGB(255, 255, 255), CreateRGB(255, 255, 255), 0);  // remove the white, making it as transparent
ImageEnView1.Proc.AddSoftShadow(2, 3, 3);  // add the shadow

<IMG help_images\HelloWorld.jpg>

<FM>See Also<FN>
- <A CreateRGB>
- <A TRGB2TColor>
- <A TColor2TRGB>
!!}
procedure TImageEnProc.SetTransparentColors(MinColor, MaxColor: TRGB; Alpha: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie1g, ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_SETTRANSPARENTCOLORS,
                              {$ELSE}
                              IEMsg( IEMSG_TRANSPARENTCOLOR ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_SETTRANSPARENTCOLORS ) then
    exit;
  _SetTransparentColors(ProcBitmap, x1, y1, x2, y2, MinColor, MaxColor, Alpha, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

// works with ie24RGB and ie1g
// for ie1g only MinColor.r cares
procedure _SetTransparentColors(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; MinColor, MaxColor: TRGB; alpha: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  x, y: Integer;
  px: PRGB;
  pa, pb: pbyte;
  per1: Double;
  st: Boolean;
begin
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  case bitmap.PixelFormat of
    ie24RGB:
      for y := fSelY1 to fSelY2 do
      begin
        px := bitmap.Scanline[y];
        inc(px, fSelX1);
        pa := bitmap.AlphaChannel.Scanline[y];
        inc(pa, fSelX1);
        for x := fSelX1 to fSelX2 do
        begin
          with px^ do
            if (r >= MinColor.r) and (g >= MinColor.g) and (b >= MinColor.b) and (r <= MaxColor.r) and (g <= MaxColor.g) and (b <= MaxColor.b) then
              pa^ := alpha;
          inc(px);
          inc(pa);
        end;
        if assigned(fOnProgress) then
          fOnProgress(Sender, trunc(per1 * (y - fSelY1 + 1)));
      end;
    ie1g:
      begin
        st := MinColor.r > 0;
        for y := fSelY1 to fSelY2 do
        begin
          pb := bitmap.Scanline[y];
          pa := bitmap.AlphaChannel.Scanline[y];
          inc(pa, fSelX1);
          for x := fSelX1 to fSelX2 do
          begin
            if pbytearray(pb)^[x shr 3] and iebitmask1[x and $7] = 0 then
            begin
              if not st then
                pa^ := alpha;
            end
            else
            begin
              if st then
                pa^ := alpha;
            end;
            inc(pa);
          end;
          if assigned(fOnProgress) then
            fOnProgress(Sender, trunc(per1 * (y - fSelY1 + 1)));
        end;
      end;
  end;
  bitmap.AlphaChannel.SyncFull;
end;

// return:
//   in Color the dominant color
//   in result the percentage
// works with ie1g and ie24RGB

{!!
<FS>TImageEnProc.GetDominantColor

<FM>Declaration<FC>
function GetDominantColor(var Color: <A TRGB>): Double;

<FM>Description<FN>
Returns the dominant (most common) color in the image.
<FC>Color<FN> will contain the dominant color, and the result will return the percentage of the image with that color.

<FM>Example<FC>
Percentage := ImageEnView.Proc.GetDominantColor(cl);
If Percentage = 100 then
   ShowMessage('the image is blank!');

<FM>See Also<FN>
- <A CreateRGB>
- <A TRGB2TColor>
- <A TColor2TRGB>

!!}
function TImageEnProc.GetDominantColor(var Color: TRGB): Double;
var
  hist: array[0..255] of integer;
  x, y, tot, c, v, i: Integer;
  hash: TIEIntegerMap;
  item: TIEIntegerMapItem;
  pxrgb: PRGB;
  maxv, maxi: Integer;
  clist, vlist: TList;
  BitmapWidth, BitmapHeight: Integer;
begin
  result := -1;
  if not MakeConsistentBitmap([]) then
    exit;
  BitmapWidth  := fIEBitmap.Width;
  BitmapHeight := fIEBitmap.Height;
  tot := BitmapWidth * BitmapHeight;
  if tot = 0 then
    exit;
  case fIEBitmap.PixelFormat of
    ie1g:
      begin
        _IEGetHistogram(fIEBitmap, @hist);
        if hist[0] > hist[1] then
        begin
          result := (hist[0] / tot) * 100;
          Color := CreateRGB(0, 0, 0);
        end
        else
        begin
          result := (hist[1] / tot) * 100;
          Color := CreateRGB(255, 255, 255);
        end;
      end;
    ie24RGB:
      begin
        clist := TList.Create;
        vlist := TList.Create;
        hash := TIEIntegerMap.Create();
        for y := 0 to BitmapHeight - 1 do
        begin
          pxrgb := fIEBitmap.ScanLine[y];
          for x := 0 to BitmapWidth - 1 do
          begin
            with pxrgb^ do
              c := (r shl 16) or (g shl 8) or (b);
            if not hash.Insert(c, item) then
            begin
              // the key (color) already exists
              v := item.value;
              vlist[v] := pointer(uint64(vlist[v]) + 1);
            end
            else
            begin
              // the key (color) is new
              v := vlist.Add(pointer(1));
              clist.Add(pointer(TRGB2TColor(pxrgb^)));
              item.value := v;
            end;
            inc(pxrgb);
          end;
        end;
        maxv := 0;
        maxi := 0;
        hash.IterateBegin();
        repeat
          i := hash.IterateGetValue();
          v := uint64(vlist[i]);
          if v > maxv then
          begin
            maxv := v;
            maxi := i;
          end;
        until not hash.IterateNext();
        Color := TColor2TRGB(integer(clist[maxi]));
        result := (maxv / tot) * 100;
        FreeAndNil(hash);
        FreeAndNil(clist);
        FreeAndNil(vlist);
      end;
  end;
  DoFinishWork;
end;

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


type
  TSource = array[0..0] of pRGBRow;
  pSourcePtr = ^TSource;

{!!
<FS>TImageEnProc.MedianFilter

<FM>Declaration<FC>
procedure MedianFilter(WindowX: Integer=5; WindowY: Integer=5; Brightness: Integer = 50; Contrast: Integer = 50; Multiplier: Integer = 1; Threshold: Integer = 50; MedianOp: <A TIEMedFilType> = mfMedianFilter);

<FM>Description<FN>
Perform fast median filtering on an image using windows from 3x3 to 19x19 maximum size. MedianFilter works only with true color images.
Filtering can be of three types:
<TABLE>
<R> <C><FC>mfMedianFilter<FN></C> <C>Substitute median if central point differs from median by a threshold amount</C> </R>
<R> <C><FC>mfSharpen<FN></C> <C>High pass sharpening</C> </R>
<R> <C><FC>mfEdgeExtract<FN></C> <C>Edge extraction</C> </R>
</TABLE>


 Operation:

 Histogram in moving window at beginning of line is initiated. Histogram is updated after each move subtracting
 left column values from previous window, adding right column values.  Median updated by counting up or down
 number of pixels less than or greater than old median.

 For color images, the grayscale intensity of a pixel is computed as a weighted linear combination of RGB and
 counted in the histogram. The pixel with the nearest (L1 norm) color to the average of all pixels in the moving
 window except the central point is used in place of the median.

 The computation of the median for a color image has a complexity of O(N^4), whereas this technique is only O(N^2)
 or less and is as good when the window size is 19x19 when the median differs only by a small amount from the mean.
 For smaller windows performance degrades as the mean differs from the median, but it is still satisfactory down to
 a 5x5 window.

 Adaptive thresholding is used to preserve sharp edges. A pixel is replaced by the median or its nearast average
 color equivalent if it lies outside the 1st and 3rd quantile of the intensity distribution. The user may modify
 the position of the quantiles interactively. Defaults are the first and third quartiles. For grayscale images,
 the quantiles and medians are used directly.

 The green element of a TRGB record is used as an intensity measurement. The user must provide means of detecting
 whether or not an image is color or grayscale.

 Author:

 I.Scollar, following Huang, Yang, Tang, unpublished report submitted under Defense Advanced Research Projects
 Agency contract no. MDA 903-77-G-1, "A fast two dimensional median filtering algorithm"
 T.S.Huang, G.J.Yang, G.Y.Tang, School of Electrical Engineering, Purdue University, West Lafayette, Indiana 47907, USA.

 First publication: T.S.Huang, G.J.Yang, G.Y.Tang, Proceedings IEEE Conference Pattern Recognition and Image Processing,
 Chicago 1978, p. 128 ff.

 I.Scollar, B.Weidner, T.S.Huang, Image enhancement using the median and the interquartile distance, Computer Vision,
 Graphics and Image Processing, 25 1984 236-251

 Original Fortran IV, 512x512 grayscale images G.Y.Tang, 1976

 Modifications:
 Large images on DEC PDP11, I. Scollar Sept. 1978
 Normalized sharpening, I.Scollar Sept. 1980
 Adaptive quantile thresholding, I.Scollar Sept. 1980
 Ported from DEC Fortran IV to Delphi 7 Pascal, I.Scollar March 11, 2003
 Extension to color images, I. Scollar, March 13, 2003

!!}
procedure TImageEnProc.MedianFilter(WindowX, WindowY: Integer; Brightness, Contrast, Multiplier, Threshold: Integer; MedianOp: TIEMedFilType);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_MEDIANFILTER,
                              {$ELSE}
                              IEMsg( IEMSG_MEDIANFILTER ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_MEDIANFILTER ) then
    exit;
  _IEMedianFilter(ProcBitmap, WindowX, WindowY, Brightness, Contrast, Multiplier, Threshold, MedianOp, fOnProgress, Self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


procedure _IEMedianFilter(image: TIEBitmap; WindowX, WindowY: Integer; Brightness, Contrast, Multiplier, Threshold: Integer; MedianOp: TIEMedFilType; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  aHeight, aHeight32, aWidth, aWidth32: Integer;
  pTarget: pRGB;
  pSource: pRGB;
  Source: TIEBitmap;
  Target: TIEBitmap;
  Nwx, Nwx2, Nwx21, Nwy, Nwy2, WinTot, WinTot2: Integer;
  i, j, k, m, n: Integer;
  Hist: array[0..255] of integer;
  HistIndex: Integer;
  Sum, LTMedian, Median: Integer;
  left1, right1: Integer;
  Thresh: Integer;
  CenterPixel: PRGB;
  CP, CPM, Gain, Off: Double;
  Value: Integer;
  PixOut: TRGB;
  WinTot1: Double;
  Diff, LastDiff: Integer;
  Q, Q25, Q75, TQ25, TQ75, LTQ25, LTQ75: Integer;

  procedure GetAveragePixelColor;
  var
    ii, jj: Integer;
    px: PRGB;
    rr, gg, bb: Integer;
    avg_r, avg_g, avg_b: Integer;
  begin
    // compute average value of pixels in the window, excluding central pixel
    FillChar(PixOut, SizeOf(PixOut), #255);
    rr := 0; gg := 0; bb := 0;
    for ii := -Nwy2 to Nwy2 do
    begin
      // 3.0.2
      px := Source.Scanline[ii+i]; inc(px, -Nwx2+j);
      for jj := -Nwx2 to Nwx2 do
      begin
        if (ii <> 0) or (jj <> 0) then
          with px^ do
          begin
            inc(rr, r);
            inc(gg, g);
            inc(bb, b);
          end;
        inc(px);
      end;
    end;
    avg_r := blimit(trunc(rr * WinTot1));
    avg_g := blimit(trunc(gg * WinTot1));
    avg_b := blimit(trunc(bb * WinTot1));
    // get the pixel in the window whose color is nearest to the average so that there are no color shifts}
    LastDiff := MaxInt;
    for ii := -Nwy2 to Nwy2 do
    begin
      // 3.0.2
      px := Source.Scanline[ii+i]; inc(px, -Nwx2+j);
      for jj := -Nwx2 to Nwx2 do
      begin
        if (ii <> 0) or (jj <> 0) then
        begin
          with px^ do
            Diff := Abs(r - avg_r) + Abs(g - avg_g) + Abs(b - avg_b);
          if (Diff = 0) then
          begin
            PixOut := px^;
            break;
          end;
          if (Diff < LastDiff) then
          begin
            PixOut := px^;
            LastDiff := Diff;
          end;
        end;
      end;
    end;
    pTarget^ := PixOut;
  end;


begin
  //pSource := nil;
  Target := nil;
  try
    Source := image;
    aHeight := Source.Height - 1;
    aWidth := Source.Width;
    Target := TIEBitmap.Create;
    Target.Location := ieMemory;
    Target.Allocate(Source.Width, Source.Height, IE24RGB);
    {get processing window sizes}
    Nwx := WindowX;
    Nwy := WindowY;
    WinTot := Nwx * Nwy;
    WinTot1 := 1.0 / (WinTot - 1);
    Nwx2 := Nwx div 2;
    Nwy2 := Nwy div 2;
    Nwx21 := Nwx2 + 1;
    WinTot2 := Nwx * Nwy div 2;
    TQ25 := WinTot div 4;
    TQ75 := 3 * TQ25;
    aWidth32 := Source.Width - Nwx2;
    aHeight32 := Source.Height - Nwy2;
    CP := WinTot;
    Off := 5.1 * (Brightness - 50);
    CPM := Multiplier;
    Gain := Contrast;
    Thresh := trunc(Threshold * 2.56);
    {set other parameters}
    case MedianOp of
      mfMedianFilter:
        begin
          Thresh := trunc(Threshold * 2.56);
          TQ25 := (WinTot div 4) - trunc((Threshold - 50) * 0.02 * TQ25);
          TQ75 := 3 * (WinTot div 4) + trunc((Threshold - 50) * 0.02 * TQ25);
        end;
      mfSharpen:
        begin
          CPM := 6.36 - (1.0 + Multiplier * 0.04);
          CPM := CPM * (WinTot - 1);
          CP := CPM + 1.0;
          Gain := 1.0 / (CP - WinTot);
        end;
      mfEdgeExtract:
        begin
          CP := Wintot;
          Gain := 0.5 * Contrast / (WinTot - 1);
          Thresh := trunc(Threshold * 2.56);
        end;
    end;
    i := 0;
    {copy top of image or set it to white}
    while (i < Nwy2) do
    begin
      if assigned(fOnProgress) then
        fOnProgress(Sender, Trunc(i / Source.Height * 100) + 1);
      if (MedianOp = mfEdgeExtract) then
        FillChar(Target.Scanline[i]^, Source.Width * SizeOf(TRGB), #255)
      else
        Move(Source.ScanLine[i]^, Target.Scanline[i]^, Source.Width * SizeOf(TRGB));
      Inc(i);
    end;
    {main loop}
    while (i < aHeight32) do
    begin
      if (i mod 10) = 0 then
        if assigned(fOnProgress) then
          fOnProgress(Sender, Trunc(i / Source.Height * 100) + 1);
      pSource := pRGB(Source.Scanline[i]);
      pTarget := pRGB(Target.Scanline[i]);
      {copy left unprocessed side of image}
      if (MedianOp = mfEdgeExtract) then
        FillChar(Target.Scanline[i]^, Nwx2 * SizeOf(TRGB), #255)
      else
        Move(pSource^, pTarget^, SizeOf(TRGB) * Nwx2);
      inc(pTarget, Nwx2);
      {Initialize histogram for this line}
      FillChar(Hist, Sizeof(Hist), #0);
      for k := -Nwy2 to Nwy2 do
      begin
        for n := -Nwx2 to Nwx2 do
        begin
          with Source.Pixels_ie24RGB[n + Nwx2, k + i] do
            HistIndex := (r * 54 + g * 182 + b * 20) shr 8;
          Inc(Hist[HistIndex]);
        end;
      end;
      Sum := 0;
      for m := 0 to 255 do
      begin
        Sum := Sum + Hist[m];
        if (Sum > TQ25) then
          break;
      end;
      Q25 := m;
      LTQ25 := Sum - Hist[m];
      Sum := 0;
      for m := 0 to 255 do
      begin
        Sum := Sum + Hist[m];
        if (Sum > WinTot2) then
          break;
      end;
      Median := m;
      LTMedian := Sum - Hist[m];
      Sum := 0;
      for m := 0 to 255 do
      begin
        Sum := Sum + Hist[m];
        if (Sum > TQ75) then
          break;
      end;
      Q75 := m;
      LTQ75 := Sum - Hist[m];
      {process all pixels in this line}
      CenterPixel := Source.Scanline[i];
      inc(CenterPixel, Nwx21);
      for j := Nwx21 to aWidth32 - 1 do
      begin

        left1 := j - Nwx21;
        right1 := j + Nwx2;
        for k := -Nwy2 to Nwy2 do
        begin
          {remove left side counts of window from histogram}
          with Source.Pixels_ie24RGB[left1, k + i] do
            HistIndex := (r * 54 + g * 182 + b * 20) shr 8;
          Dec(Hist[HistIndex]);
          if (HistIndex < Q25) then
            Dec(LTQ25);
          if (HistIndex < Median) then
            Dec(LTMedian);
          if (HistIndex < Q75) then
            Dec(LTQ75);
          {add right side counts of window to histogram}
          with Source.Pixels_ie24RGB[right1, k + i] do
            HistIndex := (r * 54 + g * 182 + b * 20) shr 8;
          Inc(Hist[HistIndex]);
          if (HistIndex < Q25) then
            Inc(LTQ25);
          if (HistIndex < Median) then
            Inc(LTMedian);
          if (HistIndex < Q75) then
            Inc(LTQ75);
        end;
        {update quartiles and median}
        if (LTQ25 < TQ25) then
        begin
          while ((LTQ25 + HIST[Q25]) < TQ25) do
          begin
            LTQ25 := LTQ25 + HIST[Q25];
            Inc(Q25);
          end;
        end
        else
        begin
          repeat
            Dec(Q25);
            LTQ25 := LTQ25 - HIST[Q25];
          until (LTQ25 < TQ25);
        end;
        if (LTMedian < WinTot2) then
        begin
          while ((LTMedian + HIST[Median]) < WinTot2) do
          begin
            LTMedian := LTMedian + HIST[Median];
            Inc(Median);
          end;
        end
        else
        begin
          repeat
            Dec(Median);
            LTMedian := LTMedian - HIST[Median];
          until (LTMedian < WinTot2);
        end;
        if (LTQ75 < TQ75) then
        begin
          while ((LTQ75 + HIST[Q75]) < TQ75) do
          begin
            LTQ75 := LTQ75 + HIST[Q75];
            Inc(Q75);
          end;
        end
        else
        begin
          repeat
            Dec(Q75);
            LTQ75 := LTQ75 - HIST[Q75];
          until (LTQ75 < TQ75);
        end;
        case MedianOp of
          mfMedianFilter:
            if (Thresh = 0) then
              GetAveragePixelColor
            else
            begin
              Q := Q75 - Q25;
              if (abs(CenterPixel^.g - Median) < Q) and
                 (abs(CenterPixel^.r - Median) < Q) and
                 (abs(CenterPixel^.b - Median) < Q) then
                pTarget^ := CenterPixel^
              else
                GetAveragePixelColor;
            end;
          mfSharpen:
            begin
              GetAveragePixelColor;
              pTarget^.r := blimit(trunc((CP * CenterPixel^.r - PixOut.r * WinTot) * Gain + Off));
              pTarget^.g := blimit(trunc((CP * CenterPixel^.g - PixOut.g * WinTot) * Gain + Off));
              pTarget^.b := blimit(trunc((CP * CenterPixel^.b - PixOut.b * WinTot) * Gain + Off));
            end;
          mfEdgeExtract:
            begin
              value := 255 - blimit(trunc((CP * CenterPixel^.g - Median * WinTot) * Gain + Off));
              if value < Thresh then
                value := 0
              else
                value := 255;
              pTarget^.r := value;
              pTarget^.g := value;
              pTarget^.b := value;
            end;
        end;
        inc(pTarget);
        inc(CenterPixel);
      end;
      {copy right unprocessed side of image}
      // 3.0.2 (22082008 1005)
      pSource := pRGB(Source.Scanline[i]); inc(pSource, aWidth32-1);
      pTarget := pRGB(Target.Scanline[i]); inc(pTarget, aWidth32-1);
      for j := aWidth32-1 to Source.Width-1 do
      begin
        if (MedianOp = mfEdgeExtract) then
        begin
          pTarget^.r := 255;
          pTarget^.g := 255;
          pTarget^.b := 255;
        end
        else
          pTarget^ := pSource^;
        inc(pTarget);
        inc(pSource);
      end;
      inc(i);
    end;
    {copy bottom of image}
    while (i <= aHeight) do
    begin
      if assigned(fOnProgress) then
        fOnProgress(Sender, Trunc(i / Source.Height * 100) + 1);
      if (MedianOp = mfEdgeExtract) then
        FillChar(Target.Scanline[i]^, Source.Width * SizeOf(TRGB), #255)
      else
        Move(Source.ScanLine[i]^, Target.Scanline[i]^, Source.Width * SizeOf(TRGB));
      Inc(i);
    end;
    Source.AssignImage(Target);
  finally
    FreeAndNil(Target);
  end;
end;


// Median Filtering
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////




///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{
Locally adaptive image enhancement based on:

Wallis, R. An approach to the space variant restoration and enhancement of images. Proceedings, Symposium on Current Mathematical Problems in Image Science, Monterey CA,  1976 10-12 reprinted in C.O. Wilde E. Barrett, eds. Image Science Mathematics, Western Periodicals, North Hollywood, CA, 1977. Summarised in Pratt:

Pratt, W.K. Digital Image Processing, 2nd. ed. John Wiley & Sons, New York, 1991, 248, 503

Programming for Delphi:

I. Scollar 2003

  W A L L I S  -  STATISTICAL DIFFERENCING USING WALLIS ALGORITHM

  PURPOSE:

  IMPLEMENT THE STATISTICAL DIFFERENCING FILTER OF WALLIS (SEE
  W. PRATT, DIGITAL IMAGE PROCESSING) FOR LARGE PICTURES
  AND LARGE WINDOWS GREATER THAN 20X20

  EFFICIENT SAMPLING TECHNIQUE TO COMPUTE LOCAL MEANS AND VARIANCES.

  OPERATION:

  THE WINDOW DIMENSIONS AND 5 PARAMETERS FOR THE WALLIS FORMULA:
 MEAN    - DESIRED LOCAL MEAN OF OUTPUT
     A COMMONLY USED VALUE FOR MANY APPLICATIONS
     IS 128.ALLOWED RANGE 0-255.
 S.D.      DESIRED LOCAL STANDARD DEVIATION (CONTRAST)
     OF OUTPUT PICTURE. ALLOWED RANGE 0-100.
     COMMONLY USED RANGE 50-75.
 GAIN      CONTROLS RATIO OF MEASURED TO DESIRED
     LOCAL VARIANCE. ALLOWED RANGE 0-INFINITY
     EFFECT:
    0  NO VARIANCE EQUALIZATION
     THIS IS THE SAME AS LEE'S
     ALGORITHM (IEEE PROC. PRIP 1978,P.56)

    INF  MAXIMUM VARIANCE EQUALIZATION
     THIS IS EQUIVALENT TO WATKIN'S
     ALGORITHM.
     COMMONLY USED RANGE 4-25.
 EDGE FACT.    CONTROLS AMOUNT OF MEAN EQUALIZATION
     ALLOWED RANGE 0-1.
     EFFECT:
    1  FULL MEAN EQUALIZATION
    0  MEASURED MEAN RESTORED

  AUTHORS:

  B. WEIDNER, RLMB, 1979
  BASED ON IDEAS TAKEN FROM MVEQN/F BY I. SCOLLAR 1979
  BASED ON IDEAS TAKEN FROM ANAY14 BY G. TANG, 1977

}

procedure _IEWallisFilter(image: TIEBitmap; WinWidth, WinHeight: Integer; Mean, StDev, InGain, Edge, Limit: Integer; Thresholding: Boolean; fOnProgress: TIEProgressEvent; Sender: TObject);
const
  VH = 15;
  VW = 15;
type
  ColumnSums = array[0..0] of Extended;
  ColumnSumsPtr = ^ColumnSums;
var
  Target: TIEBitmap;
  aHeight, aWidth, aWidth32: Integer;
  Pix, White, Black: TRGB;
  h, l, s: Double;
  ColSum: ColumnSumsPtr;
  ColSqs: ColumnSumsPtr;
  Nwx, Nwx2, Nwy, Nwy2: Integer;
  i, j, jp: Integer;
  Total, W, C1, C2, C3, AMean, SDev, Gain, EF, ALim,
    Sum, SumSq, Asd, Amy, F1, F2: Double;
  vwidth, vheight: Integer;

  function getpx(x, y: Integer): TRGB;
  begin
    dec(x, VW);
    dec(y, VH);
    x := ilimit(x, 0, image.Width - 1);
    y := ilimit(y, 0, image.Height - 1);
    result := image.Pixels_ie24RGB[x, y];
  end;

  procedure setpx(x, y: Integer; v: TRGB);
  begin
    dec(x, VW);
    dec(y, VH);
    x := ilimit(x, 0, image.Width - 1);
    y := ilimit(y, 0, image.Height - 1);
    target.Pixels_ie24RGB[x, y] := v;
  end;

begin
  ColSum := nil;
  ColSqs := nil;
  White.b := 255;
  White.g := 255;
  White.r := 255;
  Black.b := 0;
  Black.g := 0;
  Black.r := 0;
  try
    Target := TIEBitmap.Create;
    Target.Location := ieFile;
    Target.Allocate(image.Width, image.Height, IE24RGB);
    //
    vwidth := image.Width + VW * 2;
    vheight := image.height + VH * 2;
    {get window sizes and half sizes}
    aHeight := vHeight - 1;
    aWidth := vWidth - 1;
    if aHeight < aWidth then
    begin
      Nwx := Trunc(WinWidth / 100 * aHeight);
      Nwy := Trunc(WinHeight / 100 * aHeight);
    end
    else
    begin
      Nwx := Trunc(WinWidth / 100 * aWidth);
      Nwy := Trunc(WinHeight / 100 * aWidth);
    end;
    Nwx := iMax(Nwx, 21);
    Nwy := iMax(Nwy, 21);
    Nwx2 := (Nwx + 1) div 2;
    Nwy2 := (Nwy + 1) div 2;
    aWidth32 := aWidth - Nwx2;
    Total := Nwx * Nwy;
    W := 1 / Total;
    {get memory for the column sums and the column sum squared buffers}
    GetMem(ColSum, (vWidth + Nwx) * SizeOf(Extended));
    GetMem(ColSqs, (vWidth + Nwx) * SizeOf(Extended));
    FillChar(ColSum^, (vWidth + Nwx) * SizeOf(Extended), #0);
    FillChar(ColSqs^, (vWidth + Nwx) * SizeOf(Extended), #0);
    {initialization of Wallis formula parameters}
    Amean := (1.0 * Mean / 100);
    Sdev := (3.0 * StDev / 100);
    Gain := (100.0 * InGain / 100);
    EF := (1.0 * Edge / 100);
    Alim := (6.0 * Limit / 100);
    C1 := Gain * Sdev;
    C2 := EF * Amean;
    C3 := 1.0 - EF;
    {initialize column sums and squares of sums for first window swath}
    i := 0;
    while (i < Nwy) do
    begin
      jp := 0;
      while (jp < aWidth) do
      begin
        Pix := getpx(jp, i);
        RGB2HSL(Pix, h, s, l);
        ColSum^[jp] := ColSum^[jp] + l;
        ColSqs^[jp] := ColSqs^[jp] + Sqr(l);
        Inc(jp);
      end;
      Inc(i);
    end;
    {main loop}
    for i := 0 to aHeight do
    begin
      if assigned(fOnProgress) then
        fOnProgress(Sender, Trunc(i / vHeight * 100) + 1);
      if not ((i - Nwy2 < 0) or (i + Nwy2 > aHeight)) then
      begin

        {initialize sums in window for beginning of new line}
        Sum := 0.0;
        Sumsq := 0.0;
        jp := 0;
        while (jp <= Nwx - 1) do
        begin
          Sum := Sum + Colsum^[jp];
          Sumsq := Sumsq + Colsqs^[jp];
          Inc(jp);
        end;
        {new line}
        j := 0;
        while j < Nwx2 do
        begin
          if not Thresholding then
            setpx(j, i, getpx(j, i))
          else
            setpx(j, i, White);
          Inc(j);
        end;
        jp := 0;
        while (j <= aWidth32) do
        begin
          {do the Wallis correction on the luminance l}
          Pix := getpx(j, i);
          RGB2HSL(Pix, h, s, l);
          amy := sum * w;
          asd := sqrt((sumsq * w - Sqr(amy)) + 1.0);
          if (asd > alim) then
            asd := alim;
          f1 := c1 / (gain * asd + sdev + 0.00001);
          f2 := c2 + c3 * amy;
          l := (l - amy) * f1 + f2;
          if (l > 1.0) then
            l := 1.0;
          if (l < 0.0) then
            l := 0.0;
          HSL2RGB(Pix, h, s, l);
          if not Thresholding then
            setpx(j, i, Pix)
          else
          if l > 0.5 then
            setpx(j, i, White)
          else
            setpx(j, i, Black);
          {update window}
          sum := sum + colsum^[jp + nwx] - colsum^[jp];
          sumsq := sumsq + colsqs^[jp + nwx] - colsqs^[jp];
          Inc(j);
          Inc(jp);
        end;
        {fill in the non-computable remainder of the line}
        while j <= aWidth do
        begin
          if not Thresholding then
            setpx(j, i, getpx(j, i))
          else
            setpx(j, i, White);
          Inc(j);
        end;
        {update column sums for a new line}
        j := 0;
        l := 127;
        while (j <= aWidth32) do
        begin
          Pix := getpx(j, i - Nwy2);
          RGB2HSL(Pix, h, s, l);
          ColSum^[j] := ColSum^[j] - l;
          ColSqs^[j] := ColSqs^[j] - Sqr(l);
          Pix := getpx(j, i + Nwy2);
          RGB2HSL(Pix, h, s, l);
          ColSum^[j] := ColSum^[j] + l;
          ColSqs^[j] := ColSqs^[j] + Sqr(l);
          Inc(j);
        end;

      end;

    end; // end for
    image.AssignImage(Target);
  finally
    FreeMem(ColSum);
    FreeMem(ColSqs);
    FreeAndNil(Target);
  end;
end;

{!!
<FS>TImageEnProc.WallisFilter

<FM>Declaration<FC>
procedure WallisFilter(WinWidth: Integer = 2; WinHeight: Integer = 2; Mean: Integer = 50; StDev: Integer = 50; InGain: Integer = 50; Edge: Integer = 10; Limit: Integer = 50; Thresholding: Boolean = False);

<FM>Description<FN>
Apply a WallisFilter to an image.

Note: works only with true color images.

WallisFilter is a locally adaptive image enhancement based on:
Wallis, R. An approach to the space variant restoration and enhancement of images.
Proceedings, Symposium on Current Mathematical Problems in Image Science, Monterey CA, 1976 10-12 reprinted in C.O. Wilde E. Barrett, eds. Image Science Mathematics, Western Periodicals, North Hollywood, CA, 1977.

Summarised in Pratt:
Pratt, W.K. Digital Image Processing, 2nd. ed. John Wiley & Sons, New York, 1991, 248, 503

Programming for Delphi:

I. Scollar 2003

  W A L L I S  -  STATISTICAL DIFFERENCING USING WALLIS ALGORITHM

  PURPOSE:

  IMPLEMENT THE STATISTICAL DIFFERENCING FILTER OF WALLIS (SEE
  W. PRATT, DIGITAL IMAGE PROCESSING) FOR LARGE PICTURES
  AND LARGE WINDOWS GREATER THAN 20X20

  EFFICIENT SAMPLING TECHNIQUE TO COMPUTE LOCAL MEANS AND VARIANCES.

  OPERATION:

  THE WINDOW DIMENSIONS AND 5 PARAMETERS FOR THE WALLIS FORMULA:
  MEAN      DESIRED LOCAL MEAN OF OUTPUT A COMMONLY USED VALUE FOR MANY APPLICATIONS IS 128.ALLOWED RANGE 0-255.
  S.D.      DESIRED LOCAL STANDARD DEVIATION (CONTRAST) OF OUTPUT PICTURE. ALLOWED RANGE 0-100. COMMONLY USED RANGE 50-75.
  GAIN      CONTROLS RATIO OF MEASURED TO DESIRED LOCAL VARIANCE. ALLOWED RANGE 0-INFINITY
        EFFECT:
        0  NO VARIANCE EQUALIZATION
           THIS IS THE SAME AS LEE'S ALGORITHM (IEEE PROC. PRIP 1978,P.56)

        INF  MAXIMUM VARIANCE EQUALIZATION
             THIS IS EQUIVALENT TO WATKIN'S ALGORITHM.
        COMMONLY USED RANGE 4-25.
  EDGE FACT.    CONTROLS AMOUNT OF MEAN EQUALIZATION
        ALLOWED RANGE 0-1.
        EFFECT:
        100  FULL MEAN EQUALIZATION
        0  MEASURED MEAN RESTORED

  AUTHORS:

  B. WEIDNER, RLMB, 1979
  BASED ON IDEAS TAKEN FROM MVEQN/F BY I. SCOLLAR 1979
  BASED ON IDEAS TAKEN FROM ANAY14 BY G. TANG, 1977

!!}
procedure TImageEnProc.WallisFilter(WinWidth, WinHeight: Integer; Mean, StDev, InGain, Edge, Limit: Integer; Thresholding: Boolean);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_WALLISFILTER,
                              {$ELSE}
                              IEMsg( IEMSG_WALLISFILTER ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_WALLISFILTER ) then
    exit;
  _IEWallisFilter(ProcBitmap, WinWidth, WinHeight, Mean, StDev, InGain, Edge, Limit, Thresholding, fOnProgress, Self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

// Wallis filter
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// works for ie24RGB ie1g
// return 0 or 90 (cannot detect down-up, inverted text)

{!!
<FS>TImageEnProc.CalcOrientation

<FM>Declaration<FC>
function CalcOrientation: Integer;

<FM>Description<FN>
Find the correct orientation for a textual image. It is mainly used to detect whether to adjust a document from portrait to landscape.

Notes:
- Apply only to document images (images with text)
- CalcOrientation can only detect 0° or 90° orientation.  It cannot detect upside down, inverted text.

<FM>Example<FC>
Adjust := ImageEnView.Proc.CalcOrientation;
ImageEnView.Proc.Rotate( Adjust );

!!}
function TImageEnProc.CalcOrientation: Integer;
var
  VertHist, HorizHist: pintegerarray;
  i: Integer;
  rh, rv: Double;
begin
  result := 0;
  if not MakeConsistentBitmap([]) then
    exit;
  getmem(HorizHist, sizeof(integer) * fIEBitmap.Width);
  getmem(VertHist, sizeof(integer) * fIEBitmap.Height);
  _CalcDensityHistogram(fIEBitmap, 0, 0, fIEBitmap.Width, fIEBitmap.Height, fOnProgress, self, VertHist, HorizHist, 1000, 1000);
  rh := 0;
  for i := 0 to fIEBitmap.Width - 2 do
    rh := rh + sqr(HorizHist[i + 1] - HorizHist[i]);
  rv := 0;
  for i := 0 to fIEBitmap.Height - 2 do
    rv := rv + sqr(VertHist[i + 1] - VertHist[i]);
  if rh > rv then
    result := 90;
  freemem(VertHist);
  freemem(horizHist);
  DoFinishWork;
end;

function _IECalcVertOrientationFitness(bitmap: TIEBitmap): Integer;
var
  VertHist, HorizHist: pintegerarray;
  i: Integer;
  rv: Double;
begin
  getmem(HorizHist, sizeof(integer) * bitmap.Width);
  getmem(VertHist, sizeof(integer) * bitmap.Height);
  _CalcDensityHistogram(bitmap, 0, 0, bitmap.Width, bitmap.Height, nil, nil, VertHist, HorizHist, 1000, 1000);
  rv := 0;
  for i := 0 to bitmap.Height - 2 do
    rv := rv + sqr(VertHist[i + 1] - VertHist[i]);
  freemem(VertHist);
  freemem(horizHist);
  result := trunc(rv);
end;

function _IESkewDetectionFine(Bitmap: TIEBitmap; StartingAngle: Double; resolution: Double; range: Integer; maxQuality: Boolean; fOnProgress: TIEProgressEvent; Sender: TObject): Double;
var
  orgbmp, tmpbmp: TIEBitmap;
  bestfit, curfit, w, h: Integer;
  bestangle: Double;
  aa, r: Double;
begin
  orgbmp := TIEBitmap.Create;
  if not maxQuality then
  begin
    w := imax(imin(Bitmap.Width div 8, Bitmap.Width), 256);
    h := trunc(Bitmap.Height / Bitmap.Width * w);
    orgbmp.Allocate(w, h, ie24RGB);
    if Bitmap.PixelFormat = ie1g then
      _Resample1BitEx(Bitmap, orgbmp, IEGlobalSettings().DefaultResampleFilter)
    else
      _ResampleEx(Bitmap, orgbmp, nil, IEGlobalSettings().DefaultResampleFilter, nil, nil);
  end
  else
    orgbmp.Assign(Bitmap);
  tmpbmp := TIEBitmap.Create;
  r := range / 2;
  // try left (including 0°)
  bestfit := 0;
  bestangle := 0;
  aa := 0;
  while abs(aa) < r do
  begin
    tmpbmp.assign(orgbmp);
    _RotateEx(tmpbmp, StartingAngle + aa, false, CreateRGB(0, 0, 0), nil, nil);
    curfit := _IECalcVertOrientationFitness(tmpbmp);
    if curfit > bestfit then
    begin
      bestfit := curfit;
      bestangle := aa;
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, Trunc(abs(aa) / range * 100));
    aa := aa - resolution;
  end;
  // try right
  aa := resolution;
  while abs(aa) < r do
  begin
    tmpbmp.assign(orgbmp);
    _RotateEx(tmpbmp, StartingAngle + aa, false, CreateRGB(0, 0, 0), nil, nil);
    curfit := _IECalcVertOrientationFitness(tmpbmp);
    if curfit > bestfit then
    begin
      bestfit := curfit;
      bestangle := aa;
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, Trunc((r + abs(aa)) / range * 100));
    aa := aa + resolution;
  end;
  result := StartingAngle + bestangle;
  FreeAndNil(tmpbmp);
  FreeAndNil(orgbmp);
end;

{!!
<FS>TImageEnProc.SkewDetectionFine

<FM>Declaration<FC>
function SkewDetectionFine(StartingAngle: Double; resolution: Double; range: Integer; maxQuality: Boolean): Double;

<FM>Description<FN>
Estimates the orientation angle (in degrees) of the lines of text. Rather than using a Hough transform like <A TImageEnProc.SkewDetection>, SkewDetectionFine performs progressive rotations to find the best orientation.

Note: Apply this method only to images that contains printed text.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>StartingAngle<FN></C> <C>The angle to start testing (0 if you don't know)</C> </R>
<R> <C><FC>Resolution<FN></C> <C>The increments of angle tested (0.1 is good)</C> </R>
<R> <C><FC>Range<FN></C> <C>The range of angles to test (specifying 10, for example, to test from -5 to +5)</C> </R>
<R> <C><FC>MaxQuality<FN></C> <C>if <FC>False<FN>, testing is only performed on a thumbnail to speed up processing (at the cost of accuracy)</C> </R>
</TABLE>

<FM>Example<FC>
D := ImageEnView.Proc.SkewDetectionFine( 0, 0.1, 10, true );
ImageEnView.Proc.Rotate( D );

!!}
function TImageEnProc.SkewDetectionFine(StartingAngle: Double; resolution: Double; range: Integer; maxQuality: Boolean): Double;
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  result := StartingAngle;
  if not BeginImageAnalysis([ie24RGB, ie1g], x1, y1, x2, y2, ProcBitmap, mask) then
    exit;
  result := _IESkewDetectionFine(ProcBitmap, StartingAngle, resolution, range, maxQuality, fOnProgress, self);
  EndImageAnalysis(ProcBitmap);
  DoFinishWork;
end;

{!!
<FS>TImageEnProc.Sharpen

<FM>Declaration<FC>
procedure Sharpen(Intensity: Integer = 10; Neighbourhood: Integer = 4);

<FM>Description<FN>
Apply a sharpening filter to the image.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>Intensity<FN></C> <C>The amount of the sharpening (1 to 100)</C> </R>
<R> <C><FC>Neighbourhood<FN></C> <C>The window size</C> </R>
</TABLE>

<FM>Example<FC>
ImageEnView1.Proc.Sharpen( 10, 4 );

!!}
procedure TImageEnProc.Sharpen(Intensity: Integer; Neighbourhood: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_SHARPEN, [Intensity, Neighbourhood]),
                              {$ELSE}
                              IEMsg( IEMsg_SHARPEN ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_SHARPEN ) then
    exit;
  _Sharpen(ProcBitmap, x1, y1, x2, y2, Intensity, Neighbourhood, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

// Intensity from 1 to 100 (but allowed more than 100 values)
// Neighbourhood from 2, must be divisible by 2 (2, 4, 6, 8, 10...)
procedure _Sharpen(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; Intensity: Integer; Neighbourhood: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  per1: Double;
  x, y: Integer;
  nsize: Integer; // neighbourhood size / 2
  nr, ng, nb: Integer;
  newbmp: TIEBitmap;
  ps, pd: PRGB;
  k: Double;
  //
  procedure GetNeighbourhood;
  var
    i, j: Integer;
    px: PRGB;
    x1, x2, y1, y2: Integer;
  begin
    nr := 0;
    ng := 0;
    nb := 0;
    x1 := imax(0, x - nsize);
    x2 := imin(bitmap.Width - 1, x + nsize);
    y1 := imax(0, y - nsize);
    y2 := imin(bitmap.Height - 1, y + nsize);
    for i := y1 to y - 1 do
    begin
      px := bitmap.Scanline[i];
      inc(px, x1);
      for j := x1 to x - 1 do
      begin
        with px^ do
        begin
          inc(nr, r);
          inc(ng, g);
          inc(nb, b);
        end;
        inc(px);
      end;
      for j := x + 1 to x2 do
      begin
        with px^ do
        begin
          inc(nr, r);
          inc(ng, g);
          inc(nb, b);
        end;
        inc(px);
      end;
    end;
    for i := y + 1 to y2 do
    begin
      px := bitmap.Scanline[i];
      inc(px, x1);
      for j := x1 to x - 1 do
      begin
        with px^ do
        begin
          inc(nr, r);
          inc(ng, g);
          inc(nb, b);
        end;
        inc(px);
      end;
      for j := x + 1 to x2 do
      begin
        with px^ do
        begin
          inc(nr, r);
          inc(ng, g);
          inc(nb, b);
        end;
        inc(px);
      end;
    end;
    i := y2 - y1;
    j := i * (x2 - x1);
    if j <> 0 then
    begin
      nr := nr div j;
      ng := ng div j;
      nb := nb div j;
    end;
  end;
  //
begin
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  nsize := Neighbourhood div 2;
  k := Intensity / 10;
  newbmp := TIEBitmap.Create;
  newbmp.Allocate(bitmap.width, bitmap.height, ie24rgb);
  for y := fSelY1 to fSelY2 do
  begin
    ps := bitmap.GetRow(y);
    inc(ps, fSelX1);
    pd := newbmp.Scanline[y];
    inc(pd, fSelX1);
    for x := fSelX1 to fSelX2 do
    begin
      GetNeighbourhood;
      with ps^ do
      begin
        pd^.r := blimit(trunc(r + k * (r - nr)));
        pd^.g := blimit(trunc(g + k * (g - ng)));
        pd^.b := blimit(trunc(b + k * (b - nb)));
      end;
      inc(pd);
      inc(ps);
    end;
    bitmap.FreeRow(y);
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (y - fSelY1 + 1)));
  end;
  bitmap.AssignImage(newbmp);
  FreeAndNil(newbmp);
end;


procedure IEUnsharpMask(Bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; Radius: Double; Amount: Double; Threshold: Double; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  blurImage: TIEBitmap;
  px, pblur: PRGB;
  row, col: Integer;
  v: Double;
  qt: Double;
begin
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);

  qt := Threshold * 255;

  blurImage := TIEBitmap.Create(Bitmap);
  try
    _IEGBlur(blurImage, Radius, fOnProgress, Sender);
    for row := fSelY1 to fSelY2 do
    begin
      px := Bitmap.Scanline[row]; inc(px, fSelX1);
      pblur := blurImage.Scanline[row]; inc(pblur, fSelX1);
      for col := fSelX1 to fSelX2 do
      begin
        v := px^.r - pblur^.r;
        if abs(2*v) >= qt then
          px^.r := blimit(round(px^.r + v * Amount));

        v := px^.g - pblur^.g;
        if abs(2*v) >= qt then
          px^.g := blimit(round(px^.g + v * Amount));

        v := px^.b - pblur^.b;
        if abs(2*v) >= qt then
          px^.b := blimit(round(px^.b + v * Amount));

        inc(px);
        inc(pblur);
      end;
    end;
  finally
    blurImage.Free;
  end;
end;

{!!
<FS>TImageEnProc.UnsharpMask

<FM>Declaration<FC>
procedure UnsharpMask(Radius: Double = 4.0; Amount: Double = 1.0; Threshold: Double = 0.05);

<FM>Description<FN>
Apply a gaussian blur to the image.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>Radius<FN></C> <C>Radius of gaussian blur matrix (> 1)</C> </R>
<R> <C><FC>Amount<FN></C> <C>Difference between original and blurred image (0.0 to 5.0) </C> </R>
<R> <C><FC>Threshold<FN></C> <C>Threshold of maximum luminosity to apply the effect (0.0 to 1.0)</C> </R>
</TABLE>

<FM>Example<FC>
ImageEnView1.Proc.UnsharpMask(2.0, 2.0, 0.05);
!!}
procedure TImageEnProc.UnsharpMask(Radius: Double; Amount: Double; Threshold: Double);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_UNSHARPMASK, [Radius, Amount, Threshold]),
                              {$ELSE}
                              IEMsg( IEMsg_UNSHARPEN ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_UNSHARPMASK ) then
    exit;
  IEUnsharpMask(ProcBitmap, x1, y1, x2, y2, Radius, Amount, Threshold, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


{!!
<FS>TImageEnProc.RemoveRedEyes

<FM>Declaration<FC>
procedure RemoveRedEyes;

<FM>Description<FN>
Apply a simple algorithm to remove red eyes. While this function can be applied to the whole image, it is better to select only the area containing eyes, otherwise other parts of the image may be altered.

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\FullApps\PhotoEn3\ImageEx.dpr </C> </R>
</TABLE>
!!}
procedure TImageEnProc.RemoveRedEyes;
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_REMOVEREDEYES,
                              {$ELSE}
                              IEMsg( IEMSG_REMOVEREDEYES ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_REMOVEREDEYES ) then
    exit;
  _IERemoveRedEyes(ProcBitmap, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

procedure _IERemoveRedEyes(bitmap: TIEBitmap; fSelx1, fSely1, fSelx2, fSely2: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  row, col: Integer;
  nrv, bluf, redq, powr, powb, powg: Double;
  per1: Double;
  px: PRGB;
begin
  fSelX2 := imin(fSelX2, bitmap.Width);  dec(fSelX2);
  fSelY2 := imin(fSelY2, bitmap.Height); dec(fSelY2);
  per1 := 100 / (fSelY2 - fSelY1 + 0.5);
  for row := fSelY1 to fSelY2 do
  begin
    px := bitmap.Scanline[row];
    for col := fSelX1 to fSelX2 do
    begin
      nrv := px^.g + px^.b;
      if nrv < 1 then
        nrv := 1;
      if px^.g > 1 then
        bluf := px^.b / px^.g
      else
        bluf := px^.b;
      bluf := dMax(0.5, dMin(1.5, Sqrt(bluf)));
      redq := (px^.r / nrv) * bluf;
      if redq > 0.7 then
      begin
        powr := 1.775 - (redq * 0.75 + 0.25);
        if powr < 0 then
          powr := 0;
        powr := powr * powr;
        powb := 1 - (1 - powr) / 2;
        powg := 1 - (1 - powr) / 4;
        with px^ do
        begin
          r := Round(powr * r);
          b := Round(powb * b);
          g := Round(powg * g);
        end;
      end;
      inc(px);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * (row - fSelY1 + 1)));
  end;
end;

procedure IEFields_warp(source: TIEBitmap; asource_lines: PIELineArray; adest_lines: PIELineArray; num_lines: Integer; num_frames: Integer; outimages: TList);
type
  TPDPoint = record
    x, y: Double;
  end;
  TLINE = record
    P: TPDPoint;
    Q: TPDPoint;
    dx: Double;
    dy: Double;
    length_squared: Double;
    length: Double;
  end;
  TLINEARRAY = array[0..65535] of TLINE;
  PLINEARRAY = ^TLINEARRAY;
const
  a: Double = 0.001;
  b: Double = 2.0;
  p: Double = 0.75;
var
  frame: Integer;
  line: Integer;
  x, y: Integer;
  source_x, source_y: Integer;
  u, v: Double;
  warp_lines: array[0..99] of TLINE;
  fweight: Double;
  last_row, last_col: Integer;
  fraction, distance: Double;
  fdist: Double;
  qdx, qdy: Double;
  weight_sum: Double;
  numerator: Double;
  denominator: Double;
  sum_x, sum_y: Double;
  weight: Double;
  cols, rows: Integer;
  dest: TIEBitmap;
  source_lines: PLINEARRAY;
  dest_lines: PLINEARRAY;
  px: PRGB;
begin
  getmem(source_lines, sizeof(TLINE) * num_lines);
  getmem(dest_lines, sizeof(TLINE) * num_lines);
  for x := 0 to num_lines - 1 do
  begin
    source_lines[x].P.x := asource_lines[x].P.x;
    source_lines[x].P.y := asource_lines[x].P.y;
    source_lines[x].Q.x := asource_lines[x].Q.x;
    source_lines[x].Q.y := asource_lines[x].Q.y;
    source_lines[x].dx := source_lines[x].Q.x - source_lines[x].P.x;
    source_lines[x].dy := source_lines[x].Q.y - source_lines[x].P.y;
    source_lines[x].length_squared := source_lines[x].dx * source_lines[x].dx + source_lines[x].dy * source_lines[x].dy;
    source_lines[x].length := sqrt(source_lines[x].length_squared);
    dest_lines[x].P.x := adest_lines[x].P.x;
    dest_lines[x].P.y := adest_lines[x].P.y;
    dest_lines[x].Q.x := adest_lines[x].Q.x;
    dest_lines[x].Q.y := adest_lines[x].Q.y;
    dest_lines[x].dx := dest_lines[x].Q.x - dest_lines[x].P.x;
    dest_lines[x].dy := dest_lines[x].Q.y - dest_lines[x].P.y;
    dest_lines[x].length_squared := dest_lines[x].dx * dest_lines[x].dx + dest_lines[x].dy * dest_lines[x].dy;
    dest_lines[x].length := sqrt(dest_lines[x].length_squared);
  end;

  cols := source.Width;
  rows := source.Height;
  last_row := rows - 1;
  last_col := cols - 1;

  for frame := 1 to num_frames - 1 do
  begin
    dest := TIEBitmap.Create;
    dest.Allocate(source.Width, source.Height, source.PixelFormat);
    outimages.Add(dest);

    fweight := frame / num_frames;

    for line := 0 to num_lines - 1 do
    begin
      warp_lines[line].P.x := source_lines[line].P.x + ((dest_lines[line].P.x - source_lines[line].P.x) * fweight);
      warp_lines[line].P.y := source_lines[line].P.y + ((dest_lines[line].P.y - source_lines[line].P.y) * fweight);
      warp_lines[line].Q.x := source_lines[line].Q.x + ((dest_lines[line].Q.x - source_lines[line].Q.x) * fweight);
      warp_lines[line].Q.y := source_lines[line].Q.y + ((dest_lines[line].Q.y - source_lines[line].Q.y) * fweight);
      warp_lines[line].dx := warp_lines[line].Q.x - warp_lines[line].P.x;
      warp_lines[line].dy := warp_lines[line].Q.y - warp_lines[line].P.y;
      warp_lines[line].length_squared := warp_lines[line].dx * warp_lines[line].dx + warp_lines[line].dy * warp_lines[line].dy;
      warp_lines[line].length := sqrt(warp_lines[line].length_squared);
    end;

    for y := 0 to rows - 1 do
    begin
      px := dest.Scanline[y];
      for x := 0 to cols - 1 do
      begin
        weight_sum := 0;
        sum_x := 0;
        sum_y := 0;
        for line := 0 to num_lines - 1 do
        begin
          qdx := x - warp_lines[line].P.x;
          qdy := y - warp_lines[line].P.y;

          with warp_lines[line] do
          begin
            fraction := (qdx * dx + qdy * dy) / length_squared;
            fdist    := (qdy * dx - qdx * dy) / length;
          end;

          if fraction <= 0 then
            distance := sqrt(qdx * qdx + qdy * qdy)
          else
          if fraction >= 1 then
          begin
            qdx := x - warp_lines[line].Q.x;
            qdy := y - warp_lines[line].Q.y;
            distance := sqrt(qdx * qdx + qdy * qdy);
          end 
          else
          if fdist >= 0 then
            distance := fdist
          else
            distance := -1 * fdist;

          with source_lines[line] do
          begin
            u := P.x + fraction * dx - fdist * dy / length;
            v := P.y + fraction * dy + fdist * dx / length;
          end;

          numerator := Power(warp_lines[line].length, p);
          denominator := a + distance;
          weight := Power((numerator / denominator), b);

          sum_x := sum_x + ((u - x) * weight);
          sum_y := sum_y + ((v - y) * weight);
          weight_sum := weight_sum + weight;
        end;

        source_x := trunc(x + sum_x / weight_sum + 0.5);
        source_y := trunc(y + sum_y / weight_sum + 0.5);
        if source_x < 0 then
          source_x := 0
        else
        if source_x>last_col then
          source_x := last_col;
        if source_y < 0 then
          source_y := 0
        else
        if source_y>last_row then
          source_y := last_row;

        px^ := source.Pixels_ie24RGB[source_x, source_y];

        inc(px);
      end;
    end;

  end;

  freemem(source_lines);
  freemem(dest_lines);
end;

function IEAddNewFilter( const filter: TGraphFilter; const name: String ): Integer;
var
  f: PIEGraphFilter;
begin
  new(f);
  result := IEFiltPres.Add(f);
  move(filter, f^, sizeof(TGraphFilter));
  IEFiltPresNames.Add(name);
end;

function IEGetFilter( index: Integer ): PIEGraphFilter;
begin
  result := IEFiltPres[index];
end;

function IEGetFilterName( index: Integer ): String;
begin
  result := IEFiltPresNames[index]
end;

function IEGetFiltersCount: Integer;
begin
  result := IEFiltPres.Count;
end;

procedure IEInitFilterPresets;
const
  FiltPres: array[0..8] of TGraphFilter = (
    (Values: ((0, 0, 0), // None
              (0, 1, 0), 
              (0, 0, 0)); Divisor: 0), 
    (Values: ((1, 1, 1), // blur 1
              (1, 1, 1),
              (1, 1, 1)); Divisor: 9),
    (Values: ((1, 1, 1), // edge
              (1, -8, 1),
              (1, 1, 1)); Divisor: 1),
    (Values: ((-1, 0, 1), // emboss
              (-1, 1, 1),
              (-1, 0, 1)); Divisor: 1),
    (Values: ((0, -1, 0), // high pass 1
              (-1, 5, -1),
              (0, -1, 0)); Divisor: 1),
    (Values: ((-1, -1, -1), // high pass 2
              (-1, 9, -1),
              (-1, -1, -1)); Divisor: 1),
    (Values: ((1, -2, 1), // high pass 3
              (-2, 5, -2),
              (1, -2, 1)); Divisor: 1),
    (Values: ((1, 1, 1), // Low pass 1
              (1, 1, 1),
              (1, 1, 1)); Divisor: 10),
    (Values: ((1, 2, 1), // Low pass 2
              (2, 4, 2),
              (1, 2, 1)); Divisor: 16)
    );

  { doesn't work on Delphi 2007
  FiltPresNames: array [0..8] of string = (
    IERS_FLT_NONE,
    IERS_FLT_BLUR,
    IERS_FLT_EDGES,
    IERS_FLT_EMBOSS,
    IERS_FLT_HIGH_PASS_1,
    IERS_FLT_HIGH_PASS_2,
    IERS_FLT_HIGH_PASS_3,
    IERS_FLT_LOW_PASS_1,
    IERS_FLT_LOW_PASS_2 );
  }
  function FiltPresNames(idx: Integer): String;
  begin
    case idx of
      0: result := IERS_FLT_NONE;
      1: result := IERS_FLT_BLUR;
      2: result := IERS_FLT_EDGES;
      3: result := IERS_FLT_EMBOSS;
      4: result := IERS_FLT_HIGH_PASS_1;
      5: result := IERS_FLT_HIGH_PASS_2;
      6: result := IERS_FLT_HIGH_PASS_3;
      7: result := IERS_FLT_LOW_PASS_1;
      8: result := IERS_FLT_LOW_PASS_2;
    else
      result := '';
    end;
  end;

var
  i: Integer;
begin
  IEFiltPres := TList.Create;
  IEFiltPresNames := TStringList.Create;
  for i := 0 to high(Filtpres) do
    IEAddNewFilter( FiltPres[i] , FiltPresNames(i));
end;

procedure IEFreeFilterPresets;
var
  i: Integer;
begin
  for i := 0 to IEFiltPres.Count-1 do
  begin
    dispose( IEFiltPres[i] );
  end;
  FreeAndNil(IEFiltPres);
  FreeAndNil(IEFiltPresNames);
end;

procedure _IERoundImage(ProcBitmap: TIEBitmap; RoundWidth, RoundHeight: Integer; fOnProgress: TIEProgressEvent; self: TObject);
var
  x, y: Integer;
  nsteps: Integer;
  ptr: ppointarray;
  i: Integer;
  xrect: TRect;
  xx, yy: Integer;
begin
  if (ProcBitmap.Width = 0) or (ProcBitmap.Height = 0) or (RoundWidth = 0) or (RoundHeight = 0) then
    exit;
  xrect := rect(0, 0, ProcBitmap.Width, ProcBitmap.Height);
  nsteps := (RoundWidth + RoundHeight);
  getmem(ptr, sizeof(TPoint) * nsteps);
  // top-left round
  IEBezier2D4Controls(Point(xrect.Left, xrect.Top + RoundHeight),
                      xrect.TopLeft,
                      Point(xrect.Left + RoundWidth, xrect.Top),
                      Point(xrect.Left + RoundWidth, xrect.Top),
                      ptr,
                      nsteps);
  for i := 0 to nsteps - 1 do
  begin
    xx := imin(ptr[i].X, ProcBitmap.Height - 1);
    yy := imin(ptr[i].Y, ProcBitmap.Width - 1);
    for y := 0 to yy do
      for x := 0 to xx do
      begin
        ProcBitmap.Alpha[x, y] := 0;
        ProcBitmap.Alpha[ProcBitmap.Width - x - 1, y] := 0;
      end;
  end;
  // bottom-right round
  IEBezier2D4Controls(Point(xrect.Right, xrect.Bottom - RoundHeight),
                      Point(xrect.Right, xrect.Bottom),
                      Point(xrect.Right - RoundWidth, xrect.Bottom),
                      Point(xrect.Right - RoundWidth, xrect.Bottom),
                      ptr,
                      nsteps);
  for i := 0 to nsteps - 1 do
  begin
    xx := imax(ptr[i].X, 1);
    yy := imax(ptr[i].Y, 1);
    for y := ProcBitmap.Height - 1 downto yy - 1 do
      for x := ProcBitmap.Width - 1 downto xx - 1 do
      begin
        ProcBitmap.Alpha[x, y] := 0;
        ProcBitmap.Alpha[ProcBitmap.Width - x - 1, y] := 0;
      end;
  end;
  freemem(ptr);
  ProcBitmap.AlphaChannel.SyncFull();
end;

{!!
<FS>TImageEnProc.RoundImage

<FM>Declaration<FC>
procedure RoundImage(RoundWidth, RoundHeight: Integer);

<FM>Description<FN>
Round the corners of an image. <FC>RoundWidth<FN> and <FC>RoundHeight<FN> specify the rounding size.

<FM>Example<FC>
ImageEnView1.Proc.RoundImage( 100, 100 );

!!}
procedure TImageEnProc.RoundImage(RoundWidth, RoundHeight: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_ROUNDIMAGE, [RoundWidth, RoundHeight]),
                              {$ELSE}
                              IEMsg( IEMsg_ROUNDIMAGE ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_ROUNDIMAGE ) then
    exit;
  _IERoundImage(ProcBitmap, RoundWidth, RoundHeight, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

{!!
<FS>TImageEnProc.RadialStretch

<FM>Declaration<FC>
procedure RadialStretch(ARed, BRed, CRed, DRed, AGreen, BGreen, CGreen, DGreen, ABlue, BBlue, CBlue, DBlue: Double);

<FM>Description<FN>
Performs a radial stretch for each color component (R, G, B). This allows manual correction of Barrel and Pincushion distortion (lens distortion, underwater distortion).
A, B, C, D (followed by channel name) are the coefficients
                
<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\Radial\Radial.dpr </C> </R>
</TABLE>

!!}
procedure TImageEnProc.RadialStretch(ARed, BRed, CRed, DRed, AGreen, BGreen, CGreen, DGreen, ABlue, BBlue, CBlue, DBlue: Double);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_RADIALSTRETCH,
                              {$ELSE}
                              IEMsg( IEMSG_RADIALSTRETCH ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_RADIALSTRETCH ) then
    exit;
  _IERadialStretch(ProcBitmap, ARed, BRed, CRed, DRed, AGreen, BGreen, CGreen, DGreen, ABlue, BBlue, CBlue, DBlue, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

procedure _IERadialStretch(bitmap: TIEBitmap; ARed, BRed, CRed, DRed, AGreen, BGreen, CGreen, DGreen, ABlue, BBlue, CBlue, DBlue: Double; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  a, b, c, d: array [0..2] of double;
  tmpbmp: TIEBitmap;
  x, y: Integer;
  dst, src: pbyte;
  adst, asrc: pbyte;
  xx, yy: Integer;
  r, scale: Double;
  xs, ys: Integer;
  wh2: Double;
  i, w2, h2: Integer;
  o1: Double;
  lper, per: Integer;
begin

  a[0] := ABlue;
  a[1] := AGreen;
  a[2] := ARed;

  b[0] := BBlue;
  b[1] := BGreen;
  b[2] := BRed;

  c[0] := CBlue;
  c[1] := CGreen;
  c[2] := CRed;

  d[0] := DBlue;
  d[1] := DGreen;
  d[2] := DRed;

  w2 := bitmap.Width div 2;
  h2 := bitmap.Height div 2;

  if bitmap.Width < bitmap.Height then
    wh2 := bitmap.Width / 2
  else
    wh2 := bitmap.Height / 2;

  tmpbmp := TIEBitmap.Create;

  try

    tmpbmp.Allocate( bitmap.Width, bitmap.Height, ie24RGB );

    lper := -1;

    for i := 0 to 2 do
    begin

      for y := 0 to tmpbmp.Height-1 do
      begin

        dst := tmpbmp.Scanline[y];
        inc(dst, i);

        if bitmap.HasAlphaChannel then
          adst := tmpbmp.AlphaChannel.ScanLine[y]
        else
          adst := nil;

        ys := y-h2;
        o1 := ys*ys;

        for x := 0 to tmpbmp.width-1 do
        begin

          xs := x-w2;
          r := sqrt( xs*xs + o1 ) / wh2;
          scale := ((a[i] * r + b[i]) * r + c[i]) * r + d[i];
          xx := round( xs * scale ) + w2;
          yy := round( ys * scale ) + h2;

          if (xx < tmpbmp.Width) and (yy < tmpbmp.Height) and (xx >= 0) and (yy >= 0) then
          begin

            src := bitmap.ScanLine[yy];
            inc(src, xx * 3 + i);
            dst^ := src^;

            if bitmap.HasAlphaChannel and (i = 0) then  // consider only channel 0 (Blue) position for alpha
            begin
              asrc := bitmap.AlphaChannel.ScanLine[yy];
              inc(asrc, xx);
              adst^ := asrc^;
            end;

          end
          else
          begin
            dst^ := 0;
            if bitmap.HasAlphaChannel and (i = 0) then
              adst^ := 0;
          end;

          inc(dst, 3);
          inc(adst);

        end;

        if assigned(fOnProgress) then
        begin
          per := trunc((i/3+(y/tmpbmp.Height/3))*100);
          if per<>lper then
          begin
            fOnProgress(Sender, per);
            lper := per;
          end;
        end;

      end;

    end;

    bitmap.assign(tmpbmp);

  finally
    FreeAndNil(tmpbmp);
  end;

end;

// Floyd-Steinberg dithering
procedure fsditherRow(src_row: PRGBROW; dest_row: pbyte; error: pdoublearray; nexterror: pdoublearray; row_width: Integer; var dir: Integer);
var
  col: Integer;
  xstart, xend: Integer;
  newval: Double;
  cerror: Double;
  v: Integer;
  RedToGrayCoef, GreenToGrayCoef, BlueToGrayCoef: Integer;
begin
  ZeroMemory(nexterror, row_width * sizeof(double));

  if (dir = 1) then
  begin
    xstart := 0;
    xend := row_width;
  end
  else
  begin
    xstart := row_width - 1;
    xend := -1;
  end;

  RedToGrayCoef   := IEGlobalSettings().RedToGrayCoef;
  GreenToGrayCoef := IEGlobalSettings().GreenToGrayCoef;
  BlueToGrayCoef  := IEGlobalSettings().BlueToGrayCoef;

  col := xstart;
  while col <> xend do
  begin
    with src_row[col] do
      v := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;

    newval := Floor ((v + error[col]) + 0.5);

    if newval < 128 then
      newval := 0
    else
      newval := 255;

    _SetPixelbw(dest_row, col, round(newval) );

    cerror := v + error[col] - newval;
    nexterror[col] := nexterror[col] + (cerror * 5/16);

    if (col+dir >= 0) and (col+dir < row_width) then
    begin
      error[col + dir] := error[col + dir] + (cerror * 7/16);
      nexterror[col + dir] := nexterror[col + dir] + (cerror * 1/16);
    end;
    if (col - dir >= 0) and (col - dir < row_width) then
      nexterror[col - dir] := nexterror[col - dir] + (cerror * 3 / 16);

    inc(col, dir);
  end;

  dir := - dir;
end;

// Floyd-Steinberg dithering
procedure _IEfsdither(bitmap: TIEBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  error, nexterror, tmp: pdoublearray;
  row: Integer;
  newbitmap: TIEBitmap;
  dir: Integer;
  per1: Double;
begin
  per1 := 100 / (bitmap.height);

  newbitmap := TIEBitmap.Create;
  newbitmap.Allocate(bitmap.width, bitmap.height, ie1g);

  getmem(error , bitmap.Width*sizeof(double) );
  getmem(nexterror , bitmap.Width*sizeof(double) );

  ZeroMemory(error, bitmap.Width*sizeof(double));
  ZeroMemory(nexterror, bitmap.Width*sizeof(double));

  dir := 1;
  for row := 0 to bitmap.height-1 do
  begin
    fsditherRow(bitmap.Scanline[row], newbitmap.Scanline[row], error, nexterror, bitmap.width, dir);
    tmp := error;
    error := nexterror;
    nexterror := tmp;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * row) );
  end;

  freemem(error);
  freemem(nexterror);

  bitmap.assign(newbitmap);
  FreeAndNil(newbitmap);
end;

{!!
<FS>TImageEnProc.ConvertToBW_FloydSteinberg

<FM>Declaration<FC>
procedure ConvertToBW_FloydSteinberg;

<FM>Description<FN>
Convert the current image to black & white using the Floyd-Steinberg algorithm.

!!}
procedure TImageEnProc.ConvertToBW_FloydSteinberg;
begin
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  if fAutoUndo then
    SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
              IERS_CONVERTTOBW_FLOYDSTEINBERG,
              {$ELSE}
              IEMsg( IEMSG_Monochrome ),
              {$ENDIF}
              ieuImage, True, IEOP_CONVERTTOBW_FLOYDSTEINBERG );
  _IEfsdither(fIEBitmap, fOnProgress, self);
  Update;
  DoFinishWork;
end;

{!!
<FS>TImageEnProc.Crop

<FM>Declaration<FC>
procedure Crop(x1, y1, x2, y2 : Integer);
procedure Crop(Rect : TRect);
procedure Crop(Rectangle: TRect; Rotation: double; AntialiasMode: <A TIEAntialiasMode> = ierFast);
procedure Crop(Quadrilater: array of <A TIE2DPoint>); overload;

<FM>Description<FN>
Replace the current image with that within the specified rectangle (i.e. keep only the specified region).

<FM>Examples<FC>
// Crop the image at position, Top-Left: (20, 20), Bottom-right: (100, 100). The resulting image will be 80 x 80 pixels
ImageEnView1.Proc.Crop( 20, 20, 100, 100 );

// Crop to the selected area of the image (same as ImageEnView1.Proc.CropSel)
ImageEnView1.Proc.Crop( ImageEnView1.SelectedRect.x,
                        ImageEnView1.SelectedRect.y,
                        ImageEnView1.SelectedRect.x + ImageEnView1.SelectedRect.Width,
                        ImageEnView1.SelectedRect.y + ImageEnView1.SelectedRect.Height );

// Rotate an image 20 deg. CCW and crop 100 pixels from each side
ImageEnView1.Proc.Crop( Rect( 100, 100, ImageEnView1.IEBitmap.Width - 100, ImageEnView1.IEBitmap.Height - 100 ),
                        20, ierBicubic );

// Crops to the specified quadrilateral and applies forward perspective mapping. Useful to adjust perspective distortion.
ImageEnView1.Proc.Crop([IE2DPoint(104, 85), IE2DPoint(1000, 150), IE2DPoint(181, 500), IE2DPoint(54, 400)]);

<FM>See Also<FN>
- <A TImageEnProc.CropSel>
- <A Lossless Jpeg Transformations>
!!}
procedure TImageEnProc.Crop(x1, y1, x2, y2: Integer);
begin
  if not MakeConsistentBitmap([]) then
    exit;
  if (x1 = 0) and (y1 = 0) and (x2 = fIEBitmap.Width-1) and (y2 = fIEBitmap.Height-1) then
    exit;
  if ( x2 < x1 ) or ( y2 < y1 ) then
    exit;

  if fAutoUndo then
    SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
             Format(IERS_CROP, [x1, y1, x2, y2]),
             {$ELSE}
             IEMsg( IEMSG_CROPIMAGE ),
             {$ENDIF}
             ieuImage, True, IEOP_CROP );

  fIEBitmap.Crop( x1, y1, x2, y2 );
  Update();
  DoFinishWork();
end;

procedure TImageEnProc.Crop(Rect: TRect);
begin
  Crop(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
end;


procedure TImageEnProc.Crop(Rectangle: TRect; Rotation: double; AntialiasMode: TIEAntialiasMode);
begin
  if not MakeConsistentBitmap([]) then
    exit;

  if fAutoUndo then
    SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
             Format(IERS_CROPROT, [Rectangle.Left, Rectangle.Top, Rectangle.Right, Rectangle.Bottom, Rotation]),
             {$ELSE}
             IEMsg( IEMSG_CROPIMAGE ),
             {$ENDIF}
             ieuImage, True, IEOP_CROP );

  IECrop(fIEBitmap, Rectangle, Rotation, AntialiasMode);

  Update();
  DoFinishWork();
end;

procedure IECrop(Bitmap: TIEBitmap; Rectangle: TRect; Rotation: double; AntialiasMode: TIEAntialiasMode);
var
  rotatedRect: array [0..3] of TIE2DPoint;
  i: integer;
  bbox: TRect;
  newImage: TIEBitmap;
  newWidth, newHeight: integer;
  srcRow, srcCol: integer;
  dstRow, dstCol: integer;
  crect: TRect;
begin
  // calc rotated rect
  rotatedRect[0] := IE2DPoint(Rectangle.Left, Rectangle.Top); // top left
  rotatedRect[1] := IE2DPoint(Rectangle.Right, Rectangle.Top); // top right
  rotatedRect[2] := IE2DPoint(Rectangle.Right, Rectangle.Bottom); // bottom right
  rotatedRect[3] := IE2DPoint(Rectangle.Left, Rectangle.Bottom); // bottom left
  IEDRotatePointsWithCenter(rotatedRect, Rotation, (Rectangle.Left + Rectangle.Right) / 2.0, (Rectangle.Top + Rectangle.Bottom) / 2.0);

  // rotated rect bounding box
  bbox := Rect(Maxint, Maxint, Pred(-Maxint), Pred(-Maxint));
  for i := 0 to 3 do
  begin
    bbox.Left   := imin(bbox.Left, trunc(rotatedRect[i].X));
    bbox.Top    := imin(bbox.Top, trunc(rotatedRect[i].Y));
    bbox.Right  := imax(bbox.Right, trunc(rotatedRect[i].X));
    bbox.Bottom := imax(bbox.Bottom, trunc(rotatedRect[i].Y));
  end;

  // crop bounding box rectangle

  newWidth  := trunc(bbox.Right - bbox.Left + 1);
  newHeight := trunc(bbox.Bottom - bbox.Top + 1);
  newImage := TIEBitmap.Create(newWidth, newHeight, Bitmap.PixelFormat);

  try

    newImage.AlphaChannel.Fill(0);
    Bitmap.AlphaChannel;  // force to have alpha channel
    srcCol := imax(0, bbox.Left);
    srcRow := imax(0, bbox.Top);
    dstCol := -imin(0, bbox.Left);
    dstRow := -imin(0, bbox.Top);
    Bitmap.CopyRectTo(newImage, srcCol, srcRow, dstCol, dstRow, newWidth, newHeight, true); // CopyRect will reduce newWidth,newHeight to the right values

    // rotate

    newImage.Rotate(-Rotation, AntialiasMode);

    // crop internal rectangle

    crect := Rectangle;
    IECenterRectInRect(0, 0, newImage.Width - 1, newImage.Height - 1, crect.Left, crect.Top, crect.Right, crect.Bottom);
    newWidth  := crect.Right - crect.Left + 1;
    newHeight := crect.Bottom - crect.Top + 1;
    Bitmap.Allocate(newWidth, newHeight, newImage.PixelFormat);
    newImage.CopyRectTo(Bitmap, crect.Left, crect.Top, 0, 0, newWidth, newHeight, true);

    // IECrop() could create alpha channel in Bitmap, even if it not necessary: in this case just remove it
    Bitmap.AlphaChannel.SyncFull();
    if Bitmap.AlphaChannel.Full then
      Bitmap.RemoveAlphaChannel();

  finally
    newImage.Free();
  end;

end;


procedure TImageEnProc.Crop(Quadrilater: array of TIE2DPoint);
begin
  if not MakeConsistentBitmap([ie8g, ie24RGB, ieCMYK, ieCIELab, ie32RGB]) then
    exit;

  if fAutoUndo then
    SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
             Format(IERS_CROPQUAD, [Quadrilater[0].X, Quadrilater[0].Y, Quadrilater[1].X, Quadrilater[1].Y, Quadrilater[2].X, Quadrilater[2].Y, Quadrilater[3].X, Quadrilater[3].Y]),
             {$ELSE}
             IEMsg( IEMSG_CROPIMAGE ),
             {$ENDIF}
             ieuImage, True, IEOP_CROP );

  IEPerspectiveCrop(fIEBitmap, Quadrilater);

  Update();
  DoFinishWork();
end;


// Crops the specified quadrilater and applies forward perspective mapping
// Useful to adjust perspective distortion
// "quad" must be an array of 4 elements:
//   quad[0] -> top-left point
//   quad[1] -> top-right point
//   quad[2] -> bottom-right point
//   quad[3] -> bottom-left point
procedure IEPerspectiveCrop(Bitmap: TIEBitmap; quad: array of TIE2DPoint);
var
  x0, y0, x1, y1, x2, y2, x3, y3: double;
  dx1, dx2, dx3, dy1, dy2, dy3: double;
  a11, a21, a31, a12, a22, a32, a13, a23, a33: double;
  fx, fy: double;
  ix, iy: integer;
  dest: TIEBitmap;
  i, j, k: integer;
  u, v: double;
  width, height: integer;
  newWidth, newHeight: integer;
  widthA, widthB, heightA, heightB, w, h: double;
  aspectRatio, quadAspectRatio: double;
  centerValue, rightValue, bottomValue, BottomRightValue: integer;
  pdest: pbyte;
  psrc: pbyte;
  channels: integer;
begin
  x0 := quad[0].X;
  y0 := quad[0].Y;
  x1 := quad[1].X;
  y1 := quad[1].Y;
  x2 := quad[2].X;
  y2 := quad[2].Y;
  x3 := quad[3].X;
  y3 := quad[3].Y;

  // calcualate perspective transform coefficients

  dx1 := x1 - x2;
  dx2 := x3 - x2;
  dx3 := x0 - x1 + x2 - x3;
  dy1 := y1 - y2;
  dy2 := y3 - y2;
  dy3 := y0 - y1 + y2 - y3;

  if (dx3 = 0) and (dy3 = 0) then
  begin
    // the xy quadrilateral is a parallelogram, the mapping is affine
    a11 := x1 - x0;
    a21 := x2 - x1;
    a31 := x0;
    a12 := y1 - y0;
    a22 := y2 - y1;
    a32 := y0;
    a13 := 0;
    a23 := 0;
    a33 := 1;
  end
  else
  begin
    a13 := (dx3 * dy2 - dx2 * dy3) / (dx1 * dy2 - dy1 * dx2);
    a23 := (dx1 * dy3 - dy1 * dx3) / (dx1 * dy2 - dy1 * dx2);
    a33 := 1;
    a11 := x1 - x0 + a13 * x1;
    a21 := x3 - x0 + a23 * x3;
    a31 := x0;
    a12 := y1 - y0 + a13 * y1;
    a22 := y3 - y0 + a23 * y3;
    a32 := y0;
  end;

  // calculate aspect ratio of quadrilater

  widthA  := sqrt( sqr(x2 - x3) + sqr(y2 - y3) );
  widthB  := sqrt( sqr(x1 - x0) + sqr(y1 - y0) );
  heightA := sqrt( sqr(x1 - x2) + sqr(y1 - y2) );
  heightB := sqrt( sqr(x0 - x3) + sqr(y0 - y3) );
  w := dmax(widthA, widthB);
  h := dmax(heightA, heightB);

  if h = 0 then
    exit;

  quadAspectRatio := w / h;

  // calculate aspect ratio of rectified quadrilater

  width  := Bitmap.Width;
  height := Bitmap.Height;
  aspectRatio := IERectifiedRectangleAspectRatio(x0, y0, x1, y1, x2, y2, x3, y3, width / 2.0, height / 2.0);

  // calculate destination rectangle size (tech report: "Whiteboard Scanning and Image Enhancement", Zhengyou Zhang)

  if quadAspectRatio >= aspectRatio then
  begin
    newWidth := trunc(w);
    newHeight := trunc(w / aspectRatio);
  end
  else
  begin
    newWidth := trunc(aspectRatio * h);
    newHeight := trunc(h);
  end;

  // perform forward perspective transform

  dest := TIEBitmap.Create(newWidth, newHeight, Bitmap.PixelFormat);

  try

    channels := dest.ChannelCount;

    for i := 0 to newHeight - 1 do
    begin
      pdest := dest.ScanLine[i];

      v := i / newHeight;
    
      for j := 0 to newWidth - 1 do
      begin

        u := j / newWidth;

        fx := (a11 * u + a21 * v + a31) / (a13 * u + a23 * v + a33);
        fy := (a12 * u + a22 * v + a32) / (a13 * u + a23 * v + a33);

        ix := trunc(fx);
        iy := trunc(fy);

        if (ix >= 0) and (iy >= 0) and (ix < width) and (iy < height) then
        begin
          for k := 0 to channels - 1 do
          begin
            rightValue       := 0;
            bottomValue      := 0;
            BottomRightValue := 0;

            psrc := Bitmap.ScanLine[iy];
            inc(psrc, ix * channels + k);
            centerValue := psrc^;

            if (ix + 1 < width) then
            begin
              inc(psrc, channels);
              rightValue := psrc^;
            end;

            if (iy + 1 < height) then
            begin
              psrc := Bitmap.ScanLine[iy + 1];
              inc(psrc, ix * channels + k);
              bottomValue := psrc^;
              if (ix + 1 < width) then
              begin
                inc(psrc, channels);
                bottomRightValue := psrc^;
              end;
            end;

            pdest^ := IEBilinear(fx, fy, centerValue, rightValue, bottomValue, bottomRightValue);
            inc(pdest);
          end
        end
        else
        begin
          for k := 0 to channels - 1 do
          begin
            pdest^ := 0;
            inc(pdest);
          end;
          dest.Alpha[j, i] := 0;
        end;

      end;
    end;

    Bitmap.Assign(dest);
    if Bitmap.HasAlphaChannel then
      Bitmap.AlphaChannel.SyncFull();

  finally
    dest.Free();
  end;
end;



{!!
<FS>TImageEnProc.AutoCrop

<FM>Declaration<FC>
function AutoCrop(Tolerance: Integer; Background: TRGB; DoCrop: Boolean = True): TRect;
function AutoCrop(Tolerance: Integer; Background: TColor; DoCrop: Boolean = True): TRect;

<FM>Description<FN>
Remove any bordering area of an image of a certain color.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>Tolerance<FN></C> <C>How closely we match the color to <FC>Background<FN> (0 to 255, where 0 matches only the specified color, and 255 would remove everything)</C> </R>
<R> <C><FC>Background<FN></C> <C>The border color to remove</C> </R>
<R> <C><FC>DoCrop<FN></C> <C>If False the image is not cropped, but the suggested area for cropping is returned as the result</C> </R>
</TABLE>

Returns the area to crop or cropped.

<FM>Example<FC>
// Remove the black border from a scanned document
ImageEnView1.IO.Acquire;
ImageEnView1.Proc.AutoCrop(10, CreateRGB(0, 0, 0) );

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AutoCrop2></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.CropTransparentBorder></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Crop></C> </R>
</TABLE>
!!}
function TImageEnProc.AutoCrop(Tolerance: Integer; Background: TRGB; DoCrop: Boolean = True): TRect;
var
  x, y, x1, y1, x2, y2: Integer;
  done: Boolean;
  BitmapWidth, BitmapHeight: Integer;

  function _PixelIsMatch : Boolean;
  begin
    Result := IERGBColorsMatch(fIEBitmap.Pixels[x, y], Background, Tolerance);
  end;

begin
  if not MakeConsistentBitmap([]) then
    exit;

  BitmapWidth  := fIEBitmap.Width;
  BitmapHeight := fIEBitmap.Height;

  x1 := 0;
  y1 := 0;
  y2 := BitmapHeight - 1;

  // find top
  done := false;
  for y := 0 to BitmapHeight - 1 do
  begin
    for x := 0 to BitmapWidth - 1 do
    begin
      if not _PixelIsMatch then
      begin
        y1 := y;
        x1 := x;
        done := true;
        break;
      end;
    end;
    if done then break;
  end;

  // find left
  for y := y1 to BitmapHeight - 1 do
  begin
    for x := 0 to BitmapWidth - 1 do
    begin
      if not _PixelIsMatch then
      begin
        if x < x1 then
          x1 := x;
        break;
      end;
    end;
  end;

  // find right
  x2 := x1;
  for y := y1 to BitmapHeight - 1 do
  begin
    for x := BitmapWidth - 1 downto x1 do
    begin
      if not _PixelIsMatch then
      begin
        if x > x2 then
          x2 := x;
        break;
      end;
    end;
  end;

  // find bottom
  done := false;
  for y := BitmapHeight - 1 downto 0 do
  begin
    for x := 0 to BitmapWidth - 1 do
    begin
      if not _PixelIsMatch then
      begin
        y2 := y;
        done := true;
        break;
      end;
    end;
    if done then break;
  end;

  if DoCrop then
    Crop(x1, y1, x2, y2);

  result := Rect(x1, y1, x2, y2);
end;

function TImageEnProc.AutoCrop(Tolerance: Integer; Background: TColor; DoCrop: Boolean): TRect;
begin
  result := AutoCrop(Tolerance, TColor2TRGB(Background), DoCrop);
end;

// detect useful area with density analysis
// BorderRate: suggested 6, the difference between border and text
// works only when paper is white and text is black
function IEAutoCrop2(bitmap: TIEBitmap; BorderRate: Double): TRect;
var
  rows, cols: array of Integer;
  i, j, v: Integer;
  rows_media, cols_media: Double;
  x1, y1, x2, y2: Integer;
  bitmapWidth, bitmapHeight: Integer;
begin
  bitmapWidth  := bitmap.Width;
  bitmapHeight := bitmap.Height;

  // rows
  SetLength(rows, bitmapHeight);
  for i := 0 to bitmapHeight - 1 do
  begin
    v := 0;
    for j := 0 to bitmapWidth - 1 do
    begin
      with bitmap.Pixels[j, i] do
        inc(v, (r+g+b) div 3);
    end;
    rows[i] := v;
  end;

  // cols
  SetLength(cols, bitmapWidth);
  for i := 0 to bitmapWidth - 1 do
  begin
    v := 0;
    for j := 0 to bitmapHeight - 1 do
    begin
      with bitmap.Pixels[i, j] do
        inc(v, (r+g+b) div 3);
    end;
    cols[i] := v;
  end;

  // row media
  rows_media := 0;
  for i := 0 to bitmapHeight - 1 do
    rows_media := rows_media + rows[i];
  rows_media := rows_media / bitmapHeight;

  // col media
  cols_media := 0;
  for i := 0 to bitmapWidth - 1 do
    cols_media := cols_media + cols[i];
  cols_media := cols_media / bitmapWidth;

  // check current and next pixel

  // find left (x1)
  for x1 := 0 to bitmapWidth - 2 do
    if (abs(cols[x1] - cols_media) < cols_media / BorderRate) and (abs(cols[x1 + 1] - cols_media) < cols_media / BorderRate) then
      break;

  // find right (x2)
  for x2 := bitmapWidth - 1 downto 1 do
    if (abs(cols[x2] - cols_media) < cols_media / BorderRate) and (abs(cols[x2 - 1] - cols_media) < cols_media / BorderRate) then
      break;

  // find top (y1)
  for y1 := 0 to bitmapHeight - 2 do
    if (abs(rows[y1] - rows_media) < rows_media / BorderRate) and (abs(rows[y1 + 1] - rows_media) < rows_media / BorderRate) then
      break;

  // find bottom (y2)
  for y2 := bitmapHeight - 1 downto 1 do
    if (abs(rows[y2] - rows_media) < rows_media / BorderRate) and (abs(rows[y2 - 1]-rows_media) < rows_media / BorderRate) then
      break;

  result := Rect(x1, y1, x2, y2);
end;

{!!
<FS>TImageEnProc.AutoCrop2

<FM>Declaration<FC>
function AutoCrop2(BorderRate: Double = 6; DoCrop: Boolean = True): TRect;

<FM>Description<FN>
Removes the black border from a white text document using a density analysis algorithm.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>BorderRate<FN></C> <C>The difference between border and text. Must be more than 0</C> </R>
<R> <C><FC>DoCrop<FN></C> <C>If False the image is not cropped, but the suggested area for cropping is returned as the result</C> </R>
</TABLE>

Returns the area to crop or cropped.

<FM>Example<FC>
// Remove the black border from a scanned document
ImageEnView1.IO.Acquire;
ImageEnView1.Proc.AutoCrop2;
       
<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AutoCrop></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.CropTransparentBorder></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Crop></C> </R>
</TABLE>
!!}
function TImageEnProc.AutoCrop2(BorderRate: Double = 6; DoCrop: Boolean = True): TRect;
begin
  if not MakeConsistentBitmap([]) then
    exit;
  if BorderRate <= 0 then
    exit;

  result := IEAutoCrop2(fIEbitmap, BorderRate);

  if DoCrop then
    Crop(result);
end;


// returns the average Red, Green, Blue intensity difference between two images
// the bitmaps must have the same size and pixelformat
// works only with ie24RGB and ie48RGB
procedure IEGetLuminosityDiff(image1, image2: TIEBitmap; var Red, Green, Blue: Integer);
var
  x, y, wh: Integer;
  rgb1, rgb2: PRGB;
  rgb481, rgb482: PRGB48;
  r1, g1, b1, r2, g2, b2: Integer;
  imageWidth, imageHeight: Integer;
begin
  Red   := 0;
  Green := 0;
  Blue  := 0;
  if (image1.Width <> image2.Width) or (image1.Height <> image2.Height) or (image1.PixelFormat <> image2.PixelFormat) then
    exit;
  imageWidth  := image1.Width;
  imageHeight := image1.Height;
  r1 := 0; g1 := 0; b1 := 0;
  r2 := 0; g2 := 0; b2 := 0;
  case image1.PixelFormat of
    ie24RGB:
      for y := 0 to imageHeight - 1 do
      begin
        rgb1 := image1.Scanline[y];
        rgb2 := image2.Scanline[y];
        for x := 0 to imageWidth - 1 do
        begin
          inc(r1, rgb1.r);
          inc(g1, rgb1.g);
          inc(b1, rgb1.b);
          inc(r2, rgb2.r);
          inc(g2, rgb2.g);
          inc(b2, rgb2.b);
          inc(rgb1);
          inc(rgb2);
        end;
      end;
    ie48RGB:
      for y := 0 to imageHeight - 1 do
      begin
        rgb481 := image1.Scanline[y];
        rgb482 := image2.Scanline[y];
        for x := 0 to imageWidth - 1 do
        begin
          inc(r1, rgb481.r);
          inc(g1, rgb481.g);
          inc(b1, rgb481.b);
          inc(r2, rgb482.r);
          inc(g2, rgb482.g);
          inc(b2, rgb482.b);
          inc(rgb481);
          inc(rgb482);
        end;
      end;
  end;
  wh := imageWidth * imageHeight;
  r1 := r1 div wh;
  g1 := g1 div wh;
  b1 := b1 div wh;
  r2 := r2 div wh;
  g2 := g2 div wh;
  b2 := b2 div wh;

  Red   := (r1 - r2);
  Green := (g1 - g2);
  Blue  := (b1 - b2);
end;


// desiredHistogram must be of 256 values and each value must be from 0 to 255
// image.PixelFormat can be ie24RGB or ie48RGB
procedure IEHistogramSpecification(image: TIEBitmap; channel: Integer; var desiredHistogram: array of integer; desiredHistPixelsCount: Integer);
const
  maxval = 255;
var
  histogram: array of Integer;
  sum_hist: array of Double;
  scale_factor: Double;
  difference: Double;
  i, j: Integer;
  sum: Integer;
  inv_hist: array of Integer;
  min: Integer;
  pb: pbyte;
  pw: pword;
  imageWidth, imageHeight: Integer;
begin
  imageWidth  := image.Width;
  imageHeight := image.Height;

  if (imageWidth = 0) or (imageHeight = 0) then
    exit;

  SetLength(histogram, maxval + 1);
  SetLength(sum_hist, maxval + 1);
  SetLength(inv_hist, maxval + 1);

  for i := 0 to maxval do
    histogram[i] := 0;

  case image.PixelFormat of
    ie24RGB:
      for i := 0 to imageHeight - 1 do
      begin
        pb := image.Scanline[i];
        inc(pb, channel);
        for j := 0 to imageWidth - 1 do
        begin
          inc(histogram[pb^]);
          inc(pb, 3);
        end;
      end;
    ie48RGB:
      for i := 0 to imageHeight - 1 do
      begin
        pw := image.Scanline[i];
        inc(pw, 2-channel);
        for j := 0 to imageWidth - 1 do
        begin
          inc(histogram[pw^ shr 8]);
          inc(pw, 3);
        end;
      end;
  end;

  sum := 0;
  scale_factor := maxval / (imageWidth * imageHeight);
  for i := 0 to maxval do
  begin
    sum := sum + histogram[i];
    sum_hist[i] := sum * scale_factor;
  end;

  case image.PixelFormat of
    ie24RGB:
      for i := 0 to imageHeight - 1 do
      begin
        pb := image.Scanline[i];
        inc(pb, channel);
        for j := 0 to imageWidth - 1 do
        begin
          pb^ := trunc(sum_hist[pb^]);
          inc(pb, 3);
        end;
      end;
    ie48RGB:
      for i := 0 to imageHeight - 1 do
      begin
        pw := image.Scanline[i];
        inc(pw, 2 - channel);
        for j := 0 to imageWidth - 1 do
        begin
          pw^ := trunc(sum_hist[pw^ shr 8]) * 257;
          inc(pw, 3);
        end;
      end;
  end;

  sum := 0;
  scale_factor := maxval / desiredHistPixelsCount;
  for i := 0 to maxval do
  begin
    sum := sum + desiredHistogram[i];
    sum_hist[i] := sum * scale_factor;
  end;

  for i := 0 to maxval do
  begin
    difference := abs(i - sum_hist[0]);
    min := 0;
    for j := 0 to maxval do
    begin
      if abs(i - sum_hist[j]) < difference then
      begin
        difference := abs(i - sum_hist[j]);
        min := j;
      end;
    end;
    inv_hist[i] := min;
  end;

  case image.PixelFormat of
    ie24RGB:
      for i := 0 to imageHeight - 1 do
      begin
        pb := image.Scanline[i];
        inc(pb, channel);
        for j := 0 to imageWidth - 1 do
        begin
          pb^ := inv_hist[pb^];
          inc(pb, 3);
        end;
      end;
    ie48RGB:
      for i := 0 to imageHeight - 1 do
      begin
        pw := image.Scanline[i];
        inc(pw, 2 - channel);
        for j := 0 to imageWidth - 1 do
        begin
          pw^ := inv_hist[pw^ shr 8] *257;
          inc(pw, 3);
        end;
      end;
  end;
end;

// compare colors levels of templateimage and adjust targetimage
// works with ie24RGB and ie48RGB
// images can be of different sizes but must contain the same subject
// template image must be ie24RGB
procedure IEAdjustColors(templateimage, targetimage: TIEBitmap);
var
  x, y: Integer;
  rgb: PRGB;
  red, green, blue: array [0..255] of Integer;
  c: Integer;
  templateimageWidth, templateimageHeight: Integer;
begin
  if (templateimage.PixelFormat <> ie24RGB) or (templateimage.Width = 0) or (templateimage.Height = 0) or (targetimage.Width = 0) or (targetimage.Height = 0) then
    exit;

  templateimageWidth  := templateimage.Width;
  templateimageHeight := templateimage.Height;

  for y := 0 to 255 do
  begin
    red[y]   := 0;
    green[y] := 0;
    blue[y]  := 0;
  end;
  c := 0;
  for y := 0 to templateimageHeight - 1 do
  begin
    rgb := templateimage.Scanline[y];
    for x := 0 to templateimageWidth - 1 do
    begin
      with rgb^ do
      begin
        inc(red[r]);
        inc(green[g]);
        inc(blue[b]);
      end;
      inc(rgb);
      inc(c);
    end;
  end;

  IEHistogramSpecification(targetimage, 0, blue, c);
  IEHistogramSpecification(targetimage, 1, green, c);
  IEHistogramSpecification(targetimage, 2, red, c);
end;

// works only with ie24RGB
procedure IEApplyCoefficients(bitmap: TIEBitmap; var coeff: array of double; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  row, col, v: Integer;
  px: PRGB;
  per1: Double;
  LUTR, LUTG, LUTB: array [0..255] of byte;
  bitmapWidth, bitmapHeight: Integer;
begin
  bitmapWidth  := bitmap.Width;
  bitmapHeight := bitmap.Height;
  for v := 0 to 255 do
  begin
    LUTB[v] := blimit(trunc(v * coeff[0]));
    LUTG[v] := blimit(trunc(v * coeff[1]));
    LUTR[v] := blimit(trunc(v * coeff[2]));
  end;
  per1 := 100 / bitmapHeight;
  for row := 0 to bitmapHeight - 1 do
  begin
    px := bitmap.Scanline[row];
    for col := 0 to bitmapWidth - 1 do
    begin
      with px^ do
      begin
        r := LUTR[r];
        g := LUTG[g];
        b := LUTB[b];
      end;
      inc(px);
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * row));
  end;
end;

// working only with ie24RGB
procedure IEGetAverageValues(bitmap: TIEBitmap; var avg: TIEArrayOfDouble); overload;
var
  c, row, col: Integer;
  px: pbyte;
  count: array [0..2] of Integer;
  bitmapWidth, bitmapHeight: Integer;
begin
  bitmapWidth  := bitmap.Width;
  bitmapHeight := bitmap.Height;

  for c := 0 to 2 do
  begin
    count[c] := 0;
    avg[c] := 0;
  end;

  for row := 0 to bitmapHeight - 1 do
  begin
    px := bitmap.Scanline[row];
    for col := 0 to bitmapWidth - 1 do
      for c := 0 to 2 do
      begin
        avg[c] := avg[c] + px^;
        inc(count[c]);
        inc(px);
      end;
  end;
  for c := 0 to 2 do
    avg[c] := avg[c] / count[c];
end;


// ie24RGB ie48RGB
procedure IEGetMinMax(bitmap: TIEBitmap; var min, max: array of Integer);
var
  c, row, col: Integer;
  px: pbyte;
  pw: pword;
  bitmapWidth, bitmapHeight: Integer;
begin
  bitmapWidth  := bitmap.Width;
  bitmapHeight := bitmap.Height;
  for c := 0 to 2 do
  begin
    min[c] := 65535;
    max[c] := 0;
  end;
  case bitmap.PixelFormat of
    ie24RGB:
      for row := 0 to bitmapHeight - 1 do
      begin
        px := bitmap.Scanline[row];
        for col := 0 to bitmapWidth - 1 do
          for c := 0 to 2 do
          begin
            if min[c]>px^ then
              min[c] := px^;
            if max[c]<px^ then
              max[c] := px^;
            inc(px);
          end;
      end;
    ie48RGB:
      for row := 0 to bitmapHeight - 1 do
      begin
        pw := bitmap.Scanline[row];
        for col := 0 to bitmapWidth - 1 do
          for c := 0 to 2 do
          begin
            if min[c]>pw^ then
              min[c] := pw^;
            if max[c]<pw^ then
              max[c] := pw^;
            inc(pw);
          end;
      end;
  end;
end;

// working only with ie24RGB
procedure IEWhiteBalance_grayworld(bitmap: TIEBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  avg: TIEArrayOfDouble;
  c: Integer;
  maxval: Double;
  coef: array [0..2] of double;
begin
  SetLength(avg, 3);
  IEGetAverageValues(bitmap, avg);

  maxval := 0;
  for c := 0 to 2 do
    if maxval < avg[c] then
      maxval := avg[c];
  for c := 0 to 2 do
    if avg[c] = 0.0 then
      coef[c] := 1
    else
      coef[c] := maxval / avg[c];

  IEApplyCoefficients(bitmap, coef, fOnProgress, Sender);
end;

procedure IEGetAverageWhites(bitmap: TIEBitmap; var wavg: array of double);
var
  c, row, col: Integer;
  px: pbyte;
  count: array [0..2] of Integer;
  h, s, l: Double;
  bitmapWidth, bitmapHeight: Integer;
  function ToRemove: Boolean;
  begin
    result :=  ((h >= 0.01) and (h <= 0.04)) or   // skin
             ((h >= 0.35) and (h <= 0.50)) or   // vegetation
             ((h >= 0.57) and (h <= 0.59));     // sky
  end;
begin
  bitmapWidth  := bitmap.Width;
  bitmapHeight := bitmap.Height;

  for c := 0 to 2 do
  begin
    count[c] := 0;
    wavg[c] := 0;
  end;

  for row := 0 to bitmapHeight - 1 do
  begin
    px := bitmap.Scanline[row];
    for col := 0 to bitmapWidth - 1 do
    begin
      RGB2HSL(PRGB(px)^, h, s, l);
      if not ToRemove and (s < 0.30) and (l > 0.70) then
      begin
        for c := 0 to 2 do
        begin
          wavg[c] := wavg[c]+px^;
          inc(count[c]);
          inc(px);
        end;
      end
      else
        inc(PRGB(px));
    end;
  end;
  for c := 0 to 2 do
    if count[c] = 0 then
      wavg[c] := 255
    else
      wavg[c] := wavg[c] / count[c];
end;


// working only with ie24RGB
procedure IEWhiteBalance_2(bitmap: TIEBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  wavg: array [0..2] of double;
  c: Integer;
  coef: array [0..2] of double;
begin
  IEGetAverageWhites(bitmap, wavg);
  for c := 0 to 2 do
    coef[c] := 255/wavg[c];
  IEApplyCoefficients(bitmap, coef, fOnProgress, Sender);
end;

procedure IEWhiteBalance_3(bitmap: TIEBitmap; white_x, white_y: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  wavg: array [0..2] of double;
  c: Integer;
  coef: array [0..2] of double;
  min, max: array [0..2] of integer;
begin
  IEGetMinMax(bitmap, min, max);

  wavg[0] := imax(1, bitmap.Pixels_ie24RGB[white_x, white_y].b);
  wavg[1] := imax(1, bitmap.Pixels_ie24RGB[white_x, white_y].g);
  wavg[2] := imax(1, bitmap.Pixels_ie24RGB[white_x, white_y].r);

  for c := 0 to 2 do
    coef[c] := max[c]/wavg[c];

  IEApplyCoefficients(bitmap, coef, fOnProgress, Sender);
end;

// ie24rgb and ie48rgb
procedure IEAdjustGainOffset(bitmap: TIEBitmap; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  min, max: array [0..2] of integer;
  cb, cg, cr: Double;
  row, col: Integer;
  px: PRGB;
  px48: PRGB48;
  per1: Double;
  mx: Integer;
  bitmapWidth, bitmapHeight: Integer;
begin
  bitmapWidth  := bitmap.Width;
  bitmapHeight := bitmap.Height;
  IEGetMinMax(bitmap, min, max);
  case bitmap.PixelFormat of
    ie24RGB: mx := 255;
    ie48RGB: mx := 65535;
    else
      mx := 0;
  end;
  cb := (mx / (max[0] - min[0]));
  cg := (mx / (max[1] - min[1]));
  cr := (mx / (max[2] - min[2]));
  per1 := 100 / bitmapHeight;
  for row := 0 to bitmapHeight - 1 do
  begin
    case bitmap.PixelFormat of
      ie24RGB:
        begin
          px := bitmap.Scanline[row];
          for col := 0 to bitmapWidth - 1 do
          begin
            with px^ do
            begin
              b := trunc( cb * (b - min[0]) );
              g := trunc( cg * (g - min[1]) );
              r := trunc( cr * (r - min[2]) );
            end;
            inc(px);
          end;
        end;
      ie48RGB:
        begin
          px48 := bitmap.Scanline[row];
          for col := 0 to bitmapWidth - 1 do
          begin
            with px48^ do
            begin
              b := trunc( cb * (b - min[0]) );
              g := trunc( cg * (g - min[1]) );
              r := trunc( cr * (r - min[2]) );
            end;
            inc(px48);
          end;
        end;
    end;
    if assigned(fOnProgress) then
      fOnProgress(Sender, trunc(per1 * row));
  end;
end;

{!!
<FS>TImageEnProc.WhiteBalance_coef

<FM>Declaration<FC>
procedure WhiteBalance_coef(Red, Green, Blue: Double);

<FM>Description<FN>
Applies the specified coefficients to each pixel of the image. Coefficients (Red, Green, Blue) are values in the range 0 to 1.

<FM>Example<FC>
// Decrease red level by 0.8
ImageEnView1.Proc.WhiteBalance_coef(0.8, 1, 1);

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WhiteBalance_WhiteAt></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WhiteBalance_AutoWhite></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WhiteBalance_GrayWorld></C> </R>
</TABLE>

!!}
procedure TImageEnProc.WhiteBalance_coef(Red, Green, Blue: Double);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
  coef: array [0..2] of double;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_WHITEBALANCE_COEF, [Red, Green, Blue]),
                              {$ELSE}
                              IEMsg( IEMSG_WHITEBALANCE ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_WHITEBALANCE_COEF ) then
    exit;
  coef[0] := Blue;
  coef[1] := Green;
  coef[2] := Red;
  IEApplyCoefficients(ProcBitmap, coef, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

{!!
<FS>TImageEnProc.WhiteBalance_GrayWorld

<FM>Declaration<FC>
procedure WhiteBalance_GrayWorld;

<FM>Description<FN>
Adjust image colors by applying the white balance algorithm "Gray World".

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\AutoEnhance\AutoAdjust.dpr </C> </R>
</TABLE>

<FM>Example<FC>
ImageEnView1.Proc.WhiteBalance_GrayWorld;

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WhiteBalance_coef></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WhiteBalance_WhiteAt></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WhiteBalance_AutoWhite></C> </R>
</TABLE>

!!}
procedure TImageEnProc.WhiteBalance_GrayWorld;
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_WHITEBALANCE_GRAYWORLD,
                              {$ELSE}
                              IEMsg( IEMSG_WHITEBALANCE ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_WHITEBALANCE_GRAYWORLD ) then
    exit;
  IEWhiteBalance_grayworld(ProcBitmap, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

{!!
<FS>TImageEnProc.WhiteBalance_WhiteAt

<FM>Declaration<FC>
procedure WhiteBalance_WhiteAt(WhiteX, WhiteY: Integer);

<FM>Description<FN>
Adjust image colors by adjusting the white range. WhiteX and WhiteY are the coordinates of a white pixel.

<FM>Example<FC>
// Specify the white pixel to perform the white balance adjustment
ImageEnView1.Proc.WhiteBalance_WhiteAt( 150, 200 );

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WhiteBalance_AutoWhite></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WhiteBalance_coef></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WhiteBalance_GrayWorld></C> </R>
</TABLE>

!!}
procedure TImageEnProc.WhiteBalance_WhiteAt(WhiteX, WhiteY: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_WHITEBALANCE_WHITEAT, [WhiteX, WhiteY]),
                              {$ELSE}
                              IEMsg( IEMSG_WHITEBALANCE ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_WHITEBALANCE_WHITEAT ) then
    exit;
  IEWhiteBalance_3(ProcBitmap, WhiteX, WhiteY, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

{!!
<FS>TImageEnProc.WhiteBalance_AutoWhite

<FM>Declaration<FC>
procedure WhiteBalance_AutoWhite;

<FM>Description<FN>
Adjusts image colors by adjusting the white range. This method is similar to WhiteBalance_WhiteAt, but attempts to automatically detect the white.

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\AutoEnhance\AutoAdjust.dpr </C> </R>
</TABLE>

<FM>Example<FC>
ImageEnView1.Proc.WhiteBalance_AutoWhite;

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WhiteBalance_coef></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WhiteBalance_WhiteAt></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.WhiteBalance_GrayWorld></C> </R>
</TABLE>
!!}
procedure TImageEnProc.WhiteBalance_AutoWhite;
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_WHITEBALANCE_AUTOWHITE,
                              {$ELSE}
                              IEMsg( IEMSG_WHITEBALANCE ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_WHITEBALANCE_AUTOWHITE ) then
    exit;
  IEWhiteBalance_2(ProcBitmap, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

{!!
<FS>TImageEnProc.AdjustGainOffset

<FM>Declaration<FC>
procedure AdjustGainOffset;

<FM>Description<FN>
Adjust image luminosity by calculating the min and max pixels values and stretching the colors to the maximum allowed value.

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\AutoEnhance\AutoAdjust.dpr </C> </R>
</TABLE>

<FM>Example<FC>
ImageEnView1.Proc.AdjustGainOffset;

!!}
procedure TImageEnProc.AdjustGainOffset;
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB, ie48RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_ADJUSTGAINOFFSET,
                              {$ELSE}
                              IEMsg( IEMSG_ADJUSTGAINOFFSET ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_ADJUSTGAINOFFSET ) then
    exit;
  IEAdjustGainOffset(ProcBitmap, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

procedure IECastColor(Bitmap: TIEBitmap; x, y: Integer; newColor: TRGB; tolerance: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  pixmap: TIEMask;
  row, col: Integer;
  px: pbyte;
  p_rgb: PRGB;
  per1: Double;
begin
  pixmap := TIEMask.Create;
  pixmap.AllocateBits(Bitmap.Width, Bitmap.Height, 8);
  _MakeMagicWandPointsEx(Bitmap, x, y, false, tolerance, pixmap, 255);
  if not pixmap.IsEmpty then
  begin
    per1 := 100 / (pixmap.y2-pixmap.y1+1);
    for row := pixmap.y1 to pixmap.y2 do
    begin
      px := pixmap.Scanline[row];     inc(px, pixmap.x1);
      p_rgb := Bitmap.Scanline[row];  inc(p_rgb, pixmap.x1);
      for col := pixmap.x1 to pixmap.x2 do
      begin
        if px^ <> 0 then
          p_rgb^ := newColor;
        inc(px);
        inc(p_rgb);
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * row));
    end;
  end;
  FreeAndNil(pixmap);
end;

{!!
<FS>TImageEnProc.CastColor

<FM>Declaration<FC>
procedure CastColor(x, y: Integer; newColor: TRGB; tolerance: Integer);

<FM>Description<FN>
Perform a flood-fill starting at the coordinates <FC>x, y<FN>, i.e. replacing all encountered pixels that match the color at the starting position with <FC>newColor<FN>.
<FC>tolerance<FN> specifies the maximum difference from the starting pixel (0 to 255, where 0 requires an exact color match, whereas 255 would match every color)

<FM>Example<FC>
// assuming X, Y = mouse coordinates, paints points to red
ImageEnView1.Proc.CastColor(ImageEnView1.XScr2Bmp(X), ImageEnView1.Yscr2Bmp(Y), CreateRGB(255, 0, 0), 0);
!!}
procedure TImageEnProc.CastColor(x, y: Integer; newColor: TRGB; tolerance: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_CASTCOLOR,
                              {$ELSE}
                              IEMsg( IEMSG_CASTCOLOR ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_CASTCOLOR ) then
    exit;
  IECastColor(ProcBitmap, x, y, newColor, tolerance, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

procedure IECastAlpha(Bitmap: TIEBitmap; x, y: Integer; newAlpha: Integer; tolerance: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  pixmap: TIEMask;
  row, col: Integer;
  px: pbyte;
  pb: pbyte;
  per1: Double;
begin
  pixmap := TIEMask.Create;
  pixmap.AllocateBits(Bitmap.Width, Bitmap.Height, 8);
  _MakeMagicWandPointsEx(Bitmap, x, y, false, tolerance, pixmap, 255);
  if not pixmap.IsEmpty then
  begin
    per1 := 100 / (pixmap.y2-pixmap.y1+1);
    for row := pixmap.y1 to pixmap.y2 do
    begin
      px := pixmap.Scanline[row];     inc(px, pixmap.x1);
      pb := Bitmap.AlphaChannel.Scanline[row];  inc(pb, pixmap.x1);
      for col := pixmap.x1 to pixmap.x2 do
      begin
        if px^ <> 0 then
          pb^ := newAlpha;
        inc(px);
        inc(pb);
      end;
      if assigned(fOnProgress) then
        fOnProgress(Sender, trunc(per1 * row));
    end;
  end;
  FreeAndNil(pixmap);
  Bitmap.AlphaChannel.SyncFull;
end;

{!!
<FS>TImageEnProc.CastAlpha

<FM>Declaration<FC>
procedure CastAlpha(x, y: Integer; newAlpha: Integer; tolerance: Integer);

<FM>Description<FN>
Perform a flood-fill starting at the coordinates <FC>x, y<FN>, i.e. replacing all encountered pixels that match the color at the starting position with alpha.
The Alpha level is specified by <FC>newAlpha<FN> in the range 0: Fully Transparent - 255: Opaque.
<FC>tolerance<FN> specifies the maximum difference from the starting pixel (0 to 255, where 0 requires an exact color match, whereas 255 would match every color).

<FM>Example<FC>
// assuming X, Y = mouse coordinates, makes the area transparent
ImageEnView1.Proc.CastAlpha( ImageEnView1.XScr2Bmp(X), ImageEnView1.Yscr2Bmp(Y), 0, 0);
!!}
procedure TImageEnProc.CastAlpha(x, y: Integer; newAlpha: Integer; tolerance: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_CASTALPHA, [x, y, newAlpha, tolerance]),
                              {$ELSE}
                              IEMsg( IEMsg_CASTALPHA ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_CASTALPHA ) then
    exit;
  IECastAlpha(ProcBitmap, x, y, newAlpha, tolerance, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


{!!
<FS>TImageEnProc.FeatherAlphaEdges

<FM>Declaration<FC>
procedure FeatherAlphaEdges(iFeatherDepth : Integer);

<FM>Description<FN>
Applies a feathering effect to the image. Feathering softens the edges of an image by applying alpha transparency at a rate that is proportional to the distance to the edge (specifically, adding a gradient in the alpha channel).

<FC>iFeatherDepth<FN> specifies the depth in pixels of the feather effect. The range is 0 to 255, with typical values of 2 to 5. If <FC>iFeatherDepth<FN> = 0 then the image is not feathered but a simple smoothing filter is applied to reduce the jagged edges of the image.

Note: Method has no effect if the image does not have an alpha channel
!!}
procedure TImageEnProc.FeatherAlphaEdges(iFeatherDepth : Integer);
begin
  if not MakeConsistentBitmap([]) then
    exit;
  if fAutoUndo then
    SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
             Format( IERS_FEATHERALPHAEDGES, [ iFeatherDepth ]),
             {$ELSE}
             IEMsg( IEMsg_FEATHEREDGES ),
             {$ENDIF}
             ieuImage, True, IEOP_FEATHERALPHAEDGES );

  fIEBitmap.FeatherAlphaEdges( iFeatherDepth );

  Update;
  DoFinishWork;
end;

// supports: ie24RGB; ie8p
procedure IEColorize(bitmap: TIEBitmap; hue: Integer; saturation: Integer; luminosity: Double; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  i, row, col: Integer;
  px: PRGB;
  rgb: TRGB;
  v: Integer;
  per1: Double;
  RedToGrayCoef, GreenToGrayCoef, BlueToGrayCoef: Integer;
  bitmapWidth, bitmapHeight: Integer;
begin
  bitmapWidth  := bitmap.Width;
  bitmapHeight := bitmap.Height;
  RedToGrayCoef   := IEGlobalSettings().RedToGrayCoef;
  GreenToGrayCoef := IEGlobalSettings().GreenToGrayCoef;
  BlueToGrayCoef  := IEGlobalSettings().BlueToGrayCoef;
  case bitmap.PixelFormat of
    ie24RGB:
      begin
        per1 := 100 / bitmapHeight;
        for row := 0 to bitmapHeight - 1 do
        begin
          px := bitmap.Scanline[row];
          for col := 0 to bitmapWidth - 1 do
          begin
            with px^ do
              v := trunc( (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) shr 8 * luminosity );
            HSV2RGB(px^, hue, saturation, v);
            inc(px);
          end;
          if assigned(fOnProgress) then
            fOnProgress(Sender, trunc(per1 * row));
        end;
      end;
    ie8p:
      begin
        for i := 0 to 255 do
        begin
          with bitmap.Palette[i] do
            v := trunc( (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) shr 8 * luminosity );
          HSV2RGB(rgb, hue, saturation, v);
          bitmap.Palette[i] := rgb;
        end;
      end;
  end;
end;

{!!
<FS>TImageEnProc.Colorize

<FM>Declaration<FC>
procedure Colorize(hue: Integer; saturation: Integer; luminosity: Double);

<FM>Description<FN>
Set the hue and saturation for all pixels of the image. It also adjusts the luminosity using a multiplier.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>hue<FN></C> <C>A value between 0 and 359 (corresponding to 0 to 359 degrees around hexcone)</C> </R>
<R> <C><FC>saturation<FN></C> <C>A value between 0 (shade of gray) and 99 (pure color).</C> </R>
<R> <C><FC>luminosity<FN></C> <C>This is 1 if you don't touch the original luminosity. Whereas 1.1 would equate to 10% increase in luminosity, for example</C> </R>
</TABLE>
    
<FM>Example<FC>
// Apply a sepia effect to the image
<FC>ImageEnView.Proc.Colorize(40, 50, 1.1);<FN>
!!}
procedure TImageEnProc.Colorize(hue: Integer; saturation: Integer; luminosity: Double);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB, ie8p], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_COLORIZE, [hue, saturation, luminosity]),
                              {$ELSE}
                              IEMsg( IEMsg_COLORIZE ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_COLORIZE ) then
    exit;
  IEColorize(ProcBitmap, hue, saturation, luminosity, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

function IEPatternCompare(x, y: Integer; InputBitmap: TIEBitmap; pattern: TIEBitmap; precision: Double): Double;
var
  yi: Integer;      // input coordinates
  xp, yp: Integer;  // pattern coordinates
  pi, pp: pbyte;
  mx: Integer;
  patternWidth, patternHeight: Integer;
begin
  result := 0;
  patternWidth  := pattern.Width;
  patternHeight := pattern.Height;
  yp := 0;
  yi := y;
  mx := 1;
  precision := 1 - precision;
  while yp < patternHeight do
  begin
    xp := 0;
    pi := InputBitmap.Scanline[yi]; inc(pi, x);
    pp := pattern.Scanline[yp];
    while xp < patternWidth do
    begin
      result := result + abs( pi^ - pp^ )/255;
      if result / mx > precision then
      begin
        result := patternWidth * patternHeight;
        yp := patternHeight;
        break;
      end;
      inc(xp);
      inc(pi);
      inc(pp);
      inc(mx);
    end;
    inc(yi);
    inc(yp);
  end;
  result :=  1 - (result / (patternWidth * patternHeight));
end;

type
TPatt=record
  score: Double;
  x: Integer;
  y: Integer;
  s: Integer;  // scale (1..)
end;
PPatt=^TPatt;

// Founds is a list of PPatt pointers to TPatt structures
// pattern must be at scale 1
// InputBitmap and pattern MUST BE ie8g
// precision:  > 0 and < = 1   (if  = -1 it is autocalculated)
// scaleSteps: 0=no multiscale, >1 divide for scaleSteps scales
procedure IEPatternSearch8g(InputBitmap: TIEBitmap; pattern: TIEBitmap; Founds: TList; precision: Double; scaleSteps: Integer);
var
  scalecount: Integer;
  s, x, y: Integer;
  eq: Double;
  scaledpattern: TIEBitmap;
  found: PPatt;
  maxp: Double;
  InputBitmapWidth, InputBitmapHeight: Integer;
  scaledpatternWidth, scaledpatternHeight: Integer;
begin
  InputBitmapWidth  := InputBitmap.Width;
  InputBitmapHeight := InputBitmap.Height;

  scalecount :=  imin(InputBitmapWidth - pattern.Width, InputBitmapHeight - pattern.Height);

  scaledpattern := TIEBitmap.Create();

  try
    maxp := -1;
    found := nil;
    s := 0;
    while s<scalecount do
    begin
      // scale input pattern
      scaledpattern.Allocate(pattern.Width + s, pattern.Height + s, pattern.PixelFormat);
      _IEResampleIEBitmap(pattern, scaledpattern, rfNone, nil, nil );

      scaledpatternWidth  := scaledpattern.Width;
      scaledpatternHeight := scaledpattern.Height;
      for x := 0 to InputBitmapWidth - scaledpatternWidth - 1 do
      begin
        for y := 0 to InputBitmapHeight - scaledpatternHeight - 1 do
        begin

          eq := IEPatternCompare(x, y, InputBitmap, scaledpattern, dmax(precision, maxp));
          if precision = -1 then
          begin
            if eq>maxp then
            begin
              if found=nil then
              begin
                new(found);
                founds.Add(found);
              end;
              found^.score := eq;
              found^.x := x;
              found^.y := y;
              found^.s := s;
              maxp := eq;
            end;
          end
          else
          if eq>=precision then
          begin
            new(found);
            found^.score := eq;
            found^.x := x;
            found^.y := y;
            found^.s := s;
            founds.Add( found );
          end;

        end;
      end;

      if scaleSteps = 0 then
        break
      else
        inc(s, scalecount div scaleSteps);
    end;

  finally
    FreeAndNil(scaledpattern);
  end;
end;

function IEPatternSortCompare(Item1, Item2: Pointer): Integer;
var
  i1, i2: PPatt;
begin
  i1 := PPatt(Item1);
  i2 := PPatt(Item2);
  if i1^.score < i2^.score then
    result := 1
  else
  if i1^.score = i2^.score then
    result := 0
  else
    result := -1;
end;

procedure IEPatternSearch(InputBitmap: TIEBitmap; pattern: TIEBitmap; var FoundRect: TRect; precision: Double; scaleSteps: Integer);
var
  ibitmap: TIEBitmap;
  xpattern: TIEBitmap;
  founds: TList;
  i: Integer;
begin
  if InputBitmap.PixelFormat <> ie8g then
  begin
    ibitmap := TIEBitmap.Create();
    ibitmap.AssignImage( InputBitmap );
    ibitmap.PixelFormat := ie8g;
  end
  else
    ibitmap := InputBitmap;
  if pattern.PixelFormat <> ie8g then
  begin
    xpattern := TIEBitmap.Create();
    xpattern.AssignImage( pattern );
    xpattern.PixelFormat := ie8g;
  end
  else
    xpattern := pattern;

  founds := TList.Create();
  IEPatternSearch8g(ibitmap, xpattern, founds, precision, scaleSteps);

  // sort founds array
  founds.Sort( IEPatternSortCompare );

  FoundRect.Left   := PPatt(founds[0])^.x;
  FoundRect.Top    := PPatt(founds[0])^.y;
  FoundRect.Right  := FoundRect.Left + xpattern.Width + PPatt(founds[0])^.s;
  FoundRect.Bottom := FoundRect.Top + xpattern.Height + PPatt(founds[0])^.s;

  for i := 0 to founds.Count - 1 do
  begin
    with inputbitmap.Canvas do
    begin
      pen.color := clred;
      brush.Style := bsClear;

      FoundRect.Left   := PPatt(founds[i])^.x;
      FoundRect.Top    := PPatt(founds[i])^.y;
      FoundRect.Right  := FoundRect.Left + xpattern.Width+PPatt(founds[i])^.s;
      FoundRect.Bottom := FoundRect.Top + xpattern.Height+PPatt(founds[i])^.s;

      with FoundRect do
        rectangle(left, top, right, bottom);
    end;
  end;

  for i := 0 to founds.Count - 1 do
    dispose( founds[i] );
  FreeAndNil(founds);

  if ibitmap <> InputBitmap then
    FreeAndNil(ibitmap);
  if xpattern <> pattern then
    FreeAndNil(xpattern);
end;

{!!
<FS>TImageEnProc.MakeTile

<FM>Declaration<FC>
procedure MakeTile(columns, rows: Integer);

<FM>Description<FN>
Replicates the current image in multiple columns and rows. This is used to create tiled images.

Note: The final image will be resized by columns * ImageWidth and rows * ImageHeight

<FM>Example<FC>
// Create an image with pic.jpg repeated in a 6x6 grid
ImageEnView1.IO.LoadFromFile('C:\pic.jpg');
ImageEnView1.Proc.MakeTile(6, 6);
ImageEnView1.IO.SaveToFile('D:\tiled.jpg');

!!}
procedure TImageEnProc.MakeTile(columns, rows: Integer);
var
  oldWidth, oldHeight: Integer;
  x, y: Integer;
begin
  if not MakeConsistentBitmap([]) then
    exit;
  if fAutoUndo then
    SaveUndo({$IFDEF IEUseLegacyUndoCaptions}
             Format(IERS_MAKETILE, [columns, rows]),
             {$ELSE}
             IEMsg( IEMSG_TileImage ),
             {$ENDIF}
             ieuImage, True, IEOP_MAKETILE );
  oldWidth := fIEBitmap.Width;
  oldHeight := fIEBitmap.Height;
  fIEBitmap.Resize(columns * oldWidth, rows * oldHeight, 0, 255, iehLeft, ievTop);
  for x := 0 to columns - 1 do
    for y := 0 to rows - 1 do
    begin
      fIEBitmap.CopyRectTo(fIEBitmap, 0, 0, x * oldWidth, y * oldHeight, oldWidth, oldHeight, true);
    end;
  Update;
  DoFinishWork;
end;

{$ifdef IEINCLUDEDIALOGIP}
constructor TIPDialogParams.Create;
begin
  inherited;
  FFT_Selection := TMemoryStream.Create;
  SetDefaultParams;
end;

destructor TIPDialogParams.Destroy;
begin
  FFT_Selection.Free;
  inherited;
end;

{!!
<FS>TIPDialogParams.SetDefaultParams

<FM>Declaration<FC>
procedure SetDefaultParams;

<FM>Description<FN>
Load the default parameters for the <L TImageEnProc.DoPreviews>Image Processing Dialog</L> (i.e. resetting all controls to their default state). You can call this method to reset parameters before displaying the dialog.
!!}
procedure TIPDialogParams.SetDefaultParams;
var
  x, y: Integer;
begin
  DialogWidth := -1;
  DialogHeight := -1;
  CONTRAST_Contrast := 0;
  CONTRAST_Brightness := 0;
  HSV_H := 0;
  HSV_S := 0;
  HSV_V := 0;
  HSL_H := 0;
  HSL_S := 0;
  HSL_L := 0;
  RGB_R := 0;
  RGB_G := 0;
  RGB_B := 0;
  for x := 0 to 2 do
    for y := 0 to 2 do
      USERFILTER_Values.Values[x, y] := 0;
  USERFILTER_Values.Values[1, 1] := 1;
  USERFILTER_Values.Divisor := 0;
  EQUALIZATION_ThresholdDown := CreateRGB(0, 0, 0);
  EQUALIZATION_ThresholdUp := CreateRGB(255, 255, 255);
  EQUALIZATION_EqDown := CreateRGB(0, 0, 0);
  EQUALIZATION_EqUp := CreateRGB(255, 255, 255);
  EQUALIZATION_EqualizeButton := false;
  BUMPMAP_Left := 0;
  BUMPMAP_Top := 0;
  BUMPMAP_Width := 150;
  BUMPMAP_Height := 150;
  BUMPMAP_Col := CreateRGB(255, 255, 255);
  BUMPMAP_Src := 0;
  BUMPMAP_Auto := true;
  LENS_Left := 0;
  LENS_Top := 0;
  LENS_Width := 150;
  LENS_Height := 150;
  LENS_Ref := 1.7;
  LENS_Auto := true;
  WAVE_Amplitude := 10;
  WAVE_WaveLength := 10;
  WAVE_Phase := 0;
  WAVE_Reflect := false;
  MORPH_Filter := 0;
  MORPH_WinSize := 1;
  ROTATE_Angle := 0;
  FLIP_Horz := False;
  FLIP_Vert := False;
  GAMMACORRECTION_Value := 1;
  SHARPEN_Sharpen := 1;
  SHARPEN_Size := 4;
  FFT_Left := -1;
  FFT_Top := -1;
  FFT_Right := -1;
  FFT_Bottom := -1;
  FFT_GrayScale := true;
  FFT_Selection.Clear;
  Resize_Percent := 50;
  Shadow_Radius  := 3;
  Shadow_Offset  := 3;
  AutoEnhance1_Slope := 20;
  AutoEnhance1_Range := 25;
  AutoEnhance3_Gamma := 0;
  AutoEnhance3_Saturation := 0;
  BackgroundColor := clBlack;
end;

procedure TIPDialogParams.SetFFT_Left(v: Integer);
begin
  fFFT_Left := v;
  FFT_Selection.Clear;
end;

procedure TIPDialogParams.SetFFT_Top(v: Integer);
begin
  fFFT_Top := v;
  FFT_Selection.Clear;
end;

procedure TIPDialogParams.SetFFT_Right(v: Integer);
begin
  fFFT_Right := v;
  FFT_Selection.Clear;
end;

procedure TIPDialogParams.SetFFT_Bottom(v: Integer);
begin
  fFFT_Bottom := v;
  FFT_Selection.Clear;
end;

{!!
<FS>TIPDialogParams.SaveToFile

<FM>Declaration<FC>
procedure SaveToFile(const FileName: String);

<FM>Description<FN>
Save parameters for the <L TImageEnProc.DoPreviews>Image Processing Dialog</L> (i.e. the current setting of all controls).

!!}
procedure TIPDialogParams.SaveToFile(const FileName: String);
var
  fs: TFileStream;
begin
  fs := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(fs);
  finally
    FreeAndNil(fs);
  end;
end;

{!!
<FS>TIPDialogParams.LoadFromFile

<FM>Declaration<FC>
procedure LoadFromFile(const FileName: String);

<FM>Description<FN>
Load parameters for the <L TImageEnProc.DoPreviews>Image Processing Dialog</L> (i.e. the current setting of all controls).

!!}
procedure TIPDialogParams.LoadFromFile(const FileName: String);
var
  fs: TFileStream;
begin
  fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(fs);
  finally
    FreeAndNil(fs);
  end;
end;

{!!
<FS>TIPDialogParams.SaveToStream

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

<FM>Description<FN>
Save parameters for the <L TImageEnProc.DoPreviews>Image Processing Dialog</L> to a stream (i.e. the current setting of all controls).
!!}
procedure TIPDialogParams.SaveToStream(Stream: TStream);
var
  sz: Integer;
  ver: Integer;
begin
  ver := 10003;
  Stream.Write(ver, sizeof(integer));
  Stream.Write(DialogWidth, sizeof(integer));
  Stream.Write(DialogHeight, sizeof(integer));
  Stream.Write(Resize_Percent, sizeof(Integer));
  Stream.Write(Shadow_Radius, sizeof(Integer));
  Stream.Write(Shadow_Offset, sizeof(Integer));
  Stream.Write(CONTRAST_Contrast, sizeof(integer));
  Stream.Write(CONTRAST_Brightness, sizeof(integer));
  Stream.Write(HSV_H, sizeof(integer));
  Stream.Write(HSV_S, sizeof(integer));
  Stream.Write(HSV_V, sizeof(integer));
  Stream.Write(HSL_H, sizeof(integer));
  Stream.Write(HSL_S, sizeof(integer));
  Stream.Write(HSL_L, sizeof(integer));
  Stream.Write(RGB_R, sizeof(integer));
  Stream.Write(RGB_G, sizeof(integer));
  Stream.Write(RGB_B, sizeof(integer));
  Stream.Write(USERFILTER_Values, sizeof(TGraphFilter));
  Stream.Write(EQUALIZATION_ThresholdDown, sizeof(TRGB));
  Stream.Write(EQUALIZATION_ThresholdUp, sizeof(TRGB));
  Stream.Write(EQUALIZATION_EqDown, sizeof(TRGB));
  Stream.Write(EQUALIZATION_EqUp, sizeof(TRGB));
  Stream.Write(EQUALIZATION_EqualizeButton, sizeof(boolean));
  Stream.Write(BUMPMAP_Left, sizeof(integer));
  Stream.Write(BUMPMAP_Top, sizeof(integer));
  Stream.Write(BUMPMAP_Width, sizeof(integer));
  Stream.Write(BUMPMAP_Height, sizeof(integer));
  Stream.Write(BUMPMAP_Col, sizeof(TRGB));
  Stream.Write(BUMPMAP_Src, sizeof(integer));
  Stream.Write(BUMPMAP_Auto, sizeof(boolean));
  Stream.Write(LENS_Left, sizeof(integer));
  Stream.Write(LENS_Top, sizeof(integer));
  Stream.Write(LENS_Width, sizeof(integer));
  Stream.Write(LENS_Height, sizeof(integer));
  Stream.Write(LENS_Ref, sizeof( double));
  Stream.Write(LENS_Auto, sizeof(boolean));
  Stream.Write(WAVE_Amplitude, sizeof( integer));
  Stream.Write(WAVE_WaveLength, sizeof( integer));
  Stream.Write(WAVE_Phase, sizeof( integer));
  Stream.Write(WAVE_Reflect, sizeof( boolean));
  Stream.Write(MORPH_Filter, sizeof( integer));
  Stream.Write(MORPH_WinSize, sizeof( integer));
  Stream.Write(ROTATE_Angle, sizeof( double));
  Stream.Write(FLIP_Horz, sizeof(boolean));
  Stream.Write(FLIP_Vert, sizeof(boolean));
  Stream.Write(GAMMACORRECTION_Value, sizeof(double));
  Stream.Write(SHARPEN_Sharpen, sizeof( integer));
  Stream.Write(SHARPEN_Size, sizeof( integer));
  Stream.Write(fFFT_Left, sizeof(integer));
  Stream.Write(fFFT_Top, sizeof(integer));
  Stream.Write(fFFT_Right, sizeof(integer));
  Stream.Write(fFFT_Bottom, sizeof(integer));
  Stream.Write(FFT_GrayScale, sizeof(boolean));
  sz := FFT_Selection.Size;
  Stream.Write(sz, sizeof(integer));
  IECopyFrom(Stream, FFT_Selection, 0);
end;

{!!
<FS>TIPDialogParams.LoadFromStream

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

<FM>Description<FN>
Load parameters for the <L TImageEnProc.DoPreviews>Image Processing Dialog</L> from a stream (i.e. the current setting of all controls).
!!}
            
// 10001: v5.0.0
// 10002: v5.1.1
// 10003: v5.2.0
procedure TIPDialogParams.LoadFromStream(Stream: TStream);
var
  sz: Integer;
  ver: Integer;
begin
  Stream.Read(ver, sizeof(integer));
  if ver < 10000 then
    Stream.Position := 0; // Old versions do not write version
  if ver >= 10001 then
  begin
    Stream.Read(DialogWidth, sizeof(integer));
    Stream.Read(DialogHeight, sizeof(integer));
    Stream.Read(Resize_Percent, sizeof(Integer));
  end;
  if ver >= 10002 then
  begin
    Stream.Read(Shadow_Radius, sizeof(integer));
    Stream.Read(Shadow_Offset, sizeof(integer));
  end;
  Stream.Read(CONTRAST_Contrast, sizeof(integer));
  Stream.Read(CONTRAST_Brightness, sizeof(integer));
  Stream.Read(HSV_H, sizeof(integer));
  Stream.Read(HSV_S, sizeof(integer));
  Stream.Read(HSV_V, sizeof(integer));
  Stream.Read(HSL_H, sizeof(integer));
  Stream.Read(HSL_S, sizeof(integer));
  Stream.Read(HSL_L, sizeof(integer));
  Stream.Read(RGB_R, sizeof(integer));
  Stream.Read(RGB_G, sizeof(integer));
  Stream.Read(RGB_B, sizeof(integer));
  Stream.Read(USERFILTER_Values, sizeof(TGraphFilter));
  Stream.Read(EQUALIZATION_ThresholdDown, sizeof(TRGB));
  Stream.Read(EQUALIZATION_ThresholdUp, sizeof(TRGB));
  Stream.Read(EQUALIZATION_EqDown, sizeof(TRGB));
  Stream.Read(EQUALIZATION_EqUp, sizeof(TRGB));
  if ver >= 10000 then
    Stream.Read(EQUALIZATION_EqualizeButton, sizeof(boolean));
  Stream.Read(BUMPMAP_Left, sizeof(integer));
  Stream.Read(BUMPMAP_Top, sizeof(integer));
  Stream.Read(BUMPMAP_Width, sizeof(integer));
  Stream.Read(BUMPMAP_Height, sizeof(integer));
  Stream.Read(BUMPMAP_Col, sizeof(TRGB));
  Stream.Read(BUMPMAP_Src, sizeof(integer));
  Stream.Read(BUMPMAP_Auto, sizeof(boolean));
  Stream.Read(LENS_Left, sizeof(integer));
  Stream.Read(LENS_Top, sizeof(integer));
  Stream.Read(LENS_Width, sizeof(integer));
  Stream.Read(LENS_Height, sizeof(integer));
  Stream.Read(LENS_Ref, sizeof( double));
  Stream.Read(LENS_Auto, sizeof(boolean));
  Stream.Read(WAVE_Amplitude, sizeof( integer));
  Stream.Read(WAVE_WaveLength, sizeof( integer));
  Stream.Read(WAVE_Phase, sizeof( integer));
  Stream.Read(WAVE_Reflect, sizeof( boolean));
  Stream.Read(MORPH_Filter, sizeof( integer));
  Stream.Read(MORPH_WinSize, sizeof( integer));
  Stream.Read(ROTATE_Angle, sizeof( double));
                     
  if ver >= 10003 then
  begin         
    Stream.Read(FLIP_Horz, sizeof(boolean));
    Stream.Read(FLIP_Vert, sizeof(boolean));
  end;

  Stream.Read(GAMMACORRECTION_Value, sizeof(double));
  Stream.Read(SHARPEN_Sharpen, sizeof( integer));
  Stream.Read(SHARPEN_Size, sizeof( integer));
  Stream.Read(fFFT_Left, sizeof(integer));
  Stream.Read(fFFT_Top, sizeof(integer));
  Stream.Read(fFFT_Right, sizeof(integer));
  Stream.Read(fFFT_Bottom, sizeof(integer));
  Stream.Read(FFT_GrayScale, sizeof(boolean));
  FFT_Selection.Clear;
  if Stream.Position < Stream.Size + 4 then
  begin
    Stream.Read(sz, sizeof(integer));
    if sz > 0 then
      IECopyFrom(FFT_Selection, Stream, sz);
  end;
end;

{!!
<FS>TIPDialogParams.GetProperty

<FM>Declaration<FC>
function GetProperty(const Prop: String): String;

<FM>Description<FN>
Return a parameters of the <L TImageEnProc.DoPreviews>Image Processing Dialog</L> as a string.
!!}
function TIPDialogParams.GetProperty(const Prop: String): String;
var
  ss: String;
  q, w: Integer;
begin
  ss := UpperCase(IERemoveCtrlCharsS(Prop));
  if ss = IPP_DIALOGWIDTH then
    result := IntToStr(DialogWidth)
  else
  if ss = IPP_DIALOGHEIGHT then
    result := IntToStr(DialogHeight)
  else
  if ss = IPP_CONTRAST_CONTRAST then
    result := IntToStr(CONTRAST_Contrast)
  else
  if ss = IPP_CONTRAST_BRIGHTNESS then
    result := IntToStr(CONTRAST_Brightness)
  else
  if ss = IPP_HSV_H then
    result := IntToStr(HSV_H)
  else
  if ss = IPP_HSV_S then
    result := IntToStr(HSV_S)
  else
  if ss = IPP_HSV_V then
    result := IntToStr(HSV_V)
  else
  if ss = IPP_HSL_H then
    result := IntToStr(HSL_H)
  else
  if ss = IPP_HSL_S then
    result := IntToStr(HSL_S)
  else
  if ss = IPP_HSL_L then
    result := IntToStr(HSL_L)
  else
  if ss = IPP_RGB_R then
    result := IntToStr(RGB_R)
  else
  if ss = IPP_RGB_G then
    result := IntToStr(RGB_G)
  else
  if ss = IPP_RGB_B then
    result := IntToStr(RGB_B)
  else
  if Copy(ss, 1, 17) = IPP_USERFILTER_VALUES_PREFIX then   // example USERFILTER_VALUES02  (x=0 y=2)
  begin
    q := StrToIntDef(Copy(ss, 18, 1), 0);
    w := StrToIntDef(Copy(ss, 19, 1), 0);
    result := IntToStr(USERFILTER_Values.Values[q, w]);
  end
  else
  if ss = IPP_USERFILTER_DIVISOR then
    result := IntToStr(USERFILTER_Values.Divisor)
  else
  if ss = IPP_EQUALIZATION_THRESHOLDDOWN then
    result := IERGB2StrS(EQUALIZATION_ThresholdDown)
  else
  if ss = IPP_EQUALIZATION_THRESHOLDUP then
    result := IERGB2StrS(EQUALIZATION_ThresholdUp)
  else
  if ss = IPP_EQUALIZATION_EQDOWN then
    result := IERGB2StrS(EQUALIZATION_EqDown)
  else
  if ss = IPP_EQUALIZATION_EQUP then
    result := IERGB2StrS(EQUALIZATION_EqUp)
  else
  if ss = IPP_EQUALIZATION_EQUALIZEBUTTON then
    result := IEBool2StrS(EQUALIZATION_EqualizeButton)
  else
  if ss = IPP_BUMPMAP_LEFT then
    result := IntToStr(BUMPMAP_Left)
  else
  if ss = IPP_BUMPMAP_TOP then
    result := IntToStr(BUMPMAP_Top)
  else
  if ss = IPP_BUMPMAP_WIDTH then
    result := IntToStr(BUMPMAP_Width)
  else
  if ss = IPP_BUMPMAP_HEIGHT then
    result := IntToStr(BUMPMAP_Height)
  else
  if ss = IPP_BUMPMAP_COL then
    result := IERGB2StrS(BUMPMAP_Col)
  else
  if ss = IPP_BUMPMAP_SRC then
    result := IntToStr(BUMPMAP_Src)
  else
  if ss = IPP_BUMPMAP_AUTO then
    result := IEBool2StrS(BUMPMAP_Auto)
  else
  if ss = IPP_LENS_LEFT then
    result := IntToStr(LENS_Left)
  else
  if ss = IPP_LENS_TOP then
    result := IntToStr(LENS_Top)
  else
  if ss = IPP_LENS_WIDTH then
    result := IntToStr(LENS_Width)
  else
  if ss = IPP_LENS_HEIGHT then
    result := IntToStr(LENS_Height)
  else
  if ss = IPP_LENS_REF then
    result := IEFloatToStrS(LENS_Ref)
  else
  if ss = IPP_LENS_AUTO then
    result := IEBool2StrS(LENS_Auto)
  else
  if ss = IPP_WAVE_AMPLITUDE then
    result := IntToStr(WAVE_Amplitude)
  else
  if ss = IPP_WAVE_WAVELENGTH then
    result := IntToStr(WAVE_WaveLength)
  else
  if ss = IPP_WAVE_PHASE then
    result := IntToStr(WAVE_Phase)
  else
  if ss = IPP_WAVE_REFLECT then
    result := IEBool2StrS(WAVE_Reflect)
  else
  if ss = IPP_MORPH_FILTER then
    result := IntToStr(MORPH_Filter)
  else
  if ss = IPP_MORPH_WINSIZE then
    result := IntToStr(MORPH_WinSize)
  else
  if ss = IPP_ROTATE_ANGLE then
    result := IEFloatToStrS(ROTATE_Angle)
  else
  if ss = IPP_FLIP_HORZ then
    result := IEBool2StrS(FLIP_Horz)
  else
  if ss = IPP_FLIP_VERT then
    result := IEBool2StrS(FLIP_Vert)
  else
  if ss = IPP_GAMMACORRECTION_VALUE then
    result := IEFloatToStrS(GAMMACORRECTION_Value)
  else
  if ss = IPP_SHARPEN_SHARPEN then
    result := IntToStr(SHARPEN_Sharpen)
  else
  if ss = IPP_SHARPEN_SIZE then
    result := IntToStr(SHARPEN_Size)
  else
  if ss = IPP_FFT_LEFT then
    result := IntToStr(FFT_Left)
  else
  if ss = IPP_FFT_TOP then
    result := IntToStr(FFT_Top)
  else
  if ss = IPP_FFT_RIGHT then
    result := IntToStr(FFT_Right)
  else
  if ss = IPP_FFT_BOTTOM then
    result := IntToStr(FFT_Bottom)
  else
  if ss = IPP_FFT_GRAYSCALE then
    result := IEBool2StrS(FFT_GrayScale)
  else
  if ss = IPP_RESIZE_PERCENT then
    result := IntToStr(Resize_Percent)
  else
  if ss = IPP_SHADOW_RADIUS then
    result := IntToStr(Shadow_Radius)
  else
  if ss = IPP_SHADOW_OFFSET then
    result := IntToStr(Shadow_Offset)
  else
     result := 'INVALID PROPERTY';
end;

{!!
<FS>TIPDialogParams.SetProperty

<FM>Declaration<FC>
procedure SetProperty(Prop, Value: String);

<FM>Description<FN>
Set a parameters of the <L TImageEnProc.DoPreviews>Image Processing Dialog</L> by a string.

<FM>Example<FC>
<FC>SetProperty('ROTATE_Angle', '45');<FN>

Which is the same as:
<FC>Rotate_Angle := 45;<FN>
!!}
procedure TIPDialogParams.SetProperty(Prop, Value: String);
var
  ss: String;
  q, w: Integer;
begin
  ss := UpperCase(IERemoveCtrlCharsS(Prop));
  Value := IERemoveCtrlCharsS(Value);
  if ss = IPP_DIALOGWIDTH then
    DialogWidth := StrToIntDef(value, -1)
  else
  if ss = IPP_DIALOGHEIGHT then
    DialogHeight := StrToIntDef(value, -1)
  else
  if ss = IPP_CONTRAST_CONTRAST then
    CONTRAST_Contrast := StrToIntDef(value, 0)
  else
  if ss = IPP_CONTRAST_BRIGHTNESS then
    CONTRAST_Brightness := StrToIntDef(value, 0)
  else
  if ss = IPP_HSV_H then
    HSV_H := StrToIntDef(value, 0)
  else
  if ss = IPP_HSV_S then
    HSV_S := StrToIntDef(value, 0)
  else
  if ss = IPP_HSV_V then
    HSV_V := StrToIntDef(value, 0)
  else
  if ss = IPP_HSL_H then
    HSL_H := StrToIntDef(value, 0)
  else
  if ss = IPP_HSL_S then
    HSL_S := StrToIntDef(value, 0)
  else
  if ss = IPP_HSL_L then
    HSL_L := StrToIntDef(value, 0)
  else
  if ss = IPP_RGB_R then
    RGB_R := StrToIntDef(value, 0)
  else
  if ss = IPP_RGB_G then
    RGB_G := StrToIntDef(value, 0)
  else
  if ss = IPP_RGB_B then
    RGB_B := StrToIntDef(value, 0)
  else
  if ss = IPP_USERFILTER_VALUES_PREFIX then   // example USERFILTER_VALUES02  (x=0 y=2)
  begin
    q := StrToIntDef(Copy(ss, 18, 1), 0);
    w := StrToIntDef(Copy(ss, 19, 1), 0);
    USERFILTER_Values.Values[q, w] := StrToIntDef(value, 0)
  end
  else
  if ss = IPP_USERFILTER_DIVISOR then
    USERFILTER_Values.Divisor := StrToIntDef(value, 0)
  else
  if ss = IPP_EQUALIZATION_THRESHOLDDOWN then
    EQUALIZATION_ThresholdDown := IEStr2RGBS(value)
  else
  if ss = IPP_EQUALIZATION_THRESHOLDUP then
    EQUALIZATION_ThresholdUp := IEStr2RGBS(value)
  else
  if ss = IPP_EQUALIZATION_EQDOWN then
    EQUALIZATION_EqDown := IEStr2RGBS(value)
  else
  if ss = IPP_EQUALIZATION_EQUP then
    EQUALIZATION_EqUp := IEStr2RGBS(value)
  else
  if ss = IPP_EQUALIZATION_EQUALIZEBUTTON then
    EQUALIZATION_EqualizeButton := IEStr2BoolS(value)
  else
  if ss = IPP_BUMPMAP_LEFT then
    BUMPMAP_Left := StrToIntDef(value, 0)
  else
  if ss = IPP_BUMPMAP_TOP then
    BUMPMAP_Top := StrToIntDef(value, 0)
  else
  if ss = IPP_BUMPMAP_WIDTH then
    BUMPMAP_Width := StrToIntDef(value, 0)
  else
  if ss = IPP_BUMPMAP_HEIGHT then
    BUMPMAP_Height := StrToIntDef(value, 0)
  else
  if ss = IPP_BUMPMAP_COL then
    BUMPMAP_Col := IEStr2RGBS(value)
  else
  if ss = IPP_BUMPMAP_SRC then
    BUMPMAP_Src := StrToIntDef(value, 0)
  else
  if ss = IPP_BUMPMAP_AUTO then
    BUMPMAP_Auto := IEStr2BoolS(value)
  else
  if ss = IPP_LENS_LEFT then
    LENS_Left := StrToIntDef(value, 0)
  else
  if ss = IPP_LENS_TOP then
    LENS_Top := StrToIntDef(value, 0)
  else
  if ss = IPP_LENS_WIDTH then
    LENS_Width := StrToIntDef(value, 0)
  else
  if ss = IPP_LENS_HEIGHT then
    LENS_Height := StrToIntDef(value, 0)
  else
  if ss = IPP_LENS_REF then
    LENS_Ref := IEStrToFloatDefS(value, 1.7)
  else
  if ss = IPP_LENS_AUTO then
    LENS_Auto := IEStr2BoolS(value)
  else
  if ss = IPP_WAVE_AMPLITUDE then
    WAVE_Amplitude := StrToIntDef(value, 0)
  else
  if ss = IPP_WAVE_WAVELENGTH then
    WAVE_WaveLength := StrToIntDef(value, 0)
  else
  if ss = IPP_WAVE_PHASE then
    WAVE_Phase := StrToIntDef(value, 0)
  else
  if ss = IPP_WAVE_REFLECT then
    WAVE_Reflect := IEStr2BoolS(value)
  else
  if ss = IPP_MORPH_FILTER then
    MORPH_Filter := StrToIntDef(value, 0)
  else
  if ss = IPP_MORPH_WINSIZE then
    MORPH_WinSize := StrToIntDef(value, 0)
  else
  if ss = IPP_ROTATE_ANGLE then
    ROTATE_Angle := IEStrToFloatDefS(value, 0)
  else
  if ss = IPP_FLIP_HORZ then
    FLIP_Horz := IEStr2BoolS(value)
  else
  if ss = IPP_FLIP_VERT then
    FLIP_Vert := IEStr2BoolS(value)
  else
  if ss = IPP_GAMMACORRECTION_VALUE then
    GAMMACORRECTION_Value := IEStrToFloatDefS(value, 0)
  else
  if ss = IPP_SHARPEN_SHARPEN then
    SHARPEN_Sharpen := StrToIntDef(value, 0)
  else
  if ss = IPP_SHARPEN_SIZE then
    SHARPEN_Size := StrToIntDef(value, 0)
  else
  if ss = IPP_FFT_LEFT then
    FFT_Left := StrToIntDef(value, 0)
  else
  if ss = IPP_FFT_TOP then
    FFT_Top := StrToIntDef(value, 0)
  else
  if ss = IPP_FFT_RIGHT then
    FFT_Right := StrToIntDef(value, 0)
  else
  if ss = IPP_FFT_BOTTOM then
    FFT_Bottom := StrToIntDef(value, 0)
  else
  if ss = IPP_FFT_GRAYSCALE then
    FFT_GrayScale := IEStr2BoolS(value)
  else
  if ss = IPP_RESIZE_PERCENT then
    Resize_Percent := StrToIntDef(value, 100)
  else
  if ss = IPP_SHADOW_RADIUS then
    Shadow_Radius := StrToIntDef(value, 3)
  else
  if ss = IPP_SHADOW_OFFSET then
    Shadow_Offset := StrToIntDef(value, 3);
end;

{$endif}

//////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////
// Automatic Color Equalization with linear local LUT

// apply a local LUT
// SubOriginal : the original image (Bitmap) subsampled
// SubFiltered : the filtered image, got filtering SubOriginal
// Bitmap      : the original image and the output
procedure IELLLUT( SubOriginal, SubFiltered: TIEBitmap; Bitmap: TIEBitmap; Neighbour: Integer; OnProgress: TIEProgressEvent; Sender: TObject; ProgressOffset: Integer; ProgressMultiplier: Double);
var
  xx, yy: Integer;
  x, y: Integer;
  xk, yk: Integer;
  d: Double;
  psf, pso: PRGB;
  R_Dleft, R_Dright: Integer;
  R_kleft, R_kright: Integer;
  R_kfleft, R_kfright: Integer;
  G_Dleft, G_Dright: Integer;
  G_kleft, G_kright: Integer;
  G_kfleft, G_kfright: Integer;
  B_Dleft, B_Dright: Integer;
  B_kleft, B_kright: Integer;
  B_kfleft, B_kfright: Integer;
  BitmapWidth, BitmapHeight: Integer;
  SubOriginalWidth, SubOriginalHeight: Integer;
  pb: PRGB;
  s: Integer;
  x1, y1, x2, y2: Integer;
  lper, per: Integer;
begin
  lper := -1;
  BitmapWidth := Bitmap.Width;
  BitmapHeight := Bitmap.Height;
  SubOriginalWidth := SubOriginal.Width;
  SubOriginalHeight := SubOriginal.Height;
  d := BitmapWidth / SubOriginal.Width;  // calculates decimation (divisor)
  R_kleft := 0;
  R_kfleft := 0;
  G_kleft := 0;
  G_kfleft := 0;
  B_kleft := 0;
  B_kfleft := 0;
  R_kright := 0;
  R_kfright := 0;
  G_kright := 0;
  G_kfright := 0;
  B_kright := 0;
  B_kfright := 0;
  for y := 0 to BitmapHeight-1 do
  begin
    pb := Bitmap.Scanline[y];
    yk := trunc( y / d );
    y1 := imax(0, yk-1);
    y2 := imin(SubOriginalHeight-1, yk+1);
    for x := 0 to BitmapWidth-1 do
    begin

      R_Dright := 100000;
      R_Dleft  := 100000;
      G_Dright := 100000;
      G_Dleft  := 100000;
      B_Dright := 100000;
      B_Dleft  := 100000;

      xk := trunc(x / d);

      x1 := imax(0, xk-Neighbour);
      x2 := imin(SubOriginalWidth-1, xk+Neighbour);

      for yy := y1 to y2 do
      begin
        pso := SubOriginal.Scanline[yy]; inc(pso, x1);
        psf := SubFiltered.Scanline[yy]; inc(psf, x1);
        for xx := x1 to x2 do
        begin
          // R
          s := pb^.r-pso^.r;
          if (s <= 0) and (-s<R_Dright) then
          begin
            R_Dright := -s;
            R_kright := pso^.r;
            R_kfright := psf^.r;
          end;
          if (s >= 0) and (s<R_Dleft) then
          begin
            R_Dleft := s;
            R_kleft := pso^.r;
            R_kfleft := psf^.r;
          end;
          // G
          s := pb^.g-pso^.g;
          if (s <= 0) and (-s<G_Dright) then
          begin
            G_Dright := -s;
            G_kright := pso^.g;
            G_kfright := psf^.g;
          end;
          if (s >= 0) and (s<G_Dleft) then
          begin
            G_Dleft := s;
            G_kleft := pso^.g;
            G_kfleft := psf^.g;
          end;
          // B
          s := pb^.b-pso^.b;
          if (s <= 0) and (-s<B_Dright) then
          begin
            B_Dright := -s;
            B_kright := pso^.b;
            B_kfright := psf^.b;
          end;
          if (s >= 0) and (s<B_Dleft) then
          begin
            B_Dleft := s;
            B_kleft := pso^.b;
            B_kfleft := psf^.b;
          end;
          inc(pso);
          inc(psf);
        end;
      end;

      if R_Dleft = 100000 then
      begin
        R_kleft := 0;
        R_kfleft := 0;
      end;
      if R_Dright = 100000 then
      begin
        R_kright := 255;
        R_kfright := 255;
      end;
      if G_Dleft = 100000 then
      begin
        G_kleft := 0;
        G_kfleft := 0;
      end;
      if G_Dright = 100000 then
      begin
        G_kright := 255;
        G_kfright := 255;
      end;
      if B_Dleft = 100000 then
      begin
        B_kleft := 0;
        B_kfleft := 0;
      end;
      if B_Dright = 100000 then
      begin
        B_kright := 255;
        B_kfright := 255;
      end;

      with pb^ do
      begin
        r :=  blimit( round( (r-R_kleft)*(R_kfright-R_kfleft)/imax(1, R_kright-R_kleft)+R_kfleft ) );
        g :=  blimit( round( (g-G_kleft)*(G_kfright-G_kfleft)/imax(1, G_kright-G_kleft)+G_kfleft ) );
        b :=  blimit( round( (b-B_kleft)*(B_kfright-B_kfleft)/imax(1, B_kright-B_kleft)+B_kfleft ) );
      end;

      inc(pb);

      if assigned(OnProgress) then
      begin
        per := trunc(ProgressOffset+y/BitmapHeight*ProgressMultiplier);
        if per<>lper then
          OnProgress(Sender, per );
        lper := per;
      end;

    end;
  end;
end;

// slope is in degree and can be from 0 to 90
// cut varies from 0 to 100 for all values of slope
procedure IEACE(OrigBitmap: TIEBitmap; subwidth: Integer; Slope: Integer; Cut: Integer; Neighbour: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
var
  SubBitmap, dst, MidBitmap: TIEBitmap;
  maxv, minv: array [0..2] of double;
  pxin: Integer;
  px_in: pbyte;  // input pixel
  px_out: psingle; // output pixel
  x, y, c: Integer;
  width, height: Integer;
  optp1, optm1: pdouble;
  slom: Double;
  cutm: Double;
  //
  procedure ProcessPixelMid;
  var
    sum1: Double;  // numerator
    sum2: Double;  // denominator
    xx, yy: Integer;
    px_cur: pbyte;
    rmax: Double;
    r: Double;
  begin
    optp1 := optm1;
    sum1 := 0;
    rmax := 0;
    for yy := 0 to height-1 do
    begin
      px_cur := SubBitmap.Scanline[yy]; inc(px_cur, c);
      for xx := 0 to width-1 do
      begin

        r := slom*(pxin-px_cur^);
        //r := 1* ( iepower(pxin, 1.1) - iepower(px_cur^, 1.1) );

        if r>cutm then
          r := cutm
        else
        if r<-cutm then

          r := -cutm;

        if abs(r)>rmax then
          rmax := abs(r);

        sum1 := sum1 + r / optp1^;

        inc(px_cur, 3);
        inc(optp1);
      end;
    end;

    optp1 := optm1;
    sum2 := 0;
    yy := width*height-1;
    for xx := 0 to yy do
    begin
      sum2 := sum2 + rmax / optp1^;
      inc(optp1);
    end;

    if sum2 = 0 then
      sum2 := 1;
    px_out^ :=  sum1 / sum2;

    if px_out^>maxv[c] then
      maxv[c] := px_out^;
    if px_out^<minv[c] then
      minv[c] := px_out^;
  end;
  //
  procedure CalcOpt1;
  var
    xx, yy: Integer;
    dd: psinglearray;
  begin
    optp1 := optm1;
    yy := 0;
    while yy<height do
    begin
      dd := dst.Scanline[abs(y-yy)];
      xx := 0;
      while xx<width do
      begin
        optp1^ := dd[abs(x-xx)];
        inc(xx);
        inc(optp1);
      end;
      inc(yy);
    end;
  end;
  //
var
  md: psingle;
  px: pbyte;
  sc: array [0..2] of double;
  decimation: Integer;
begin

  slom := tan(pi*slope/180);
  cutm := (cut/100)*(slom*255);

  decimation := trunc( OrigBitmap.Width / subwidth );
  if decimation = 0 then
    decimation := 1;

  SubBitmap := TIEBitmap.Create;
  SubBitmap.Allocate( OrigBitmap.Width div decimation, OrigBitmap.Height div decimation, ie24RGB );
  _IEResampleIEBitmap(OrigBitmap, SubBitmap, rfNone, nil, nil);

  width := SubBitmap.Width;
  height := SubBitmap.Height;

  MidBitmap := TIEBitmap.Create;
  MidBitmap.allocate(width*3, height, ie32f);

  dst := TIEBitmap.Create;
  dst.Allocate(width, height, ie32f);
  for y := 0 to Height-1 do
  begin
    md := dst.Scanline[y];
    for x := 0 to Width-1 do
    begin
      md^ := sqrt( x*x+y*y );
      if md^ = 0 then md^ := 1000000;
      inc(md);
    end;
  end;

  for c := 0 to 2 do
  begin
    maxv[c] := -100000;
    minv[c] := +100000;
  end;

  getmem(optm1, width*height*sizeof(double));

  for y := 0 to Height-1 do
  begin
    px_in := SubBitmap.Scanline[y];
    px_out := MidBitmap.Scanline[y];
    for x := 0 to Width-1 do
    begin
      CalcOpt1;
      for c := 0 to 2 do
      begin
        pxin := px_in^;
        ProcessPixelMid;
        inc(px_in);
        inc(px_out);
      end;
    end;
    if assigned(OnProgress) then
      OnProgress(Sender, trunc(y/Height*50));
  end;

  freemem(optm1);

  for c := 0 to 2 do
  begin
    if maxv[c]-minv[c] <> 0 then
      sc[c] := 255 / (maxv[c]-minv[c])
    else
      sc[c] := 255;
  end;

  dst.Allocate( width, height, ie24RGB );

  for y := 0 to Height-1 do
  begin
    px := dst.Scanline[y];
    md := MidBitmap.Scanline[y];
    for x := 0 to Width-1 do
      for c := 0 to 2 do
      begin
        px^ := blimit(round( sc[c]*(md^-minv[c]) ));

        inc(px);
        inc(md);
      end;
  end;

  FreeAndNil(MidBitmap);

  IELLLUT(SubBitmap, dst, OrigBitmap, Neighbour, OnProgress, Sender, 50, 50);

  FreeAndNil(dst);
  FreeAndNil(SubBitmap);
end;

{!!
<FS>TImageEnProc.AutoImageEnhance1

<FM>Declaration<FC>
procedure AutoImageEnhance1(SubsampledSize: Integer = 60; Slope: Integer = 20; Cut: Integer = 25; Neighbour: Integer = 2);

<FM>Description<FN>
ImageEn offers a selection of functions to automatically enhance an image. AutoImageEnhance1 performs a series of complex operations to improve the contrast and colors in the image.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>SubsampledSize<FN></C> <C>For better performance operations are performed on a subsampled image. This parameter specifies the image width (default 60)</C> </R>
<R> <C><FC>Slope<FN></C> <C>The core function slope (in degrees) which will affect the contrast. Allowed values: 0 to 90°, default 20</C> </R>
<R> <C><FC>Cut<FN></C> <C>The code function range which will affect the contrast. Allowed values are 0 to 100, default 25</C> </R>
<R> <C><FC>Neighbour<FN></C> <C>When the subsampled image is used to change the full size image, Neighbour specifies the window size of the conversion. High values slow down processing but produce better results. Default is 2.</C> </R>
</TABLE>

Note: The default parameters will generally offer an agreeable result.

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\AutoEnhance\AutoAdjust.dpr </C> </R>
</TABLE>

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AutoImageEnhance2></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AutoImageEnhance3></C> </R>
</TABLE>
!!}                 
procedure TImageEnProc.AutoImageEnhance1(SubsampledSize: Integer = 60; Slope: Integer = 20; Cut: Integer = 25; Neighbour: Integer = 2);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_AUTOIMAGEENHANCE1, [SubsampledSize, Slope, Cut, Neighbour]),
                              {$ELSE}
                              IEMsg( IEMsg_AutoEnhance ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_AUTOIMAGEENHANCE1 ) then
    exit;
  IEACE(ProcBitmap, SubsampledSize, Slope, Cut, Neighbour, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


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

//////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////
// Auto Sharp

procedure SharpAt(source: TIEBitmap; dest: TIEBitmap; x, y: Integer; Intensity: Integer; Neighbourhood: Integer);
var
  nsize: Integer; // neighbourhood size / 2
  nr, ng, nb: Integer;
  k: Double;
  //
  procedure GetNeighbourhood;
  var
    i, j: Integer;
    px: PRGB;
    x1, x2, y1, y2: Integer;
  begin
    nr := 0;
    ng := 0;
    nb := 0;
    x1 := imax(0, x - nsize);
    x2 := imin(source.Width - 1, x + nsize);
    y1 := imax(0, y - nsize);
    y2 := imin(source.Height - 1, y + nsize);
    for i := y1 to y - 1 do
    begin
      px := source.Scanline[i];
      inc(px, x1);
      for j := x1 to x - 1 do
      begin
        with px^ do
        begin
          inc(nr, r);
          inc(ng, g);
          inc(nb, b);
        end;
        inc(px);
      end;
      for j := x + 1 to x2 do
      begin
        with px^ do
        begin
          inc(nr, r);
          inc(ng, g);
          inc(nb, b);
        end;
        inc(px);
      end;
    end;
    for i := y + 1 to y2 do
    begin
      px := source.Scanline[i];
      inc(px, x1);
      for j := x1 to x - 1 do
      begin
        with px^ do
        begin
          inc(nr, r);
          inc(ng, g);
          inc(nb, b);
        end;
        inc(px);
      end;
      for j := x + 1 to x2 do
      begin
        with px^ do
        begin
          inc(nr, r);
          inc(ng, g);
          inc(nb, b);
        end;
        inc(px);
      end;
    end;
    i := y2 - y1;
    j := i * (x2 - x1);
    if j <> 0 then
    begin
      nr := nr div j;
      ng := ng div j;
      nb := nb div j;
    end;
  end;
  //
  var px: PRGB;
begin
  nsize := Neighbourhood div 2;
  k := Intensity / 10;
  GetNeighbourhood;
  px := dest.PPixels_ie24RGB[x, y];
  with source.PPixels_ie24RGB[x, y]^ do
  begin
    px^.r := blimit(trunc(r + k * (r - nr)));
    px^.g := blimit(trunc(g + k * (g - ng)));
    px^.b := blimit(trunc(b + k * (b - nb)));
  end;
end;

// ref values: Intensity=68, rate = 0.035
procedure IEAutoSharp(bitmap: TIEBitmap; Intensity: Integer; rate: Double; OnProgress: TIEProgressEvent; Sender: TObject);
var
  edge, dest: TIEBitmap;
  NullProgress: TProgressRec;
  x, y: Integer;
  width, height: Integer;
begin
  width := bitmap.Width;
  height := bitmap.Height;

  dest := TIEBitmap.Create;
  dest.Allocate(width, height, ie24RGB);

  edge := TIEBitmap.Create;

  NullProgress := NullProgressRec( nil );
  _IEEdgeDetect_ShenCastan(bitmap, edge, rate, 0.9, 7, 0, true, NullProgress);
  edge.PixelFormat := ie8g;
  _IEGBlur(edge, 4, nil, nil);

  for y := 0 to height-1 do
  begin
    for x := 0 to width-1 do
      SharpAt(bitmap, dest, x, y, round((255-edge.Pixels_ie8[x, y])/255*Intensity), 4);
    if assigned(OnProgress) then
      OnProgress(Sender, trunc(y/height*100) );
  end;

  bitmap.AssignImage(dest);

  FreeAndNil(dest);
  FreeAndNil(edge);
end;

{!!
<FS>TImageEnProc.AutoSharp

<FM>Declaration<FC>
procedure AutoSharp(Intensity: Integer; rate: Double);

<FM>Description<FN>
Automatically enhances the image sharpness by sharpening the contours of detected objects.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>Intensity<FN></C> <C>The effect intensity. Values: 0 to 100, Default 68</C> </R>
<R> <C><FC>Rate<FN></C> <C>The borders detection rate. Values: 0 to 1, Default 0.035</C> </R>
</TABLE>

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\AutoEnhance\AutoAdjust.dpr </C> </R>
</TABLE>

<FM>Example<FC>
ImageEnView.Proc.AutoSharp;
!!}
procedure TImageEnProc.AutoSharp(Intensity: Integer; rate: Double);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_AUTOSHARP, [Intensity, rate]),
                              {$ELSE}
                              IEMsg( IEMsg_AUTOSHARPEN ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_AUTOSHARP ) then
    exit;
  IEAutoSharp(ProcBitmap, Intensity, rate, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


//////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////
// MRSCR

const
  GOS=3;

  ICHANNEL0  = 0;  // input channel 0
  ICHANNEL1  = 1;  // input channel 1
  ICHANNEL2  = 2;  // input channel 2

  MCHANNEL0 =3;  // mid channel 0
  MCHANNEL1 =4;  // mid channel 1
  MCHANNEL2 =5;  // mid channel 2

  OCHANNEL0 =6;  // output channel 0
  OCHANNEL1 =7;  // output channel 1
  OCHANNEL2 =8;  // output channel 2

procedure GaussX(sourceflt: psingle; destflt: psingle; fltmap: psinglearray; width: Integer; alpha: single; beta: psinglearray);
var
  i: Integer;
  fltmapm: psinglearray;
begin
  inc(sourceflt , (width-1));
  fltmap[0] := alpha * sourceflt^;
  dec(sourceflt);
  inc(psingle(fltmap));
  fltmapm := fltmap; dec(psingle(fltmapm), 1);
  fltmap[0] := alpha * sourceflt^ + beta[1]*fltmapm[0];
  dec(sourceflt);
  inc(psingle(fltmap));
  fltmapm := fltmap; dec(psingle(fltmapm), 2);
  fltmap[0] := alpha * sourceflt^ + beta[1]*fltmapm[1] + beta[2]*fltmapm[0];
  dec(sourceflt);
  inc(psingle(fltmap));
  for i := GOS to width-1 do
  begin
    fltmapm := fltmap; dec(psingle(fltmapm), 3);
    fltmap[0] := alpha * sourceflt^ + (beta[1]*fltmapm[2] + beta[2]*fltmapm[1] + beta[3]*fltmapm[0]);
    dec(sourceflt);
    inc(psingle(fltmap));
  end;
  for i := 0 to width-1 do
  begin
    fltmapm := fltmap; dec(psingle(fltmapm), 3);
    fltmap[0] := alpha * sourceflt^ + (beta[1]*fltmapm[2] + beta[2]*fltmapm[1] + beta[3]*fltmapm[0]);
    inc(sourceflt);
    inc(psingle(fltmap));
  end;
  for i := 0 to width-1 do
  begin
    fltmapm := fltmap; dec(psingle(fltmapm), 3);
    fltmap[0] := alpha * sourceflt^ + (beta[1]*fltmapm[2] + beta[2]*fltmapm[1] + beta[3]*fltmapm[0]);
    dec(sourceflt);
    inc(psingle(fltmap));
  end;
  dec(psingle(fltmap));
  fltmap[0] := alpha * fltmap[0];
  dec(psingle(fltmap));
  fltmap[0] := alpha * fltmap[0] + (beta[1]*fltmap[1]);
  dec(psingle(fltmap));
  fltmap[0] := alpha * fltmap[0] + (beta[1]*fltmap[1] + beta[2]*fltmap[2]);
  dec(psingle(fltmap));
  for i := GOS to width-1 do
  begin
    fltmap[0] := alpha * fltmap[0] + (beta[1]*fltmap[1] + beta[2]*fltmap[2] + beta[3]*fltmap[3]);
    dec(psingle(fltmap));
  end;
  inc(psingle(destflt) , width-1);
  for i := 0 to width-1 do
  begin
    fltmap[0] := alpha * fltmap[0] + (beta[1]*fltmap[1] + beta[2]*fltmap[2] + beta[3]*fltmap[3]);
    destflt^ := fltmap[0];
    dec(psingle(destflt));
    dec(psingle(fltmap));
  end;
end;

procedure GaussY(src: psingle; srcoff: Integer; dst: psingle; dstoff: Integer; fltmap: psinglearray; height: Integer; alpha: single; beta: psinglearray);
var
  i: Integer;
  fltmapm: psinglearray;
begin
  inc( src , srcoff*(height-1) );
  fltmap[0] := alpha * src^;
  dec( src , srcoff);
  inc(psingle(fltmap));
  fltmapm := fltmap; dec(psingle(fltmapm), 1);
  fltmap[0] := alpha * src^ + beta[1]*fltmapm[0];
  dec(src , srcoff);
  inc(psingle(fltmap));
  fltmapm := fltmap; dec(psingle(fltmapm), 2);
  fltmap[0] := alpha * src^ + beta[1]*fltmapm[1] + beta[2]*fltmapm[0];
  dec(src , srcoff);
  inc(psingle(fltmap));
  for i := GOS to height-1 do
  begin
    fltmapm := fltmap; dec(psingle(fltmapm), 3);
    fltmap[0] := alpha * src^ + (beta[1]*fltmapm[2] + beta[2]*fltmapm[1] + beta[3]*fltmapm[0]);
    dec(src , srcoff);
    inc(psingle(fltmap));
  end;
  for i := 0 to height-1 do
  begin
    fltmapm := fltmap; dec(psingle(fltmapm), 3);
    fltmap[0] := alpha * src^ + (beta[1]*fltmapm[2] + beta[2]*fltmapm[1] + beta[3]*fltmapm[0]);
    inc(src , srcoff);
    inc(psingle(fltmap));
  end;
  for i := 0 to height-1 do
  begin
    fltmapm := fltmap; dec(psingle(fltmapm), 3);
    fltmap[0] := alpha * src^ + (beta[1]*fltmapm[2] + beta[2]*fltmapm[1] + beta[3]*fltmapm[0]);
    dec(src , srcoff);
    inc(psingle(fltmap));
  end;
  dec(psingle(fltmap));
  fltmap[0] := alpha * fltmap[0];
  dec(psingle(fltmap));
  fltmap[0] := alpha * fltmap[0] + (beta[1]*fltmap[1]);
  dec(psingle(fltmap));
  fltmap[0] := alpha * fltmap[0] + (beta[1]*fltmap[1] + beta[2]*fltmap[2]);
  dec(psingle(fltmap));
  for i := GOS to height-1 do
  begin
    fltmap[0] := alpha * fltmap[0] + (beta[1]*fltmap[1] + beta[2]*fltmap[2] + beta[3]*fltmap[3]);
    dec(psingle(fltmap));
  end;
  inc(dst , dstoff*(height-1));
  for i := 0 to height-1 do
  begin
    fltmap[0] := alpha * fltmap[0] + (beta[1]*fltmap[1] + beta[2]*fltmap[2] + beta[3]*fltmap[3]);
    dst^ := fltmap[0];
    dec(dst , dstoff);
    dec(psingle(fltmap));
  end;
end;

procedure DoGauss(src: psingle; dst: psingle; width, height: Integer; alpha: single; beta: psinglearray);
var
  i: Integer;
  fltmap: array of single;
  vin: psingle;
  vout: psingle;
  xin: psingle;
  xinoff: Integer;
  xout: psingle;
  xoutoff: Integer;
begin
  SetLength(fltmap , 3 * (width + height));
  vin := src;
  vout := dst;
  for i := 0 to height-1 do
  begin
    GaussX(vin, vout, @fltmap[0], width, alpha, beta);
    inc(vin , width);
    inc(vout , width);
  end;
  xin := dst;
  xinoff := width;
  xout := xin;
  xoutoff := xinoff;
  for i := 0 to width-1 do
  begin
    GaussY(xin, xinoff, xout, xoutoff, @fltmap[0], height, alpha, beta);
    xin := @psinglearray(dst)[i];
    xout := @psinglearray(dst)[i];
  end;
end;

procedure CalcCoef(sigma: single; var alpha: single; beta: psinglearray);
var
  c1, c2, c3: single;
begin
  if sigma >= 2.5 then
    c1 := 0.98711*sigma-0.96330
  else
  if (sigma >= 0.5) and (sigma < 2.5) then
    c1 := 3.97156-4.14554 * sqrt(1-0.26891 * sigma)
  else
    c1 := 0.1147705018520355224609375;
  c2 := c1*c1;
  c3 := c1*c2;
  beta[0] := 1.57825+2.44413*c1+1.4281*c2+0.422205*c3;
  beta[1] := (2.44413*c1+2.85619*c2+1.26661*c3)/beta[0];
  beta[2] := -(1.4281*c2+1.26661*c3)/beta[0];
  beta[3] := (0.422205*c3)/beta[0];
  alpha := 1-(beta[1]+beta[2]+beta[3]);
end;

function IELN(v: Double): Double;
begin
  if v <= 0.0 then
    result := ln(5.0e-324)
  else
    result := ln(v);
end;

procedure MRSCR(fltmap: psinglearray; width, height: Integer; scales: psinglearray; ScaleCount: Integer; Luma: Boolean; OnProgress: TIEProgressEvent; Sender: TObject);
var
  i, j: Integer;
  size: Integer;
  weight: single;
  vout: psinglearray;
  opt: single;
  alpha: single;
  beta: array [0..3] of single;
begin
  size := width*height;
  weight := 1/ScaleCount;
  for i := 0 to ScaleCount-1 do
  begin
    if assigned(OnProgress) then
      OnProgress(Sender, trunc(20+i/ScaleCount*50) );
    CalcCoef(scales[i], alpha, @beta);
    DoGauss(@fltmap[ICHANNEL0*size], @fltmap[MCHANNEL0*size], width, height, alpha, @beta);
    if not Luma then
    begin
      DoGauss(@fltmap[ICHANNEL1*size], @fltmap[MCHANNEL1*size], width, height, alpha, @beta);
      DoGauss(@fltmap[ICHANNEL2*size], @fltmap[MCHANNEL2*size], width, height, alpha, @beta);
    end;
    vout := fltmap;
    for j := 0 to size-1 do
    begin
      vout[OCHANNEL0*size] := vout[OCHANNEL0*size] + weight * (IELN(vout[ICHANNEL0*size]) - IELN(vout[MCHANNEL0*size]));
      if not Luma then
      begin
        vout[OCHANNEL1*size] := vout[OCHANNEL1*size] + weight * (IELN(vout[ICHANNEL1*size]) - IELN(vout[MCHANNEL1*size]));
        vout[OCHANNEL2*size] := vout[OCHANNEL2*size] + weight * (IELN(vout[ICHANNEL2*size]) - IELN(vout[MCHANNEL2*size]));
      end;
      inc(psingle(vout));
    end;
  end;
  if assigned(OnProgress) then
    OnProgress(Sender, 80 );
  vout := fltmap;
  for i := 0 to size-1 do
  begin
    if Luma then
    begin
      opt := ln(vout[ICHANNEL0*size]);
      vout[OCHANNEL0*size] := (ln(128 * vout[ICHANNEL0*size]) - opt) * vout[OCHANNEL0*size];
    end
    else
    begin
      opt := ln(vout[ICHANNEL0*size] + vout[ICHANNEL1*size] + vout[ICHANNEL2*size]);
      vout[OCHANNEL0*size] := (ln(128 * vout[ICHANNEL0*size]) - opt) * vout[OCHANNEL0*size];
      vout[OCHANNEL1*size] := (ln(128 * vout[ICHANNEL1*size]) - opt) * vout[OCHANNEL1*size];
      vout[OCHANNEL2*size] := (ln(128 * vout[ICHANNEL2*size]) - opt) * vout[OCHANNEL2*size];
    end;
    inc(psingle(vout));
  end;
end;

procedure CalcMeanVar(src: psingle; mean: psingle; xvar: psingle; size: Integer);
var
  q: single;
  i: Integer;
begin
  q := 0;
  mean^ := 0;
  for i := 0 to size-1 do
  begin
    mean^ := mean^ + src^;
    q := q + src^ * src^;
    inc(src);
  end;
  mean^ := mean^ / size;
  q := q / size;
  xvar^ := ( q - (mean^ * mean^) );
  xvar^ := sqrt(xvar^);
end;

// ScaleCurve:
// 0: low;
// 1: high
// 2: linear
// ScaleHigh: from 16 to 250 (ref. 150)
// ScaleCount: 1...
procedure IERetinex(bitmap: TIEBitmap; ScaleCount: Integer; ScaleCurve: Integer; Variance: single; ScaleHigh: Integer; Luma: Boolean; OnProgress: TIEProgressEvent; Sender: TObject);
var
  width, height: Integer;
  size: Integer;
  fltmap: array of single;
  mean, xvar: single;
  minval, maxval, rangeval: single;
  px_flt: psinglearray;
  px_rgb: PRGB;
  i, j: Integer;
  Scales: array of single;
  YY, Cb, Cr: Integer;
begin

  if assigned(OnProgress) then
    OnProgress(Sender, 0 );

  width := bitmap.Width;
  height := bitmap.Height;
  size := width*height;

  SetLength(fltmap, 9 * size );
  FillChar(fltmap, 0, length(fltmap) * sizeof(single));

  // From bitmap to float
  px_flt := @fltmap[0];
  for i := 0 to height-1 do
  begin
    px_rgb := bitmap.Scanline[i];
    for j := 0 to width-1 do
    begin
      if Luma then
      begin
        IERGB2YCbCr(px_rgb^, YY, Cb, Cr);
        px_flt[ICHANNEL0*size] := 1 + YY;
      end
      else
        with px_rgb^ do
        begin
          px_flt[ICHANNEL0*size] := 1 + b;
          px_flt[ICHANNEL1*size] := 1 + g;
          px_flt[ICHANNEL2*size] := 1 + r;
        end;
      inc(px_rgb);
      inc(psingle(px_flt));
    end;
  end;

  if assigned(OnProgress) then
    OnProgress(Sender, 10 );

  SetLength(Scales, ScaleCount + 1);
  scales[0] := ScaleHigh / 2;
  scales[1] := ScaleHigh;
  if ScaleCount>2 then
    case ScaleCurve of
      0:
        // low
        for i := 0 to ScaleCount-1 do
          scales[i] := 2 + Power(10, (i*(ln(ScaleHigh-2)/ScaleCount))/ln(10));
      1:
        // high
        for i := 0 to ScaleCount-1 do
          scales[i] := ScaleHigh - Power(10, (i*(ln(ScaleHigh-2)/ScaleCount))/ln(10));
      2:
        // linear
        for i := 0 to ScaleCount-1 do
          scales[i] := 2 + i * (ScaleHigh/ScaleCount);
    end;

  MRSCR(@fltmap[0], width, height, @Scales[0], ScaleCount, Luma, OnProgress, Sender);
  if Luma then
    CalcMeanVar(@fltmap[OCHANNEL0*size], @mean, @xvar, size)
  else
    CalcMeanVar(@fltmap[OCHANNEL0*size], @mean, @xvar, 3*size);
  minval := mean - Variance*xvar;
  maxval := mean + Variance*xvar;
  rangeval := maxval - minval;
  if rangeval = 0 then
    rangeval := 1;

  if assigned(OnProgress) then
    OnProgress(Sender, 90 );

  // from float to bitmap
  px_flt := @fltmap[0];
  for i := 0 to height-1 do
  begin
    px_rgb := bitmap.Scanline[i];
    for j := 0 to width-1 do
    begin
      if Luma then
      begin
        IERGB2YCbCr(px_rgb^, YY, Cb, Cr);
        YY := blimit(trunc(255 * ( px_flt[OCHANNEL0*size] - minval) / rangeval));
        IEYCbCr2RGB(px_rgb^, YY, Cb, Cr);
      end
      else
        with px_rgb^ do
        begin
          b := blimit(trunc(255 * ( px_flt[OCHANNEL0*size] - minval) / rangeval));
          g := blimit(trunc(255 * ( px_flt[OCHANNEL1*size] - minval) / rangeval));
          r := blimit(trunc(255 * ( px_flt[OCHANNEL2*size] - minval) / rangeval));
        end;
      inc(px_rgb);
      inc(psingle(px_flt));
    end;
  end;

  if assigned(OnProgress) then
    OnProgress(Sender, 100 );
end;

{!!
<FS>TImageEnProc.AutoImageEnhance2


<FM>Declaration<FC>
procedure AutoImageEnhance2(ScaleCount: Integer = 3; ScaleCurve: Integer = 2; Variance: Double = 1.8; ScaleHigh: Integer = 200; Luminance: Boolean = True);

<FM>Description<FN>
ImageEn offers a selection of functions to automatically enhance an image. AutoImageEnhance2 uses a "Retinex" algorithm to simulate how humans see the world.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>ScaleCount<FN></C> <C>The algorithm is applied to different scales of the image. This parameter specifies the number of scales. Default 3.</C> </R>
<R> <C><FC>ScaleCurve<FN></C> <C>Specifies how build the size of each scale. Allowed values 0..2. Default 2.</C> </R>
<R> <C><FC>Variance<FN></C> <C>The output variance. Default 1.8.</C> </R>
<R> <C><FC>ScaleHigh<FN></C> <C>Allowed values from 16 to 250. Default 200.</C> </R>
<R> <C><FC>Luminance<FN></C> <C>If true the algorithm is applied only to luminance (luminosity) channel, so the algorithm doesn't touch colors.</C> </R>
</TABLE>

Note: The default parameters will generally offer an agreeable result.

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\AutoEnhance\AutoAdjust.dpr </C> </R>
</TABLE>

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AutoImageEnhance1></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AutoImageEnhance3></C> </R>
</TABLE>

!!}
procedure TImageEnProc.AutoImageEnhance2(ScaleCount: Integer = 3; ScaleCurve: Integer = 2; Variance: Double = 1.8; ScaleHigh: Integer = 200; Luminance: Boolean = True);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_AUTOIMAGEENHANCE2,
                              {$ELSE}
                              IEMsg( IEMsg_AutoEnhance ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_AUTOIMAGEENHANCE2 ) then
    exit;
  IERetinex(ProcBitmap, ScaleCount, ScaleCurve, Variance, ScaleHigh, Luminance, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


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

// shift a channel by the specified offset
// blank pixels are padded with the old one
// the alpha channel is not shifted
// channel: 0=blue, 1=green, 2=red
// works only with ie24RGB
// if FillValue=-1 the previous value is set
// if FillValue >= 0 this is the value to fill
procedure IEShift(Bitmap: TIEBitmap; offsetx, offsety: Integer; channel: Integer; FillValue: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
var
  i, j: Integer;
  newbmp: TIEBitmap;
  width, height, v: Integer;
  src, dst: PRGB;
  newsrc, dst2: pbyte;
  src_48, dst_48: PRGB48;
  newsrc_48, dst2_48: pword;
  ox, oy: Integer;
begin
  width := Bitmap.Width;
  height := Bitmap.Height;
  newbmp := TIEBitmap.Create;
  newbmp.Allocate(width, height, Bitmap.PixelFormat);
  case Bitmap.PixelFormat of
    ie24RGB:
      begin
        for i := 0 to height-1 do
        begin
          src := Bitmap.Scanline[i];
          dst := newbmp.Scanline[i];
          for j := 0 to width-1 do
          begin
            if FillValue>-1 then
            begin
              ox := j-offsetx;
              oy := i-offsety;
              if (ox >= 0) and (ox<width) and (oy >= 0) and (oy<height) then
              begin
                newsrc := pbyte(Bitmap.PPixels_ie24RGB[ox, oy]);
                inc(newsrc, channel);
                v := newsrc^;
              end
              else
                v := FillValue;
            end
            else
            begin
              ox := imin(imax(0, j-offsetx), width-1);
              oy := imin(imax(0, i-offsety), height-1);
              newsrc := pbyte(Bitmap.PPixels_ie24RGB[ox, oy]);
              inc(newsrc, channel);
              v := newsrc^;
            end;
            dst2 := pbyte(dst); inc(dst2, channel);
            dst^ := src^;
            dst2^ := v;
            inc(src);
            inc(dst);
          end;
          if assigned(OnProgress) then
            OnProgress(Sender, trunc(i/height) );
        end;
      end;
    ie48RGB:
      begin
        for i := 0 to height-1 do
        begin
          src_48 := Bitmap.Scanline[i];
          dst_48 := newbmp.Scanline[i];
          for j := 0 to width-1 do
          begin
            if FillValue>-1 then
            begin
              ox := j-offsetx;
              oy := i-offsety;
              if (ox >= 0) and (ox<width) and (oy >= 0) and (oy<height) then
              begin
                newsrc_48 := pword(Bitmap.PPixels_ie48RGB[ox, oy]);
                inc(newsrc_48, channel);
                v := newsrc_48^;
              end
              else
                v := FillValue;
            end
            else
            begin
              ox := imin(imax(0, j-offsetx), width-1);
              oy := imin(imax(0, i-offsety), height-1);
              newsrc_48 := pword(Bitmap.PPixels_ie48RGB[ox, oy]);
              inc(newsrc_48, channel);
              v := newsrc_48^;
            end;
            dst2_48 := pword(dst_48); inc(dst2_48, channel);
            dst_48^ := src_48^;
            dst2_48^ := v;
            inc(src_48);
            inc(dst_48);
          end;
          if assigned(OnProgress) then
            OnProgress(Sender, trunc(i/height) );
        end;
      end;
  end;
  Bitmap.AssignImage(newbmp);
  FreeAndNil(newbmp);
end;

{!!
<FS>TImageEnProc.ShiftChannel

<FM>Declaration<FC>
procedure ShiftChannel(offsetX, offsetY: Integer; channel: <A TIEChannel>; fillValue: Integer);

<FM>Description<FN>
Move the specified channel by an offset, filling the blank position with a color.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>offsetX<FN></C> <C>Specifies the horizontal offset in pixels. This can have negative values.</C> </R>
<R> <C><FC>offsetY<FN></C> <C>Specifies the vertical offset in pixels. This can have negative values.</C> </R>
<R> <C><FC>channel<FN></C> <C>The channel to shift: iecBlue, iecGreen or iecRed</C> </R>
<R> <C><FC>fillValue<FN></C> <C>The filling color (this is the channel intensity, because ShiftChannel works on a channel at the time).</C> </R>
</TABLE>

<FM>Example<FC>
// shift to -2 in horizontal and -1 in vertical the Blue channel, filling new areas with 0.
ImageEnView1.Proc.ShiftChannel(-2, -1, iecBlue, 0);

<FM>Compatibility Notes<FN>
In versions prior to v5.2.0, ShiftChannel() used an integer to specify the channel: 0 = iecBlue, 1 = iecGreen and 2= iecRed
!!}
procedure TImageEnProc.ShiftChannel(offsetX, offsetY: Integer; channel: TIEChannel; fillValue: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
  iChannel: Integer;
begin
  case channel of
    iecRed   : iChannel := 2 { R };
    iecGreen : iChannel := 1 { G };
    iecBlue  : iChannel := 0 { B };
    else exit;
  end;

  if not BeginImageProcessing([ie24RGB, ie48RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_SHIFTCHANNEL, [offsetX, offsetY, iChannel, fillValue]),
                              {$ELSE}
                              IEMsg( IEMsg_SHIFTCHANNEL ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_SHIFTCHANNEL ) then
    exit;
  IEShift(ProcBitmap, offsetX, offsetY, iChannel, fillValue, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

procedure IEChangeYCbCrCoefficients(Bitmap: TIEBitmap; srcLumaRed, srcLumaGreen, srcLumaBlue, dstLumaRed, dstLumaGreen, dstLumaBlue: Double);
var
  row, col: Integer;
  rgb: PRGB;
  width, height: Integer;
  Y, Cb, Cr: Double;
  rr, gg, bb: Double;
begin
  width := Bitmap.Width;
  height := Bitmap.Height;
  for row := 0 to height-1 do
  begin
    rgb := Bitmap.Scanline[row];
    for col := 0 to width-1 do
    begin
      with rgb^ do
      begin
        rr := r/255;
        gg := g/255;
        bb := b/255;
      end;
      Y := (srcLumaRed*rr + srcLumaGreen*gg + srcLumaBlue*bb);
      Cb :=  (bb-Y)/(2-2*srcLumaBlue);
      Cr :=  (rr-Y)/(2-2*srcLumaRed);

      rr :=  Cr*(2-2*dstLumaRed)+Y;
      gg :=  (Y-dstLumaBlue*bb - dstLumaRed*rr)/dstLumaGreen;
      bb :=  Cb*(2-2*dstLumaBlue)+Y;

      with rgb^ do
      begin
        r := blimit(round(rr*255));
        g := blimit(round(gg*255));
        b := blimit(round(bb*255));
      end;

      inc(rgb);
    end;
  end;
end;



// amount: 0..1 (ref 0.3)
{!!
<FS>TImageEnProc.Contrast2

<FM>Declaration<FC>
procedure Contrast2(Amount: Double);

<FM>Description<FN>
Adjust the contrast of the image. Amount is a floating point value between from 0 and 1.

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\AutoEnhance\AutoAdjust.dpr </C> </R>
</TABLE>

<FM>Example<FC>
ImageEnView1.Proc.Contrast2(0.3);

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Contrast></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Contrast3></C> </R>
</TABLE>

!!}             
procedure TImageEnProc.Contrast2(Amount: Double);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_CONTRAST2, [Amount]),
                              {$ELSE}
                              IEMsg( IEMsg_CONTRAST ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_CONTRAST2 ) then
    exit;
  IEContrast2(ProcBitmap, Amount, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

//Amount [0 .. 1000]
procedure IEAdjustSaturation(Src: TIEBitmap; Amount: Integer; pr: TProgressRec);
var
  x, y1: Integer;
  ry1, by1, gy1, y: Double;
  cr, cg, cb: Integer;
  RGB: PRGB;
  width, height: Integer;
  amt: Double;
begin
  width := Src.Width;
  height := Src.Height;
  amt := Amount/100;
  for y1 := 0 to height - 1 do
  begin
    RGB := Src.Scanline[y1];
    for x := 0 to width - 1 do
    begin
      with RGB^ do
      begin
        ry1 :=  0.70 * r - 0.59 * g - 0.11 * b;
        by1 := -0.30 * r - 0.59 * g + 0.89 * b;
        gy1 := -0.30 * r + 0.41 * g - 0.11 * b;
        y   :=  0.30 * r + 0.59 * g + 0.11 * b;
        cr := round(ry1*amt + y);
        cg := round(gy1*amt + y);
        cb := round(by1*amt + y);
        if cr < 0 then
          r := 0
        else
        if cr > 255 then
          r := 255
        else
          r := cr;
        if cg < 0 then
          g := 0
        else
        if cg > 255 then
          g := 255
        else
          g := cg;
        if cb < 0 then
          b := 0
        else
        if cb > 255 then
          b := 255
        else
          b := cb;
      end;
      inc(RGB);
    end;
    with pr do
      if assigned(fOnProgress) then
        fOnProgress(Sender, tot + trunc(y1/height*per1*100) );
  end;
end;

{!!
<FS>TImageEnProc.AdjustSaturation

<FM>Declaration<FC>
procedure AdjustSaturation(Amount: Integer);

<FM>Description<FN>
Adjusts color saturation. Amount is a value between -100 and 100.

!!}
procedure TImageEnProc.AdjustSaturation(Amount: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
  pr: TProgressRec;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_ADJUSTSATURATION, [Amount]),
                              {$ELSE}
                              IEMsg( IEMsg_SATURATION ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_ADJUSTSATURATION ) then
    exit;
  pr.fOnProgress := fOnProgress;
  pr.Sender := self;
  pr.tot := 0;
  pr.per1 := 1;
  IEAdjustSaturation(ProcBitmap, Amount+100, pr);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


// Amount [-180 .. 180]
procedure IEAdjustTint(Src: TIEBitmap; Amount: Integer; UseFixedColor: Boolean; FixedColorStart: TRGB; FixedColorEnd: TRGB; OnProgress: TIEProgressEvent; Sender: TObject);
var
  x, ry, by, gy, ry1, by1, y1: Integer;
  y, cr, cg, cb, r1, b1, g1: Integer;
  RGB: PRGB;
  C, S, Theta: Single;
  width, height: Integer;
begin
  width  := Src.Width;
  height := Src.Height;

  Theta := (3.14159 * Amount) / 180;
  C := 256 * Cos(Theta);
  S := 256 * Sin(Theta);
  for y1 := 0 to height - 1 do
  begin
    RGB := Src.Scanline[y1];
    for x := 0 to width - 1 do
    begin
      if not UseFixedColor or (RGB^.r < FixedColorStart.r) or (RGB^.g < FixedColorStart.g) or (RGB^.b < FixedColorStart.b) or (RGB^.r > FixedColorEnd.r) or (RGB^.g > FixedColorEnd.g) or (RGB^.b > FixedColorEnd.b) then
      begin
        r1 := RGB^.R;
        g1 := RGB^.G;
        b1 := RGB^.B;
        ry1 := Round((70 * r1 - 59 * g1 - 11 * b1) / 100);
        by1 := Round((-30 * r1 - 59 * g1 + 89 * b1) / 100);
        //gy1 := Round((-30 * r1 + 41 * g1 - 11 * b1) / 100);
        y := Round((30 * r1 + 59 * g1 + 11 * b1) / 100);
        by := Round((C * by1 - S * ry1) / 256);
        ry := Round((S * by1 + C * ry1) / 256);
        gy := Round((-51 * ry - 19 * by) / 100);
        cr := ry + y;
        cg := gy + y;
        cb := by + y;
        if cr < 0 then
          cr := 0
        else
        if cr > 255 then
          cr := 255;
        if cg < 0 then
          cg := 0
        else
        if cg > 255 then
          cg := 255;
        if cb < 0 then
          cb := 0
        else
        if cb > 255 then
          cb := 255;
        with RGB^ do
        begin
          r := cr;
          g := cg;
          b := cb;
        end;
      end;
      inc(RGB);
    end;
    if assigned(OnProgress) then
      OnProgress(Sender, trunc(y1/height*100) );
  end;
end;

{!!
<FS>TImageEnProc.AdjustTint

<FM>Declaration<FC>
procedure AdjustTint(Amount: Integer);
procedure AdjustTint(Amount: Integer; FixedColorStart: TRGB; FixedColorEnd: TRGB);
procedure AdjustTint(Amount: Integer; FixedColorPos: TPoint);

<FM>Description<FN>
Adjusts the color tint of the image. Amount (in degrees) is a value between -180 and 180.
Second and third overload leave untouched a specified color range or the color at a position.
!!}
procedure TImageEnProc.AdjustTint(Amount: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_ADJUSTTINT, [Amount]),
                              {$ELSE}
                              IEMsg( IEMsg_ADJUSTTINT ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_ADJUSTTINT ) then
    exit;
  IEAdjustTint(ProcBitmap, Amount, false, CreateRGB(0, 0, 0), CreateRGB(0, 0, 0), fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;



// Brightnes, Contrast and Saturation
// b [0 .. 512]
// c [-100 .. 100]
// s [0 .. 512]

procedure IEAdjustBrightnessContrastSaturation(Bitmap: TIEBitmap; b, c, s: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
var
  x, y, i, k, v: Integer;
  ci1, ci2, ci3: Integer;
  alpha: Integer;
  a: Double;
  ContrastLut: array[0..255] of byte;
  BCLut: array[0..255] of byte;
  SaturationLut: record
    Grays: array[0..767] of Integer;
    Alpha: array[Byte] of Word;
  end;
  color: PRGB;
  width, height: Integer;
begin
  width := Bitmap.Width;
  height := Bitmap.Height;

  if c = 100 then
    c := 99;
  for i := 0 to 255 do
  begin
    if c > 0 then
      a := 1 / cos(c * (PI / 200))
    else
      a := 1 * cos(c * (3.1416 / 200));
    v := Round(a * (i - 170) + 170);
    if v > 255 then
      v := 255
    else
    if v < 0 then
      v := 0;
    ContrastLut[i] := v;
  end;

  for i := 0 to 255 do
  begin
    alpha := b;
    k := 256 - alpha;
    v := (k + alpha * i) div 256;
    if v < 0 then
      v := 0;
    if v > 255 then
      v := 255;
    BCLut[i] := ContrastLut[v];
  end;

  //  Calculate saturation
  x := 0;
  for i := 1 to 256 do
    SaturationLut.Alpha[i - 1] := (i * s) shr 8;
  for i := 0 to 255 do
  begin
    y := i - SaturationLut.Alpha[i];
    SaturationLut.Grays[x] := y;
    Inc(x);
    SaturationLut.Grays[x] := y;
    Inc(x);
    SaturationLut.Grays[x] := y;
    Inc(x);
  end;
  // Done saturation

  // Then apply them...
  for y := 0 to height - 1 do
  begin
    Color := Bitmap.Scanline[y];
    for x := 0 to width - 1 do
    begin
      v := Color.R + Color.G + Color.B;
      ci1 := SaturationLut.Grays[v] + SaturationLut.Alpha[Color.B];
      ci2 := SaturationLut.Grays[v] + SaturationLut.Alpha[Color.G];
      ci3 := SaturationLut.Grays[v] + SaturationLut.Alpha[Color.R];

      with Color^ do
      begin
        B := BCLut[ blimit(ci1) ];
        G := BCLut[ blimit(ci2) ];
        R := BCLut[ blimit(ci3) ];
      end;

      inc(Color);
    end;
    if assigned(OnProgress) then
      OnProgress(Sender, trunc(y/height*100) );
  end;
end;

// b [-100 .. 100]     (the internal function has 0..512)
// c [-100 .. 100]
// s [-100 .. 100]     (the internal function has 0..512)
{!!
<FS>TImageEnProc.AdjustBrightnessContrastSaturation

<FM>Declaration<FC>
procedure AdjustBrightnessContrastSaturation(Brightness, Contrast, Saturation: Integer);

<FM>Description<FN>
Adjust brightness, contrast and color saturation in a single step.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>Brightness<FN></C> <C>A value between -100 and 512</C> </R>
<R> <C><FC>Contrast<FN></C> <C>A value between -100 and 100</C> </R>
<R> <C><FC>Saturation<FN></C> <C>A value between 0 and 512</C> </R>
</TABLE>

Note: Set a parameter to zero, to avoid changing that value.

<FM>Example<FC>
// Enhance brightness, contrast and color saturation
ImageEnView1.Proc.AdjustBrightnessContrastSaturation(50, 10, 10);

// Enhance only brightness and contrast, maintain existing color saturation
ImageEnView1.Proc.AdjustBrightnessContrastSaturation(50, 10, 0);
!!}
procedure TImageEnProc.AdjustBrightnessContrastSaturation(Brightness, Contrast, Saturation: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_ADJUSTBRIGHTNESSCONTRASTSATURATION, [Brightness, Contrast, Saturation]),
                              {$ELSE}
                              IEMsg( IEMsg_ADJUSTBRIGHTNESSCONTRASTSATURATION ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_ADJUSTBRIGHTNESSCONTRASTSATURATION) then
    exit;
  IEAdjustBrightnessContrastSaturation(ProcBitmap, trunc((Brightness/100+1)*256), Contrast, trunc((Saturation/100+1)*256), fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

// z: ref. 0.3
procedure IEContrast2(src: TIEBitmap; z: single; OnProgress: TIEProgressEvent; Sender: TObject);
type
  THistSingle = array[0..255] of Single;
  THistogram = array[0..255] of integer;
var
  p0: PRGB;
  x, y: Integer;
  q1: Single;
  histB: Thistogram;
  Hist, VCumSumR: THistSingle;
  wH, wS, wB: Word;
  width, height: Integer;

  procedure HistCalc(src: TIEBitmap; var histB: THistogram);
  var
    p0: PRGB;
    sx, sy, x, y: Integer;
    wH, wS, wB: Word;
  begin
    sx := width - 1;
    sy := height - 1;

    for x := 0 to 255 do
      histB[x] := 0;

    for y := 0 to sy do
    begin
      p0 := src.ScanLine[y];
      for x := 0 to sx do
      begin
        with p0^ do
          IERGBToHSB(r, g, b, wH, wS, wB);
        inc(histB[wB]);
        inc(p0);
      end;
    end;
  end;

  function CumSum(hist: THistSingle): THistSingle;
  var
    x: Byte;
    Temp: THistsingle;
  begin
    Temp[0] := Hist[0];
    for x := 1 to 255 do
      Temp[x] := Temp[x - 1] + Hist[x];
    CumSum := Temp;
  end;

begin

  width := src.Width;
  height := src.Height;

  HistCalc(src, histB);

  // Intensity Channel B
  q1 := 0;
  for x := 0 to 255 do
  begin
    Hist[x] := Power(HistB[x], z);
    q1 := q1 + Hist[x];
  end;
  vcumsumR := cumsum(Hist);

  for y := 0 to height - 1 do
  begin
    p0 := src.scanline[y];
    for x := 0 to width - 1 do
    begin
      with p0^ do
      begin
        IERGBToHSB(r, g, b, wH, wS, wB);
        wB :=  Trunc((255 / q1) * vcumsumR[wB]);
        IEHSBToRGB(wH, wS, wB, r, g, b);
      end;
      inc(p0);
    end;
    if assigned(OnProgress) then
      OnProgress(Sender, trunc(y/height*100) );
  end;
end;

procedure TImageEnProc.AdjustTint(Amount: Integer; FixedColorStart: TRGB; FixedColorEnd: TRGB);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_ADJUSTTINT, [Amount]),
                              {$ELSE}
                              IEMsg( IEMsg_ADJUSTTINT ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_ADJUSTTINT ) then
    exit;
  IEAdjustTint(ProcBitmap, Amount, true, FixedColorStart, FixedColorEnd, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

procedure TImageEnProc.AdjustTint(Amount: Integer; FixedColorPos: TPoint);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
  FixedColorStart, FixedColorEnd: TRGB;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_ADJUSTTINT, [Amount]),
                              {$ELSE}
                              IEMsg( IEMsg_ADJUSTTINT ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_ADJUSTTINT ) then
    exit;
  FixedColorStart := ProcBitmap.Pixels_ie24RGB[FixedColorPos.X, FixedColorPos.Y];
  FixedColorEnd   := FixedColorStart;
  IEAdjustTint(ProcBitmap, Amount, true, FixedColorStart, FixedColorEnd, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


// z1=saturation  (ref. 0.1)
// z2=contrast    (ref. 0.3)
procedure IEAutoSBHist(src: TIEBitmap; z1, z2: single; OnProgress: TIEProgressEvent; Sender: TObject);
type
  THistSingle = array[0..255] of Single;
  THistogram = array[0..255] of Integer;
var
  p0: PRGBROW;
  x, y: Integer;
  q1, q2: Single;
  HistS, HistB: THistogram;
  Hist1, VCumSumS: THistSingle;
  Hist2, VCumSumB: THistSingle;
  cy, ccr, ccb: word;
  width, height: Integer;

  procedure HistCalc(src: TIEBitmap; var HS, HB: THistogram);
  var
    p0: PRGBROW;
    sx, sy, x, y: Integer;
    cy, ccr, ccb: word;
  begin
    sx := width - 1;
    sy := height - 1;

    for x := 0 to 255 do
    begin
      HS[x] := 0;
      HB[x] := 0;
    end;

    for y := 0 to sy do
    begin
      p0 := src.ScanLine[y];
      for x := 0 to sx do
        with p0[x] do
        begin
          IERGBtoHSB(r, g, b, ccb, cy, ccr);
          Inc(HS[cy]);
          Inc(HB[ccr]);
        end;
    end;
  end;

  function CumSum(hist: THistSingle): THistSingle;
  var
    x: Byte;
    Temp: THistsingle;
  begin
    Temp[0] := Hist[0];
    for x := 1 to 255 do
      Temp[x] := Temp[x - 1] + Hist[x];
    CumSum := Temp;
  end;

begin

  width := src.Width;
  height := src.Height;

  HistCalc(src, HistS, HistB);

  q1 := 0;
  for x := 0 to 255 do
  begin
    Hist1[x] := Power(HistS[x], z1);
    q1 := q1 + Hist1[x];
  end;
  vcumsumS := cumsum(Hist1);

  q2 := 0;
  for x := 0 to 255 do
  begin
    Hist2[x] := Power(HistB[x], z2);
    q2 := q2 + Hist2[x];
  end;
  vcumsumB := cumsum(Hist2);

  for y := 0 to height - 1 do
  begin
    p0 := src.scanline[y];
    for x := 0 to width - 1 do
      with p0[x] do
      begin
        IERGBtoHSB(r, g, b, ccb, cy, ccr);
        cy := Trunc((255 / q1) * vcumsumS[cy]);
        ccr := Trunc((255 / q2) * vcumsumB[ccr]);
        IEHSBtoRGB(ccb, cy, ccr, r, g, b);
      end;
    if assigned(OnProgress) then
      OnProgress(Sender, trunc(y/height*100) );
  end;
end;

{!!
<FS>TImageEnProc.AdjustLumSatHistogram

<FM>Declaration<FC>
procedure AdjustLumSatHistogram(Saturation, Luminance: Double);

<FM>Description<FN>
Adjusts Saturation, Luminance and the histogram.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>Saturation<FN></C> <C>Value between 0 and 1</C> </R>
<R> <C><FC>Luminance<FN></C> <C>Value between 0 and 1</C> </R>
</TABLE>

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\AutoEnhance\AutoAdjust.dpr </C> </R>
</TABLE>
!!}
procedure TImageEnProc.AdjustLumSatHistogram(Saturation, Luminance: Double);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_ADJUSTLUMSATHISTOGRAM, [Saturation, Luminance]),
                              {$ELSE}
                              IEMsg( IEMsg_AdjustLuminanceSaturation ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_ADJUSTLUMSATHISTOGRAM ) then
    exit;
  IEAutoSBHist(ProcBitmap, Saturation, Luminance, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


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


procedure IEDisposeChannels(Bitmap: TIEBitmap; newDispo: String; OnProgress: TIEProgressEvent; Sender: TObject);
var
  x, y: Integer;
  s8: array [0..3] of byte;
  s16: array [0..3] of word;
  p: array [0..2] of integer;
  d_rgb8: PRGB;
  d_rgb16: PRGB48;
  width, height: Integer;

  procedure DoProgress;
  begin
    if assigned(OnProgress) then
      OnProgress(Sender, trunc(y/height*100) );
  end;

begin
  width  := Bitmap.Width;
  height := Bitmap.Height;
  newDispo := UpperCase(newDispo);
  for y := 1 to 3 do
    case newDispo[y] of
      'R': p[y-1] := 2;
      'G': p[y-1] := 1;
      'B': p[y-1] := 0;
      '0': p[y-1] := 3;
    end;

  case Bitmap.PixelFormat of
    ie24RGB:
      begin
        s8[3] := 0;  // const '0' value
        for y := 0 to height-1 do
        begin
          d_rgb8 := Bitmap.Scanline[y];
          for x := 0 to width-1 do
          begin
            s8[0] := d_rgb8^.b;
            s8[1] := d_rgb8^.g;
            s8[2] := d_rgb8^.r;
            d_rgb8^.b := s8[ p[0] ];
            d_rgb8^.g := s8[ p[1] ];
            d_rgb8^.r := s8[ p[2] ];
            inc(d_rgb8);
          end;
          DoProgress;
        end;
      end;
    ie48RGB:
      begin
        s16[3] := 0;  // const '0' value
        for y := 0 to height-1 do
        begin
          d_rgb16 := Bitmap.Scanline[y];
          for x := 0 to width-1 do
          begin
            s16[0] := d_rgb16^.b;
            s16[1] := d_rgb16^.g;
            s16[2] := d_rgb16^.r;
            d_rgb16^.b := s16[ p[0] ];
            d_rgb16^.g := s16[ p[1] ];
            d_rgb16^.r := s16[ p[2] ];
            inc(d_rgb16);
          end;
          DoProgress;
        end;
      end;
  end;
end;


{!!
<FS>TImageEnProc.DisposeChannels

<FM>Declaration<FC>
procedure DisposeChannels(newDispo: String);

<FM>Description<FN>
Changes the channel order from BGR to the specified one.
<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>newDispo<FN></C> <C>A string of three characters, one for each channel ('RGB', 'RBG', etc). Can contain also '0' to set a channel to zero. You can also replicate the same channel: 'RRR' or 'GGG', etc.</C> </R>
</TABLE>

Default: 'BGR'

<FM>Example<FC>
// invert R with B
ImageEnView1.Proc.DisposeChannels('RGB');

// set channels B and G to 0, leaving only R
ImageEnView1.Proc.DisposeChannels('00R');

!!}
procedure TImageEnProc.DisposeChannels(newDispo: String);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB, ie48RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_DISPOSECHANNELS, [newDispo]),
                              {$ELSE}
                              IEMsg( IEMsg_ReorderColorChannels ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_DISPOSECHANNELS ) then
    exit;
  IEDisposeChannels(ProcBitmap, newDispo, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

procedure IEIntensity(Bitmap: TIEBitmap; LoLimit, HiLimit, Change: Integer; UseAverageRGB: Boolean; DoRed, DoGreen, DoBlue: Boolean; OnProgress: TIEProgressEvent; Sender: TObject);
var
  MidPoint: Integer;
  Steps: Double;
  VInc: Double;
  Accum: Double;
  i: Integer;
  LUT1, LUT2: array [0..255] of integer;
  x, y, width, height: Integer;
  rgb: PRGB;
  AverageRGB: Integer;
begin
  // control parameters
  if (LoLimit = 255) or (HiLimit = 0) or (HiLimit <= LoLimit) or (Change = 0) then
    exit;
  if Abs(HiLimit - LoLimit) <= 1 then
    exit;     

  width := Bitmap.Width;
  height := Bitmap.Height;

  MidPoint := trunc( LoLimit + ((HiLimit - LoLimit) / 2) );

  Steps := MidPoint - LoLimit;
  VInc := Change / Steps;
  Accum := 0;

  // Initialise look-up tables
  for i := 0 To 255 do
  begin
    LUT1[i] := i;
    LUT2[i] := 0;
  end;

  // Populate the tables with increasing gradient values
  for i := LoLimit to MidPoint do
  begin
    Accum := Accum + VInc;
    LUT1[i] := trunc(LUT1[i] + Accum);
    LUT2[i] := trunc(Accum) ;
  end;

  // Populate the tables with decreasing gradient values
  for i := MidPoint + 1 to HiLimit do
  begin
    Accum := Accum - VInc;
    LUT1[i] := trunc(LUT1[i] + Accum);
    LUT2[i] := trunc(Accum);
  end;

  for i := 0 To 255 do
  begin
    if Change < 0 Then
    begin
      if LUT1[i] < 0 then
        LUT1[i] := 0;
    end
    else
    begin
      If LUT1[i] > 255 then
        LUT1[i] := 255
    end;
  end;

  if UseAverageRGB then
  begin

    for y := 0 to height - 1 do
    begin
      rgb := Bitmap.Scanline[y];
      for x := 0 To width - 1 do
      begin
        with rgb^ do
        begin
          AverageRGB := (r + g + b) div 3;
          // UPDATE the existing value with the entry in the 2nd table
          if DoRed then
            r := blimit(r + LUT2[AverageRGB]);
          if DoGreen then
            g := blimit(g + LUT2[AverageRGB]);
          if DoBlue then
            b := blimit(b + LUT2[AverageRGB]);
        end;
        inc(rgb);
      end;
      if assigned(OnProgress) then
        OnProgress(Sender, trunc(y/height*100) );
    end;

  end
  else
  begin

    for y := 0 to height - 1 do
    begin
      rgb := Bitmap.Scanline[y];
      for x := 0 To width - 1 do
      begin
        with rgb^ do
        begin
          if DoRed then
            r := LUT1[r];
          if DoGreen then
            g := LUT1[g];
          if DoBlue then
            b := LUT1[b];
        end;
        inc(rgb);
      end;
      if assigned(OnProgress) then
        OnProgress(Sender, trunc(y/height*100) );
    end;

  end;

end;

{!!
<FS>TImageEnProc.Intensity

<FM>Declaration<FC>
procedure Intensity(LoLimit, HiLimit, Change: Integer; UseAverageRGB: Boolean; DoRed, DoGreen, DoBlue: Boolean);

<FM>Description<FN>
Changes the value of a pixel by an amount determined by the input Red, Green and Blue channel RGB values individually, or as an averaged value. The change is graduated starting from LoLimit, with a maximum change applied to the midpoint between LoLimit and HiLimit, then reduced again to HiLimit.
Typically this method can be used to effectively progressively brighten or darken any range of colors as requested without affecting colors outside the range.  RGB values in the range of 0 to 127 are considered as darker, and 128 to 255 as lighter.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>LoLimit<FN></C> <C>The start point of the range (value between 0 and 255)</C> </R>
<R> <C><FC>HiLimit<FN></C> <C>The end point of the range (value between 0 and 255)</C> </R>
<R> <C><FC>Change<FN></C> <C> The maximum or minimum value to be applied to the midpoint, and used to determine the slope of the increment/decrement used over the range (value between -255 and 255)</C> </R>
<R> <C><FC>UseAverageRGB<FN></C> <C>If True, uses the average value of the input Red, Green and Blue channels to determine the amount to change all RGB channels of the pixel</C> </R>
<R> <C><FC>DoRed, DoGreen, DoBlue<FN></C> <C>If True, changes are applied to that RGB channel</C> </R>
</TABLE>

<FM>Example<FC>
// Apply an Intensity gradient peaking at +40 to all RGB values between 80 and 255
ImageEnView.Proc.Intensity( 80, 255, 40, False, True, True, True );

// Apply an Intensity gradient dropping to -24, to the Red RGB channel only, when Red values are between 20 and 127
ImageEnView.Proc.Intensity( 20, 127, -24, False, True, False, False );

!!}
procedure TImageEnProc.Intensity(LoLimit, HiLimit, Change: Integer; UseAverageRGB: Boolean; DoRed, DoGreen, DoBlue: Boolean);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_INTENSITY,
                              {$ELSE}
                              IEMsg( IEMSG_INTENSITY ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_INTENSITY ) then
    exit;
  IEIntensity(ProcBitmap, LoLimit, HiLimit, Change, UseAverageRGB, DoRed, DoGreen, DoBlue, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

procedure IEContrast3(Bitmap: TIEBitmap; Change, Midpoint: Integer; DoRed, DoGreen, DoBlue: Boolean; OnProgress: TIEProgressEvent; Sender: TObject);
var
  i, x, y: Integer;
  rgb: PRGB;
  width, height: Integer;
  contrast: Double;
  modifier: Integer;
  LUT1: array [0..255] of integer;
begin
  if Change = 0 then
    exit;

  if change < -255 then
    Change := -255;
  if change > 255 then
    Change := 255;

  if Midpoint < -100 then
    Midpoint := -100;
  if Midpoint > 100 then
    Midpoint := 100;

  i := Change + 100;

  if i = 100 then
    Contrast := 1
  else
  if i < 100 then
    contrast := 1 / (5 - (i / 25))
  else
    Contrast := ((i - 100) / 50) + 1;

  Modifier := 100 + Midpoint;
  for i := 0 to 255 do
    LUT1[i] := blimit( trunc(((i - Modifier) * Contrast) + Modifier) );

  width := Bitmap.Width;
  height := Bitmap.Height;

  for y := 0 to height-1 do
  begin
    rgb := Bitmap.Scanline[y];
    for x := 0 to width-1 do
    begin
      with rgb^ do
      begin
        if DoRed then
          r := LUT1[r];
        if DoGreen then
          g := LUT1[g];
        if DoBlue then
          b := LUT1[b];
      end;
      inc(rgb);
    end;
    if assigned(OnProgress) then
      OnProgress(Sender, trunc(y/height*100) );
  end;

end;

{!!
<FS>TImageEnProc.Contrast3

<FM>Declaration<FC>
procedure Contrast3(Change, Midpoint: Integer; DoRed, DoGreen, DoBlue: Boolean);

<FM>Description<FN>
Applies contrast to the image by lightening or darkening pixels depending on whether they are above or below a threshold. The Midpoint value determines the threshold, i.e. the point at which the Change value influences the pixel value lighter or darker.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>Change<FN></C> <C>The level of contrast to be applied each side of the midpoint (value between -255 and 255). When positive, increasing the Midpoint value increases the contrast (darkens the image). When negative, Increasing the Midpoint value lightens the image</C> </R>
<R> <C><FC>Midpoint<FN></C> <C>The threshold of light and dark (value between -100 and 100)</C> </R>
<R> <C><FC>DoRed, DoGreen, DoBlue<FN></C> <C>If True, changes are applied to that RGB channel</C> </R>
</TABLE>

<FM>Examples<FC>
// Apply Contrast of +20 to all RGB values around the default Midpoint value:
ImageEnView.Proc.Contrast3 (0, 20, True, True, True);

// Apply Contrast of -24, to the Red and Blue RGB channels only, around a Midpoint of +10, to lighten the overall result:
ImageEnView.Proc.Intensity (10, -24, True, False, True);

// Apply Contrast of +15, to the Green RGB channel only, around a Midpoint of +30, to darken the overall result:
ImageEnView.Proc.Intensity (30, 15, False, True, False);

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Contrast></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Contrast2></C> </R>
</TABLE>
!!}
procedure TImageEnProc.Contrast3(Change, Midpoint: Integer; DoRed, DoGreen, DoBlue: Boolean);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_CONTRAST3,
                              {$ELSE}
                              IEMsg( IEMSG_CONTRAST ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_CONTRAST3 ) then
    exit;
  IEContrast3(ProcBitmap, Change, Midpoint, DoRed, DoGreen, DoBlue, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


/////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////
// vectorization routines


const
  DEFAULT_CODE_LENGTH = 512;
  CONTOUR = 2; // 'c';
  VISITED = 3; // 'v';
  BLACK = 0;
  WHITE = 1;


type

pt2 = record
  x, y: Integer;
end;
ppt2 = ^pt2;

TIEChainCode = class
  SCALE: Integer;
  code: PAnsiChar;
  alength: Integer;  // actual length
  length: Integer;
  constructor Create(aSCALE: Integer);
  destructor Destroy; override;
  procedure add(c: AnsiChar);
  function postProcess: TIEChainCode;
end;

constructor TIEChainCode.Create(aSCALE: Integer);
begin
  inherited Create;
  SCALE := aSCALE;
  code := allocmem(DEFAULT_CODE_LENGTH * sizeof(AnsiChar));
  code[0] := #0;
  length := DEFAULT_CODE_LENGTH;
  alength := 0;
end;

destructor TIEChainCode.Destroy;
begin
  freemem(code);
  inherited Destroy;
end;

procedure TIEChainCode.add(c: AnsiChar);
begin
  if (alength >= length-1) then
  begin
    length := length*2;
    reallocmem(code, length);
  end;
  code[alength] := c;
  inc(alength);
  code[alength] := #0;
end;

function TIEChainCode.postProcess: TIEChainCode;
var
  i, j: Integer;
  filtCode: TIEChainCode;
begin
  i := 0;

  filtCode := TIEChainCode.Create(SCALE);
  while (i<alength) do
  begin
    if (i+SCALE-1 < alength) then
    begin
      for j := 0 to SCALE-1-1 do
        if (code[i+j] <> code[i+j+1]) then
          break;
      if (j = SCALE-1) then
      begin
        filtCode.add(code[i]);
        inc(i , SCALE);
        continue;
      end;
    end;

    if (i+SCALE-2 < alength) then
    begin
      for j := 0 to SCALE-2-1 do
        if (code[i+j] <> code[i+j+1]) then
          break;
      if (j = SCALE-2) then
      begin
        inc(i , SCALE-1);
        continue;
      end;
    end;
    filtCode.add(code[i]);
    inc(i);
  end;
  result := filtCode;
end;

function addPt2(a: ppt2; b: ppt2; c: ppt2): ppt2;
begin
  c^.x := a^.x + b^.x;
  c^.y := a^.y + b^.y;
  result := c;
end;

function subPt2(a: ppt2; b: ppt2; c: ppt2): ppt2;
begin
  c^.x := a^.x - b^.x;
  c^.y := a^.y - b^.y;
  result := c;
end;

function IEVectorize(bitmap: TIEMask; x1, y1, x2, y2: Integer; SCALE: Integer): TList;
const
  contour_dir: array [0..7] of pt2 = (( x:1; y:0), 
                (x: 0; y:-1),
                (x:-1; y: 0),
                (x: 0; y: 1), 
                (x: 1; y:-1), 
                (x:-1; y:-1), 
                (x:-1; y: 1),
                (x: 1; y: 1));
var
  code4, tmpcode: TIEChainCode;
  fatmap: array of byte;
  direction_code: array [0..8-1] of AnsiChar;
  i, j, u, v, l,
  last_dir: Integer;
  flag: Boolean;
  pixel,
  test_pixel,
  start_pixel: pt2;
  fwidth, fheight, fwidthUnscaled: Integer;
  pt: PPoint;
  x, y: Integer;
  origX, origY: Integer;
  fatmap_size: Integer;
  pb: pbyte;
  ly, lx: Integer;

  procedure fatmapSet(x, y: integer; value: byte);
  var
    addr: integer;
    bit: integer;
  begin
    addr := y * fwidthUnscaled + (x shr 2);
    bit := 2 * (x and 3);
    fatmap[addr] := (fatmap[addr] and not (3 shl bit)) or (value shl bit);
  end;

  function fatmapGet(x, y: integer): byte;
  begin
    result := (fatmap[y * fwidthUnscaled + (x shr 2)] shr (2 * (x and 3))) and 3;
  end;

  function fatmapGet4(x, y: integer): byte;
  begin
    result := fatmap[y * fwidthUnscaled + (x shr 2)];
  end;

begin

  result := TList.Create;

  direction_code[0] := '0';
  direction_code[1] := '2';
  direction_code[2] := '4';
  direction_code[3] := '6';
  direction_code[4] := '1';
  direction_code[5] := '3';
  direction_code[6] := '5';
  direction_code[7] := '7';

  fwidth  := 2 + SCALE * (x2 - x1 + 1) + 2;
  fheight := 2 + SCALE * (y2 - y1 + 1) + 2;
  fwidthUnscaled := fwidth div SCALE;
  fatmap_size := fwidthUnscaled * fheight;
  SetLength(fatmap, fatmap_size);
  FillChar(fatmap[0], fatmap_size, 0);  // corresponds to all BLACK

  case bitmap.BitsPerPixel of
    1:
      begin
        for j := y1 to y2 do
        begin
          pb := bitmap.ScanLine[j];
          for i := x1 to x2 do
          begin
            if pbytearray(pb)^[i shr 3] and iebitmask1[i and $7] <> 0 then
            begin
              lx := 2+SCALE*(i-x1);
              ly := 2+SCALE*(j-y1);
              for v := 0 to SCALE-1 do
                for u := 0 to SCALE-1 do
                  fatmapSet(lx + u, ly + v, WHITE);
            end;
          end;
        end;
      end;
    8:
      begin
        for j := y1 to y2 do
        begin
          pb := bitmap.ScanLine[j]; inc(pb, x1);
          for i := x1 to x2 do
          begin
            if pb^ <> 0 then
            begin
              lx := 2+SCALE*(i-x1);
              ly := 2+SCALE*(j-y1);
              for v := 0 to SCALE-1 do
                for u := 0 to SCALE-1 do
                  fatmapSet(lx + u, ly + v, WHITE);
            end;
            inc(pb);
          end;
        end;
      end;
    else
    begin
      for j := y1 to y2 do
        for i := x1 to x2 do
          if bitmap.GetPixel(i, j) <> 0 then
          begin
            for v := 0 to SCALE-1 do
              for u := 0 to SCALE-1 do
                fatmapSet(2 + SCALE * (i - x1) + u, 2 + SCALE * (j - y1) + v, WHITE);
          end;
    end;
  end;

  flag := true;

  for j := 0 to fheight - 1 do
  begin
    for i := 1 to fwidth - 1 do
    begin
      if (fatmapGet(i, j) = BLACK) then
      begin
        if flag then
        begin
          fatmapSet(i - 1, j, CONTOUR);
          flag := false;
        end
      end
      else
        flag := true;
    end;
  end;

  for j := 0 to fheight - 1 do
  begin
    for i := fwidth - 3 downto 1 do
    begin
      if (fatmapGet(i, j) = BLACK) then
      begin
        if flag then
        begin
          fatmapSet(i + 1, j, CONTOUR);
          flag := false;
        end
      end
      else
        flag := true;
    end;
  end;

  flag := true;
  for i := 0 to fwidth - 1 do
  begin
    for j := 1 to fheight - 1 do
    begin
      if fatmapGet(i, j) = BLACK then
      begin
        if flag then
        begin
          fatmapSet(i, j - 1, CONTOUR);
          flag := false;
        end
      end
      else
        flag := true;
    end;
  end;

  flag := true;
  for i := 0 to fwidth - 1 do
  begin
    for j := fheight - 3 downto 1 do
    begin
      if (fatmapGet(i, j) = BLACK) then
      begin
        if flag then
        begin
          fatmapSet(i, j + 1, CONTOUR);
          flag := false;
        end
      end
      else
        flag := true;
    end;
  end;

  ly := 0;

  code4 := nil;
  while true do
  begin

    code4 := TIEChainCode.Create(SCALE);

    l := 0;
    for j := ly to fheight-1 do
    begin
      for i := 1 to fwidth-1 do
      begin
        if (fatmapGet(i, j) = CONTOUR) then
        begin
          start_pixel.x := i;
          start_pixel.y := j;
          ly := j;
          l := 1;
          break;
        end;
      end;
      if l = 1 then
        break;
    end;

    if l = 0 then
      break;

    origX := x1+ (start_pixel.x-2) div SCALE;
    origY := y1+ (start_pixel.y-2) div SCALE;

    pixel.x := start_pixel.x;
    pixel.y := start_pixel.y;

    fatmapSet(pixel.x, pixel.y, VISITED);

    last_dir := 4;
    while true do
    begin
      addPt2(@pixel, @contour_dir[last_dir], @test_pixel);
      if (fatmapGet(test_pixel.x, test_pixel.y) = CONTOUR) then
      begin
        pixel.x := test_pixel.x;
        pixel.y := test_pixel.y;
        fatmapSet(pixel.x, pixel.y, VISITED);
        code4.add(direction_code[last_dir]);
      end;
      i := 0;
      while i<8 do
      begin
        addPt2(@pixel, @contour_dir[i], @test_pixel);
        if (fatmapGet(test_pixel.x, test_pixel.y) = CONTOUR) then
        begin
          pixel.x := test_pixel.x;
          pixel.y := test_pixel.y;
          fatmapSet(pixel.x, pixel.y, VISITED);
          code4.add(direction_code[i]);
          last_dir := i;
          break;
        end;
        inc(i);
      end;
      if (i = 8) then
        break;
    end;

    for i := 0 to 7 do
    begin
      subPt2(@start_pixel, @pixel, @test_pixel);
      if (test_pixel.x=contour_dir[i].x) and (test_pixel.y=contour_dir[i].y) then
      begin
        code4.add(direction_code[i]);
        break;
      end;
    end;

    tmpCode := code4.postProcess;
    // put marker
    new(pt);
    pt^.x := MAXINT;
    pt^.y := MAXINT;
    result.Add(pt);
    //
    l := IEStrLen(tmpCode.code);
    x := origX;
    y := origY;
    for i := 0 to l - 1 do
    begin
      if (i = 0) or (i = l - 1) or (tmpCode.code[i] <> tmpCode.code[i - 1]) then
      begin
        new(pt);
        pt^.x := x;
        pt^.y := y;
        result.Add(pt);
      end;
      case tmpCode.code[i] of
        '0': begin inc(x);          end;
        '1': begin inc(x); dec(y);  end;
        '2': begin dec(y);          end;
        '3': begin dec(x); dec(y);  end;
        '4': begin dec(x);          end;
        '5': begin dec(x); inc(y);  end;
        '6': begin inc(y);          end;
        '7': begin inc(x); inc(y);  end;
      end;
    end;
    tmpCode.free;

    FreeAndNil(code4);

  end;

  if assigned(code4) then
    FreeAndNil(code4);

  // put final marker
  new(pt);
  pt^.x := MAXINT;
  pt^.y := MAXINT;
  result.Add(pt);
end;



// returns a list (TList) of TRect records (caller must free TList and dispose records)
// Quality (SCALE used in IEVectorize), from 1... (4=suggested)
// possible enhancements:
//  - instead of merge rectangles, merge polygons
//  - better algorithm to discard the background
function IESeparateObjects(Bitmap: TIEBitmap; MergeCommonAreas: Boolean; Quality: Integer; UseBackgroundColor: Boolean; BackgroundColorBegin, BackgroundColorEnd: TRGB): TList;
var
  mask: TIEMask;
  vect: TList;
  i, c, j, t: Integer;
  pp1: PPoint;
  x1, y1, x2, y2: Integer;
  rects: TList;  // a list of TRect
  pr1, pr2: PRect;
  pxrgb: PRGB;
  pxb, pxs: pbyte;
  mR, mG, mB: Integer;
  RedToGrayCoef, GreenToGrayCoef, BlueToGrayCoef: Integer;
  BitmapWidth, BitmapHeight: Integer;

  function compRect(ax1, ay1, ax2, ay2, bx1, by1, bx2, by2: Integer): Boolean;
  begin
    if MergeCommonAreas then
      result := _RectXRect(ax1, ay1, ax2, ay2, bx1, by1, bx2, by2)    // must intersect
    else
      result := _RectPRect(ax1, ay1, ax2, ay2, bx1, by1, bx2, by2) = 2; // must be inclusive
  end;

  function FindMergingRect(x1, y1, x2, y2: Integer): Integer;
  var
    i: Integer;
    r: PRect;
  begin
    for i := 0 to rects.Count - 1 do
    begin
      r := PRect(rects[i]);
      if compRect(x1, y1, x2, y2, r^.Left, r^.Top, r^.Right, r^.Bottom) then
      begin
        result := i;
        exit;
      end;
    end;
    result := -1;
  end;

begin

  BitmapWidth  := Bitmap.Width;
  BitmapHeight := Bitmap.Height;

  mask := TIEMask.Create();
  mask.AllocateBits(BitmapWidth + 2, BitmapHeight + 2, 8);
  mask.Fill(255);

  RedToGrayCoef   := IEGlobalSettings().RedToGrayCoef;
  GreenToGrayCoef := IEGlobalSettings().GreenToGrayCoef;
  BlueToGrayCoef  := IEGlobalSettings().BlueToGrayCoef;

  // convert bitmap to mask (0 or 255 values)
  case Bitmap.PixelFormat of
    ie1g:
      for i := 0 to BitmapHeight - 1 do
      begin
        pxb := mask.Scanline[i+1]; inc(pxb);
        pxs := Bitmap.Scanline[i];
        for j := 0 to BitmapWidth - 1 do
        begin
          if pbytearray(pxs)^[j shr 3] and iebitmask1[j and $7] <> 0 then
            pxb^ := 255
          else
            pxb^ := 0;
          inc(pxb);
        end;
      end;
    ie24RGB:
      begin
        if UseBackgroundColor then
        begin
          for i := 0 to BitmapHeight - 1 do
          begin
            pxrgb := Bitmap.Scanline[i];
            pxb := mask.Scanline[i + 1]; inc(pxb);
            for j := 0 to BitmapWidth - 1 do
            begin
              with pxrgb^ do
                if (r >= BackgroundColorBegin.r) and (g >= BackgroundColorBegin.g) and (b >= BackgroundColorBegin.b) and
                   (r <= BackgroundColorEnd.r) and (g <= BackgroundColorEnd.g) and (b <= BackgroundColorEnd.b) then
                  pxb^ := 0
                else
                  pxb^ := 255;
              inc(pxrgb);
              inc(pxb);
            end;
          end;
        end
        else
        begin
          _GetMediaContrastRGB(Bitmap, mR, mG, mB);
          t := (mR * RedToGrayCoef + mG * GreenToGrayCoef + mB * BlueToGrayCoef) div 100;
          for i := 0 to BitmapHeight - 1 do
          begin
            pxrgb := Bitmap.Scanline[i];
            pxb := mask.Scanline[i + 1]; inc(pxb);
            for j := 0 to BitmapWidth - 1 do
            begin
              with pxrgb^ do
                c := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;
              if c >= t then
                pxb^ := 255
              else
                pxb^ := 0;
              inc(pxrgb);
              inc(pxb);
            end;
          end;
        end;
      end;
    else
      for i := 0 to BitmapHeight - 1 do
      begin
        pxb := mask.Scanline[i + 1]; inc(pxb);
        for j := 0 to BitmapWidth - 1 do
        begin
          with Bitmap.Pixels[j, i] do
            c := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;
          if c >= 200 then
            pxb^ := 255
          else
            pxb^ := 0;
          inc(pxb);
        end;
      end;
  end;

  // raster to vect conversion
  vect := IEVectorize(mask, 0, 0, mask.Width - 1, mask.Height - 1, Quality);

  // converts polygons to rectangles (bounding boxes)
  rects := TList.Create();
  x1 := MAXINT;
  y1 := MAXINT;
  x2 := -MAXINT;
  y2 := -MAXINT;
  c := 0;
  for i := 0 to vect.Count - 1 do
  begin
    pp1 := PPoint(vect[i]);
    if pp1^.x = MAXINT then
    begin
      if (c > 3) and not ((x1 = 0) and (y1 = 0) and (x2 = mask.Width - 1) and (y2 = mask.Height - 1)) then
      begin
        j := FindMergingRect(x1, y1, x2, y2);
        if j = -1 then
        begin
          new(pr1);
          pr1^.Left := x1; pr1^.Top := y1; pr1^.Right := x2; pr1^.Bottom := y2;
          rects.Add(pr1);
        end
        else
        begin
          pr1 := PRect(rects[j]);
          pr1^.Left := imin(x1, pr1^.Left);
          pr1^.Top := imin(y1, pr1^.Top);
          pr1^.Right := imax(x2, pr1^.Right);
          pr1^.Bottom := imax(y2, pr1^.Bottom);
        end;
      end;
      x1 := MAXINT;
      y1 := MAXINT;
      x2 := -MAXINT;
      y2 := -MAXINT;
      c := 0;
    end
    else
    begin
      with pp1^ do
      begin
        if x < x1 then x1 := x;
        if y < y1 then y1 := y;
        if x > x2 then x2 := x;
        if y > y2 then y2 := y;
        inc(c);
      end;
    end;
  end;

  // groups intersecting rectangles
  i := 0;
  while i < rects.Count do
  begin
    for j := i + 1 to rects.Count - 1 do
    begin
      pr1 := PRect(rects[i]);
      pr2 := PRect(rects[j]);
      if compRect(pr1^.Left, pr1^.Top, pr1^.Right, pr1^.Bottom, pr2^.Left, pr2^.Top, pr2^.Right, pr2^.Bottom) then
      begin
        pr1^.Left := imin(pr1^.Left, pr2^.Left);
        pr1^.Top := imin(pr1^.Top, pr2^.Top);
        pr1^.Right := imax(pr1^.Right, pr2^.Right);
        pr1^.Bottom := imax(pr1^.Bottom, pr2^.Bottom);
        dispose(pr2);
        rects.Delete(j);
        dec(i);
        break;
      end;
    end;
    inc(i);
  end;

  // remove zero size objects
  i := 0;
  while i < rects.Count do
  begin
    pr1 := PRect(rects[i]);
    if (pr1^.Left >= pr1^.Right - 1) or (pr1^.Top >= pr1^.Bottom - 1) then
    begin
      dispose(pr1);
      rects.Delete(i);
    end
    else
      inc(i);
  end;

  // remove empty rectangles
  for i := 0 to rects.Count - 1 do
    with PRect(rects[i])^ do
    begin
      dec(Right, 2);
      dec(Bottom, 2);
    end;

  mask.free;
  // free vect
  for i := 0 to vect.Count - 1 do
    dispose( PPoint(vect[i]) );
  vect.free;

  result := rects;

end;



// end of vectorization routines
/////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////


{!!
<FS>TImageEnProc.SeparateObjects

<FM>Declaration<FC>
function SeparateObjects(Quality: Integer=4; MergeCommonAreas: Boolean = True): TList;
function SeparateObjects(Quality: Integer; MergeCommonAreas: Boolean; BackgroundColorBegin, BackgroundColorEnd: <A TRGB>): TList; overload;

<FM>Description<FN>
Creates a list (TList) of TRect pointers. Each rectangle encloses an "object" detected in an image. An object is a separate shape or image within a picture. It works best when separating photos or simple objects upon a white or black background. The background cannot contain a pattern.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>Quality<FN></C> <C>The contour search routine definition. Minimum value is 1, suggested is 4. Lower values increases speed, but it might failt to recognize complex objects like characters</C> </R>
<R> <C><FC>MergeCommonAreas<FN></C> <C>If true, when two rectangles intersect they are merged. When false, two rectangles are merged only if they are inclusive</C> </R>
<R> <C><FC>BackgroundColorBegin and BackgroundColorEnd<FN></C> <C>The background color range. This helps the function to separate the background and the objects</C> </R>
</TABLE>

Note: You must free the returned list as follows: <FC>
  Rects := ImageEnView1.Proc.SeparateObjects;
  ..process rects..
  // free rects
  for i := 0 to rects.Count-1 do
    dispose(Prect(rects[i]));
  rects.free;

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageAnalysis\SeparateObjects\SeparateObjects.dpr </C> </R>
</TABLE>

<FM>Example<FC>
// draws a red box around each found object
var rects: Tlist;
..
rects := ImageEnView1.Proc.SeparateObjects;
for i := 0 to rects.Count-1 do
begin
  with PRect(rects[i])^, ImageEnView1.IEBitmap.Canvas do
  begin
    Pen.Color := clRed;
    Brush.Style := bsClear;
    Rectangle(Left, Top, Right + 1, Bottom + 1);
  end;
  dispose(PRect(rects[i]));
end;
rects.free;
ImageEnView1.Update;

<FM>See Also<FN>
- <A CreateRGB>
- <A TRGB2TColor>
- <A TColor2TRGB>
!!}
// returns a list (TList) or TRect records (caller must free TList and dispose records)
// Quality (SCALE) from 1... (4=suggested)
function TImageEnProc.SeparateObjects(Quality: Integer; MergeCommonAreas: Boolean): TList;
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  result := nil;
  if not BeginImageAnalysis([], x1, y1, x2, y2, ProcBitmap, mask) then
    exit;
  result := IESeparateObjects(ProcBitmap, MergeCommonAreas, Quality, false, CreateRGB(0, 0, 0), CreateRGB(0, 0, 0));
  EndImageAnalysis(ProcBitmap);
  DoFinishWork;
end;

function TImageEnProc.SeparateObjects(Quality: Integer; MergeCommonAreas: Boolean; BackgroundColorBegin, BackgroundColorEnd: TRGB): TList;
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  result := nil;
  if not BeginImageAnalysis([], x1, y1, x2, y2, ProcBitmap, mask) then
    exit;
  result := IESeparateObjects(ProcBitmap, MergeCommonAreas, Quality, true, BackgroundColorBegin, BackgroundColorEnd);
  EndImageAnalysis(ProcBitmap);
  DoFinishWork;
end;

procedure TImageEnProc.DoFinishWork;
begin
  if assigned(fOnProgress) then
    fOnProgress(self, 100);
  if assigned(fOnFinishWork) then
    fOnFinishWork(self);
end;        


// Angle: -180..+180
// Rate: quotient of UnRotatedWidth / UnRotateHeight. Necessary only when Angle=+-45 or +-135
procedure CalcUnRotateSize_Document(RotatedWidth: integer; RotatedHeight: integer; Angle: double; Rate: double; var UnRotatedWidth: integer; var UnRotatedHeight: integer);
var
  a: double;
  den: double;
  s1: double;
begin
  a := IEDegreesToRadians( angle );

  if (Angle = 0) or (abs(Angle) = 180)then
  begin
    UnRotatedWidth  := RotatedWidth;
    UnRotatedHeight := RotatedHeight;
  end

  else if (abs(Angle) = 45) or (abs(Angle) = 135) then
  begin
    UnRotatedWidth  := trunc( sqrt(2) * rate * RotatedWidth / (rate + 1) );
    UnRotatedHeight := trunc( sqrt(2) * RotatedWidth / (rate + 1) );
  end

  else
  begin
    den := power(tan(a / 2), 4) - 6 * power(tan(a / 2), 2) + 1;
    s1 := 1 * sign(Angle);
    if ((Angle > -180) and (Angle < -90)) or ((Angle > 0) and (Angle <= 90)) then
      s1 := -s1;
    // solve equation [W=x*|cos(A)|+y*|sin(A)|, H=x*|sin(A)|+y*|cos(A)|, x, y]
    UnRotatedWidth  := trunc( ( -1 * sign(Angle) * 2 * RotatedHeight * power(tan(a / 2), 3) + -1 * sign(Angle) * 2 * RotatedHeight * tan(a / 2) + s1 * RotatedWidth * power(tan(a / 2), 4) - s1 * RotatedWidth ) / den );
    UnRotatedHeight := trunc( ( s1 * RotatedHeight * power(tan(a / 2), 4) + -1 * sign(Angle) * 2 * RotatedWidth * power(tan(a / 2), 3) + -1 * sign(Angle) * 2 * RotatedWidth * tan(a / 2) - s1 * RotatedHeight ) / den );
  end;
end;

procedure CalcUnRotateSize_Photo(OrigWidth: Integer; OrigHeight : integer; Angle: double; var NewWidth: integer; var NewHeight: integer);
var
  ScaleBy: Double;
  i: Integer;
  kdia, Rotation, NewDiagonalAngle, DiagonalAngle: Double;
  l1, h1, w1: Double;
begin
  ScaleBy := 1;
  for i := 0 to 1 do
  begin
    if i = 0 then
      kdia := 1
    else
      kdia := -1;

    DiagonalAngle := ArcTan2( OrigHeight * kdia, OrigWidth );
    Rotation := IEDegreesToRadians( Angle );

    if Rotation > Pi / 2 then
      Rotation := Rotation - Pi;

    if Rotation < -Pi / 2 then
      Rotation := Rotation + Pi;

    NewDiagonalAngle := DiagonalAngle + Rotation;
    l1 := kdia * OrigHeight / Cos( Pi / 2 - DiagonalAngle );
    h1 := kdia * OrigHeight / Cos( Pi / 2 - NewDiagonalAngle );
    w1 := OrigWidth / Cos( NewDiagonalAngle );

    ScaleBy := max( ScaleBy, max( l1 / h1, l1 / w1 ));
  end;

  NewWidth  := Trunc( OrigWidth / ScaleBy );
  NewHeight := Trunc( OrigHeight / ScaleBy );
end;


{!!
<FS>TImageEnProc.RotateAndCrop

<FM>Declaration<FC>
procedure RotateAndCrop(Angle: Double; AntiAliasMode: <A TIEAntialiasMode> = ierFast; Rate: Double = 1.3; CropAlgorithm: <A TIECropAlgorithm> = iecaSkewedDocument);

<FM>Description<FN>
Rotates the image by the specified angle and crops the borders of the original bitmap. It is useful to deskew an image if you know the rotation angle.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>Angle<FN></C> <C>Rotation angle. Must be in the range -180 and +180 degrees (specified as counter-clockwise, i.e. RotateAndCrop(45) means rotated 45° left).</C> </R>
<R> <C><FC>AntiAliasMode<FN></C> <C>Specifies the <L TIEAntialiasMode>anti-aliasing algorithm</L> that is used to improve rotation quality.</C> </R>
<R> <C><FC>Rate<FN></C> <C>Specifies the approximate quotient of resulting image width and height. For example a landscape image would typically be 1.3, whereas a portrait image would be 0.75. <FB>This value is only needed when Angle is +/-45 or +/-135 and CropAlgorithm is iecaSkewedDocument<FN>.</C> </R>
<R> <C><FC>CropAlgorithm<FN></C> <C>Generally both cropping algorithms will give similar results, but specifying <L TIECropAlgorithm>an appropriate algorithm</L> can improve results at higher rotation levels.</C> </R>
</TABLE>

<FM>Crop Algorithm<FN>
<TABLE>
<R> <H>Value</H> <H>Description</H> </R>
<R> <C><FC>iecaSkewedDocument<FN></C> <C>Works best with documents requiring rotation due to scanning skew (not lined up correctly when scanning) or a previous rotation</C> </R>
<R> <C><FC>iecaAngledPhoto<FN></C> <C>Works best with photos requiring rotation due camera skew (the camera is not quite horizontal)</C> </R>
</TABLE>

If you have this image:
<IMG help_images\77.jpg>

You can determine the required rotation by calling:
<FC>D := ImageEnView1.Proc.SkewDetection;<FN>

Then you can rotate the image using <FC>ImageEnView1.Proc.Rotate(D)<FN>, but you get:
<IMG help_images\78.jpg>

The gray border (which is part of the original bitmap) is rotated with the image. To remove that border you must execute <FC>ImageEnView1.Proc.RotateAndCrop(D)<FN>, so you will have:
<IMG help_images\79.jpg>

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\RotateAndCrop\RotateAndCrop.dpr </C> </R>
</TABLE>

<FM>Examples<FC>
// Detect the skew in an image and automatically rotate and crop it
angle := ImageEnView1.Proc.SkewDetection( ImageEnView1.Bitmap.Width div 4, 30, 0.1, false );
ImageEnView1.Proc.RotateAndCrop( angle );

// Rotate and crop a landscape document by 45 degrees
ImageEnView1.Proc.RotateAndCrop( 45, ierBicubic, 1.3 );

// Rotate and crop a portrait document by 45 degrees
ImageEnView1.Proc.RotateAndCrop( 45, ierBicubic, 0.75 );

// Rotate and crop a digital photo by 5 degrees
ImageEnView1.Proc.RotateAndCrop( 5, ierBicubic, 0, iecaAngledPhoto );
!!}
procedure TImageEnProc.RotateAndCrop(Angle: Double; AntiAliasMode: TIEAntialiasMode = ierFast; Rate: double = 1.3; CropAlgorithm: TIECropAlgorithm = iecaSkewedDocument);
var
  w, h, nw, nh: Integer;
begin
  if not MakeConsistentBitmap([]) then
    exit;
  if fAutoUndo then
    SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
              IERS_ROTATEANDCROP,
              {$ELSE}
              IEMsg( IEMSG_ROTATEANDCROP ) + Format( ' %d°', [ Trunc( ImageEnRotateAngleToAngle( Angle ))]),
              {$ENDIF}
              ieuImage, True, IEOP_ROTATEANDCROP );

  w := fIEBitmap.width;
  h := fIEBitmap.height;
  Rotate(Angle, AntialiasMode);

  if CropAlgorithm = iecaAngledPhoto then
    CalcUnRotateSize_Photo(w, h, Angle, nw, nh)
  else
    CalcUnRotateSize_Document(w, h, Angle, Rate, nw, nh);
  ImageResize(nw, nh, iehCenter, ievCenter); // calls Update and FinishWork
end;
     
{$ifdef IEIncludeDeprecatedInV4}
// Deprecated in 5.0.0
procedure TImageEnProc.RotateAndCrop(Angle: Double; AntiAlias: Boolean; AntiAliasMode: TIEAntialiasMode; Rate: Double);
begin
  if AntiAlias then
    RotateAndCrop(Angle, AntiAliasMode, Rate)
  else
    RotateAndCrop(Angle, ierNone, Rate);
end;
{$endif}

{!!
<FS>TImageEnProc.Deinterlace

<FM>Declaration<FC>
procedure Deinterlace(mode: <A TIEDeinterlaceMode>);

<FM>Description<FN>
Deinterlaces the current image using the specified algorithm.
!!}
procedure TImageEnProc.Deinterlace(mode: TIEDeinterlaceMode);
var
  row, col: Integer;
  w, h: Integer;
  px1, px2: PRGB;
  i1, i2: Integer;
  d: Double;
  RedToGrayCoef, GreenToGrayCoef, BlueToGrayCoef: Integer;
begin
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  if fAutoUndo then
    SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
              IERS_DEINTERLACE,
              {$ELSE}
              IEMsg( IEMSG_DEINTERLACE ),
              {$ENDIF}
              ieuImage, True, IEOP_DEINTERLACE );

  case mode of
    iedDiscard:
      begin
        // just discard one row every two
        row := fIEBitmap.Height - 1;
        while row>1 do
        begin
          CopyMemory( fIEBitmap.Scanline[row-1], fIEBitmap.Scanline[row], fIEBitmap.Rowlen );
          dec(row, 2);
        end;
      end;
    iedIntelliMerge:
      begin
        // merge only if the two fields are similar (less movement)
        RedToGrayCoef   := IEGlobalSettings().RedToGrayCoef;
        GreenToGrayCoef := IEGlobalSettings().GreenToGrayCoef;
        BlueToGrayCoef  := IEGlobalSettings().BlueToGrayCoef;
        w := fIEBitmap.Width;
        h := fIEBitmap.Height;
        d := 0;
        row := 0;
        while row < h - 2 do
        begin
          px1 := fIEBitmap.Scanline[row];
          px2 := fIEBitmap.Scanline[row + 1];
          for col := 0 to w-1 do
          begin
            with px1^ do
              i1 := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;
            with px2^ do
              i2 := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;
            d := d + sqrt(sqr(i1 - i2));
            inc(px1);
            inc(px2);
          end;
          inc(row, 2);
        end;
        d := d / (w * h);
        if d > 5 then
          Deinterlace(iedDiscard)
        else
        begin
          beep;
        end;
      end;
  end;

  DoFinishWork;
  Update;

end;

// output will ie8g or ie24RGB (when locaton is ieTBitmap)
// doesn't produce a black & white edge map (suggested _ConvertToBWThreshold(-2))
procedure IESobel(bitmap: TIEBitmap; OnProgress: TIEProgressEvent; Sender: TObject);
var
  i, j, n, m: Integer;
  x: TIEBitmap;
  w, h: Integer;
  p1: pbyte;
  p2: PRGB;
  i0, i1, i2, i3, i4, i5, i6, i7: pbyte;
begin
  w := bitmap.Width;
  h := bitmap.Height;

  x := TIEBitmap.Create(w, h, ie8g);
  x.CopyAndConvertFormat(bitmap);

  if bitmap.Location=ieTBitmap then
  begin
    // out is ie24RGB
    bitmap.Allocate(w, h, ie24RGB);
    bitmap.Fill(0); // to clear unset areas (left, top, right, bottom borders)
    for i := 1 to h-2 do
    begin
      p2 := bitmap.Scanline[i]; inc(p2);
      i0 := x.Scanline[i-1]; inc(i0, 2); // j+1, i-1
      i1 := x.Scanline[i]; inc(i1, 2);   // j+1, i
      i2 := x.Scanline[i+1]; inc(i2, 2); // j+1, i+1
      i3 := x.Scanline[i-1]; // j-1, i-1
      i4 := x.Scanline[i];   // j-1, i
      i5 := x.Scanline[i+1]; // j-1, i+1
      i6 := x.Scanline[i+1]; inc(i6); // j, i+1
      i7 := x.Scanline[i-1]; inc(i7); // j, i-1
      for j := 1 to w-2 do
      begin
        n := (i0^ + 2*i1^ + i2^) -
             (i3^ + 2*i4^ + i5^);
        m := (i5^ + 2*i6^ + i2^) -
             (i3^ + 2*i7^ + i0^);
        with p2^ do
        begin
          r := trunc( sqrt( (n*n + m*m) )/4 );
          g := r;
          b := r;
        end;
        inc(p2);
        inc(i0); inc(i1); inc(i2); inc(i3); inc(i4); inc(i5); inc(i6); inc(i7);
      end;
      if assigned(OnProgress) then
        OnProgress(Sender, trunc(i/h*100) );
    end;
  end
  else
  begin
    // out is ie8g
    bitmap.Allocate(w, h, ie8g);
    bitmap.Fill(0); // to clear unset areas (left, top, right, bottom borders)
    for i := 1 to h-2 do
    begin
      p1 := bitmap.Scanline[i]; inc(p1);
      i0 := x.Scanline[i-1]; inc(i0, 2); // j+1, i-1
      i1 := x.Scanline[i]; inc(i1, 2);   // j+1, i
      i2 := x.Scanline[i+1]; inc(i2, 2); // j+1, i+1
      i3 := x.Scanline[i-1]; // j-1, i-1
      i4 := x.Scanline[i];   // j-1, i
      i5 := x.Scanline[i+1]; // j-1, i+1
      i6 := x.Scanline[i+1]; inc(i6); // j, i+1
      i7 := x.Scanline[i-1]; inc(i7); // j, i-1
      for j := 1 to w-2 do
      begin
        n := (i0^ + 2*i1^ + i2^) -
             (i3^ + 2*i4^ + i5^);
        m := (i5^ + 2*i6^ + i2^) -
             (i3^ + 2*i7^ + i0^);
        p1^ := trunc( sqrt( (n*n + m*m) )/4 );
        inc(p1);
        inc(i0); inc(i1); inc(i2); inc(i3); inc(i4); inc(i5); inc(i6); inc(i7);
      end;
      if assigned(OnProgress) then
        OnProgress(Sender, trunc(i/h*100) );
    end;
  end;

  x.free;
end;

{!!
<FS>TImageEnProc.EdgeDetect_Sobel

<FM>Declaration<FC>
procedure EdgeDetect_Sobel;

<FM>Description<FN>
Detects the edges of objects within an image using a Sobel filter.
The result is a gray scale bitmap: high values (closed to 255) are edges.
When <A TIEBitmap.Location> is ieTBitmap, the output pixel format is i24RGB, otherwise it is ie8g.
To make the result black & white (with 1=edge) it is recommended you call <A TImageEnProc.ConvertToBWThreshold> using the parameter -2 (Maximum Entropy Algorithm).

<FM>Example<FC>
ImageEnView1.Proc.EdgeDetect_Sobel;
ImageEnView1.proc.ConvertToBWThreshold(-2);
!!}
procedure TImageEnProc.EdgeDetect_Sobel;
begin
  if not MakeConsistentBitmap([]) then
    exit;
  if fAutoUndo then
    SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
              IERS_EDGEDETECT_SOBEL,
              {$ELSE}
              IEMsg( IEMsg_EDGEDETECT ),
              {$ENDIF}
              ieuImage, True, IEOP_EDGEDETECT_SOBEL );
  IESobel(fIEBitmap, fOnProgress, self);
  Update;
  DoFinishWork;
end;

function TImageEnProc.GetDPIX: Integer;
begin
  if assigned( fImageEnView ) and ( fImageEnView is TImageEnView ) then
    result := TImageEnView( fImageEnView ).IO.Params.DpiX
  else
    result := IEGlobalSettings().DefaultDPIX;
end;

function TImageEnProc.GetDPIY: Integer;
begin
  if assigned( fImageEnView ) and ( fImageEnView is TImageEnView ) then
    result := TImageEnView( fImageEnView ).IO.Params.DpiY
  else
    result := IEGlobalSettings().DefaultDPIY;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////
// Local adaptation tone mapping
// by Irwin Scollar

const NaN = 0.0/0.0;

type TISCommonData = record
  filter: array[0..6] of double;
  M: array[0..8] of double;
  MeanLuminance2: Double;
  pr: TProgressRec;
end;

function ISMakeLuminanceBitmap(var context: TISCommonData; SourceBitmap: TIEBitmap): TIEBitmap;
const
  one255 = 1 / 255;
var
  x, y: Integer;
  Source: pRGB;
  Luminance: pSingle;
  w1, h1: Integer;
  YY, Cb, Cr: Integer;
  MeanLuminance: Double;
begin

  with context do
  begin

    result := TIEBitmap.Create(SourceBitmap.Width, SourceBitmap.Height, ie32f);
    result.Fill(0);
    w1 := result.Width - 1;
    h1 := result.Height - 1;
    MeanLuminance := 0.0;

    for y := 0 to h1 do
    begin
      Source := SourceBitmap.ScanLine[y];
      Luminance := result.Scanline[y];

      for x := 0 to w1 do
      begin
        IERGB2YCbCr(Source^, YY, Cb, Cr);
        Luminance^ := YY * one255;
        MeanLuminance := MeanLuminance + Luminance^;
        inc(Source);
        inc(Luminance);
      end;

      if assigned(pr.fOnProgress) then
        pr.fOnProgress(pr.Sender, pr.tot+trunc(y/h1*pr.per1*100) );

    end;

    MeanLuminance2 := (0.5 * MeanLuminance) / (w1 * h1);

    inc(pr.tot, trunc(pr.per1*100));
  end;
end;

procedure ISTriggsM(var context: TISCommonData);
var
  scale: Double;
  a1, a2, a3: Double;

begin

  with context do
  begin

    a3 := filter[0];
    a2 := filter[1];
    a1 := filter[2];

    scale := 1.0 / ((1.0 + a1 - a2 + a3) * (1.0 - a1 - a2 - a3) * (1.0 + a2 + (a1 - a3) * a3));
    M[0] := scale * (-a3 * a1 + 1.0 - a3 * a3 - a2);
    M[1] := scale * (a3 + a1) * (a2 + a3 * a1);
    M[2] := scale * a3 * (a1 + a3 * a2);
    M[3] := scale * (a1 + a3 * a2);
    M[4] := -scale * (a2 - 1.0) * (a2 + a3 * a1);
    M[5] := -scale * a3 * (a3 * a1 + a3 * a3 + a2 - 1.0);
    M[6] := scale * (a3 * a1 + a2 + a1 * a1 - a2 * a2);
    M[7] := scale * (a1 * a2 + a3 * a2 * a2 - a1 * a3 * a3 - a3 * a3 * a3 - a3 * a2 + a3);
    M[8] := scale * a3 * (a1 + a3 * a2);

  end;
end;

procedure ISYvVfilterCoef(var context: TISCommonData; sigma: Double);
const
  m0 = 1.16680;
  m1 = 1.10783;
  m2 = 1.40586;
  m1sq = m1 * m1;
  m2sq = m2 * m2;
var
  q, qsq, 
  scale, 
  B, b1, b2, b3: Double;
begin

  with context do
  begin

    if (sigma < 3.556) then
      q := -0.2568 + 0.5784 * sigma + 0.0561 * sigma * sigma
    else
      q := 2.5091 + 0.9804 * (sigma - 3.556);

    qsq := q * q;

    scale := (m0 + q) * (m1sq + m2sq + 2 * m1 * q + qsq);
    b1 := -q * (2 * m0 * m1 + m1sq + m2sq + (2 * m0 + 4 * m1) * q + 3 * qsq) / scale;
    b2 := qsq * (m0 + 2 * m1 + 3 * q) / scale;
    b3 := -qsq * q / scale;

    B := (m0 * (m1sq + m2sq)) / scale;

    filter[0] := -b3;
    filter[1] := -b2;
    filter[2] := -b1;
    filter[3] := B;
    filter[4] := -b1;
    filter[5] := -b2;
    filter[6] := -b3;

  end;
end;

function ISGaussX(var context: TISCommonData; SourceBitmap: TIEBitmap): TIEBitmap;
var
  x, y: Integer;
  w1, h1: Integer;
  sum, sumsq, b1, b2, b3, iplus, uplus, vplus, unp, unp1, unp2, 
  pix, p1, p2, p3: Double;
  Source, Dest: psingle;
  denom1, denom2: Double;
begin

  with context do
  begin

    w1 := SourceBitmap.Width - 1;
    h1 := SourceBitmap.Height - 1;
    result := TIEBitmap.Create(SourceBitmap.Width, SourceBitmap.Height, ie32f);
    result.Fill(0);

    sumsq := filter[3];
    sum := sumsq * sumsq;

    for y := 0 to h1 do
    begin
      Source := SourceBitmap.ScanLine[y];
      Dest := result.ScanLine[y];
      b1 := filter[2];
      b2 := filter[1];
      b3 := filter[0];
      denom1 := 1 / (1.0 - b1 - b2 - b3);
      p1 := Source^ / sumsq;
      p2 := p1;
      p3 := p1;
      for x := 0 to w1 do
      begin
        pix := Source^ + b1 * p1 + b2 * p2 + b3 * p3;
        dest^ := pix;
        p3 := p2;
        p2 := p1;
        p1 := pix;
        inc(Source);
        inc(Dest);
      end;

      dec(Source, 3);
      iplus := Source^;
      dec(Dest);

      uplus := iplus * denom1;
      b1 := filter[4];
      b2 := filter[5];
      b3 := filter[6];
      denom2 := 1 / (1.0 - b1 - b2 - b3);
      vplus := uplus * denom2;

      unp := p1 - uplus;
      unp1 := p2 - uplus;
      unp2 := p3 - uplus;

      pix := sum * (M[0] * unp + M[1] * unp1 + M[2] * unp2 + vplus);
      p1 := sum * (M[3] * unp + M[4] * unp1 + M[5] * unp2 + vplus);
      p2 := sum * (M[6] * unp + M[7] * unp1 + M[8] * unp2 + vplus);

      dest^ := pix;
      dec(Dest);
      p3 := p2;
      p2 := p1;
      p1 := pix;

      for x := w1 - 2 downto 0 do
      begin
        pix := sum * dest^ + b1 * p1 + b2 * p2 + b3 * p3;
        dest^ := pix;
        p3 := p2;
        p2 := p1;
        p1 := pix;
        dec(Dest);
      end;

      if assigned(pr.fOnProgress) then
        pr.fOnProgress(pr.Sender, pr.tot+trunc(y/h1*pr.per1*100) );

    end;

    inc(pr.tot, trunc(pr.per1*100));

  end;

end;

function ISGaussY(var context: TISCommonData; SourceBitmap: TIEBitmap): TIEBitmap;
var
  x, y: Integer;
  w1, h1: Integer;
  sum, sumsq, b1, b2, b3, uplus, vplus, 
    onesumsq, unp, unp1, unp2, pix, denom1: Double;
  buf0, buf1, buf2, buf3, uplusbuf: array of single;
  p0, p1, p2, p3: psinglearray;
  pswap: psinglearray;
  Source, Dest: psingle;
  MeanLuminance: Double;
begin
  with context do
  begin
    dest := nil;

    w1 := SourceBitmap.Width - 1;
    h1 := SourceBitmap.Height - 1;

    result := TIEBitmap.Create(SourceBitmap.Width, SourceBitmap.Height, ie32f);
    result.Fill(0);

    sumsq := filter[3];
    onesumsq := 1 / sumsq;
    sum := sumsq * sumsq;
    MeanLuminance := MeanLuminance2;

    SetLength(buf0, SourceBitmap.Width);
    SetLength(buf1, SourceBitmap.Width);
    SetLength(buf2, SourceBitmap.Width);
    SetLength(buf3, SourceBitmap.Width);
    SetLength(uplusbuf, SourceBitmap.Width);
    
    p0 := @buf0[0];
    p1 := @buf1[0];
    p2 := @buf2[0];
    p3 := @buf3[0];

    b1 := filter[2];
    b2 := filter[1];
    b3 := filter[0];

    Source := SourceBitmap.ScanLine[0];
    for x := 0 to w1 do
    begin
      pix := Source^ * onesumsq;
      inc(Source);
      p1[x] := pix;
      p2[x] := pix;
      p3[x] := pix;
    end;

    denom1 := 1 / (1.0 - b1 - b2 - b3);
    Source := SourceBitmap.ScanLine[h1];
    for x := 0 to w1 do
    begin
      uplusbuf[x] := Source^ * denom1;
      inc(Source);
    end;

    for y := 0 to h1 do
    begin
      Source := SourceBitmap.ScanLine[y];
      Dest := result.ScanLine[y];
      for x := 0 to w1 do
      begin
        pix := Source^ + b1 * p1[x] + b2 * p2[x] + b3 * p3[x];
        inc(Source);
        dest^ := pix;
        inc(Dest);
        p0[x] := pix;
      end;

      pswap := p3;
      p3 := p2;
      p2 := p1;
      p1 := p0;
      p0 := pswap;

      if assigned(pr.fOnProgress) then
        pr.fOnProgress(pr.Sender, pr.tot+trunc(y / h1 * pr.per1 * 100) );

    end;
    inc(pr.tot, trunc(pr.per1*100));

    b1 := filter[4];
    b2 := filter[5];
    b3 := filter[6];

    p0 := @uplusbuf[0];
    denom1 := 1 / (1.0 - b1 - b2 - b3);

    for x := w1 downto 0 do
    begin
      uplus := p0[x];
      vplus := uplus * denom1;

      unp := p1[x] - uplus;
      unp1 := p2[x] - uplus;
      unp2 := p3[x] - uplus;

      pix := M[0] * unp + M[1] * unp1 + M[2] * unp2 + vplus;
      pix := pix + sum;

      dec(Dest);
      Dest^ := pix;

      p1[x] := pix;

      pix := M[3] * unp + M[4] * unp1 + M[5] * unp2 + vplus;
      p2[x] := pix * sum;

      pix := M[6] * unp + M[7] * unp1 + M[8] * unp2 + vplus;
      p3[x] := pix * sum;
    end;

    for y := h1 - 2 downto 0 do
    begin
      Dest := result.ScanLine[y];
      inc(Dest, w1);
      for x := w1 downto 0 do
      begin
        pix := sum * dest^ + b1 * p1[x] + b2 * p2[x] + b3 * p3[x];
        dest^ := pix + MeanLuminance;
        dec(Dest);
        p0[x] := pix;
      end;

      pswap := p3;
      p3 := p2;
      p2 := p1;
      p1 := p0;
      p0 := pswap;

      if assigned(pr.fOnProgress) then
        pr.fOnProgress(pr.Sender, pr.tot + trunc((h1 - y) / h1 * pr.per1 * 100) );
    end;
    inc(pr.tot, trunc(pr.per1 * 100));

  end;
end;

function ISNRprocess(var context: TISCommonData; InputBitmap, X0Bitmap: TIEBitmap): TIEBitmap;
var
  x, y: Integer;
  w1, h1: Integer;
  Input, X0, NR: pSingle;
  NewInputMean2: Double;
begin

  with context do
  begin

    w1 := InputBitmap.Width - 1;
    h1 := InputBitmap.Height - 1;
    result := TIEBitmap.Create(InputBitmap.Width, InputBitmap.Height, ie32f);
    result.Fill(0);

    NewInputMean2 := 0.0;

    for y := 0 to h1 do
    begin
      Input := InputBitmap.ScanLine[y];
      X0 := X0Bitmap.ScanLine[y];
      NR := result.Scanline[y];
      for x := 0 to w1 do
      begin
        if ((Input^ + X0^) > 0) then
        begin
          NR^ := ((1 + x0^) * Input^) / (Input^ + X0^);
          NewInputMean2 := NewInputMean2 + NR^;
        end;
        inc(Input);
        inc(X0);
        inc(NR);
      end;
      if assigned(pr.fOnProgress) then
        pr.fOnProgress(pr.Sender, pr.tot+trunc(y/h1*pr.per1*100) );
    end;
    inc(pr.tot, trunc(pr.per1*100));
    MeanLuminance2 := (0.5 * NewInputMean2) / (w1 * h1);

  end;
end;

procedure ISBuildLUT(AValue: Double; var LUT: array of byte);
var
  C1: Integer;
begin
  for C1 := 0 to 255 do
    LUT[C1] := blimit(Round(Power(C1 / 255, 1 / AValue) * 255));
end;

function ISRestoreChrominance(var context: TISCommonData; Gamma: Double; Gamma2: Double; SourceBitmap: TIEBitmap; LuminanceBitmap, NRBitmap: TIEBitmap): TIEBitmap;
const
  one255 = 1 / 255;
var
  x, y: Integer;
  Source, Target: pRGB;
  NR: pSingle;
  Lum: pSingle;
  w1, h1: Integer;
  GammaLUT, GammaLUT2: array[0..255] of byte;
  Ratio: Double;
  LUTSource: TRGB;
  Ygamma: Double;

begin

  with context do
  begin

    ISBuildLUT(Gamma, GammaLUT);
    GammaLUT[0] := 1;

    ISBuildLUT(Gamma2, GammaLUT2);

    w1 := NRBitmap.Width - 1;
    h1 := NRBitmap.Height - 1;
    result := TIEBitmap.Create(SourceBitmap.Width, SourceBitmap.Height, ie24RGB);

    for y := 0 to h1 do
    begin
      Source := SourceBitmap.ScanLine[y];
      NR := NRBitmap.ScanLine[y];
      Lum := LuminanceBitmap.ScanLine[y];
      Target := result.Scanline[y];

      for x := 0 to w1 do
      begin
        LUTSource.r := GammaLUT[Source^.r];
        LUTSource.g := GammaLUT[Source^.g];
        LUTSource.b := GammaLUT[Source^.b];

        YGamma := GammaLUT[trunc(Lum^ * 255)];
        Ratio := (NR^ * 255) / YGamma;

        Target^.r := GammaLUT2[blimit(trunc(LUTSource.r * ratio))];
        Target^.g := GammaLUT2[blimit(trunc(LUTSource.g * ratio))];
        Target^.b := GammaLUT2[blimit(trunc(LUTSource.b * ratio))];

        inc(Source);
        inc(Lum);
        inc(NR);
        inc(Target);
      end;

      if assigned(pr.fOnProgress) then
        pr.fOnProgress(pr.Sender, pr.tot+trunc(y/h1*pr.per1*100) );
    end;
    inc(pr.tot, trunc(pr.per1*100));

  end;

end;

procedure IELuminanceEnhancement(Bitmap: TIEBitmap; Gamma: Double; Saturation: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
var
  context: TISCommonData;
  LuminanceBitmap: TIEBitmap;
  X0Bitmap, X1Bitmap, X01Bitmap, X02Bitmap, NRBitmap, NR2Bitmap: TIEBitmap;
  r: TIEBitmap;
  prevAlpha: TIEBitmap;
begin
  with context do
  begin

    pr.fOnProgress := OnProgress;
    pr.Sender := Sender;
    pr.val := 0;

    FillChar(Filter, SizeOf(Filter), #0);
    FillChar(M, SizeOf(M), #0);

    prevAlpha := Bitmap.DetachAlphaChannel();

    Bitmap.Resize(Bitmap.Width + 8, Bitmap.Height + 8, 0.5, 255, iehRight, ievTop);

    pr.tot := 0;
    pr.per1 := 0.09;
    LuminanceBitmap := ISMakeLuminanceBitmap(context, Bitmap);

    ISYvVfilterCoef(context, 3.0);
    ISTriggsM(context);

    X1Bitmap := ISGaussX(context, LuminanceBitmap);
    X0Bitmap := ISGaussY(context, X1Bitmap);
    X1Bitmap.Free;

    NRBitmap := ISNRprocess(context, LuminanceBitmap, X0Bitmap);
    X0Bitmap.Free;

    ISYvVfilterCoef(context, 1.5);
    ISTriggsM(context);

    X01Bitmap := ISGaussX(context, NRBitmap);
    X02Bitmap := ISGaussY(context, X01Bitmap);
    X01Bitmap.Free;

    NR2Bitmap := ISNRprocess(context, NRBitmap, X02Bitmap);
    NRBitmap.Free;
    X02Bitmap.Free;

    r := ISRestoreChrominance(context, 2.2, Gamma, Bitmap, LuminanceBitmap, NR2Bitmap);
    LuminanceBitmap.Free;
    NR2Bitmap.Free;

    IEAdjustSaturation(r, Saturation, pr);
    r.Resize(r.Width - 8, r.Height - 8, 0.5, 255, iehRight, ievTop);

    Bitmap.Assign(r);
    Bitmap.ReplaceAlphaChannel(prevAlpha);
    r.Free;

  end;

end;

{!!
<FS>TImageEnProc.AutoImageEnhance3

<FM>Declaration<FC>
procedure AutoImageEnhance3(Gamma: Double = 0.35; Saturation: Integer = 80);

<FM>Description<FN>
Enhances luminosity by applying a local adaptation tone mapping algorithm (thanks to Prof. Irwin Scollar).

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>Gamma<FN></C> <C>Adjust the resulting luminosity. Value must be more than 0</C> </R>
<R> <C><FC>Saturation<FN></C> <C>Adjusts the color saturation. Allowed values: -100 to 100</C> </R>
</TABLE>

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\ImageEditing\AutoEnhance\AutoAdjust.dpr </C> </R>
</TABLE>

<FM>Example<FC>
ImageEnView1.Proc.AutoImageEnhance3;

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AutoImageEnhance1></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AutoImageEnhance2></C> </R>
</TABLE>

!!}
procedure TImageEnProc.AutoImageEnhance3(Gamma: Double = 0.35; Saturation: Integer = 80);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing( [ie24RGB], x1, y1, x2, y2,
                               {$IFDEF IEUseLegacyUndoCaptions}
                               Format(IERS_AUTOIMAGEENHANCE3, [Gamma, Saturation]),
                               {$ELSE}
                               IEMsg( IEMsg_AutoEnhance ),
                               {$ENDIF}
                               ProcBitmap, mask, IEOP_AUTOIMAGEENHANCE3 ) then
    exit;
  IELuminanceEnhancement(ProcBitmap, Gamma, Saturation, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


// end of "Local adaptation tone mapping"
/////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////

function IEGetVisibleArea(Bitmap: TIEBitmap; OnProgress: TIEProgressEvent; Sender: TObject): TRect;
var
  x, y: Integer;
  pb: pbyte;
  w, h: Integer;
  endloop: Boolean;
begin
  w := Bitmap.Width;
  h := Bitmap.Height;
  with result do
  begin
    Left   := 0;
    Top    := 0;
    Right  := w - 1;
    Bottom := h - 1;
    if Bitmap.HasAlphaChannel then
    begin
      // left
      endloop := false;
      while Left < w do
      begin
        for y := 0 to h-1 do
        begin
          pb := Bitmap.AlphaChannel.Scanline[y];
          inc(pb, Left);
          if pb^ > 0 then
          begin
            endloop := true;
            break;
          end;
        end;
        if endloop then
          break;
        inc(Left);
      end;
      // right
      endloop := false;
      while Right >= 0 do
      begin
        for y := 0 to h-1 do
        begin
          pb := Bitmap.AlphaChannel.Scanline[y];
          inc(pb, Right);
          if pb^ > 0 then
          begin
            endloop := true;
            break;
          end;
        end;
        if endloop then
          break;
        dec(Right);
      end;
      // top
      endloop := false;
      while Top < h do
      begin
        pb := Bitmap.AlphaChannel.Scanline[Top];
        for x := 0 to w-1 do
        begin
          if pb^ > 0 then
          begin
            endloop := true;
            break;
          end;
          inc(pb);
        end;
        if endloop then
          break;
        inc(Top);
      end;
      // bottom
      endloop := false;
      while Bottom >= 0 do
      begin
        pb := Bitmap.AlphaChannel.Scanline[Bottom];
        for x := 0 to w-1 do
        begin
          if pb^ > 0 then
          begin
            endloop := true;
            break;
          end;
          inc(pb);
        end;
        if endloop then
          break;
        dec(Bottom);
      end;
    end;
  end;
end;


{!!
<FS>TImageEnProc.CropTransparentBorder

<FM>Declaration<FC>
procedure CropTransparentBorder;

<FM>Description<FN>
Removes any transparent area on the edge of the image, resizing the resulting image to the visible rectangle.

<FM>Example<FC>
// Add text to a layer and then remove the transparent area around the text

// add a new layer
ImageEnView1.LayersAdd;

// White fill the new layer
ImageEnView1.Proc.Fill(CreateRGB(255, 255, 255));

// Output our text
ImageEnView1.Proc.TextOut(Align_Text_Horz_Center, Align_Text_Near_Bottom, ExtractFileName(ImageEnView1.IO.Params.Filename), 'Arial', 32, clRed, [fsBold]);

// Make the white background transparent
ImageEnView1.Proc.SetTransparentColors(CreateRGB(255, 255, 255), CreateRGB(255, 255, 255), 0); // remove the white, making it as transparent

// Crop to the text size
ImageEnView1.Proc.CropTransparentBorder;

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AutoCrop></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.AutoCrop2></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.Crop></C> </R>
<R> <C_IMG_METHOD> <C>TIEBitmap.CropAlpha</C> </R>
</TABLE>
!!}
procedure TImageEnProc.CropTransparentBorder;
var
  r: TRect;
  lAutoUndo: Boolean;
begin
  if not MakeConsistentBitmap([]) then
    exit;
  r := IEGetVisibleArea(fIEBitmap, nil, nil);
  if ( r.Right < 0 ) or ( r.Bottom < 0 ) then
    exit; // Nothing to crop
  lAutoUndo := fAutoUndo;
  fAutoUndo := false;
  Crop(r);
  fautoUndo := lAutoUndo;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// TEA Tiny Encryption Algorithm

procedure IETEAEncipher64(v, w, k: pdwordarray);
var
  y, z, sum, delta, a, b, c, d, n: cardinal;
begin
  y := v[0];
  z := v[1];
  sum := 0;
  delta := $9E3779B9;
  a := k[0];
  b := k[1];
  c := k[2];
  d := k[3];
  for n := 32 downto 1 do
  begin
    inc(sum , delta);
    inc(y , (z shl 4) + a xor z + sum xor (z shr 5) + b);
    inc(z , (y shl 4) + c xor y + sum xor (y shr 5) + d);
  end;
  w[0] := y;
  w[1] := z;
end;

procedure IETEADecipher64(v, w, k: pdwordarray);
var
  y, z, sum, delta, a, b, c, d, n: cardinal;
begin
  y := v[0];
  z := v[1];
  sum := $C6EF3720;
  delta := $9E3779B9;
  a := k[0];
  b := k[1];
  c := k[2];
  d := k[3];
  for n := 32 downto 1 do
  begin
    dec(z , (y shl 4) + c xor y + sum xor (y shr 5) + d );
    dec(y , (z shl 4) + a xor z + sum xor (z shr 5) + b );
    dec(sum , delta);
  end;
  w[0] := y;
  w[1] := z;
end;


// for sizes or exceeds less than 64 (22 pixels in RGB) width uses XOR, otherwise uses TEA algorithm
procedure IEEncipherBitmap_TEA2(Bitmap: TIEBitmap; key: pdwordarray; OnProgress: TIEProgressEvent; Sender: TObject);
var
  row, col, i, c: Integer;
  ww, hh: Integer;
  pb: pbyte;
  buf: array [0..7] of byte;
  ckey: array [0..3] of dword;
  rand: TIERandomGenerator;
begin
  rand := TIERandomGenerator.Create(key[0], key[1], key[2], key[3]);
  try
    ww := IEBitmapRowlen(Bitmap.Width, Bitmap.BitCount, 8);
    hh := Bitmap.Height;
    for row := 0 to hh - 1 do
    begin
      pb := Bitmap.Scanline[row];
      col := 0;
      while col < ww do
      begin
        c := imin(8, ww - col);
        CopyMemory(@buf[0], pb, c);
        if c < 8 then
        begin
          for i := 0 to c - 1 do
            buf[i] := buf[i] xor pbytearray(key)[i];
        end
        else
        begin
          ckey[0] := rand.NextDWORD();
          ckey[1] := rand.NextDWORD();
          ckey[2] := rand.NextDWORD();
          ckey[3] := rand.NextDWORD();
          IETEAEncipher64(pdwordarray(@buf[0]), pdwordarray(@buf[0]), @ckey[0]);
        end;
        CopyMemory(pb, @buf[0], c);
        inc(pb, c);
        inc(col, c);
      end;
      if assigned(OnProgress) then
        OnProgress(Sender, trunc(row / hh * 100));
    end;
  finally
    rand.Free();
  end;
end;

procedure IEDecipherBitmap_TEA2(Bitmap: TIEBitmap; key: pdwordarray; OnProgress: TIEProgressEvent; Sender: TObject);
var
  row, col, i, c: Integer;
  ww, hh: Integer;
  pb: pbyte;
  buf: array [0..7] of byte;
  ckey: array [0..3] of dword;
  rand: TIERandomGenerator;
begin
  rand := TIERandomGenerator.Create(key[0], key[1], key[2], key[3]);
  try
    ww := IEBitmapRowlen(Bitmap.Width, Bitmap.BitCount, 8);
    hh := Bitmap.Height;
    for row := 0 to hh - 1 do
    begin
      pb := Bitmap.Scanline[row];
      col := 0;
      while col < ww do
      begin
        c := imin(8, ww - col);
        CopyMemory(@buf[0], pb, c);
        if c < 8 then
        begin
          for i := 0 to c - 1 do
            buf[i] := buf[i] xor pbytearray(key)[i];
        end
        else
        begin
          ckey[0] := rand.NextDWORD();
          ckey[1] := rand.NextDWORD();
          ckey[2] := rand.NextDWORD();
          ckey[3] := rand.NextDWORD();
          IETEADecipher64(pdwordarray(@buf[0]), pdwordarray(@buf[0]), @ckey[0]);
        end;
        CopyMemory(pb, @buf[0], c);
        inc(pb, c);
        inc(col, c);
      end;
      if assigned(OnProgress) then
        OnProgress(Sender, trunc(row / hh * 100));
    end;
  finally
    rand.Free();
  end;
end;




// for sizes or exceeds less than 64 (22 pixels in RGB) width uses XOR, otherwise uses TEA algorithm
procedure IEEncipherBitmap_TEA(Bitmap: TIEBitmap; key: pdwordarray; OnProgress: TIEProgressEvent; Sender: TObject);
var
  row, col, i, c: Integer;
  ww, hh: Integer;
  pb: pbyte;
  buf: array [0..7] of byte;
begin
  ww := IEBitmapRowlen(Bitmap.Width, Bitmap.BitCount, 8);
  hh := Bitmap.Height;
  for row := 0 to hh - 1 do
  begin
    pb := Bitmap.Scanline[row];
    col := 0;
    while col < ww do
    begin
      c := imin(8, ww - col);
      CopyMemory(@buf[0], pb, c);
      if c < 8 then
      begin
        for i := 0 to c - 1 do
          buf[i] := buf[i] xor pbytearray(key)[i];
      end
      else
        IETEAEncipher64(pdwordarray(@buf[0]), pdwordarray(@buf[0]), key);
      CopyMemory(pb, @buf[0], c);
      inc(pb, c);
      inc(col, c);
    end;
    if assigned(OnProgress) then
      OnProgress(Sender, trunc(row / hh * 100));
  end;
end;

procedure IEDecipherBitmap_TEA(Bitmap: TIEBitmap; key: pdwordarray; OnProgress: TIEProgressEvent; Sender: TObject);
var
  row, col, i, c: Integer;
  ww, hh: Integer;
  pb: pbyte;
  buf: array [0..7] of byte;
begin
  ww := IEBitmapRowlen(Bitmap.Width, Bitmap.BitCount, 8);
  hh := Bitmap.Height;
  for row := 0 to hh - 1 do
  begin
    pb := Bitmap.Scanline[row];
    col := 0;
    while col < ww do
    begin
      c := imin(8, ww - col);
      CopyMemory(@buf[0], pb, c);
      if c < 8 then
      begin
        for i := 0 to c - 1 do
          buf[i] := buf[i] xor pbytearray(key)[i];
      end
      else
        IETEADecipher64(pdwordarray(@buf[0]), pdwordarray(@buf[0]), key);
      CopyMemory(pb, @buf[0], c);
      inc(pb, c);
      inc(col, c);
    end;
    if assigned(OnProgress) then
      OnProgress(Sender, trunc(row / hh * 100));
  end;
end;

procedure IECreatePasskey(Passkey: AnsiString; var key: array of byte);
var
  i: Integer;
  pd: pdwordarray;
begin
  pd := @(key[0]);
  for i := 0 to 3 do
    pd[i] := 0;
  for i := 1 to length(Passkey) do
  begin
    pd[0] := ord(Passkey[i]) + (pd[0] shl 3) + (pd[0] shl 13) - pd[0];
    pd[1] := ord(Passkey[i]) + (pd[1] shl 4) + (pd[1] shl 14) - pd[1];
    pd[2] := ord(Passkey[i]) + (pd[2] shl 5) + (pd[2] shl 15) - pd[2];
    pd[3] := ord(Passkey[i]) + (pd[3] shl 6) + (pd[3] shl 16) - pd[3];
  end;
end;


// End of TEA Tiny Encryption Algorithm
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

{!!
<FS>TImageEnProc.Encrypt

<FM>Declaration<FC>
procedure Encrypt(Passkey: AnsiString; Algorithm: <A TIEEncryptionAlgorithm> = ieeaTEA);
procedure Encrypt(Passkey: array of byte; Algorithm: <A TIEEncryptionAlgorithm> = ieeaTEA);

<FM>Description<FN>
Encrypts the current image (layer) using the TEA Tiny Encryption Algorithm with a key of 128 bits.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>PassKey<FN></C> <C>If using a string you should specify a string password, which will be hashed to a 128 bits key.
If using an array of bytes you should specify a binary key of 16 bytes</C> </R>
<R> <C><FC>Algorithm<FN></C> <C>Either ieeaTEA or ieeaTEA2. We recommend to use ieeaTEA2 for better encryption</C> </R>
</TABLE>

Warning: The image must be saved using a lossless formats and in full rgb color spaces (no palette). If you use a lossy format such as JPEG you will not be able to decrypt the image.

Notes:
- To decrypt use <A TImageEnProc.Decrypt>
- There is no way to know whether an image is encrypted, unless you insert special tags (like EXIF or IPTC) manually.

<FM>Example<FC>
ImageEnView1.IO.LoadFromFile('input.jpg');
ImageEnView1.Proc.Encrypt('captiva', ieeaTEA2);
ImageEnView1.IO.SaveToFile('crypted.png');  // Saving to lossless format

<FM>Demo<FC>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\Other\Encrypt\Encrypt.dpr </C> </R>
</TABLE>
!!}
procedure TImageEnProc.Encrypt(Passkey: array of byte; Algorithm: TIEEncryptionAlgorithm);
begin
  if not MakeConsistentBitmap([]) then
    exit;
  if fAutoUndo then
    SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
              IERS_ENCRYPT,
              {$ELSE}
              IEMsg( IEMSG_ENCRYPT ),
              {$ENDIF}
              ieuImage, True, IEOP_ENCRYPT );

  case Algorithm of
    ieeaTEA:  IEEncipherBitmap_TEA(fIEBitmap, pdwordarray(@Passkey[0]), fOnProgress, self);
    ieeaTEA2: IEEncipherBitmap_TEA2(fIEBitmap, pdwordarray(@Passkey[0]), fOnProgress, self);
  end;

  if fIEBitmap.HasAlphaChannel then
    case Algorithm of
      ieeaTEA:  IEEncipherBitmap_TEA(fIEBitmap.AlphaChannel, pdwordarray(@Passkey[0]), fOnProgress, self);
      ieeaTEA2: IEEncipherBitmap_TEA2(fIEBitmap.AlphaChannel, pdwordarray(@Passkey[0]), fOnProgress, self);
    end;

  Update;
  DoFinishWork;
end;

procedure TImageEnProc.Encrypt(Passkey: AnsiString; Algorithm: TIEEncryptionAlgorithm);
var
  key: array [0..15] of byte;  // 128 bit generated key
begin
  IECreatePasskey(Passkey, key);
  Encrypt(key, Algorithm);
end;



{!!
<FS>TImageEnProc.Decrypt

<FM>Declaration<FC>
procedure Decrypt(Passkey: AnsiString; Algorithm: <A TIEEncryptionAlgorithm> = ieeaTEA);
procedure Decrypt(Passkey: array of byte; Algorithm: <A TIEEncryptionAlgorithm> = ieeaTEA);

<FM>Description<FN>
This function decrypts the current image (layer), which was encrypted using <A TImageEnProc.Encrypt>.
You must specify the same <FC>Passkey<FN> and <FC>Algorithm<FN> that was used for encrypting.

Warning: If you are unable to decrypt an image, ensure it was not saved to a lossy format such as JPEG.

<FM>Example<FC>
ImageEnView1.IO.LoadFromFile('crypted.png');
ImageEnView1.Proc.Decrypt('captiva', ieeaTEA2);

<FM>Demo<FC>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\Other\Encrypt\Encrypt.dpr </C> </R>
</TABLE>
!!}
procedure TImageEnProc.Decrypt(Passkey: array of byte; Algorithm: TIEEncryptionAlgorithm);
begin
  if not MakeConsistentBitmap([]) then
    exit;
  if fAutoUndo then
    SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
              IERS_DECRYPT,
              {$ELSE}
              IEMsg( IEMSG_DECRYPT ),
              {$ENDIF}
              ieuImage, True, IEOP_DECRYPT );

  case Algorithm of
    ieeaTEA:  IEDecipherBitmap_TEA(fIEBitmap, pdwordarray(@Passkey[0]), fOnProgress, self);
    ieeaTEA2: IEDecipherBitmap_TEA2(fIEBitmap, pdwordarray(@Passkey[0]), fOnProgress, self);
  end;

  if fIEBitmap.HasAlphaChannel then
    case Algorithm of
      ieeaTEA:  IEDecipherBitmap_TEA(fIEBitmap.AlphaChannel, pdwordarray(@Passkey[0]), fOnProgress, self);
      ieeaTEA2: IEDecipherBitmap_TEA2(fIEBitmap.AlphaChannel, pdwordarray(@Passkey[0]), fOnProgress, self);
    end;
  Update;
  DoFinishWork;
end;

procedure TImageEnProc.Decrypt(Passkey: AnsiString; Algorithm: TIEEncryptionAlgorithm);
var
  key: array [0..15] of byte;  // 128 bit generated key
begin
  IECreatePasskey(Passkey, key);
  Decrypt(key, Algorithm);
end;



function IEGraphFilterToString(filter: TGraphFilter): String;
var
  i, j: Integer;
begin
  result := '';
  for i := 0 to 2 do
    for j := 0 to 2 do
      result := result+IntToStr(filter.Values[i, j])+'/'+IntToStr(filter.Divisor);
end;


procedure IELocalBinarize(InBitmap, OutBitmap: TIEBitmap; WinSize: Integer; Mode: TIEThreshMode; Offset: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
var
  GrayBitmap: TIEBitmap;
  width, height: Integer;
  i, j: Integer;
  CurrentThreshold: Integer;
  WinSize2: Integer;
  med: array of byte;
  b: Integer;
  p, ps: pbyte;
  prog, lprog: Integer;

  procedure CalcThreshold_MeanMinMax;
  var
    x, y: Integer;
    pb: pbyte;
    max, min: Integer;
  begin
    max := 0; min := 255;
    for y := i-WinSize2+1 to i+WinSize2 do
    begin
      if (y >= 0) and (y < height) then
      begin
        pb := GrayBitmap.Scanline[y]; inc(pb, j-WinSize2);
        for x := j-WinSize2+1 to j+WinSize2 do
        begin
          if (x >= 0) and (x<width) then
          begin
            if pb^>max then max := pb^;
            if pb^<min then min := pb^;
          end;
          inc(pb);
        end;
      end;
    end;
    CurrentThreshold := (max+min) div 2 - Offset;
  end;

  procedure CalcThreshold_Mean;
  var
    x, y: Integer;
    s, c: Integer;
    pb: pbyte;
  begin
    s := 0; c := 0;
    for y := i-WinSize2+1 to i+WinSize2 do
    begin
      if (y >= 0) and (y<height) then
      begin
        pb := GrayBitmap.Scanline[y]; inc(pb, j-WinSize2);
        for x := j-WinSize2+1 to j+WinSize2 do
        begin
          if (x >= 0) and (x<width) then
          begin
            s := s+pb^;
            inc(c);
          end;
          inc(pb);
        end;
      end;
    end;
    CurrentThreshold := s div c - Offset;
  end;

  procedure QuickSort(L, R: Integer);
  var
    I, J, P: Integer;
  begin
    repeat
      I := L;
      J := R;
      P := L + (R - L) shr 1; // 3.0.4
      repeat
        while med[I]<med[P] do Inc(I);
        while med[J]>med[P] do Dec(J);
        if I <= J then
        begin
          if I = P then
            P := J
          else
          if J = P then
            P := I;
          bswap(med[I], med[J]);
          Inc(I);
          Dec(J);
        end;
      until I > J;
      if L < J then QuickSort(L, J);
      L := I;
    until I >= R;
  end;

  procedure CalcThreshold_Median;
  var
    x, y: Integer;
    c: Integer;
    pb: pbyte;
  begin
    c := 0;
    for y := i-WinSize2+1 to i+WinSize2 do
    begin
      if (y >= 0) and (y<height) then
      begin
        pb := GrayBitmap.Scanline[y]; inc(pb, j-WinSize2);
        for x := j-WinSize2+1 to j+WinSize2 do
        begin
          if (x >= 0) and (x<width) then
          begin
            med[c] := pb^;
            inc(c);
          end;
          inc(pb);
        end;
      end;
    end;
    QuickSort(0, c-1);
    CurrentThreshold :=  med[c div 2] - Offset;
  end;

begin
  width := InBitmap.Width;
  height := InBitmap.height;
  GrayBitmap := TIEBitmap.Create(width, height, ie8g);

  try

    GrayBitmap.CopyAndConvertFormat(InBitmap);
    OutBitmap.Allocate(width, height, ie1g);

    WinSize2 := WinSize div 2;

    if Mode = ietMedian then
      SetLength(med, WinSize * WinSize);

    lprog := -1;

    for i := 0 to height-1 do
    begin
      p := OutBitmap.Scanline[i];
      ps := GrayBitmap.Scanline[i];
      for j := 0 to width-1 do
      begin
        case Mode of
          ietMean: CalcThreshold_Mean;
          ietMedian: CalcThreshold_Median;
          ietMeanMinMax: CalcThreshold_MeanMinMax;
        end;
        b := j and 7;
        if ps^>=CurrentThreshold then
          p^ := p^ or iebitmask1[b]
        else
          p^ := p^ and (not iebitmask1[b]);
        if b = 7 then
          inc(p);
        inc(ps);
      end;
      if assigned(OnProgress) then
      begin
        prog := trunc(i/height*100);
        if prog <> lprog then
        begin
          OnProgress(Sender, prog);
          lprog := prog;
        end;
      end;
    end;

  finally
    GrayBitmap.Free();
  end;

end;

{!!
<FS>TImageEnProc.ConvertToBWLocalThreshold

<FM>Declaration<FC>
procedure ConvertToBWLocalThreshold(WinSize: Integer = 4; Mode: <A TIEThreshMode> = ietMean; Offset: Integer = 4);

<FM>Description<FN>
Converts a true color image (24 bit) to black & white (1 bit) using a local threshold algorithms (mean, median, min/max mean).

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>WinSize<FN></C> <C>The size of the box to analyze when calculating the threshold algorithm, minimum value is 2</C> </R>
<R> <C><FC>Mode<FN></C> <C>ietMean, ietMedian or ietMeanMinMax</C> </R>
<R> <C><FC>Offset<FN></C> <C>Subtracts an offset from the calculated threshold</C> </R>
</TABLE>

<FM>Example<FC>
ImageEnView1.Proc.ConvertToBWLocalThreshold(8, ietMean);

!!}
procedure TImageEnProc.ConvertToBWLocalThreshold(WinSize: Integer = 4; Mode: TIEThreshMode = ietMean; Offset: Integer = 4);
begin
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  if fAutoUndo then
    SaveUndo( {$IFDEF IEUseLegacyUndoCaptions}
              IERS_CONVERTTOBWLOCALTHRESHOLD,
              {$ELSE}
              IEMsg( IEMSG_Monochrome ),
              {$ENDIF}
              ieuImage, True, IEOP_CONVERTTOBWLOCALTHRESHOLD );
  IELocalBinarize(fIEBitmap, fIEBitmap, WinSize, Mode, Offset, fOnProgress, self);
  Update;
  DoFinishWork;
end;

{!!
<FS>TImageEnProc.CompareHistogramWith

<FM>Declaration<FC>
function CompareHistogramWith(SecondImage: <A TIEBitmap>; Mode: <A TIECmpMode>; GrayScale: Boolean): Double;

<FM>Description<FN>
Compares histograms of the current image with another image and returns a floating point value from 0 to 1 indicating the percentage of equality.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>SecondImage<FN></C> <C>Another image to compare with</C> </R>
<R> <C><FC>Mode<FN></C> <C>The <L TIECmpMode>algorithm</L> used for comparison</C> </R>
<R> <C><FC>GrayScale<FN></C> <C>If True, only a gray scale histogram is compared</C> </R>
</TABLE>

!!}
function TImageEnProc.CompareHistogramWith(SecondImage: TIEBitmap; Mode: TIECmpMode; GrayScale: Boolean): Double;
begin
  result := 0;
  if not MakeConsistentBitmap([ie24RGB]) then
    exit;
  result := IECompareImagesHistogram(fIEBitmap, SecondImage, Mode, GrayScale);
  DoFinishWork;
end;

// channel: 0=R, 1=G, 2=B, 3=gray
function IECompareHistograms(h1, h2: TIEHistogram; Mode: TIECmpMode; channel: Integer): Double;
var
  i: Integer;
  v1, v2: PDWORD;
  max, min: DWORD;
  m1, m2, d1, d2: Double;
  histlen: Integer;
begin
  result := 0;
  histlen := imin( length(h1), length(h2) );
  case Mode of
    iecmpRMSE: // Root Mean Square error
      begin
        max := 0;
        min := $FFFFFFFF;
        for i := 0 to histlen - 1 do
        begin
          v1 := PDWORD(@h1[i]); inc(v1, channel);
          v2 := PDWORD(@h2[i]); inc(v2, channel);
          result := result + sqr(v1^ - v2^);
          if v1^ > max then max := v1^;
          if v2^ > max then max := v2^;
          if v1^ < min then min := v1^;
          if v2^ < min then min := v2^;
        end;
        result := sqrt(result / histlen) / (max - min);
      end;
    iecmpHamming: // Hamming distance
      begin
        for i := 0 to histlen - 1 do
        begin
          v1 := PDWORD(@h1[i]); inc(v1, channel);
          v2 := PDWORD(@h2[i]); inc(v2, channel);
          if v1^ <> v2^ then
            result := result + 1;
        end;
        result := result / histlen;
      end;
    iecmpCovariance: // Covariance
      begin
        m1 := 0; m2 := 0;
        for i := 0 to histlen - 1 do
        begin
          v1 := PDWORD(@h1[i]); inc(v1, channel);
          v2 := PDWORD(@h2[i]); inc(v2, channel);
          m1 := m1 + v1^;
          m2 := m2 + v2^;
        end;
        m1 := m1 / histlen;
        m2 := m2 / histlen;
        for i := 0 to histlen - 1 do
        begin
          v1 := PDWORD(@h1[i]); inc(v1, channel);
          v2 := PDWORD(@h2[i]); inc(v2, channel);
          d1 := v1^ - m1;
          d2 := v2^ - m2;
          result := result + (d1 * d2 - result) / (i + 1);
        end;
      end;
  end;
end;

function IECompareImagesHistogram(bitmap1, bitmap2: TIEBitmap; Mode: TIECmpMode; GrayScale: Boolean): Double;
var
  hist1, hist2: TIEHistogram;
  er, eg, eb, ei: Double;
begin
  hist1 := IEGetHistogram(bitmap1, 0, 0, bitmap1.Width, bitmap2.Height, nil, [iehcRed, iehcGreen, iehcBlue, iehcGray]);
  hist2 := IEGetHistogram(bitmap2, 0, 0, bitmap1.Width, bitmap2.Height, nil, [iehcRed, iehcGreen, iehcBlue, iehcGray]);
  if GrayScale then
  begin
    ei := IECompareHistograms(hist1, hist2, Mode, 3);
    result := 1 - ei;
  end
  else
  begin
    er := IECompareHistograms(hist1, hist2, Mode, 0);
    eg := IECompareHistograms(hist1, hist2, Mode, 1);
    eb := IECompareHistograms(hist1, hist2, Mode, 2);
    result := 1 - (er + eg + eb) / 3;
  end;
end;


///////////////////////////////////////////////////////////////////////////////////////
// Reflection effect

{!!
<FS>TImageEnProc.Reflection


<FM>Declaration<FC>
procedure Reflection(minAlpha: Integer = 0; maxAlpha: Integer = 200; percentage: Integer = 100);

<FM>Description<FN>
Extends the image vertically and simulates a reflection of the image (like reflection of "coverflow" presentations).

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>minAlpha<FN></C> <C>Minimum alpha value (0=fully transparent, 255=fully opaque).</C> </R>
<R> <C><FC>maxAlpha<FN></C> <C>Maximum alpha value (0=fully transparent, 255=fully opaque).</C> </R>
<R> <C><FC>percentage<FN></C> <C>Effect percentage (0=no effect, 100=maximum effect).</C> </R>
</TABLE>

<FM>Example<FC>
ImageEnView1.Reflection();
!!}
procedure TImageEnProc.Reflection(minAlpha: Integer; maxAlpha: Integer; percentage: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_REFLECTION, [minAlpha, maxAlpha, percentage]),
                              {$ELSE}
                              IEMsg( IEMsg_REFLECTION ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_REFLECTION ) then
    exit;
  IEReflectionEffect(ProcBitmap, minAlpha, maxAlpha, percentage, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


// accept only ie24RGB
procedure IEReflectionEffect(bitmap: TIEBitmap; minAlpha, maxAlpha: Integer; percentage: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
var
  x, y, dst_y : Integer;
  w, h : Integer;
  src, dst : PRGB;
  src_alpha, dst_alpha : pbyte;
  mul: Double;
  prevPer, per: Integer;
begin
  prevPer := -1;
  w := bitmap.Width;
  h := bitmap.Height;
  bitmap.Resize(w, h*2);
  for y := 0 to h-1 do
  begin
    dst_y := h*2-y-1;

    src := bitmap.GetRow(y);
    src_alpha := bitmap.AlphaChannel.GetRow(y);
    dst := bitmap.GetRow(dst_y);
    dst_alpha := bitmap.AlphaChannel.GetRow(dst_y);

    CopyMemory(dst, src, bitmap.Rowlen);

    mul := (y/h-((100-percentage)/100));

    for x := 0 to w-1 do
    begin
      dst_alpha^ := imax(minAlpha, imin(maxAlpha, imin(src_alpha^, trunc(src_alpha^ * mul))));
      inc(dst_alpha);
      inc(src_alpha);
    end;

    bitmap.FreeRow(y);
    bitmap.FreeRow(dst_y);
    bitmap.AlphaChannel.FreeRow(y);
    bitmap.AlphaChannel.FreeRow(dst_y);

    if assigned(OnProgress) then
    begin
      per := trunc(y/h*100);
      if per<>prevPer then
      begin
        prevPer := per;
        OnProgress(Sender, per);
      end;
    end;
  end;

  bitmap.AlphaChannel.Full := false;
end;


///////////////////////////////////////////////////////////////////////////////////////
// Perspective transformation and 3d animations support


// merges source Bitmap to destination coordinates
// if alphaMin>-1 and alphaMax>-1 then draws with specified alpha range
procedure IEPerspectiveTransform(SrcBitmap, DstBitmap : TIEBitmap;
                                 xx0, yy0, xx1, yy1, xx2, yy2, xx3, yy3 : Integer;
                                 alphaMin : Integer = -1; alphaMax : Integer = -1; mergeAlpha : Boolean = false; alpha : Integer = 255);
var
  srccols, srcrows: Double;
  isrcrows: Integer;
  dstcols, dstrows: Integer;
  dstWidth, dstHeight: Integer;
  x0, y0, x1, y1, x2, y2, x3, y3: Double;
  delx1, dely1, delx2, dely2, delx3, dely3: Double;
  a11, a12, a13, a21, a22, a23, a31, a32: Double;
  u, v, i, j: Integer;
  floatu, floatv, x, y: Double;
  AA, BB, CC, DD, EE, FF, GG, HH, II: Double;
  px: PRGB;
  pa: pbyte;
  v1, v2, v3, v4: Double;
  dst_x1, dst_x2, dst_y1, dst_y2: Integer;
  aap: Integer;
  SrcAlphaChannel: TIEBitmap;
  rgb: TRGB;
  ai, al: Integer;
  asign, aofs: Integer;
begin

  dst_x1 := imin(xx0, imin(xx1, imin(xx2, xx3)));
  dst_y1 := imin(yy0, imin(yy1, imin(yy2, yy3)));
  dst_x2 := imax(xx0, imax(xx1, imax(xx2, xx3)));
  dst_y2 := imax(yy0, imax(yy1, imax(yy2, yy3)));

  dstrows := imax( imax( imax( yy0, yy1 ), yy2 ), yy3) +1;
  dstcols := imax( imax( imax( xx0, xx1 ), xx2 ), xx3) +1;

  if (dstrows = 0) or (dstcols = 0) then
    exit;
  if (xx0=xx1) or (yy0=yy2) then
    exit;
  if alpha = 0 then
    exit;


  x0 := xx0 / dstcols;
  y0 := yy0 / dstrows;
  x1 := xx1 / dstcols;
  y1 := yy1 / dstrows;
  x2 := xx2 / dstcols;
  y2 := yy2 / dstrows;
  x3 := xx3 / dstcols;
  y3 := yy3 / dstrows;

  srccols := SrcBitmap.Width;
  srcrows := SrcBitmap.Height;
  isrcrows := SrcBitmap.Height;

  dstWidth  := DstBitmap.Width;
  dstHeight := DstBitmap.Height;

  delx1 := x1-x2;
  dely1 := y1-y2;
  delx2 := x3-x2;
  dely2 := y3-y2;
  delx3 := x0-x1+x2-x3;
  dely3 := y0-y1+y2-y3;

  if (delx3 = 0) and (dely3 = 0) then
  begin
    a11 := x1-x0;
    a21 := x2-x1;
    a31 := x0;
    a12 := y1-y0;
    a22 := y2-y1;
    a32 := y0;
    a13  := 0;
    a23 := 0;
  end
  else
  begin
    a13 := (delx3*dely2-delx2*dely3)/(delx1*dely2-dely1*delx2);
    a23 := (delx1*dely3-dely1*delx3)/(delx1*dely2-dely1*delx2);
    a11 := x1-x0+a13*x1;
    a21 := x3-x0+a23*x3;
    a31 := x0;
    a12 := y1-y0+a13*y1;
    a22 := y3-y0+a23*y3;
    a32 := y0;
  end;

  AA := a22-a32*a23;
  BB := a31*a23-a21;
  CC := a21*a32-a31*a22;
  DD := a32*a13-a12;
  EE := a11-a31*a13;
  FF := a31*a12-a11*a32;
  GG := a12*a23-a22*a13;
  HH := a21*a13-a11*a23;
  II := a11*a22-a21*a12;

  SrcAlphaChannel := SrcBitmap.AlphaChannel;

  dst_y1 := imin(imax(0, dst_y1), dstHeight-1);
  dst_y2 := imin(imax(0, dst_y2), dstHeight-1);

  dst_x1 := imin(imax(0, dst_x1), dstWidth-1);
  dst_x2 := imin(imax(0, dst_x2), dstWidth-1);

  if (alphaMin > -1) and (alphaMax > -1) then
  begin
    // alpha modified (in the range)

    if yy0 < yy3 then
    begin
      asign := -1;
      aofs  := 255;
    end
    else
    begin
      asign := 1;
      aofs  := 0;
    end;

    for i := dst_y1 to dst_y2 do
    begin
      px := DstBitmap.ScanLine[i];
      inc(px, dst_x1);

      if not mergeAlpha then
      begin
        pa := DstBitmap.AlphaChannel.Scanline[i];
        inc(pa, dst_x1);
      end
      else
        pa := nil;

      y := i/dstrows;
      v2 := HH*y+II;
      v3 := BB*y+CC;
      v4 := EE*y+FF;
      for j := dst_x1 to dst_x2 do
      begin
        x := j/dstcols;
        v1 := (GG*x+v2);
        if v1 = 0 then v1 := 1;
        floatu := ((AA * x + v3) / v1) * srccols + 0.5;
        floatv := ((DD * x + v4) / v1) * srcrows + 0.5;
        if (floatu < srccols) and (floatu >= 0.0) and (floatv < srcrows) and (floatv >= 0.0) then
        begin
          u := trunc(floatu);
          v := trunc(floatv);
          if mergeAlpha then
          begin
            // blend alpha channel with the background
            ai := aofs + asign * v * 255 div isrcrows;
            al := pbytearray(SrcAlphaChannel.Scanline[v])[u];
            if al < ai then
              ai := al;
            if alpha < ai then
              ai := alpha;
            if ai < alphaMin then
              ai := alphaMin
            else
            if ai > alphaMax then
              ai := alphaMax;
            ai := ai shl 10;
            rgb := PRGBROW(SrcBitmap.Scanline[v])[u];
            with px^ do
            begin
              r := (ai * (rgb.r - r) shr 18 + r);
              g := (ai * (rgb.g - g) shr 18 + g);
              b := (ai * (rgb.b - b) shr 18 + b);
            end;
          end
          else
          begin
            px^ := PRGBROW(SrcBitmap.Scanline[v])[u];
            pa^ := pbytearray(SrcAlphaChannel.Scanline[v])[u];
            if yy0 < yy3 then
              aap := trunc( pa^ * (1-v/srcrows) )
            else
              aap := trunc( pa^ * (v/srcrows) );
            if pa^ < aap then
              aap := pa^;
            if alpha < aap then
              aap := alpha;

            if aap < alphaMin then
              pa^ := alphaMin
            else
            if aap > alphaMax then
              pa^ := alphaMax
            else
              pa^ := aap;
          end;
        end;
        inc(px);
        inc(pa);
      end;
    end;
    if not mergeAlpha then
      DstBitmap.AlphaChannel.Full := false;

  end
  else
  begin

    // alpha unmodified
    for i := dst_y1 to dst_y2 do
    begin
      px := DstBitmap.ScanLine[i];
      inc(px, dst_x1);

      if not mergeAlpha then
      begin
        pa := DstBitmap.AlphaChannel.Scanline[i];
        inc(pa, dst_x1);
      end
      else
        pa := nil;

      y := i / dstrows;
      v2 := HH * y + II;
      v3 := BB * y + CC;
      v4 := EE * y + FF;
      for j := dst_x1 to dst_x2 do
      begin
        x := j / dstcols;
        v1 := GG * x + v2;
        if v1 = 0 then v1 := 1;
        floatu := ((AA * x + v3) / v1) * srccols + 0.5;
        floatv := ((DD * x + v4) / v1) * srcrows + 0.5;
        if (floatu < srccols) and (floatu >= 0.0) and (floatv < srcrows) and (floatv >= 0.0) then
        begin
          u := trunc(floatu);
          v := trunc(floatv);
          if mergeAlpha then
          begin
            // blend alpha channel with the background
            rgb := PRGBROW(SrcBitmap.Scanline[v])[u];
            ai := pbytearray(SrcAlphaChannel.Scanline[v])[u];
            if alpha < ai then
              ai := alpha;
            ai := ai shl 10;
            with px^ do
            begin
              r := (ai * (rgb.r - r) shr 18 + r);
              g := (ai * (rgb.g - g) shr 18 + g);
              b := (ai * (rgb.b - b) shr 18 + b);
            end;
          end
          else
          begin
            px^ := PRGBROW(SrcBitmap.Scanline[v])[u];
            pa^ := imin(pbytearray(SrcAlphaChannel.Scanline[v])[u], alpha);
          end;
        end;
        inc(px);
        inc(pa);
      end;
    end;
  end;
end;



// rotate about Y axis
procedure IERotateCoordsY(var p: TIE3DPoint; angle: Double);
var
  rx, ry, rz: Double;
begin
  rx := p.z*sin(angle) + p.x*cos(angle);
  ry := p.y;
  rz := p.z*cos(angle) - p.x*sin(angle);
  p.x := rx;
  p.y := ry;
  p.z := rz;
end;

// rotate about X axis
procedure IERotateCoordsX(var p: TIE3DPoint; angle: Double);
var
  rx, ry, rz: Double;
begin
  rx := p.x;
  ry := p.y*cos(angle) - p.z*sin(angle);
  rz := p.y*sin(angle) + p.z*cos(angle);
  p.x := rx;
  p.y := ry;
  p.z := rz;
end;

procedure IEProjectCoords(const p: TIE3DPoint; distance: Double; var xp, yp: Double);
begin
  xp := (p.x*distance) / (p.z + distance);
  yp := (p.y*distance) / (p.z + distance);
end;

procedure IERotateRectangle(const rect: TRect; viewerX, viewerY: Double; var p1, p2, p3, p4: TIE3DPoint; angleX, angleY: Double);
var
  ox, oy: Double;
begin
  ox := (rect.Right+rect.Left)/2-viewerX;
  oy := (rect.Bottom+rect.Top)/2-viewerY;

  p1.x := rect.Left - ox;
  p1.y := rect.Top  - oy;
  p1.z := 0;
  IERotateCoordsY(p1, angleY);
  IERotateCoordsX(p1, angleX);

  p2.x := rect.Right - ox;
  p2.y := rect.Top   - oy;
  p2.z := 0;
  IERotateCoordsY(p2, angleY);
  IERotateCoordsX(p2, angleX);

  p3.x := rect.Right  - ox;
  p3.y := rect.Bottom - oy;
  p3.z := 0;
  IERotateCoordsY(p3, angleY);
  IERotateCoordsX(p3, angleX);

  p4.x := rect.Left   - ox;
  p4.y := rect.Bottom - oy;
  p4.z := 0;
  IERotateCoordsY(p4, angleY);
  IERotateCoordsX(p4, angleX);
end;

procedure IEProjectRectangle(const p1, p2, p3, p4: TIE3DPoint; distance: Double; var x1, y1, x2, y2, x3, y3, x4, y4: Double);
begin
  IEProjectCoords(p1, distance, x1, y1);
  IEProjectCoords(p2, distance, x2, y2);
  IEProjectCoords(p3, distance, x3, y3);
  IEProjectCoords(p4, distance, x4, y4);
end;



// angles in degrees
// if op=ieovoCALCRECTONLY then Bitmap and DstBitmap can be "nil"
procedure IEProjectBitmap1(Bitmap: TIEBitmap; DstBitmap: TIEBitmap; centerDstX, centerDstY: Integer; destWidth, destHeight: Integer; translateX, translateY: Integer; depth: Double; rotateX, rotateY: Double; specularAlphaMin, specularAlphaMax: Integer; var outCoords: TIEQuadCoords; op: TIEProjectBitmapOp; mergeAlpha: Boolean; alpha: Integer);
var
  r: TRect;
  p1, p2, p3, p4: TIE3DPoint;
  x0, y0, x1, y1, x2, y2, x3, y3: Double;
  h1, h2: Integer;
begin
  if (op = ieovoCALCRECTONLY) or (op = ieovoFULLOP) then
  begin
    rotateX := rotateX * (PI/180);
    rotateY := rotateY * (PI/180);
    r := rect(0, 0, destWidth, destHeight);
    IERotateRectangle(r, translateX, translateY, p1, p2, p3, p4, rotateX, rotateY);
    IEProjectRectangle(p1, p2, p3, p4, depth, x0, y0, x1, y1, x2, y2, x3, y3);
    outCoords.x0 := trunc(x0 + centerDstX - translateX);
    outCoords.y0 := trunc(y0 + centerDstY - translateY);
    outCoords.x1 := trunc(x1 + centerDstX - translateX);
    outCoords.y1 := trunc(y1 + centerDstY - translateY);
    outCoords.x2 := trunc(x2 + centerDstX - translateX);
    outCoords.y2 := trunc(y2 + centerDstY - translateY);
    outCoords.x3 := trunc(x3 + centerDstX - translateX);
    outCoords.y3 := trunc(y3 + centerDstY - translateY);
  end;

  if (op = ieovoDRAWONLY) or (op = ieovoFULLOP) then
  begin
    IEPerspectiveTransform(Bitmap, DstBitmap, 
                           outCoords.x0, outCoords.y0, 
                           outCoords.x1, outCoords.y1, 
                           outCoords.x2, outCoords.y2, 
                           outCoords.x3, outCoords.y3, 
                           -1, -1, mergeAlpha, alpha);

    h1 := abs(outCoords.y3-outCoords.y0);
    h2 := abs(outCoords.y2-outCoords.y1);
    if (specularAlphaMin > -1) and (specularAlphaMax > -1) then
      IEPerspectiveTransform(Bitmap, DstBitmap, 
                             outCoords.x0, outCoords.y3+h1, 
                             outCoords.x1, outCoords.y2+h2, 
                             outCoords.x2, outCoords.y1+h2, 
                             outCoords.x3, outCoords.y0+h1, 
                             specularAlphaMin, specularAlphaMax, mergeAlpha, alpha);
  end;
end;

// autocalculates scale from dstWidth and dstHeight
procedure IEProjectBitmap2(Bitmap: TIEBitmap; DstBitmap: TIEBitmap; centerDstX, centerDstY: Integer; dstWidth, dstHeight: Integer; translateX, translateY: Integer; depth: Double; rotateX, rotateY: Double; specularAlphaMin, specularAlphaMax: Integer; var outCoords: TIEQuadCoords; op: TIEProjectBitmapOp; mergeAlpha: Boolean; alpha: Integer);
var
  w, h: Integer;
begin
  IEGetFitResampleSize(Bitmap.Width, Bitmap.Height, dstWidth, dstHeight, w, h);
  IEProjectBitmap1(Bitmap, DstBitmap, centerDstX, centerDstY, w, h, translateX, translateY, depth, rotateX, rotateY, specularAlphaMin, specularAlphaMax, outCoords, op, mergeAlpha, alpha);
end;


{!!
<FS>TImageEnProc.ProjectDraw

<FM>Declaration<FC>
function ProjectDraw(Source: <A TIEBitmap>; centerDestX: Integer; centerDestY: Integer; destWidth: Integer; destHeight: Integer; depth: Double; translateX: Integer; translateY: Integer; rotateX: Double; rotateY: Double; specularAlphaMin: Integer; specularAlphaMax: Integer; mergeAlpha: Boolean = false): <A TIEQuadCoords>;
function ProjectDraw(Source: <A TIEBitmap>; centerDestX: Integer; centerDestY: Integer; scale: Double; depth: Double; translateX: Integer; translateY: Integer; rotateX: Double; rotateY: Double; specularAlphaMin: Integer; specularAlphaMax: Integer; mergeAlpha: Boolean = false): <A TIEQuadCoords>;

<FM>Description<FN>
Draws the source bitmap over current layer, performing translations, rotations and perspective transform.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>Source<FN></C> <C>Source bitmap to draw.</C> </R>
<R> <C><FC>centerDestX<FN></C> <C>Horizontal position of center of destination position.</C> </R>
<R> <C><FC>centerDestY<FN></C> <C>Vertical position of center of destination position.</C> </R>
<R> <C><FC>destWidth<FN></C> <C>Destination bounding box width, not including specular bitmap. The resulting bitmap will be adapted (but not stretched) to this size.</C> </R>
<R> <C><FC>destHeight<FN></C> <C>Destination bounding box height, not including specular bitmap. The resulting bitmap will be adapted (but not stretched) to this size.</C> </R>
<R> <C><FC>scale<FN></C> <C>Replaces destWidth and destHeight in the second overload. Specifies a multiplier of the original size (1=same size, 0.5=half size, etc..).</C> </R>
<R> <C><FC>depth<FN></C> <C>Destination depth of field.</C> </R>
<R> <C><FC>translateX<FN></C> <C>Horizontal offset in 3D space (before perspective projection)</C> </R>
<R> <C><FC>translateY<FN></C> <C>Vertical offset in 3D space (before perspective projection)</C> </R>
<R> <C><FC>rotateX<FN></C> <C>X axis rotations in 3D space (before perspective projection). Angles are in degrees.</C> </R>
<R> <C><FC>rotateY<FN></C> <C>Y axis rotations in 3D space (before perspective projection). Angles are in degrees.</C> </R>
<R> <C><FC>specularAlphaMin<FN></C> <C>If >-1 a reflection bitmap will be drawn, using specified alpha range.</C> </R>
<R> <C><FC>specularAlphaMax<FN></C> <C>If >-1 a reflection bitmap will be drawn, using specified alpha range.</C> </R>
<R> <C><FC>mergeAlpha<FN></C> <C>If image alpha channel is merged with the background image.</C> </R>
</TABLE>

Returns coordinates of four points of stretched bitmap.

<FM>Demo<FN>
<TABLE2>
<R> <C_IMG_DEMO> <C>Demos\Display\ProjectDraw\ProjectDraw.dpr </C> </R>
</TABLE>

<FM>Example<FC>
// draw at 200, 200 (center), inside a box of 150x150, depth 400, rotating by 30° on Y axis, with specular effect
ImageEnView1.Proc.ProjectDraw( ImageEnView2.IEBitmap, 200, 200, 150, 150, 400, 0, 0, 0, 30, 0, 100 );

!!}
function TImageEnProc.ProjectDraw(Source: TIEBitmap; centerDestX: Integer; centerDestY: Integer; destWidth: Integer; destHeight: Integer;
                                  depth: Double; translateX: Integer; translateY: Integer; rotateX: Double; rotateY: Double;
                                  specularAlphaMin: Integer; specularAlphaMax: Integer; mergeAlpha: Boolean): TIEQuadCoords;
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  sx1, sy1, sx2, sy2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], sx1, sy1, sx2, sy2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_PROJECTDRAW,
                              {$ELSE}
                              IEMsg( IEMsg_PROJECTDRAW ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_PROJECTDRAW ) then
    exit;
  IEProjectBitmap2(Source, ProcBitmap, centerDestX, centerDestY, destWidth, destHeight, translateX, translateY, depth, 
                   rotateX, rotateY, specularAlphaMin, specularAlphaMax, result, ieovoFULLOP, mergeAlpha, 255);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

function TImageEnProc.ProjectDraw(Source: TIEBitmap; centerDestX: Integer; centerDestY: Integer; scale: Double;
                                  depth: Double; translateX: Integer; translateY: Integer; rotateX: Double; rotateY: Double;
                                  specularAlphaMin: Integer; specularAlphaMax: Integer; mergeAlpha: Boolean): TIEQuadCoords;
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  sx1, sy1, sx2, sy2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], sx1, sy1, sx2, sy2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_PROJECTDRAW,
                              {$ELSE}
                              IEMsg( IEMSG_PROJECTDRAW ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_PROJECTDRAW ) then
    exit;
  IEProjectBitmap1(Source, ProcBitmap, centerDestX, centerDestY, trunc(Source.Width*scale), trunc(Source.Height*scale), translateX, translateY, depth, 
                  rotateX, rotateY, specularAlphaMin, specularAlphaMax, result, ieovoFULLOP, mergeAlpha, 255);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;



{!!
<FS>TImageEnProc.PerspectiveDraw

<FM>Declaration<FC>
procedure PerspectiveDraw(Source: <A TIEBitmap>; x0, y0, x1, y1, x2, y2, x3, y3: Integer; alphaMin: Integer=-1; alphaMax: Integer=-1; mergeAlpha: Boolean);

<FM>Description<FN>
Draws the source bitmap over current layer, stretching bitmap inside four points.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>x0, y0<FN></C> <C>Top-Left point</C> </R>
<R> <C><FC>x1, y1<FN></C> <C>Top-Right point</C> </R>
<R> <C><FC>x2, y2<FN></C> <C>Bottom-Right point</C> </R>
<R> <C><FC>x3, y3<FN></C> <C>Bottom-Left point</C> </R>
<R> <C><FC>alphaMin, alphaMax<FN></C> <C>If alphaMin>-1 and alphaMax>-1 then alpha (transparency) will be limited to the specified range (useful for "cover-flow" like reflection). alphaMin (0..255) specifies minimum transparency. alphaMax (0..255) specifies maximum transparency.</C> </R>
<R> <C><FC>mergeAlpha<FN></C> <C>If image alpha channel is merged with the background image.</C> </R>
</TABLE>

It is possible to invert the image by making lesser coordinates exceed greater ones, for example, (x0, y0) > (x1, y1).

Note: Check your parameters as the coordinates are ordered differently from common designations

<FM>Example<FC>
// stretch the image to be full size on the left, but angled in on the right
var
  ABitmap: TIEbitmap;
  iOffset: Integer;
begin
  iOffset := 50;

  // Create clear bitmap
  ImageEnView1.IEBitmap.Allocate(500, 500);
  ImageEnView1.Bitmap.Canvas.Brush.Color := clBlack;
  ImageEnView1.Bitmap.Canvas.FillRect(Rect(0, 0, 
  ImageEnView1.Bitmap.Width, ImageEnView1.Bitmap.Height));

  // Perspective Draw
  ABitmap := TIEbitmap.create;
  ABitmap.Read('hongkong.jpg');
  ImageEnView1.Proc.PerspectiveDraw(ABitmap, 
                                    0, iOffset,                                                     // top-left
                                    ImageEnView1.Bitmap.Width - 1, 0,                               // top-right
                                    ImageEnView1.Bitmap.Width - 1, ImageEnView1.Bitmap.Height - 1,  // bottom-right
                                    0, ImageEnView1.Bitmap.Height - iOffset,                        // bottom-left
                                    -1, -1, true);
  ImageEnView1.Update;
  ABitmap.free;
end;

!!}
procedure TImageEnProc.PerspectiveDraw(Source: TIEBitmap; x0, y0, x1, y1, x2, y2, x3, y3: Integer; alphaMin: Integer; alphaMax: Integer; mergeAlpha: Boolean);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  sx1, sy1, sx2, sy2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], sx1, sy1, sx2, sy2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_PERSPECTIVEDRAW,
                              {$ELSE}
                              IEMsg( IEMSG_PERSPECTIVEDRAW ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_PERSPECTIVEDRAW ) then
    exit;
  IEPerspectiveTransform(Source, ProcBitmap, x0, y0, x1, y1, x2, y2, x3, y3, alphaMin, alphaMax, mergeAlpha, 255);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;






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

{!!
<FS>TImageEnProc.AdjustTemperature

<FM>Declaration<FC>
procedure AdjustTemperature(temperature: Integer);


<FM>Description<FN>
Adjusts the image temperature.
<FC>temperature<FN> is measured in degrees Kelvin. Minimum value is 1000 (K) and maximum is 40000 (K). Resolution is 100K (so allowed values are 1000, 1100, 1200, etc).

<FM>Example<FC>
ImageEnView1.Proc.AdjustTemperature(6500);
!!}
procedure TImageEnProc.AdjustTemperature(temperature: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_ADJUSTTEMPERATURE,
                              {$ELSE}
                              IEMsg( IEMSG_ADJUSTTEMPERATURE ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_ADJUSTTEMPERATURE ) then
    exit;
  IEAdjustTemperature(ProcBitmap, x1, y1, x2, y2, temperature, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

const 
temps: array [0..390, 0..2] of byte = (
  (255,56,0), (255,71,0), (255,83,0), (255,93,0), (255,101,0), (255,109,0), (255,115,0), (255,121,0), (255,126,0), (255,131,0), (255,137,18), (255,142,33),
  (255,147,44), (255,152,54), (255,157,63), (255,161,72), (255,165,79), (255,169,87), (255,173,94), (255,177,101), (255,180,107), (255,184,114), (255,187,120), (255,190,126),
  (255,193,132), (255,196,137), (255,199,143), (255,201,148), (255,204,153), (255,206,159), (255,209,163), (255,211,168), (255,213,173), (255,215,177), (255,217,182), (255,219,186),
  (255,221,190), (255,223,194), (255,225,198), (255,227,202), (255,228,206), (255,230,210), (255,232,213), (255,233,217), (255,235,220), (255,236,224), (255,238,227), (255,239,230),
  (255,240,233), (255,242,236), (255,243,239), (255,244,242), (255,245,245), (255,246,248), (255,248,251), (255,249,253), (254,249,255), (252,247,255), (249,246,255), (247,245,255),
  (245,243,255), (243,242,255), (240,241,255), (239,240,255), (237,239,255), (235,238,255), (233,237,255), (231,236,255), (230,235,255), (228,234,255), (227,233,255), (225,232,255),
  (224,231,255), (222,230,255), (221,230,255), (220,229,255), (218,228,255), (217,227,255), (216,227,255), (215,226,255), (214,225,255), (212,225,255), (211,224,255), (210,223,255),
  (209,223,255), (208,222,255), (207,221,255), (207,221,255), (206,220,255), (205,220,255), (204,219,255), (203,219,255), (202,218,255), (201,218,255), (201,217,255), (200,217,255),
  (199,216,255), (199,216,255), (198,216,255), (197,215,255), (196,215,255), (196,214,255), (195,214,255), (195,214,255), (194,213,255), (193,213,255), (193,212,255), (192,212,255),
  (192,212,255), (191,211,255), (191,211,255), (190,211,255), (190,210,255), (189,210,255), (189,210,255), (188,210,255), (188,209,255), (187,209,255), (187,209,255), (186,208,255),
  (186,208,255), (185,208,255), (185,208,255), (185,207,255), (184,207,255), (184,207,255), (183,207,255), (183,206,255), (183,206,255), (182,206,255), (182,206,255), (182,205,255),
  (181,205,255), (181,205,255), (181,205,255), (180,205,255), (180,204,255), (180,204,255), (179,204,255), (179,204,255), (179,204,255), (178,203,255), (178,203,255), (178,203,255),
  (178,203,255), (177,203,255), (177,202,255), (177,202,255), (177,202,255), (176,202,255), (176,202,255), (176,202,255), (175,201,255), (175,201,255), (175,201,255), (175,201,255),
  (175,201,255), (174,201,255), (174,201,255), (174,200,255), (174,200,255), (173,200,255), (173,200,255), (173,200,255), (173,200,255), (173,200,255), (172,199,255), (172,199,255),
  (172,199,255), (172,199,255), (172,199,255), (171,199,255), (171,199,255), (171,199,255), (171,198,255), (171,198,255), (170,198,255), (170,198,255), (170,198,255), (170,198,255),
  (170,198,255), (170,198,255), (169,198,255), (169,197,255), (169,197,255), (169,197,255), (169,197,255), (169,197,255), (169,197,255), (168,197,255), (168,197,255), (168,197,255),
  (168,197,255), (168,196,255), (168,196,255), (168,196,255), (167,196,255), (167,196,255), (167,196,255), (167,196,255), (167,196,255), (167,196,255), (167,196,255), (166,196,255),
  (166,195,255), (166,195,255), (166,195,255), (166,195,255), (166,195,255), (166,195,255), (166,195,255), (165,195,255), (165,195,255), (165,195,255), (165,195,255), (165,195,255),
  (165,195,255), (165,194,255), (165,194,255), (165,194,255), (164,194,255), (164,194,255), (164,194,255), (164,194,255), (164,194,255), (164,194,255), (164,194,255), (164,194,255),
  (164,194,255), (164,194,255), (163,194,255), (163,194,255), (163,193,255), (163,193,255), (163,193,255), (163,193,255), (163,193,255), (163,193,255), (163,193,255), (163,193,255),
  (163,193,255), (162,193,255), (162,193,255), (162,193,255), (162,193,255), (162,193,255), (162,193,255), (162,193,255), (162,193,255), (162,192,255), (162,192,255), (162,192,255),
  (162,192,255), (162,192,255), (161,192,255), (161,192,255), (161,192,255), (161,192,255), (161,192,255), (161,192,255), (161,192,255), (161,192,255), (161,192,255), (161,192,255),
  (161,192,255), (161,192,255), (161,192,255), (161,192,255), (160,192,255), (160,192,255), (160,191,255), (160,191,255), (160,191,255), (160,191,255), (160,191,255), (160,191,255),
  (160,191,255), (160,191,255), (160,191,255), (160,191,255), (160,191,255), (160,191,255), (160,191,255), (159,191,255), (159,191,255), (159,191,255), (159,191,255), (159,191,255),
  (159,191,255), (159,191,255), (159,191,255), (159,191,255), (159,191,255), (159,191,255), (159,190,255), (159,190,255), (159,190,255), (159,190,255), (159,190,255), (159,190,255),
  (159,190,255), (158,190,255), (158,190,255), (158,190,255), (158,190,255), (158,190,255), (158,190,255), (158,190,255), (158,190,255), (158,190,255), (158,190,255), (158,190,255),
  (158,190,255), (158,190,255), (158,190,255), (158,190,255), (158,190,255), (158,190,255), (158,190,255), (158,190,255), (158,190,255), (158,190,255), (157,190,255), (157,190,255),
  (157,189,255), (157,189,255), (157,189,255), (157,189,255), (157,189,255), (157,189,255), (157,189,255), (157,189,255), (157,189,255), (157,189,255), (157,189,255), (157,189,255),
  (157,189,255), (157,189,255), (157,189,255), (157,189,255), (157,189,255), (157,189,255), (157,189,255), (157,189,255), (157,189,255), (157,189,255), (156,189,255), (156,189,255),
  (156,189,255), (156,189,255), (156,189,255), (156,189,255), (156,189,255), (156,189,255), (156,189,255), (156,189,255), (156,189,255), (156,189,255), (156,189,255), (156,189,255),
  (156,189,255), (156,189,255), (156,188,255), (156,188,255), (156,188,255), (156,188,255), (156,188,255), (156,188,255), (156,188,255), (156,188,255), (156,188,255), (156,188,255),
  (156,188,255), (156,188,255), (155,188,255), (155,188,255), (155,188,255), (155,188,255), (155,188,255), (155,188,255), (155,188,255), (155,188,255), (155,188,255), (155,188,255),
  (155,188,255), (155,188,255), (155,188,255), (155,188,255), (155,188,255), (155,188,255), (155,188,255));


procedure IEAdjustTemperature(bitmap: TIEBitmap; x1, y1, x2, y2: Integer; temperature: Integer; fOnProgress: TIEProgressEvent; Sender: TObject);
var
  i, j: Integer;
  px: PRGB;
  temp_idx: Integer;
  LUT_R, LUT_G, LUT_B: array [0..255] of byte;
  lprog, prog: Integer;
begin
  x2 := imin(x2, bitmap.Width);  dec(x2);
  y2 := imin(y2, bitmap.Height); dec(y2);

  temperature := imax(1000, imin(40000, temperature));
  temp_idx := imin(trunc(temperature/100-10), high(temps));

  for i := 0 to 255 do
  begin
    LUT_R[i] := trunc( i * temps[temp_idx][0] / 255  );
    LUT_G[i] := trunc( i * temps[temp_idx][1] / 255  );
    LUT_B[i] := trunc( i * temps[temp_idx][2] / 255  );
  end;

  lprog := -1;
  for i := y1 to y2 do
  begin
    px := bitmap.Scanline[i]; inc(px, x1);
    for j := x1 to x2 do
    begin
      px^.r := LUT_R[px^.r];
      px^.g := LUT_G[px^.g];
      px^.b := LUT_B[px^.b];
      inc(px);
    end;
    if assigned(fOnProgress) then
    begin
      prog := trunc(i/(y2-y1)*100);
      if prog<>lprog then
        fOnProgress(Sender, prog);
      lprog := prog;
    end;
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////
// Motion blur

{!!
<FS>TImageEnProc.MotionBlur

<FM>Declaration<FC>
procedure MotionBlur(angle: Double; radius: Integer = 8; sigma: Integer = 7);

<FM>Description<FN>
Applies a motion blur effect.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>angle<FN></C> <C>Angle in degrees (0 to 360)</C> </R>
<R> <C><FC>radius<FN></C> <C>Radius of Gaussian kernel in pixels (> 0)</C> </R>
<R> <C><FC>sigma<FN></C> <C>Standard deviation of Gaussian kernel in pixels (> 0)</C> </R>
</TABLE>

<FM>Example<FC>
ImageEnView1.Proc.MotionBlur(45);
!!}
procedure TImageEnProc.MotionBlur(angle: Double; radius: Integer; sigma: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB, ie8g], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_MOTIONBLUR, [angle, radius, sigma]),
                              {$ELSE}
                              IEMsg( IEMsg_MOTIONBLUR ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_MOTIONBLUR ) then
    exit;
  IEMotionBlur(ProcBitmap, angle, radius, sigma, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


// supports: ie24RGB, ie8g
// sigma must be >0
procedure IEMotionBlur(bitmap: TIEBitmap; angle: Double; radius: Integer; sigma: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
var
  rangle: Double;
  kernel: pdoublearray;
  i, ii, u, v, row, col: Integer;
  gm, vx, vy: Double;
  coords: pdouble;
  rr, gg, bb: Double;
  kval: pdouble;
  dstrgb8, srcrgb8: PRGB;
  dstg8, srcg8: pbyte;
  kwidth: Integer;
  bitmapWidth1, bitmapHeight1: Integer;
  crd: pdouble;
  sg, sq: Double;
  kwidth3, kwidth1: Integer;
  dst: TIEBitmap;
begin
  if sigma<1 then
    exit;

  coords := nil;
  kernel := nil;
  dst := TIEBitmap.Create(bitmap.Width, bitmap.Height, bitmap.PixelFormat);

  try
    bitmapWidth1  := bitmap.Width-1;
    bitmapHeight1 := bitmap.Height-1;

    kwidth := imax(2*radius+1, 3);
    kwidth1 := kwidth-1;
    kwidth3 := kwidth*3-1;

    kernel := allocmem(sizeof(double)*kwidth);
    sg := 18*sigma*sigma;
    sq := sqrt(2*PI)*sigma;
    for i := 0 to kwidth3 do
    begin
      ii := i div 3;
      kernel[ii] := kernel[ii] + exp(-(i*i)/sg)/sq;
    end;
    gm := 0.0;
    for i := 0 to kwidth1 do
      gm := gm+kernel[i];
    for i := 0 to kwidth1 do
      kernel[i] := kernel[i]/gm;

    coords := allocmem(2*kwidth*sizeof(double));

    rangle := PI*angle/180;

    vx := round(kwidth*sin(rangle));
    vy := round(kwidth*cos(rangle));
    vx := vx/sqrt(vx*vx+vy*vy);
    vy := vy/sqrt(vx*vx+vy*vy);
    crd := coords;
    for i := 0 to kwidth1 do
    begin
      crd^ := i*vy; inc(crd);
      crd^ := i*vx; inc(crd);
    end;

    for row := 0 to bitmapHeight1 do
    begin
      case bitmap.PixelFormat of
        ie24RGB:
          begin
            dstrgb8 := dst.Scanline[row];
            for col := 0 to bitmapWidth1 do
            begin
              rr := 0.0;
              gg := 0.0;
              bb := 0.0;
              gm := 0.0;
              kval := @kernel[0];
              crd := coords;
              for i := 0 to kwidth1 do
              begin
                u := round(col+crd^);
                inc(crd);
                if u < 0 then
                  u := 0
                else
                if u>bitmapWidth1 then
                  u := bitmapWidth1;
                v := round(row+crd^);
                inc(crd);
                if v < 0 then
                  v := 0
                else
                if v>bitmapHeight1 then
                  v := bitmapHeight1;
                srcrgb8 := bitmap.Scanline[v]; inc(srcrgb8, u);
                rr := rr + kval^ * srcrgb8^.r;
                gg := gg + kval^ * srcrgb8^.g;
                bb := bb + kval^ * srcrgb8^.b;
                gm := gm + kval^;
                inc(kval);
              end;
              if abs(gm) <= 1.0e-6 then
                with dstrgb8^ do
                begin
                  r := blimit(trunc(rr));
                  g := blimit(trunc(gg));
                  b := blimit(trunc(bb));
                end
              else
                with dstrgb8^ do
                begin
                  gm := 1/gm;
                  r := blimit(trunc(gm*rr));
                  g := blimit(trunc(gm*gg));
                  b := blimit(trunc(gm*bb));
                end;
              inc(dstrgb8);
            end;
          end;
        ie8g:
          begin
            dstg8 := dst.Scanline[row];
            for col := 0 to bitmapWidth1 do
            begin
              gg := 0.0;
              gm := 0.0;
              kval := @kernel[0];
              crd := coords;
              for i := 0 to kwidth1 do
              begin
                u := round(col+crd^); inc(crd);
                if u < 0 then
                  u := 0 else
                if u>bitmapWidth1 then
                  u := bitmapWidth1;
                v := round(row+crd^); inc(crd);
                if v < 0 then
                  v := 0
                else
                if v>bitmapHeight1 then
                  v := bitmapHeight1;
                srcg8 := bitmap.Scanline[v]; inc(srcg8, u);
                gg := gg + kval^ * srcg8^;
                gm := gm + kval^;
                inc(kval);
              end;
              if abs(gm) <= 1.0e-6 then
                dstg8^ := blimit(trunc(gg))
              else
                dstg8^ := blimit(trunc(gm*gg));
              inc(dstg8);
            end;
          end;
      end;
      if assigned(OnProgress) then
        OnProgress(Sender, trunc(row/bitmapHeight1*100));
    end;
    bitmap.AssignImage(dst);

    if bitmap.HasAlphaChannel then
      IEMotionBlur(bitmap.AlphaChannel, angle, radius, sigma, nil, nil);

  finally
    freemem(kernel);
    freemem(coords);
    dst.Free;
  end;
end;


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

///////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////
// Random

{!!
<FS>TImageEnProc.Random

<FM>Declaration<FC>
procedure Random(mean: Double = 0.5; stdDev: Double = 0.123);

<FM>Description<FN>
Fills the selected pixels with random values (Gaussian distribution).
Random values are mutiplied by 255 and truncated to be in the range 0 to 255.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>mean<FN></C> <C>Mean value. 0.5 = gray (128).</C> </R>
<R> <C><FC>stdDev<FN></C> <C>Standard deviation about mean.</C> </R>
</TABLE>
!!}
procedure TImageEnProc.Random(mean: Double; stdDev: Double);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB, ie8g, ie1g], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_RANDOM, [mean, stdDev]),
                              {$ELSE}
                              IEMsg( IEMsg_RANDOMIZE ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_RANDOM ) then
    exit;
  IERandom(ProcBitmap, mean, stdDev, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

function IERandG(Mean, StdDev: Double): Double;
var
  U1, S2: Double;
begin
  repeat
    U1 := 2*Random - 1;
    S2 := Sqr(U1) + Sqr(2*Random-1);
  until S2 < 1;
  Result := Sqrt(-2*Ln(S2)/S2) * U1 * StdDev + Mean;
end;

procedure IERandom(bitmap: TIEBitmap; mean: Double; stdDev: Double; x1, y1, x2, y2: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
var
  i, j: Integer;
  dstrgb8: PRGB;
  dstg8: pbyte;
  pb: pbyte;
begin
  x2 := imin(x2, bitmap.Width);  dec(x2);
  y2 := imin(y2, bitmap.Height); dec(y2);
  case bitmap.PixelFormat of

    ie1g:
      for i := y1 to y2 do
      begin
        dstg8 := bitmap.ScanLine[i];
        for j := x1 to x2 do
        begin
          pb := dstg8;
          inc(pb, j shr 3);
          if IERandG(mean, stdDev) > 0.5 then
            pb^ := pb^ or iebitmask1[j and 7]
          else
            pb^ := pb^ and not iebitmask1[j and 7];
        end;
      end;

    ie24RGB:
      for i := y1 to y2 do
      begin
        dstrgb8 := bitmap.Scanline[i]; inc(dstrgb8, x1);
        for j := x1 to x2 do
        begin
          dstrgb8^.r := blimit(round(IERandG(mean, stdDev)*255));
          dstrgb8^.g := blimit(round(IERandG(mean, stdDev)*255));
          dstrgb8^.b := blimit(round(IERandG(mean, stdDev)*255));
          inc(dstrgb8);
        end;
      end;

    ie8g:
      for i := y1 to y2 do
      begin
        dstg8 := bitmap.Scanline[i]; inc(dstg8, x1);
        for j := x1 to x2 do
        begin
          dstg8^ := blimit(round(IERandG(mean, stdDev)*255));
          inc(dstg8);
        end;
      end;

  end;
end;



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

{!!
<FS>TImageEnProc.MapGrayToColor

<FM>Declaration<FC>
procedure MapGrayToColor(map: array of TRGB);

<FM>Description<FN>
Maps each gray scale level to specified RGB color using the provided map.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>map<FN></C> <C>Array of 256 elements of TRGB values.</C> </R>
</TABLE>

<FM>Example<FC>
var
  map: array [0..255] of TRGB;
  i: Integer;
begin
  for i := 0 to 255 do
  begin
    map[i].r := i;
    map[i].g := 255-i;
    map[i].b := i;
  end;
  ImageEnView1.IO.LoadFromFile('grayimage.jpg');
  ImageEnView1.Proc.MapGrayToColor(map);
end;
!!}
procedure TImageEnProc.MapGrayToColor(map: array of TRGB);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_MAPGRAYTOCOLOR,
                              {$ELSE}
                              IEMsg( IEMSG_MAPGRAYTOCOLOR ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_MAPGRAYTOCOLOR ) then
    exit;
  IEMapGrayToColor(ProcBitmap, map, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

// accepts only ie24RGB format.
// output is always ie24RGB
procedure IEMapGrayToColor(Bitmap: TIEBitmap; map: array of TRGB; x1, y1, x2, y2: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
var
  p_rgb: PRGB;
  i, j, gray: Integer;
  RedToGrayCoef, GreenToGrayCoef, BlueToGrayCoef: Integer;
begin
  RedToGrayCoef   := IEGlobalSettings().RedToGrayCoef;
  GreenToGrayCoef := IEGlobalSettings().GreenToGrayCoef;
  BlueToGrayCoef  := IEGlobalSettings().BlueToGrayCoef;
  x2 := imin(x2, bitmap.Width);  dec(x2);
  y2 := imin(y2, bitmap.Height); dec(y2);
  for i := y1 to y2 do
  begin
    p_rgb := Bitmap.Scanline[i]; inc(p_rgb, x1);
    for j := x1 to x2 do
    begin
      with p_rgb^ do
        gray := (r * RedToGrayCoef + g * GreenToGrayCoef + b * BlueToGrayCoef) div 100;
      p_rgb^ := map[gray];
      inc(p_rgb);
    end;
  end;
end;

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

type
  TSNNThread = class(TIEExecutor)
  private
    Radius: integer;
    oldbmp: TIEArrayOfTRGB;
    Bitmap: TIEBitmap;
    y1, y2: integer;
    threadIndex: Integer;
    percentage: Integer;
    OnProgress: TIEProgressEvent;
    Sender: TObject;
  public
    procedure Execute; override;
    constructor Create(useThread: Boolean; Radius_: integer; oldbmp_: TIEArrayOfTRGB; Bitmap_: TIEBitmap; y1_, y2_: integer; OnProgress_: TIEProgressEvent; Sender_: TObject; threadIndex_: Integer);
    procedure DoProgress;
  end;

constructor TSNNThread.Create(useThread: Boolean; Radius_: integer; oldbmp_: TIEArrayOfTRGB; Bitmap_: TIEBitmap; y1_, y2_: integer; OnProgress_: TIEProgressEvent; Sender_: TObject; threadIndex_: Integer);
begin
  inherited Create(useThread);
  Radius := Radius_;
  y1 := y1_;
  y2 := y2_;
  oldbmp := oldbmp_;
  Bitmap := Bitmap_;
  OnProgress := OnProgress_;
  Sender := Sender_;
  threadIndex := threadIndex_;
end;

procedure TSNNThread.DoProgress;
begin
  OnProgress(Sender, percentage);
end;

procedure TSNNThread.Execute();
var
  x, y, sumR, sumG, sumB, count, u, v: integer;
  d1, d2: integer;
  lr, lg, lb, r1, r2, g1, g2, b1, b2: integer;
  rmean, r, g, b: integer;
  destpx, oldpx, px1, px2: PRGB;
  bitmapWidth: integer;
  bitmapWidthWithRadius: integer;
  aper, lper: integer;
begin
  bitmapWidth  := Bitmap.Width;
  bitmapWidthWithRadius := BitmapWidth + Radius * 2;

  count := (Radius + 1) * (Radius + 1);
  
  lper := -1;

  for y := y1 to y2 do
  begin

    oldpx := @oldbmp[BitmapWidthWithRadius * (Radius + y) + Radius];
    destpx := Bitmap.ScanLine[y];

    for x := 0 to bitmapWidth - 1 do
    begin

      sumR := 0;
      sumG := 0;
      sumB := 0;
      lr := oldpx^.R;
      lg := oldpx^.G;
      lb := oldpx^.B;

      for v := -Radius to 0 do
      begin

        px1 := @oldbmp[(Radius + y + v) * bitmapWidthWithRadius + x];
        px2 := @oldbmp[(Radius + y - v) * bitmapWidthWithRadius + Radius + Radius + x];

        for u :=  -Radius to 0 do
        begin
          r1 := px1^.R;
          g1 := px1^.G;
          b1 := px1^.B;
          inc(px1);

          r2 := px2^.R;
          g2 := px2^.G;
          b2 := px2^.B;
          dec(px2);

          rmean := (lr + r1) shr 1;
          r := lr - r1;
          g := lg - g1;
          b := lb - b1;
          d1 := (((512 + rmean) * r * r) shr 8) + 4 * g * g + (((767 - rmean) * b * b) shr 8);

          rmean := (lr + r2) shr 1;
          r := lr - r2;
          g := lg - g2;
          b := lb - b2;
          d2 := (((512 + rmean) * r * r) shr 8) + 4 * g * g + (((767 - rmean) * b * b) shr 8);

          if d1 < d2 then
          begin
            inc(sumR, r1);
            inc(sumG, g1);
            inc(sumB, b1);
          end
          else
          begin
            inc(sumR, r2);
            inc(sumG, g2);
            inc(sumB, b2);
          end;
        end;
      end;
      destpx^.R := sumR div count;
      destpx^.G := sumG div count;
      destpx^.B := sumB div count;

      inc(destpx);
      inc(oldpx);
    end;

    if (threadIndex = 0) and assigned(OnProgress) then
    begin
      aper := trunc(y / (y2 - y1 + 0.5) * 100);
      if aper <> lper then
      begin
        OnProgress(Sender, aper);
        lper := aper;
      end;
    end;

  end;
end;

// Symmetric Nearest Neighbour optimized (error less than 0.005)
procedure IESymmetricNearestNeighbourOpt(Bitmap: TIEBitmap; Radius: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
var
  i: integer;
  oldbmp: TIEArrayOfTRGB;
  bitmapWidth, bitmapHeight: integer;
  bitmapWidthWithRadius, bitmapHeightWithRadius: integer;
  threads: TIEThreadPool;
  threadsCount: integer;
  rowsPerThread: integer;
  y1, y2: integer;
begin
  bitmapWidth  := Bitmap.Width;
  bitmapHeight := Bitmap.Height;
  bitmapWidthWithRadius := BitmapWidth + Radius * 2;
  bitmapHeightWithRadius := BitmapHeight + Radius * 2;

  SetLength(oldbmp, BitmapWidthWithRadius * BitmapHeightWithRadius);
  for i := 0 to bitmapHeight - 1 do
    CopyMemory(@oldbmp[BitmapWidthWithRadius * (Radius + i) + Radius], Bitmap.ScanLine[i], BitmapWidth * sizeof(TRGB));

  threads := TIEThreadPool.Create();
  try
    threadsCount := IEGetRequiredThreads(Bitmap.Width, Bitmap.Height);
    rowsPerThread := Bitmap.Height div threadsCount;
    y1 := 0;
    for i := 0 to threadsCount - 1 do
    begin
      y2 := y1 + rowsPerThread;
      if y2 >= Bitmap.Height then
        y2 := Bitmap.Height - 1;
      threads.Add( TSNNThread.Create(threadsCount > 1, Radius, oldbmp, Bitmap, y1, y2, OnProgress, Sender, i) );
      inc(y1, rowsPerThread);
    end;
    threads.Join();
  finally
    threads.Free;
  end;
end;

{!!
<FS>TImageEnProc.SymmetricNearestNeighbour

<FM>Declaration<FC>
procedure SymmetricNearestNeighbour(Radius: Integer = 6);

<FM>Description<FN>
Applies a "Symmetric Nearest Neighbour" smoothing filter to the image.

SNN smoothing is very effective at noise reduction, while preserving edges.

Original image:
<IMG help_images\snn_orig.jpg>

Applying SymmetricNearestNeighbour(6):
<IMG help_images\snn_proc.jpg>

<FM>Example<FC>
ImageEnView1.Proc.SymmetricNearestNeighbour(6);
!!}
procedure TImageEnProc.SymmetricNearestNeighbour(Radius: Integer);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_SYMMETRICNEARESTNEIGHBOUR, [Radius]),
                              {$ELSE}
                              IEMsg( IEMSG_SYMMETRICNEARESTNEIGHBOUR ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_SYMMETRICNEARESTNEIGHBOUR ) then
    exit;
  IESymmetricNearestNeighbourOpt(ProcBitmap, Radius, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;



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


// Amount: 0...1
procedure IEPixelize(Bitmap: TIEBitmap; Mask: TIEMask; Amount: double; x1, y1, x2, y2: Integer; OnProgress: TIEProgressEvent; Sender: TObject);
var
  bitmapWidth, bitmapHeight: integer;
  pixelSize: integer;
  row, col: integer;
  px: PRGB;
  amapR, amapG, amapB, amapT: array of integer;
  roiWidth, roiHeight: integer;
  amapRow, amapCol: integer;
  amapWidth, amapHeight: integer;
  xx2, yy2: integer;
  idx: integer;
  aper, lper: integer;
begin
  if Amount <= 0 then
    exit;

  lper := -1;

  bitmapWidth  := Bitmap.Width;
  bitmapHeight := Bitmap.Height;

  x2 := imin(x2, bitmapWidth);  dec(x2);
  y2 := imin(y2, bitmapHeight); dec(y2);

  roiWidth  := (x2 - x1 + 1);
  roiHeight := (y2 - y1 + 1);

  pixelSize := ceil( (bitmapWidth + bitmapHeight) / 2.0 * Amount );

  // calc averages map
  amapWidth  := ceil(roiWidth / pixelSize);
  amapHeight := ceil(roiHeight / pixelSize);
  SetLength(amapR, amapWidth * amapHeight);
  SetLength(amapG, amapWidth * amapHeight);
  SetLength(amapB, amapWidth * amapHeight);
  SetLength(amapT, amapWidth * amapHeight);

  xx2 := imin(x1 + pixelSize * amapWidth - 1, bitmapWidth - 1);
  yy2 := imin(y1 + pixelSize * amapHeight - 1, bitmapHeight - 1);

  for row := y1 to yy2 do
  begin
    px := Bitmap.ScanLine[row];
    inc(px, x1);

    amapRow := (row - y1) div pixelSize;

    for col := x1 to xx2 do
    begin
      amapCol := (col - x1) div pixelSize;
      idx := amapRow * amapWidth + amapCol;
      inc(amapR[idx], px^.r);
      inc(amapG[idx], px^.g);
      inc(amapB[idx], px^.b);
      inc(amapT[idx]);
      inc(px);
    end;
  end;

  for row := 0 to amapHeight - 1 do
  begin
    idx := row * amapWidth;
    for col := 0 to amapWidth - 1 do
    begin
      amapR[idx] := amapR[idx] div amapT[idx];
      amapG[idx] := amapG[idx] div amapT[idx];
      amapB[idx] := amapB[idx] div amapT[idx];
      inc(idx);
    end;
  end;

  // applies averages map
  for row := y1 to y2 do
  begin
    px := Bitmap.ScanLine[row];
    inc(px, x1);

    amapRow := (row - y1) div pixelSize;

    for col :=  x1 to x2 do
    begin
      if mask.IsPointInside(col, row) then
      begin
        amapCol := (col - x1) div pixelSize;
        idx := amapRow * amapWidth + amapCol;
        px^.r := trunc( amapR[idx] );
        px^.g := trunc( amapG[idx] );
        px^.b := trunc( amapB[idx] );
      end;
      inc(px);
    end;

    if assigned(OnProgress) then
    begin
      aper := trunc(row / (y2 - y1 + 0.5) * 100);
      if aper <> lper then
      begin
        OnProgress(Sender, aper);
        lper := aper;
      end;
    end;

  end;

end;

{!!
<FS>TImageEnProc.Pixelize

<FM>Declaration<FC>
procedure Pixelize(Amount: Double = 0.02);

<FM>Description<FN>
Pixelize filter renders the selected area using large color blocks. It is very similar to the effect seen on television when obscuring faces.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>Amount<FN></C> <C>A floating point value from 0 to 1 which specifies the size of the rectangular block in percentage.</C> </R>
</TABLE>

Original image:
<IMG help_images\pixelize_before.jpeg>

Applying Pixelize(0.02) to the selected areas:
<IMG help_images\pixelize_after.jpeg>


<FM>Example<FC>
ImageEnView1.Proc.Pixelize(0.02);
!!}
procedure TImageEnProc.Pixelize(Amount: Double);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_PIXELIZE, [Amount]),
                              {$ELSE}
                              IEMsg( IEMSG_PIXELIZE ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_PIXELIZE, false ) then
    exit;
  IEPixelize(ProcBitmap, mask, Amount, x1, y1, x2, y2, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


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

// Delphi implementation of Geraint Luff algorithm
type
TIEPencilSketch = class
public
  constructor Create(Bitmap: TIEBitmap; grayScale: boolean; levelSteps: integer; maxTextures: integer; edgeBlurAmount: integer; edgeAmount: double; lineThickness: double; darkeningFactor: double; lineAlpha: double; lineDensity: double; lightness: double; antialiasedLines: boolean; onProgress: TIEProgressEvent; sender: TObject);
  destructor Destroy(); override;
  procedure Run();

private
  m_bitmap: TIEBitmap;
  m_levelSteps: integer;
  m_maxTextures: integer;
  m_edgeBlurAmount: integer;
  m_grayScale: boolean;
  m_edgeAmount: double;
  m_lineThickness: double;
  m_darkeningFactor: double;
  m_lineAlpha: double;
  m_lineDensity: double;
  m_lightness: double;
  m_antialiasedLines: boolean;
  m_onProgress: TIEProgressEvent;
  m_sender: TObject;

  m_srcPixels: array of TRGB; // m_bitmap as consecutive array of TRGB
  m_textures: array of array of array of TIEArrayOfByte;
  m_texturesColor: array of array of array of TRGB;
  m_requiredColours: TIERGBMap;
  m_lineLength: double;

  procedure CalcRequiredColours();
  procedure CalcStandardDeviation(var sd: TIEArrayOfSingle);
  function GetPixel(index: integer; const rgb: TRGB): TRGB;
  procedure CreateTextures();
  function DirectionalStrokes(width, height: integer; angle: double; angleVariation: double; thickness: double; length: double; density: double; alpha: double): TIEArrayOfByte;
end;

constructor TIEPencilSketch.Create(Bitmap: TIEBitmap; grayScale: boolean; levelSteps: integer; maxTextures: integer; edgeBlurAmount: integer; edgeAmount: double; lineThickness: double; darkeningFactor: double; lineAlpha: double; lineDensity: double; lightness: double; antialiasedLines: boolean; onProgress: TIEProgressEvent; sender: TObject);
begin
  m_bitmap           := Bitmap;
  m_levelSteps       := levelSteps;
  m_maxTextures      := maxTextures;
  m_edgeBlurAmount   := edgeBlurAmount;
  m_grayScale        := grayScale;
  m_edgeAmount       := edgeAmount;
  m_lineThickness    := lineThickness;
  m_darkeningFactor  := darkeningFactor;
  m_lineAlpha        := lineAlpha;
  m_lineDensity      := lineDensity;
  m_lightness        := lightness;
  m_antialiasedLines := antialiasedLines;
  m_onProgress       := onProgress;
  m_sender           := sender;

  m_requiredColours := TIERGBMap.Create();
  m_lineLength := sqrt(m_bitmap.Width * m_bitmap.Height) * 0.2;
end;

destructor TIEPencilSketch.Destroy();
begin
  m_requiredColours.Free();
  
  inherited;
end;

procedure TIEPencilSketch.CalcRequiredColours();
var
  pixelCodes: array of array of array of byte;
  requiredColours: array of array of array of byte;
  px: PRGB;
  i, row, col: integer;
  bmpWidth, bmpHeight: integer;
  red, green, blue: integer;
  redIndex, greenIndex, blueIndex: integer;
  ri, gi, bi: integer;
begin
  bmpWidth  := m_bitmap.Width;
  bmpHeight := m_bitmap.Height;

  SetLength(m_srcPixels, bmpWidth * bmpHeight);
  i := 0;
  for row := 0 to bmpHeight - 1 do
  begin
    px := m_bitmap.ScanLine[row];
    for col := 0 to bmpWidth - 1 do
    begin
      m_srcPixels[i] := px^;
      inc(px);
      inc(i);
    end;
  end;

  SetLength(pixelCodes, 256, 256, 256);
  for i := 0 to length(m_srcPixels) - 1 do
    pixelCodes[m_srcPixels[i].r, m_srcPixels[i].g, m_srcPixels[i].b] := 1;

  while true do
  begin
    SetLength(requiredColours, 3 + (m_levelSteps - 1), 3 + (m_levelSteps - 1), 3 + (m_levelSteps - 1));
    for red := 0 to 255 do
      for green := 0 to 255 do
        for blue := 0 to 255 do
          if pixelCodes[red, green, blue] = 1 then
          begin
            redIndex   := round(red / 255 * (m_levelSteps - 1));
            greenIndex := round(green / 255 * (m_levelSteps - 1));
            blueIndex  := round(blue / 255 * (m_levelSteps - 1));
            for ri := 0 to 2 do
              for gi := 0 to 2 do
                for bi := 0 to 2 do
                  requiredColours[redIndex + ri, greenIndex + gi, blueIndex + bi] := 1;
          end;
    m_requiredColours.Clear();
    for ri := 0 to length(requiredColours) - 1 do
      for gi := 0 to length(requiredColours[ri]) - 1 do
        for bi := 0 to length(requiredColours[ri, gi]) - 1 do
        begin
          if requiredColours[ri, gi, bi] = 1 then
            m_requiredColours.Insert(CreateRGB(ri, gi, bi));
        end;
    if (m_requiredColours.KeysCount > m_maxTextures) and (m_levelSteps > 2) then
    begin
      dec(m_levelSteps);
      continue;
    end;
    break;
  end;

end;

procedure TIEPencilSketch.CalcStandardDeviation(var sd: TIEArrayOfSingle);
var
  bmpWidth, bmpHeight: integer;
  vsum, vsum2: array of array [0..2] of single;
  hsum, hsum2: array of array [0..2] of single;
  totals, totals2: array [0..2] of single;
  i, index, x, y: integer;
  startIndex, endIndex: integer;
  avgR, avgG, avgB: double;
  avgR2, avgG2, avgB2: double;
  v: double;
begin
  bmpWidth  := m_bitmap.Width;
  bmpHeight := m_bitmap.Height;

  SetLength(vsum, length(m_srcPixels));
  SetLength(vsum2, length(m_SrcPixels));

  for x := 0 to bmpWidth - 1 do
  begin
    for i := 0 to 2 do
    begin
      totals[i]  := 0;
      totals2[i] := 0;
    end;
    for y := 0 to bmpHeight - 1 do
    begin
      index := x + y * bmpWidth;
      totals[0] := totals[0] + m_srcPixels[index].r;
      totals[1] := totals[1] + m_srcPixels[index].g;
      totals[2] := totals[2] + m_srcPixels[index].b;
      totals2[0] := totals2[0] + m_srcPixels[index].r * m_srcPixels[index].r;
      totals2[1] := totals2[1] + m_srcPixels[index].g * m_srcPixels[index].g;
      totals2[2] := totals2[2] + m_srcPixels[index].b * m_srcPixels[index].b;
      for i := 0 to 2 do
      begin
        vsum[index][i]  := totals[i];
        vsum2[index][i] := totals2[i];
      end;
    end;
  end;

  SetLength(hsum, length(m_srcPixels));
  SetLength(hsum2, length(m_SrcPixels));

  for y := 0 to bmpHeight - 1 do
  begin
    for i := 0 to 2 do
    begin
      totals[i]  := 0;
      totals2[i] := 0;
    end;
    for x := 0 to bmpWidth - 1 do
    begin
      index := x + y * bmpWidth;
      startIndex := x + max(0, round(y - m_edgeBlurAmount / 2.0)) * bmpWidth;
      endIndex   := x + min(bmpHeight - 1, round(y + m_edgeBlurAmount / 2.0)) * bmpWidth;
      totals[0] := totals[0] + (vsum[endIndex][0] - vsum[startIndex][0]) / (endIndex - startIndex) * bmpWidth;
      totals[1] := totals[1] + (vsum[endIndex][1] - vsum[startIndex][1]) / (endIndex - startIndex) * bmpWidth;
      totals[2] := totals[2] + (vsum[endIndex][2] - vsum[startIndex][2]) / (endIndex - startIndex) * bmpWidth;
      totals2[0] := totals2[0] + (vsum2[endIndex][0] - vsum2[startIndex][0]) / (endIndex - startIndex) * bmpWidth;
      totals2[1] := totals2[1] + (vsum2[endIndex][1] - vsum2[startIndex][1]) / (endIndex - startIndex) * bmpWidth;
      totals2[2] := totals2[2] + (vsum2[endIndex][2] - vsum2[startIndex][2]) / (endIndex - startIndex) * bmpWidth;
      for i := 0 to 2 do
      begin
        hsum[index][i]  := totals[i];
        hsum2[index][i] := totals2[i];
      end;
    end;
  end;

  SetLength(sd, bmpWidth * bmpHeight);
  for x := 0 to bmpWidth - 1 do
  begin
    for y := 0 to bmpHeight -1 do
    begin
      index := x + y * bmpWidth;

      startIndex := max(0, round(x - m_edgeBlurAmount / 2.0)) + y * bmpWidth;
      endIndex   := min(bmpWidth - 1, round(x + m_edgeBlurAmount / 2.0)) + y * bmpWidth;

      avgR := (hsum[endIndex][0] - hsum[startIndex][0]) / (endIndex - startIndex);
      avgG := (hsum[endIndex][1] - hsum[startIndex][1]) / (endIndex - startIndex);
      avgB := (hsum[endIndex][2] - hsum[startIndex][2]) / (endIndex - startIndex);
      avgR2 := (hsum2[endIndex][0] - hsum2[startIndex][0]) / (endIndex - startIndex);
      avgG2 := (hsum2[endIndex][1] - hsum2[startIndex][1]) / (endIndex - startIndex);
      avgB2 := (hsum2[endIndex][2] - hsum2[startIndex][2]) / (endIndex - startIndex);

      v := (avgR2 + avgG2 + avgB2) - (avgR * avgR + avgG * avgG + avgB * avgB);
      if v >= 0 then
        sd[index] := sqrt(v)
      else
        sd[index] := 0;
    end;
  end;

end;

procedure TIEPencilSketch.Run();
var
  bmpWidth, bmpHeight: integer;
  edges: TIEArrayOfSingle;
  x, y: integer;
  value: integer;
  px: PRGB;
  rgb: TRGB;
  edgeFactor: double;
  index: integer;
begin
  // Calculate required textures
  CalcRequiredColours();

  // Create textures
  CreateTextures();

  // Calculate edges
  CalcStandardDeviation(edges);

  // Assembly final image

  bmpWidth  := m_bitmap.Width;
  bmpHeight := m_bitmap.Height;

  for y := 0 to bmpHeight - 1 do
  begin
    px := m_bitmap.ScanLine[y];
    for x := 0 to bmpWidth - 1 do
    begin
      index := x + y * bmpWidth;
      rgb := getPixel(index, px^);
      if (m_grayscale) then
      begin
        value := round((rgb.r + rgb.g + rgb.b) / 3.0);
        rgb.r := value;
        rgb.g := value;
        rgb.b := value;
      end;
      edgeFactor := max(0, (255 - edges[index] * m_edgeAmount) / 255.0);
      edgeFactor := min(1, max(0.5, edgeFactor * edgeFactor));
      px^.r := round(rgb.r * edgeFactor);
      px^.g := round(rgb.g * edgeFactor);
      px^.b := round(rgb.b * edgeFactor);

      inc(px);
    end;
  end;
end;

procedure TIEPencilSketch.CreateTextures();
var
  width, height: integer;
  steps: integer;
  thickness: double;
  length: double;
  darkeningFactor: double;
  alpha: double;
  densityFactor: double;
  lightness: double;
  ri, gi, bi: integer;
  red, green, blue: double;
  minimum: double;
  scaling: double;
  displayRed, displayGreen, displayBlue: integer;
  colour: TRGB;
  hue, maxRgb, minRgb: double;
  saturation: double;
  angleVariation: double;
  i: integer;
begin
  width  := m_bitmap.Width;
  height := m_bitmap.Height;
  steps  := m_levelSteps;
  thickness := m_lineThickness;
  length := m_lineLength;
  darkeningFactor := 1 - m_darkeningFactor;
  alpha := m_lineAlpha;
  densityFactor := m_lineDensity * 2;
  lightness := m_lightness;

  SetLength(m_textures, steps + 2, steps + 2, steps + 2);
  SetLength(m_texturesColor, steps + 2, steps + 2, steps + 2);

  i := 0;
  m_requiredColours.IterateBegin();
  repeat

    if assigned(m_onProgress) then
      m_onProgress(m_sender, trunc(i / m_requiredColours.KeysCount * 100));

    with m_requiredColours.IterateGetKey() do
    begin
      ri := r - 1;
      gi := g - 1;
      bi := b - 1;
    end;
    red   := 255 * ri / (steps - 1);
    green := 255 * gi / (steps - 1);
    blue  := 255 * bi / (steps - 1);
    red   := min(255, max(0, red));
    green := min(255, max(0, green));
    blue  := min(255, max(0, blue));

    minimum := 1 - min(red, min(green, blue)) / 255;
    if (minimum > 0) then
    begin
      scaling := power(1 / minimum, 1.0 / lightness);
      displayRed   := round((255 - (255 - red) * scaling) * darkeningFactor);
      displayGreen := round((255 - (255 - green) * scaling) * darkeningFactor);
      displayBlue  := round((255 - (255 - blue) * scaling) * darkeningFactor);
      colour := CreateRGB(displayRed, displayGreen, displayBlue);
    end
    else
    begin
      displayRed   := round(red * darkeningFactor);
      displayGreen := round(green * darkeningFactor);
      displayBlue  := round(blue * darkeningFactor);
      colour := CreateRGB(displayRed, displayGreen, displayBlue);
    end;

    if (abs(green - blue) > 0.1) or (abs(2 * red - green - blue) > 0.1) then
    begin
      hue := ArcTan2(sqrt(3) * (green - blue), 2 * red - green - blue);
      maxRgb := max(255 - red, max(255 - green, 255 - blue));
      minRgb := min(255 - red, min(255 - green, 255 - blue));
      saturation := (maxRgb - minRgb) / maxRgb;
      if (saturation = 0) then
        hue := random * PI * 2;
    end
    else
    begin
      hue := 0;
      saturation := 0;
    end;

    angleVariation := PI * (0.1 + 0.9 * power(1 - saturation, 3));
    m_textures[ri + 1][gi + 1][bi + 1] := directionalStrokes(width, height, hue / 2 + PI * 0.3, angleVariation, thickness, length, minimum * densityFactor, alpha);
    m_texturesColor[ri + 1][gi + 1][bi + 1] := colour;

    inc(i);
  until not m_requiredColours.IterateNext();
end;

// plot a line (non antialiased)
// alpha 0..1
procedure IEPencilSketchPlotLine(Bitmap: TIEArrayOfByte; bitmapWidth, bitmapHeight: integer; x0, y0, x1, y1: integer; alpha: double);
var
  dx, dy, sx, sy, err, e2: integer;
  bitmapLength: integer;
  idx: integer;
begin
  bitmapLength := bitmapWidth * bitmapHeight;

  dx := abs(x1 - x0);
  if x0 < x1 then sx := 1 else sx := -1;
  dy := -abs(y1 - y0);
  if y0 < y1 then sy := 1 else sy := -1;
  err := dx + dy;

  while true do
  begin

    // set pixel at x0, y0
    idx := x0 + y0 * bitmapWidth;
    if (idx >= 0) and (idx < BitmapLength) then
      Bitmap[idx] := trunc((1 - alpha) * Bitmap[idx]);

    if (x0 = x1) and (y0 = y1) then
      break;
    e2 := 2 * err;
    if e2 >= dy then
    begin
      inc(err, dy);
      inc(x0, sx);
    end;
    if e2 <= dx then
    begin
      inc(err, dx);
      inc(y0, sy);
    end;
  end;
end;

// plot line with antialias and width
// alpha: 0..1
procedure IEPencilSketchPlotLineAntialias(Bitmap: TIEArrayOfByte; bitmapWidth, bitmapHeight: integer; x0, y0, x1, y1: integer; width: double; alpha: double);
var
  dx, dy, err: integer;
  sx, sy: integer;
  e2, x2, y2: integer;
  ed: double;
  bitmapLength: integer;

  procedure setPixelColor(x, y: integer; c: double);
  var
    idx: integer;
  begin
    idx := x + y * bitmapWidth;
    if (idx >= 0) and (idx < BitmapLength) then
      Bitmap[idx] := trunc((1 - c * alpha) * Bitmap[idx]);
  end;

begin

  bitmapLength := bitmapWidth * bitmapHeight;

  dx := abs(x1 - x0);
  if x0 < x1 then sx := 1 else sx := -1;
  dy := abs(y1 - y0);
  if y0 < y1 then sy := 1 else sy := -1;
  err := dx - dy;
  if dx + dy = 0 then ed := 1 else ed := sqrt(dx * dx + dy * dy);

  width := (width + 1) / 2; ;
  while true do
  begin
    setPixelColor(x0, y0, 1 - max(0, (abs(err - dx + dy) / ed - width + 1)));
    e2 := err;
    x2 := x0;
    if (2 * e2 >= -dx) then
    begin
      inc(e2, dy);
      y2 := y0;
      while (e2 < ed * width) and ((y1 <> y2) or (dx > dy)) do
      begin
        inc(y2, sy);
        setPixelColor(x0, y2, 1 - max(0 , (abs(e2) / ed - width + 1)));
        inc(e2, dx);
      end;
      if x0 = x1 then
        break;
      e2 := err;
      dec(err, dy);
      inc(x0, sx);
    end;
    if 2 * e2 <= dy then
    begin
      e2 := dx - e2;
      while (e2 < ed * width) and ((x1 <> x2) or (dx < dy)) do
      begin
        inc(x2, sx);
        setPixelColor(x2, y0, 1 - max(0 , (abs(e2) / ed - width + 1)));
        inc(e2, dy);
      end;
      if y0 = y1 then
        break;
      inc(err, dx);
      inc(y0, sy);
    end;
  end;
end;



function TIEPencilSketch.DirectionalStrokes(width, height: integer; angle: double; angleVariation: double; thickness: double; length: double; density: double; alpha: double): TIEArrayOfByte;
var
  count: integer;
  i: integer;
  lineAngle, midX, midY, deltaX, deltaY: double;
  startX, endX, startY, endY: double;
begin
  SetLength(result, width * height);
  FillChar(result[0], width * height, 255);
  count := trunc(density * width * height / length / thickness / alpha);
  for i := 0 to count - 1 do
  begin
    lineAngle := angle + round(random * 2 - 1) / 2 * angleVariation;
    midX := random * width;
    midY := random * height;
    deltaX := length / 2 * cos(lineAngle);
    deltaY := length / 2 * sin(lineAngle);
    startX := midX + deltaX;
    endX := midX - deltaX;
    startY := midY + deltaY;
    endY := midY - deltaY;
    if (thickness = 1) and not m_antialiasedLines then
      IEPencilSketchPlotLine(result, width, height, trunc(startX), trunc(startY), trunc(endX), trunc(endY), alpha)
    else
      IEPencilSketchPlotLineAntialias(result, width, height, trunc(startX), trunc(startY), trunc(endX), trunc(endY), thickness, alpha);
  end;
end;


function TIEPencilSketch.GetPixel(index: integer; const rgb: TRGB): TRGB;
var
  redIndex, greenIndex, blueIndex: double;
  redBlend, greenBlend, blueBlend: double;
  blend, blendTotal: double;
  ri, bi, gi: integer;
  red, green, blue: double;
  brighteningFactor: double;
  txri, txgi, txbi: integer;
  c: TRGB;
  v: double;
begin
  redIndex   := rgb.r / 255 * (m_levelSteps - 1);
  greenIndex := rgb.g / 255 * (m_levelSteps - 1);
  blueIndex  := rgb.b / 255 * (m_levelSteps - 1);

  redBlend   := redIndex;
  greenBlend := greenIndex;
  blueBlend  := blueIndex;

  redIndex   := round(redIndex);
  greenIndex := round(greenIndex);
  blueIndex  := round(blueIndex);

  blendTotal := 0;
  for ri := -1 to 1 do
  begin
    for gi := -1 to 1 do
    begin
      for bi := -1 to 1 do
      begin
        blend := (0.75 - abs(redIndex + ri - redBlend) / 2)
                 * (0.75 - abs(greenIndex + gi - greenBlend) / 2)
                 * (0.75 - abs(blueIndex + bi - blueBlend) / 2);
        blendTotal := blendTotal + blend;
      end;
    end;
  end;

  red   := 0;
  green := 0;
  blue  := 0;
  for ri := -1 to 1 do
  begin
    for gi := -1 to 1 do
    begin
      for bi := -1 to 1 do
      begin
        blend := (0.75 - abs(redIndex + ri - redBlend) / 2)
                 *(0.75 - abs(greenIndex + gi - greenBlend) / 2)
                 *(0.75 - abs(blueIndex + bi - blueBlend) / 2);
        blend := blend / blendTotal;

        txri := round(redIndex) + ri + 1;
        txgi := round(greenIndex) + gi + 1;
        txbi := round(blueIndex) + bi + 1;
        v := 1 - m_textures[txri, txgi, txbi][index] / 255;
        c := m_texturesColor[txri, txgi, txbi];
        red   := red   + (v * c.r + (1 - v) * 255) * blend;
        green := green + (v * c.g + (1 - v) * 255) * blend;
        blue  := blue  + (v * c.b + (1 - v) * 255) * blend;
      end;
    end;
  end;
  brighteningFactor := 1 - (1 - (m_levelSteps + 1) / m_levelSteps) * 0.25;
  with result do
  begin
    r := min(255, round(red * brighteningFactor));
    g := min(255, round(green * brighteningFactor));
    b := min(255, round(blue * brighteningFactor));
  end;
end;


procedure IEPencilSketch(Bitmap: TIEBitmap; grayScale: boolean; levelSteps: integer; maxTextures: integer; edgeBlurAmount: integer; edgeAmount: double; lineThickness: double; darkeningFactor: double; lineAlpha: double; lineDensity: double; lightness: double; antialiasedLines: boolean; onProgress: TIEProgressEvent; sender: TObject);
var
  pc: TIEPencilSketch;
begin
  if (Bitmap.Width > 1) and (Bitmap.Height > 1) then
  begin
    pc := TIEPencilSketch.Create(Bitmap, grayScale, levelSteps, maxTextures, edgeBlurAmount, edgeAmount, lineThickness, darkeningFactor, lineAlpha, lineDensity, lightness, antialiasedLines, onProgress, sender);
    try
      pc.Run();
    finally
      pc.Free();
    end;
  end;
end;

{!!
<FS>TImageEnProc.PencilSketch

<FM>Declaration<FC>
procedure PencilSketch(GrayScale: boolean = true; LevelSteps: integer = 2; MaxTextures: integer = MAXINT; EdgeBlurAmount: integer = 4; EdgeAmount: double = 0.5; LineThickness: double = 1; DarkeningFactor: double = 0.1; LineAlpha: double = 0.1; LineDensity: double = 0.5; Lightness: double = 4; AntialiasedLines: boolean = false);

<FM>Description<FN>
Transform an image or the selected area into a pencil-sketch.
This method can be very slow for large images or for particular combination of parameters (like LevelSteps and AntialiasedLines).
It also requires a lot of memory and can fail processing large images.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC> GrayScale <FN></C> <C> If True produces gray scale drawings. </C> </R>
<R> <C><FC> LevelSteps <FN></C> <C> Determines number of colors detected from the image. Suggested range: 2 up to 6. </C> </R>
<R> <C><FC> MaxTextures <FN></C> <C> Overcome LevelSteps parameter, specifing maximum number of textures (colors) to generate. </C> </R>
<R> <C><FC> EdgeBlurAmount <FN></C> <C> Specifies the edge thickness. Suggested range: 2 up to 10. </C> </R>
<R> <C><FC> EdgeAmount <FN></C> <C> Specifies the edge amount. Suggested range: 0 up to 2. </C> </R>
<R> <C><FC> LineThickness <FN></C> <C> Specifies drawn lines thickness. Suggested range: 0.5 up to 10. </C> </R>
<R> <C><FC> DarkeningFactor <FN></C> Specifies how dark is resulting image. Suggested range: 0 up to 10. <C>  </C> </R>
<R> <C><FC> LineAlpha <FN></C> <C> Specifies drawn lines transparency (alpha). Suggested range: 0.05 up to 0.5. </C> </R>
<R> <C><FC> LineDensity <FN></C> <C> Specifies drawn lines density (how much lines are drawn in the textures). Suggested range: 0.25 up to 1. </C> </R>
<R> <C><FC> Lightness <FN></C> <C> Specifies the overall lightness of the resulting image. Suggested range: 1 up to 8. </C> </R>
<R> <C><FC> AntialiasedLines <FN></C> <C> If True texture lines are drawn with antialiasing routine. </C> </R>
</TABLE>

Original image:
<IMG help_images\pencilsketch_before.jpeg>

Applying PencilSketch() to the selected areas:
<IMG help_images\pencilsketch_after1.jpeg>

Applying PencilSketch(false) to the selected areas:
<IMG help_images\pencilsketch_after2.jpeg>
!!}
procedure TImageEnProc.PencilSketch(GrayScale: boolean; LevelSteps: integer; MaxTextures: integer; EdgeBlurAmount: integer; EdgeAmount: double; LineThickness: double; DarkeningFactor: double; LineAlpha: double; LineDensity: double; Lightness: double; AntialiasedLines: boolean);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              Format(IERS_PENCILSKETCH, []),
                              {$ELSE}
                              IEMsg( IEMSG_PENCILSKETCH ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_PENCILSKETCH) then
    exit;
  IEPencilSketch(ProcBitmap, GrayScale, LevelSteps, MaxTextures, EdgeBlurAmount, EdgeAmount, LineThickness, DarkeningFactor, LineAlpha, LineDensity, Lightness, AntialiasedLines, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;


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

{$ifdef IEINCLUDEFFT}

procedure IEFTClearZone(Bitmap: TIEBitmap; x1, y1, x2, y2: Integer; tx1, ty1, tx2, ty2: Integer; GrayScale: Boolean; OnProgress: TIEProgressEvent; Sender: TObject);
var
  FTImage: TIEFtImage;
  nw, nh, wh: Integer;
  zx, zy: Double;
begin
  FTImage := TIEFtImage.Create;
  try
    FTImage.OnProgress := OnProgress;
    if GrayScale then
      FTImage.BuildFT(Bitmap, ieitGRAYSCALE)
    else
      FTImage.BuildFT(Bitmap, ieitRGB);

    TIEFtImage.CalcSuitableSourceSize(Bitmap.Width, Bitmap.Height, nw, nh);
    TIEFtImage.CalcFFTImageSize(nw, nh, wh);
    zx := FTImage.ComplexWidth / wh;
    zy := FTImage.ComplexHeight / wh;

    FTImage.ClearZone(trunc(tx1 * zx), trunc(ty1 * zy), trunc(tx2 * zx), trunc(ty2 * zy));

    FTImage.BuildBitmap(Bitmap);

  finally
    FTImage.Free;
  end;
end;

{!!
<FS>TImageEnProc.FTClearZone

<FM>Declaration<FC>
procedure FTClearZone(tx1, ty1, tx2, ty2: Integer; GrayScale: Boolean);

<FM>Description<FN>
Clear area of an FFT map.

<TABLE>
<R> <H>Parameter</H> <H>Description</H> </R>
<R> <C><FC>tx1<FN></C> <C>Left coordinate of reduced FFT map. Corresponds to <A TImageEnProc.IPDialogParams>.FFT_Left.</C> </R>
<R> <C><FC>ty1<FN></C> <C>Top coordinate of reduced FFT map. Corresponds to <A TImageEnProc.IPDialogParams>.FFT_Top.</C> </R>
<R> <C><FC>tx2<FN></C> <C>Right coordinate of reduced FFT map. Corresponds to <A TImageEnProc.IPDialogParams>.FFT_Right.</C> </R>
<R> <C><FC>ty2<FN></C> <C>Bottom coordinate of reduced FFT map. Corresponds to <A TImageEnProc.IPDialogParams>.FFT_Bottom.</C> </R>
<R> <C><FC>GrayScale<FN></C> <C>Makes the bitmap grayscale. Corresponds to <A TImageEnProc.IPDialogParams>.FFT_GrayScale.</C> </R>
</TABLE>

<FM>Example<FC>
ImageEnView1.Proc.FTClearZone(ImageEnView1.Proc.IPDialogParams.FFT_Left, ImageEnView1.Proc.IPDialogParams.FFT_Top, ImageEnView1.Proc.IPDialogParams.FFT_Right, ImageEnView1.Proc.IPDialogParams.FFT_Bottom, ImageEnView1.Proc.IPDialogParams.FFT_GrayScale);

<FM>See Also<FN>
<TABLE2>
<R> <C_IMG_METHOD> <C><A TImageEnProc.FTClearZone></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.FTConvertFrom></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.FTCreateImage></C> </R>
<R> <C_IMG_METHOD> <C><A TImageEnProc.FTDisplayFrom></C> </R>
</TABLE>
!!}
procedure TImageEnProc.FTClearZone(tx1, ty1, tx2, ty2: Integer; GrayScale: Boolean);
var
  ProcBitmap: TIEBitmap;
  mask: TIEMask;
  x1, y1, x2, y2: Integer;
begin
  if not BeginImageProcessing([ie24RGB], x1, y1, x2, y2,
                              {$IFDEF IEUseLegacyUndoCaptions}
                              IERS_FTCLEARZONE,
                              {$ELSE}
                              IEMsg( IEMSG_FTCLEARZONE ),
                              {$ENDIF}
                              ProcBitmap, mask, IEOP_FTCLEARZONE ) then
    exit;
  IEFTClearZone(ProcBitmap, x1, y1, x2, y2, tx1, ty1, tx2, ty2, GrayScale, fOnProgress, self);
  EndImageProcessing(ProcBitmap, mask);
  DoFinishWork;
end;

{$endif}


type
  TIEUndoStoreInfo = class
    public
      Caption: string;
      Source: TIEUndoSource;
      Operation: Integer;
      MViewIndex: Integer;
      LayerIndex: Integer;
  end;


constructor TIEUndoStore.Create;
begin
  inherited;
  
  fObjectList := TList.Create;
  fInfoList := TObjectList.Create;
end;

destructor TIEUndoStore.Destroy;
begin
  ClearAll();

  FreeAndNil( fObjectList );
  FreeAndNil( fInfoList );

  inherited;
end;

function TIEUndoStore.GetCaptions(index: Integer): String;
begin
  if ( index >= 0 ) and ( index < fInfoList.Count ) then
    result := TIEUndoStoreInfo( fInfoList[ index ] ).Caption;
end;

procedure TIEUndoStore.SetCaptions(index: Integer; const Value: String);
begin
  if ( index >= 0 ) and ( index < fInfoList.Count ) then
    TIEUndoStoreInfo( fInfoList[ index ] ).Caption := Value;
end;

function TIEUndoStore.GetUndoSources(index: Integer): TIEUndoSource;
begin
  Result := ieuUnknown;
  if ( index >= 0 ) and ( index < fInfoList.Count ) then
    result := TIEUndoStoreInfo( fInfoList[ index ] ).Source;
end;

function TIEUndoStore.GetUndoOperations(index: Integer): Integer;
begin
  Result := 0; 
  if ( index >= 0 ) and ( index < fInfoList.Count ) then
    result := TIEUndoStoreInfo( fInfoList[ index ] ).Operation;
end;

function TIEUndoStore.GetMViewIndexes(index: Integer): Integer;
begin
  Result := -1;
  if ( index >= 0 ) and ( index < fInfoList.Count ) then
    result := TIEUndoStoreInfo( fInfoList[ index ] ).MViewIndex;
end;

procedure TIEUndoStore.SetMViewIndexes(index: Integer; const Value: Integer);
begin
  if ( index >= 0 ) and ( index < fInfoList.Count ) then
    TIEUndoStoreInfo( fInfoList[ index ] ).MViewIndex := Value;
end;

function TIEUndoStore.GetUndoObjects(index: Integer): TObject;
begin
  Result := nil;
  if ( index >= 0 ) and ( index < fObjectList.Count ) then
    Result := fObjectList[ Index ];
end;

{$IFDEF IEUseLegacyUndoFunctionality}
procedure TIEUndoStore.SetUndoObjects(index: Integer; obj: TObject);
begin
  if ( index >= 0 ) and ( index < fObjectList.Count ) then
    fObjectList[ Index ] := obj;
end;
{$ENDIF}

procedure TIEUndoStore.SetUndoOperations(index: Integer; const Value: Integer);
begin
  if ( index >= 0 ) and ( index < fInfoList.Count ) then
    TIEUndoStoreInfo( fInfoList[ index ] ).Operation := Value;
end;

function TIEUndoStore.GetLayerIndexes(index: Integer): Integer;
begin
  Result := -1;
  if ( index >= 0 ) and ( index < fInfoList.Count ) then
    result := TIEUndoStoreInfo( fInfoList[ index ] ).LayerIndex;
end;

procedure TIEUndoStore.SetLayerIndexes(index: Integer; const Value: Integer);
begin
  if ( index >= 0 ) and ( index < fInfoList.Count ) then
    TIEUndoStoreInfo( fInfoList[ index ] ).LayerIndex := Value;
end;

procedure TIEUndoStore.ClearAll();
var
  i: Integer;
begin
  for i := 0 to fObjectList.Count - 1 do
    TObject( fObjectList[ i ]).free;
  fObjectList.Clear;
             
  fInfoList.Clear;
end;

procedure TIEUndoStore.ClearAt(idx: Integer; bFreeUndoImg: Boolean = true);
begin
  if ( idx >= 0 ) and ( idx < fObjectList.Count ) then
  begin
    if bFreeUndoImg then
      TObject( fObjectList[ idx ]).free;
    fObjectList.delete( idx );

    fInfoList.delete( idx );
  end;
end;

function TIEUndoStore.Count: integer;
begin
  Result := fObjectList.Count
end;

procedure TIEUndoStore.Add(Obj: TObject; Source: TIEUndoSource; Operation: Integer; MViewIndex: Integer);
var
  info: TIEUndoStoreInfo;
begin
  fObjectList.Add( Obj );

  info := TIEUndoStoreInfo.Create();
  info.Caption    := '';
  info.Source     := Source;
  info.Operation  := Operation;
  info.MViewIndex := MViewIndex;
  info.LayerIndex := -1;

  fInfoList.Add( info );
end;



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



procedure IEInitialize_imageenproc;
begin
  MakeC1TO24;
  IEInitFilterPresets;
  IERawClipFormat := RegisterClipboardFormat( PChar( string( IERawClipFormat_Name )));
  IELayerClipboardFormat := RegisterClipboardFormat( PChar( string( IELayerClipboardFormat_Name )));
end;

procedure IEFinalize_imageenproc;
begin
  IEFreeFilterPresets;
end;


end.