Delphi-OpenCV/component/uOCVImageOperation.pas

// *****************************************************************
// Delphi-OpenCV Demo
// Copyright (C) 2013 Project Delphi-OpenCV
// ****************************************************************
// Contributor:
// Laentir Valetov
// email:laex@bk.ru
// ****************************************************************
// You may retrieve the latest version of this file at the GitHub,
// located at git://github.com/Laex/Delphi-OpenCV.git
// ****************************************************************
// The contents of this file are used with permission, subject to
// the Mozilla Public License Version 1.1 (the "License"); you may
// not use this file except in compliance with the License. You may
// obtain a copy of the License at
// http://www.mozilla.org/MPL/MPL-1_1Final.html
//
// Software distributed under the License is distributed on an
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
// implied. See the License for the specific language governing
// rights and limitations under the License.
// *******************************************************************

unit uOCVImageOperation;

interface

uses
  Winapi.Windows,
  System.SysUtils,
  System.Classes,
  System.SyncObjs,
  System.Types,
  uOCVTypes,
  objdetect_c,
  core.types_c,
  Vcl.Graphics;

type

  TocvCustomImageOperation = class(TComponent)
  protected
    procedure AssignTo(Dest: TPersistent); override;
  private
    FCriticalSection: TCriticalSection;
    FOwner: TPersistent;
    FFloatParams: TArray<Double>;
    FIntParams: TArray<Integer>;
    FBoolParams: TArray<Boolean>;
    FOnAfterPaint: TOnOcvAfterTransform;
    FOnBeforePaint: TOnOcvBeforeTransform;
  protected
    function GetFloatParam(const index: Integer): Double;
    function GetIntParam(const index: Integer): Integer;
    procedure SetFloatParam(const index: Integer; const Value: Double);
    procedure SetIntParam(const index: Integer; const Value: Integer);
    function GetBoolParam(const index: Integer): Boolean;
    procedure SetBoolParam(const index: Integer; const Value: Boolean);
    function LockTransform: Boolean;
    procedure UnlockTransform;
    function GetOwner: TPersistent; override;
    function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean; virtual;
    property FloatParams[const index: Integer]: Double Read GetFloatParam write SetFloatParam;
    property IntParams[const index: Integer]: Integer Read GetIntParam write SetIntParam;
    property BoolParams[const index: Integer]: Boolean Read GetBoolParam write SetBoolParam;
  public
    constructor Create(AOwner: TPersistent); reintroduce; virtual;
    destructor Destroy; override;
    function Transform(const Source: IocvImage; var Destanation: IocvImage): Boolean; virtual;
    function GetNamePath: string; override;
    property Name;
  published
    property OnAfterPaint: TOnOcvAfterTransform read FOnAfterPaint write FOnAfterPaint;
    property OnBeforePaint: TOnOcvBeforeTransform read FOnBeforePaint write FOnBeforePaint;
  end;

  TocvImageOperationClass = class of TocvCustomImageOperation;

  TocvNoneOperation = class(TocvCustomImageOperation)
  public
    function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean; override;
  end;

  TocvGrayScaleOperation = class(TocvCustomImageOperation)
  public
    function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean; override;
  end;

  TovcCannyOperation = class(TocvCustomImageOperation)
  public
    constructor Create(AOwner: TPersistent); override;
    function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean; override;
  published
    property Threshold1: Double index 0 Read GetFloatParam write SetFloatParam;
    property Threshold2: Double index 1 Read GetFloatParam write SetFloatParam;
    property ApertureSize: Integer index 0 Read GetIntParam write SetIntParam;
  end;

  TocvErodeDilateMode = (SHAPE_RECT, SHAPE_CROSS, SHAPE_ELLIPSE, SHAPE_CUSTOM);

  TovcCustomErodeDilateOperation = class(TocvCustomImageOperation)
  protected
    procedure AssignTo(Dest: TPersistent); override;
  private
    FMorphOp: TocvErodeDilateMode;
    procedure SetMorphOp(const Value: TocvErodeDilateMode);
  protected
  public
    constructor Create(AOwner: TPersistent); override;
  published
    property Radius: Integer index 0 Read GetIntParam write SetIntParam;
    property Iterations: Integer index 1 Read GetIntParam write SetIntParam;
    property MorphOp: TocvErodeDilateMode read FMorphOp write SetMorphOp default SHAPE_RECT;
  end;

  TovcErodeOperation = class(TovcCustomErodeDilateOperation)
  public
    function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean; override;
  end;

  TovcDilateOperation = class(TovcCustomErodeDilateOperation)
  public
    function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean; override;
  end;

  TocvLaplaceOperation = class(TocvCustomImageOperation)
  public
    constructor Create(AOwner: TPersistent); override;
    function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean; override;
  published
    property Aperture: Integer index 0 Read GetIntParam write SetIntParam;
  end;

  TovcSobelOperation = class(TocvCustomImageOperation)
  public
    constructor Create(AOwner: TPersistent); override;
    function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean; override;
  published
    property XOrder: Integer index 0 Read GetIntParam write SetIntParam;
    property YOrder: Integer index 1 Read GetIntParam write SetIntParam;
    property Aperture: Integer index 2 Read GetIntParam write SetIntParam;
  end;

  TocvSmoothOperations = (BLUR_NO_SCALE, BLUR, GAUSSIAN, MEDIAN, BILATERAL);

  TovcSmoothOperation = class(TocvCustomImageOperation)
  protected
    procedure AssignTo(Dest: TPersistent); override;
  private
    FSmoothOperation: TocvSmoothOperations;
    procedure SetSmoothOperation(const Value: TocvSmoothOperations);
  public
    constructor Create(AOwner: TPersistent); override;
    function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean; override;
  published
    property sigma1: Double index 0 Read GetFloatParam write SetFloatParam;
    property sigma2: Double index 1 Read GetFloatParam write SetFloatParam;
    property size1: Integer index 0 Read GetIntParam write SetIntParam;
    property size2: Integer index 1 Read GetIntParam write SetIntParam;
    property SmoothOperation: TocvSmoothOperations read FSmoothOperation write SetSmoothOperation default GAUSSIAN;
  end;

  TocvThresholdType = (THRESH_BINARY, THRESH_BINARY_INV, THRESH_TRUNC, THRESH_TOZERO, THRESH_TOZERO_INV, THRESH_MASK,
    THRESH_OTSU);

  TocvCustomThresholdOperation = class(TocvCustomImageOperation)
  private
    function GetThresholdType: TocvThresholdType;
    procedure SetThresholdType(const Value: TocvThresholdType);
  public
    constructor Create(AOwner: TPersistent); override;
  published
    property MaxValue: Double index 0 Read GetFloatParam write SetFloatParam; // default 250;
    property ThresholdType: TocvThresholdType read GetThresholdType write SetThresholdType default THRESH_BINARY; // index 0
  end;

  TocvThresholdOperation = class(TocvCustomThresholdOperation)
  public
    constructor Create(AOwner: TPersistent); override;
    function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean; override;
  published
    property Threshold: Double index 1 Read GetFloatParam write SetFloatParam; // default 50;
  end;

  TocvAdaptiveThresholdType = (ADAPTIVE_THRESH_MEAN_C, ADAPTIVE_THRESH_GAUSSIAN_C);

  TocvAdaptiveThresholdOperation = class(TocvCustomThresholdOperation)
  private
    function GetAdaptiveThresholdType: TocvAdaptiveThresholdType;
    procedure SetAdaptiveThresholdType(const Value: TocvAdaptiveThresholdType);
  public
    constructor Create(AOwner: TPersistent); override;
    function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean; override;
  published
    property AdaptiveThresholdType: TocvAdaptiveThresholdType read GetAdaptiveThresholdType write SetAdaptiveThresholdType
      default ADAPTIVE_THRESH_MEAN_C; // index 1
    property BlockSize: Integer index 2 Read GetIntParam write SetIntParam; // 3
    property Param: Double index 1 Read GetFloatParam write SetFloatParam; // 5;
  end;

  TocvPoint = class(TPersistent)
  protected
    procedure AssignTo(Dest: TPersistent); override;
  private
    FPoint: TPoint;
  public
    constructor Create(const AX: Integer = 0; const AY: Integer = 0);
  published
    property X: Integer read FPoint.X write FPoint.X;
    property Y: Integer read FPoint.Y write FPoint.Y;
  end;

  TocvInterpolationMethod = (INTER_NN, INTER_LINEAR, INTER_CUBIC, INTER_AREA, INTER_LANCZOS4);

  TocvInterpolationWarpingFlag = (WARP_FILL_OUTLIERS, WARP_INVERSE_MAP);
  TocvInterpolationWarpingFlagSet = set of TocvInterpolationWarpingFlag;

  TocvRotateOperation = class(TocvCustomImageOperation)
  protected
    procedure AssignTo(Dest: TPersistent); override;
  private
    FCustomCenter: TocvPoint;
    FMethod: TocvInterpolationMethod;
    FWarpingFlag: TocvInterpolationWarpingFlagSet;
    FScale: Double;
  public
    constructor Create(AOwner: TPersistent); override;
    destructor Destroy; override;
    function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean; override;
  published
    property Angle: Integer index 0 Read GetIntParam write SetIntParam;
    property RotateAroundCenter: Boolean index 0 Read GetBoolParam write SetBoolParam;
    property CustomCenter: TocvPoint Read FCustomCenter write FCustomCenter;
    property Method: TocvInterpolationMethod read FMethod write FMethod default INTER_LINEAR;
    property WarpingFlag: TocvInterpolationWarpingFlagSet read FWarpingFlag write FWarpingFlag default [WARP_FILL_OUTLIERS];
    property Scale: Double read FScale write FScale;
  end;

  TocvAbsDiff = class(TocvCustomImageOperation)
  protected
    FPrevFrame: IocvImage;
  public
    function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean; override;
  end;

  TocvLineType = (LT_FILLED, LT_8, LT_AA);

  TocvDraw = class(TPersistent)
  protected
    procedure AssignTo(Dest: TPersistent); override;
    function GetOwner: TPersistent; override;
  private
    FOwner: TPersistent;
    FOffset: TocvPoint;
    FEnabled: Boolean;
    FThickness: Integer;
    FLineType: TocvLineType;
    FColor: TColor;
    FShift: Integer;
  public
    constructor Create(AOwner: TPersistent);
    destructor Destroy; override;
    property Color: TColor read FColor write FColor default clGreen;
    property Shift: Integer read FShift write FShift default 0;
  published
    property Enabled: Boolean read FEnabled write FEnabled default True;
    property Thickness: Integer read FThickness write FThickness default 2;
    property LineType: TocvLineType read FLineType write FLineType default LT_AA;
    property Offset: TocvPoint read FOffset write FOffset;
  end;

  TocvMatchTemplateMethod = (TM_SQDIFF, TM_SQDIFF_NORMED, TM_CCORR, TM_CCORR_NORMED, TM_CCOEFF, TM_CCOEFF_NORMED);

  TocvMatchTemplate = class(TocvCustomImageOperation)
  protected
    procedure AssignTo(Dest: TPersistent); override;
  private
    FMethod: TocvMatchTemplateMethod;
    FIPLTemplate: pIplImage;
    FTemplate: TPicture;
    FOnMathTemplateRect: TOnOcvRect;
    FDrawRect: TocvDraw;
    procedure SetFIPLTemplate(const Value: pIplImage);
    function GetIPLTemplate: pIplImage;
    procedure TemplateOnChange(Sender: TObject);
  public
    constructor Create(AOwner: TPersistent); override;
    destructor Destroy; override;
    function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean; override;
    property IPLTemplate: pIplImage read GetIPLTemplate write SetFIPLTemplate;
  published
    property Method: TocvMatchTemplateMethod read FMethod write FMethod default TM_CCOEFF_NORMED;
    property Template: TPicture Read FTemplate write FTemplate;
    property DrawRect: TocvDraw read FDrawRect write FDrawRect;
    property OnMathTemplateRect: TOnOcvRect read FOnMathTemplateRect write FOnMathTemplateRect;
  end;

  TocvFaceDraw = class(TocvDraw)
  published
    property Color;
    property Shift;
  end;

  TocvHaarFrontalFace = (HCFFA, HCFFA2, HCFFD, HCFFAT);

  TocvHaarCascadeFlag = (HAAR_DO_CANNY_PRUNING, HAAR_SCALE_IMAGE, HAAR_FIND_BIGGEST_OBJECT, HAAR_DO_ROUGH_SEARCH);
  TocvHaarCascadeFlagSet = set of TocvHaarCascadeFlag;

  TocvFaceDetect = class(TocvCustomImageOperation)
  private
    FFrontalFace: TocvHaarFrontalFace;
    FLockFrontalFaceChange: TCriticalSection;
    FCascade: pCvHaarClassifierCascade;
    FMinSize: TocvPoint;
    FMaxSize: TocvPoint;
    FDrawFace: TocvFaceDraw;
    FCascadeFlags: TocvHaarCascadeFlagSet;
    FOnFace: TOnOcvFaces;
    procedure SetFrontalFace(const Value: TocvHaarFrontalFace);
    procedure ReleaseCascade;
    function GetHaarCascadeFlag: Integer;
  protected
    FPrevFrame: IocvImage;
  public
    constructor Create(AOwner: TPersistent); override;
    destructor Destroy; override;
    function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean; override;
  published
    property FrontalFace: TocvHaarFrontalFace read FFrontalFace write SetFrontalFace default HCFFA;
    property Equalize: Boolean index 1 Read GetBoolParam write SetBoolParam;
    property Scale: Double index 0 Read GetFloatParam write SetFloatParam; // 1.3
    property MinNeighbors: Integer index 0 Read GetIntParam write SetIntParam; // 3
    property MinSize: TocvPoint read FMinSize write FMinSize; // CV_DEFAULT(cvSize(0,0))
    property MaxSize: TocvPoint read FMaxSize write FMaxSize; // {CV_DEFAULT(cvSize(0,0))}
    property DrawFace: TocvFaceDraw read FDrawFace write FDrawFace;
    property CascadeFlags: TocvHaarCascadeFlagSet read FCascadeFlags write FCascadeFlags default [];
    property OnFaces: TOnOcvFaces read FOnFace write FOnFace;
  end;

  IocvEditorPropertiesContainer = interface
    ['{418F88DD-E35D-4425-BF24-E753E83D35D6}']
    function GetProperties: TocvCustomImageOperation;
    function GetPropertiesClass: TocvImageOperationClass;
    procedure SetPropertiesClass(Value: TocvImageOperationClass);
  end;

  TocvContourDraw = class(TocvDraw)
  protected
    procedure AssignTo(Dest: TPersistent); override;
  private
    FHoleColor: TColor;
    FMaxLevel: Integer;
  public
    constructor Create(AOwner: TPersistent);
  published
    property ExternalColor: TColor read FColor write FColor default clGreen;
    property HoleColor: TColor read FHoleColor write FHoleColor default clRed;
    property MaxLevel: Integer read FMaxLevel write FMaxLevel default 2;
  end;

  TocvContourRetrievalModes = (RETR_EXTERNAL, RETR_LIST, RETR_CCOMP, RETR_TREE, RETR_FLOODFILL);

  TocvContourApproximationMethods = (CHAIN_CODE, CHAIN_APPROX_NONE, CHAIN_APPROX_SIMPLE, CHAIN_APPROX_TC89_L1,
    CHAIN_APPROX_TC89_KCOS, LINK_RUNS);

  TocvContourApprox = class(TPersistent)
  protected
    procedure AssignTo(Dest: TPersistent); override;
    function GetOwner: TPersistent; override;
  private
    FOwner: TPersistent;
    FEnabled: Boolean;
    FRecursive: Boolean;
    FEps: Double;
  public
    constructor Create(AOwner: TPersistent);
  published
    property Enabled: Boolean read FEnabled write FEnabled default True;
    property Eps: Double read FEps write FEps;
    property Recursive: Boolean read FRecursive write FRecursive default True;
  end;

  TocvContoursOperation = class(TocvCustomImageOperation, IocvEditorPropertiesContainer)
  private
    CS: TCriticalSection;
    FOperation: TocvCustomImageOperation;
    FOperationClass: TocvImageOperationClass;
    FRetrievalMode: TocvContourRetrievalModes;
    FApproximationMethod: TocvContourApproximationMethods;
    FOffset: TocvPoint;
    FContourDraw: TocvContourDraw;
    FApprox: TocvContourApprox;
    FOnContour: TOnOcvContour;
    FContours: pCvSeq;
    function LockTransform: Boolean;
    procedure UnlockTransform;
    procedure CreateProperties;
    procedure DestroyProperties;
    procedure RecreateProperties;
    function GetPropertiesClassName: string;
    procedure SetProperties(const Value: TocvCustomImageOperation);
    procedure SetPropertiesClass(Value: TocvImageOperationClass);
    procedure SetPropertiesClassName(const Value: string);
    procedure DoNotifyContours(const Image: IocvImage; const ContourCount: Integer; const Contours: pCvSeq);
  protected
    function GetProperties: TocvCustomImageOperation;
    function GetPropertiesClass: TocvImageOperationClass;
    {IInterface}
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  public
    constructor Create(AOwner: TPersistent); override;
    destructor Destroy; override;
    function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean; override;
    property OperationClass: TocvImageOperationClass read GetPropertiesClass write SetPropertiesClass;
    property Contours: pCvSeq read FContours;
  published
    property OperationClassName: string read GetPropertiesClassName write SetPropertiesClassName;
    property Preprocessing: TocvCustomImageOperation read GetProperties write SetProperties;
    property RetrievalMode: TocvContourRetrievalModes read FRetrievalMode write FRetrievalMode default RETR_LIST;
    property ApproximationMethod: TocvContourApproximationMethods read FApproximationMethod write FApproximationMethod
      default CHAIN_APPROX_SIMPLE;
    property Offset: TocvPoint read FOffset write FOffset;
    property MinArea: Integer index 0 Read GetIntParam write SetIntParam;
    property ContourDraw: TocvContourDraw read FContourDraw write FContourDraw;
    property ApproxPoly: TocvContourApprox read FApprox write FApprox;
    property OnContour: TOnOcvContour read FOnContour write FOnContour;
  end;

  TocvImageOperationCollectionItem = class(TCollectionItem, IocvEditorPropertiesContainer)
  private
    CS: TCriticalSection;
    FOperation: TocvCustomImageOperation;
    FOperationClass: TocvImageOperationClass;
    FOnAfterPaint: TOnOcvAfterTransform;
    FOnBeforePaint: TOnOcvBeforeTransform;
    FOwner: TCollection;
    function LockTransform: Boolean;
    procedure UnlockTransform;
    procedure CreateProperties;
    procedure DestroyProperties;
    procedure RecreateProperties;
    function GetPropertiesClassName: string;
    procedure SetProperties(const Value: TocvCustomImageOperation);
    procedure SetPropertiesClass(Value: TocvImageOperationClass);
    procedure SetPropertiesClassName(const Value: string);
  protected
    function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean; virtual;
    function GetProperties: TocvCustomImageOperation;
    function GetPropertiesClass: TocvImageOperationClass;
    function GetDisplayName: string; override;
    function GetOwner: TPersistent; override;
    {IInterface}
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property OperationClass: TocvImageOperationClass read GetPropertiesClass write SetPropertiesClass;
    function Transform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
  published
    property OperationClassName: string read GetPropertiesClassName write SetPropertiesClassName;
    property Operation: TocvCustomImageOperation read GetProperties write SetProperties;
    property OnAfterPaint: TOnOcvAfterTransform read FOnAfterPaint write FOnAfterPaint;
    property OnBeforePaint: TOnOcvBeforeTransform read FOnBeforePaint write FOnBeforePaint;
  end;

  TocvImageOperationCollection = class(TOwnedCollection);

  TocvImageOperation = class(TocvDataSourceAndReceiver, IocvEditorPropertiesContainer)
  private
    CS: TCriticalSection;
    FOperation: TocvCustomImageOperation;
    FOperationClass: TocvImageOperationClass;
    FOperations: TocvImageOperationCollection;
    FUseCollection: Boolean;
    function LockTransform: Boolean;
    procedure UnlockTransform;
    procedure CreateProperties;
    procedure DestroyProperties;
    procedure RecreateProperties;
    function GetPropertiesClassName: string;
    procedure SetProperties(const Value: TocvCustomImageOperation);
    procedure SetPropertiesClass(Value: TocvImageOperationClass);
    procedure SetPropertiesClassName(const Value: string);
    procedure SetUseCollection(const Value: Boolean);
  protected
    procedure TakeImage(const IplImage: IocvImage); override;
    function GetProperties: TocvCustomImageOperation;
    function GetPropertiesClass: TocvImageOperationClass;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property OperationClass: TocvImageOperationClass read GetPropertiesClass write SetPropertiesClass;
  published
    property OperationClassName: string read GetPropertiesClassName write SetPropertiesClassName;
    property Operation: TocvCustomImageOperation read GetProperties write SetProperties;
    property Operations: TocvImageOperationCollection Read FOperations write FOperations;
    property OperationsEnabled: Boolean read FUseCollection write SetUseCollection default True;
  end;

  TRegisteredImageOperations = class(TStringList)
  public
    function FindByClassName(const ClassName: String): TocvImageOperationClass;
    function FindByName(const Name: String): TocvImageOperationClass;
    function GetNameByClass(const IOClass: TClass): String;
    procedure RegisterIOClass(const IOClass: TClass; const ClassName: String);
  end;

function GetRegisteredImageOperations: TRegisteredImageOperations;

implementation

{$R opencv.dres}

Uses
  core_c,
  imgproc_c,
  imgproc.types_c, cvUtils;

type
  TPersistentAccessProtected = class(TPersistent);

Var
  _RegisteredImageOperations: TRegisteredImageOperations = nil;

function GetRegisteredImageOperations: TRegisteredImageOperations;
begin
  if not Assigned(_RegisteredImageOperations) then
    _RegisteredImageOperations := TRegisteredImageOperations.Create;
  Result := _RegisteredImageOperations;
end;

const
  cLineType: array [TocvLineType] of Integer = (CV_FILLED, 8, CV_AA);

procedure GetRGBValue(const AColor: TColor; var r, g, b: byte);
Var
  RGBColor: TColor;
begin
  RGBColor := ColorToRGB(AColor);
  r := GetRValue(RGBColor);
  g := GetGValue(RGBColor);
  b := GetBValue(RGBColor);
end;

{TocvImageOperation}

procedure TocvImageOperation.SetProperties(const Value: TocvCustomImageOperation);
begin
  if (FOperation <> nil) and (Value <> nil) then
    FOperation.Assign(Value);
end;

procedure TocvImageOperation.SetPropertiesClass(Value: TocvImageOperationClass);
begin
  if FOperationClass <> Value then
  begin
    FOperationClass := Value;
    RecreateProperties;
  end;
end;

procedure TocvImageOperation.CreateProperties;
begin
  if FOperationClass <> nil then
    FOperation := FOperationClass.Create(Self);
end;

procedure TocvImageOperation.DestroyProperties;
begin
  FreeAndNil(FOperation);
end;

procedure TocvImageOperation.RecreateProperties;
begin
  DestroyProperties;
  CreateProperties;
end;

procedure TocvImageOperation.SetPropertiesClassName(const Value: string);
begin
  OperationClass := TocvImageOperationClass(GetRegisteredImageOperations.FindByClassName(Value));
end;

procedure TocvImageOperation.SetUseCollection(const Value: Boolean);
begin
  if FUseCollection <> Value then
  begin
    CS.Enter;
    try
      FUseCollection := Value;
    finally
      CS.Leave;
    end;
  end;
end;

constructor TocvImageOperation.Create(AOwner: TComponent);
begin
  inherited;
  CS := TCriticalSection.Create;
  FOperations := TocvImageOperationCollection.Create(Self, TocvImageOperationCollectionItem);
  FUseCollection := True;
end;

destructor TocvImageOperation.Destroy;
begin
  if LockTransform then
    if Assigned(FOperation) then
      FreeAndNil(FOperation);
  FOperations.Free;
  CS.Free;
  inherited;
end;

function TocvImageOperation.GetProperties: TocvCustomImageOperation;
begin
  if not Assigned(FOperation) then
    FOperation := TocvNoneOperation.Create(Self);
  Result := FOperation;
end;

function TocvImageOperation.GetPropertiesClass: TocvImageOperationClass;
begin
  Result := TocvImageOperationClass(Operation.ClassType);
end;

function TocvImageOperation.GetPropertiesClassName: string;
begin
  Result := Operation.ClassName;
end;

function TocvImageOperation.LockTransform: Boolean;
begin
  Result := CS.TryEnter;
end;

procedure TocvImageOperation.TakeImage(const IplImage: IocvImage);
var
  Destanation: IocvImage;
  i: Integer;
begin
  if LockTransform then
    try
      Destanation := IplImage;

      if OperationsEnabled and (FOperations.Count > 0) then
      begin
        for i := 0 to FOperations.Count - 1 do
          if not(FOperations.Items[i] as TocvImageOperationCollectionItem).Transform(Destanation, Destanation) then
            Exit;
      end
      else if Assigned(FOperation) then
        FOperation.Transform(IplImage, Destanation);

      NotifyReceiver(Destanation);
    finally
      Destanation := nil;
      UnlockTransform;
    end;
end;

procedure TocvImageOperation.UnlockTransform;
begin
  CS.Leave;
end;

{TovcImageOperationCanny}

constructor TovcCannyOperation.Create {(AOwner: TPersistent)};
begin
  inherited;
  Threshold1 := 10;
  Threshold2 := 100;
  ApertureSize := 3;
end;

function TovcCannyOperation.DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
begin
  Destanation := TocvImage.Create(cvCreateImage(cvGetSize(Source.IpImage), IPL_DEPTH_8U, 1));
  cvCanny(Source.GrayImage.IpImage, Destanation.IpImage, Threshold1, Threshold2, ApertureSize);
  Result := True;
end;

{TocvImageOperationGrayScale}

function TocvGrayScaleOperation.DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
begin
  Destanation := Source.GrayImage;
  Result := True;
end;

{TocvImageOperationNone}

function TocvNoneOperation.DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
begin
  Destanation := Source;
  Result := True;
end;

{TCustomOpenCVImgOperation}

procedure TocvCustomImageOperation.AssignTo(Dest: TPersistent);
begin
  if Dest is TocvCustomImageOperation then
  begin
    FFloatParams := (Dest as TocvCustomImageOperation).FFloatParams;
    FIntParams := (Dest as TocvCustomImageOperation).FIntParams;
    FBoolParams := (Dest as TocvCustomImageOperation).FBoolParams;
  end
  else
    inherited;
end;

constructor TocvCustomImageOperation.Create(AOwner: TPersistent);
begin
  if AOwner is TComponent then
    inherited Create(AOwner as TComponent)
  else
    inherited Create(nil);
  SetSubComponent(True);

  FOwner := AOwner;
  FCriticalSection := TCriticalSection.Create;
end;

destructor TocvCustomImageOperation.Destroy;
begin
  FCriticalSection.Free;
  inherited;
end;

function TocvCustomImageOperation.DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
begin
  Result := False;
end;

function TocvCustomImageOperation.GetBoolParam(const index: Integer): Boolean;
begin
  if (index >= 0) and (index < Length(FBoolParams)) then
    Result := FBoolParams[index]
  else
    Result := False;
end;

function TocvCustomImageOperation.GetFloatParam(const index: Integer): Double;
begin
  if (index >= 0) and (index < Length(FFloatParams)) then
    Result := FFloatParams[index]
  else
    Result := 0;
end;

function TocvCustomImageOperation.GetIntParam(const index: Integer): Integer;
begin
  if (index >= 0) and (index < Length(FIntParams)) then
    Result := FIntParams[index]
  else
    Result := 0;
end;

function TocvCustomImageOperation.GetNamePath: string;
var
  S: string;
  lOwner: TPersistent;
begin
  Result := inherited GetNamePath;
  lOwner := GetOwner;
  if
  {} (lOwner <> nil) and
  {} (
    {} (csSubComponent in TComponent(lOwner).ComponentStyle) or
    {} (TPersistentAccessProtected(lOwner).GetOwner <> nil)
    {} ) then
  begin
    S := lOwner.GetNamePath;
    if S <> '' then
      Result := S + '.' + Result;
  end;
end;

function TocvCustomImageOperation.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

function TocvCustomImageOperation.LockTransform: Boolean;
begin
  Result := FCriticalSection.TryEnter;
end;

procedure TocvCustomImageOperation.SetBoolParam(const index: Integer; const Value: Boolean);
begin
  if (index >= 0) and LockTransform then
    try
      if index > High(FBoolParams) then
        SetLength(FBoolParams, index + 1);
      FBoolParams[index] := Value;
    finally
      UnlockTransform;
    end;
end;

procedure TocvCustomImageOperation.SetFloatParam(const index: Integer; const Value: Double);
begin
  if (index >= 0) and LockTransform then
    try
      if index > High(FFloatParams) then
        SetLength(FFloatParams, index + 1);
      FFloatParams[index] := Value;
    finally
      UnlockTransform;
    end;
end;

procedure TocvCustomImageOperation.SetIntParam(const index: Integer; const Value: Integer);
begin
  if (index >= 0) and LockTransform then
    try
      if index > High(FIntParams) then
        SetLength(FIntParams, index + 1);
      FIntParams[index] := Value;
    finally
      UnlockTransform;
    end;
end;

function TocvCustomImageOperation.Transform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
Var
  Transform: Boolean;
begin
  Result := LockTransform;
  if Result then
    try
      Transform := True;
      if Assigned(OnBeforePaint) then
        OnBeforePaint(Self, Source, Transform);
      if Transform then
        Result := DoTransform(Source, Destanation)
      else
      begin
        Destanation := Source;
        Result := True;
      end;
      if Result and Assigned(OnAfterPaint) then
        OnAfterPaint(Self, Source);
    finally
      UnlockTransform;
    end;
end;

procedure TocvCustomImageOperation.UnlockTransform;
begin
  FCriticalSection.Leave;
end;

{TovcImageOperationSmooth}
Const
  ocvSmoothOperations: array [TocvSmoothOperations] of Integer = (CV_BLUR_NO_SCALE, CV_BLUR, CV_GAUSSIAN, CV_MEDIAN,
    CV_BILATERAL);

procedure TovcSmoothOperation.AssignTo(Dest: TPersistent);
begin
  inherited;
  if Dest is TovcSmoothOperation then
    FSmoothOperation := (Dest as TovcSmoothOperation).FSmoothOperation;
end;

constructor TovcSmoothOperation.Create {(AOwner: TPersistent)};
begin
  inherited;
  FSmoothOperation := GAUSSIAN;
  size1 := 3;
  size2 := 3;
  sigma1 := 0;
  sigma2 := 0;
end;

procedure TovcSmoothOperation.SetSmoothOperation(const Value: TocvSmoothOperations);
begin
  if LockTransform then
    try
      FSmoothOperation := Value;
    finally
      UnlockTransform;
    end;
end;

function TovcSmoothOperation.DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
Var
  Image: pIplImage;
begin
  Image := cvCloneImage(Source.IpImage);
  cvSmooth(Source.IpImage, Image, ocvSmoothOperations[SmoothOperation], size1, size2, sigma1, sigma2);
  Destanation := TocvImage.Create(Image);
  Result := True;
end;

{TRegisteredImageOperations}

function TRegisteredImageOperations.FindByClassName(const ClassName: String): TocvImageOperationClass;
Var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    if TocvImageOperationClass(Objects[i]).ClassName = ClassName then
      Exit(TocvImageOperationClass(Objects[i]));
end;

function TRegisteredImageOperations.FindByName(const Name: String): TocvImageOperationClass;
Var
  i: Integer;
begin
  i := IndexOf(Name);
  if i <> -1 then
    Result := TocvImageOperationClass(Objects[i])
  else
    Result := Nil;
end;

function TRegisteredImageOperations.GetNameByClass(const IOClass: TClass): String;
Var
  i: Integer;
begin
  Result := '';
  for i := 0 to Count - 1 do
    if Integer(Objects[i]) = Integer(IOClass) then
    begin
      Result := Self[i];
      Break;
    end;
end;

procedure TRegisteredImageOperations.RegisterIOClass(const IOClass: TClass; const ClassName: String);
begin
  AddObject(ClassName, TObject(IOClass));
  RegisterClass(TPersistentClass(IOClass));
end;

{TovcCustomErodeDilate}

procedure TovcCustomErodeDilateOperation.AssignTo(Dest: TPersistent);
begin
  inherited;
  if Dest is TovcCustomErodeDilateOperation then
    FMorphOp := (Dest as TovcCustomErodeDilateOperation).MorphOp;
end;

constructor TovcCustomErodeDilateOperation.Create {(AOwner: TComponent)};
begin
  inherited;
  Radius := 5;
  Iterations := 5;
  FMorphOp := SHAPE_RECT;
end;

procedure TovcCustomErodeDilateOperation.SetMorphOp(const Value: TocvErodeDilateMode);
begin
  if LockTransform then
    try
      FMorphOp := Value;
    finally
      UnlockTransform;
    end;
end;

const
  EDMorpgOp: array [TocvErodeDilateMode] of Integer = (CV_SHAPE_RECT, CV_SHAPE_CROSS, CV_SHAPE_ELLIPSE, CV_SHAPE_CUSTOM);

  {TovcErode}

function TovcErodeOperation.DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
Var
  Kern: pIplConvKernel;
begin
  Destanation := TocvImage.Create(cvCloneImage(Source.IpImage));
  Kern := cvCreateStructuringElementEx(Radius * 2 + 1, Radius * 2 + 1, Radius, Radius, EDMorpgOp[FMorphOp]);
  cvErode(Source.IpImage, Destanation.IpImage, Kern, Iterations);
  cvReleaseStructuringElement(Kern);
  Result := True;
end;

{TovcDilate}

function TovcDilateOperation.DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
Var
  Kern: pIplConvKernel;
begin
  Destanation := TocvImage.Create(cvCloneImage(Source.IpImage));
  Kern := cvCreateStructuringElementEx(Radius * 2 + 1, Radius * 2 + 1, Radius, Radius, EDMorpgOp[FMorphOp]);
  cvDilate(Source.IpImage, Destanation.IpImage, Kern, Iterations);
  cvReleaseStructuringElement(Kern);
  Result := True;
end;

{TocvLaplace}

constructor TocvLaplaceOperation.Create {(AOwner: TComponent)};
begin
  inherited;
  Aperture := 3;
end;

function TocvLaplaceOperation.DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
Var
  TempImg: pIplImage;
begin
  TempImg := cvCreateImage(cvGetSize(Source.IpImage), IPL_DEPTH_16S, Source.IpImage^.nChannels);
  Destanation := TocvImage.Create(cvCreateImage(cvGetSize(Source.IpImage), Source.IpImage^.depth, Source.IpImage^.nChannels));
  cvLaplace(Source.IpImage, TempImg, Aperture);
  cvConvertScale(TempImg, Destanation.IpImage);
  cvReleaseImage(TempImg);
  Result := True;
end;

{TovcSobel}

constructor TovcSobelOperation.Create {(AOwner: TComponent)};
begin
  inherited;
  XOrder := 1;
  YOrder := 1;
  Aperture := 3;
end;

function TovcSobelOperation.DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
Var
  TmpImg: pIplImage;
begin
  TmpImg := cvCreateImage(cvGetSize(Source.IpImage), IPL_DEPTH_16S, Source.IpImage^.nChannels);
  Destanation := TocvImage.Create(cvCreateImage(cvGetSize(Source.IpImage), Source.IpImage^.depth, Source.IpImage^.nChannels));
  cvSobel(Source.IpImage, TmpImg, XOrder, YOrder, Aperture);
  cvConvertScale(TmpImg, Destanation.IpImage);
  cvReleaseImage(TmpImg);
  Result := True;
end;

{TocvImageOperationCollectionItem}

procedure TocvImageOperationCollectionItem.Assign(Source: TPersistent);
begin
  if Source is TocvImageOperationCollectionItem then
    Operation.Assign(TocvImageOperationCollectionItem(Source).Operation)
  else
    inherited;
end;

constructor TocvImageOperationCollectionItem.Create(Collection: TCollection);
begin
  inherited;
  FOwner := Collection;
  CS := TCriticalSection.Create;
end;

procedure TocvImageOperationCollectionItem.CreateProperties;
begin
  if FOperationClass <> nil then
  begin
    FOperation := FOperationClass.Create(Self);
    FOperation.SetParentComponent((GetOwner as TOwnedCollection).Owner as TComponent);
  end;
end;

destructor TocvImageOperationCollectionItem.Destroy;
begin
  if Assigned(FOperation) then
    FOperation.Free;
  CS.Free;
  inherited;
end;

procedure TocvImageOperationCollectionItem.DestroyProperties;
begin
  FreeAndNil(FOperation);
end;

function TocvImageOperationCollectionItem.GetDisplayName: string;
begin
  Result := GetRegisteredImageOperations.GetNameByClass(FOperation.ClassType);
end;

function TocvImageOperationCollectionItem.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

function TocvImageOperationCollectionItem.GetProperties: TocvCustomImageOperation;
begin
  if not Assigned(FOperation) then
    FOperation := TocvNoneOperation.Create(Self);
  Result := FOperation;
end;

function TocvImageOperationCollectionItem.GetPropertiesClass: TocvImageOperationClass;
begin
  Result := TocvImageOperationClass(Operation.ClassType);
end;

function TocvImageOperationCollectionItem.GetPropertiesClassName: string;
begin
  Result := Operation.ClassName;
end;

function TocvImageOperationCollectionItem.LockTransform: Boolean;
begin
  Result := CS.TryEnter;
end;

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

procedure TocvImageOperationCollectionItem.RecreateProperties;
begin
  DestroyProperties;
  CreateProperties;
end;

procedure TocvImageOperationCollectionItem.SetProperties(const Value: TocvCustomImageOperation);
begin
  if (FOperation <> nil) and (Value <> nil) then
    FOperation.Assign(Value);
end;

procedure TocvImageOperationCollectionItem.SetPropertiesClass(Value: TocvImageOperationClass);
begin
  if FOperationClass <> Value then
  begin
    FOperationClass := Value;
    RecreateProperties;
  end;
end;

procedure TocvImageOperationCollectionItem.SetPropertiesClassName(const Value: string);
begin
  OperationClass := TocvImageOperationClass(GetRegisteredImageOperations.FindByClassName(Value));
end;

function TocvImageOperationCollectionItem.DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
begin
  Result := Assigned(FOperation) and FOperation.DoTransform(Source, Destanation);
end;

function TocvImageOperationCollectionItem.Transform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
Var
  Transform: Boolean;
begin
  Result := LockTransform;
  if Result then
    try
      Transform := True;
      if Assigned(OnBeforePaint) then
        OnBeforePaint(Self, Source, Transform);
      if Transform then
        Result := DoTransform(Source, Destanation)
      else
      begin
        Destanation := Source;
        Result := True;
      end;
      if Result and Assigned(OnAfterPaint) then
        OnAfterPaint(Self, Source);
    finally
      UnlockTransform;
    end;
end;

procedure TocvImageOperationCollectionItem.UnlockTransform;
begin
  CS.Leave;
end;

function TocvImageOperationCollectionItem._AddRef: Integer;
begin
  Result := -1;
end;

function TocvImageOperationCollectionItem._Release: Integer;
begin
  Result := -1;
end;

{TocvThresholdOperation}

Const
  cThreshold: array [TocvThresholdType] of Integer = (CV_THRESH_BINARY, CV_THRESH_BINARY_INV, CV_THRESH_TRUNC, CV_THRESH_TOZERO,
    CV_THRESH_TOZERO_INV, CV_THRESH_MASK, CV_THRESH_OTSU);

constructor TocvThresholdOperation.Create {(AOwner: TComponent)};
begin
  inherited;
  Threshold := 50;
end;

constructor TocvCustomThresholdOperation.Create {(AOwner: TComponent)};
begin
  inherited;
  MaxValue := 250;
  ThresholdType := THRESH_BINARY;
end;

function TocvCustomThresholdOperation.GetThresholdType: TocvThresholdType;
begin
  Result := TocvThresholdType(GetIntParam(0));
end;

procedure TocvCustomThresholdOperation.SetThresholdType(const Value: TocvThresholdType);
begin
  SetIntParam(0, Integer(Value));
end;

function TocvThresholdOperation.DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
begin
  Destanation := TocvImage.Create(cvCreateImage(cvGetSize(Source.IpImage), IPL_DEPTH_8U, 1));
  cvThreshold(Source.GrayImage.IpImage, Destanation.IpImage, Threshold, MaxValue, cThreshold[ThresholdType]);
  Result := True;
end;

{TocvAdaptiveThresholdOperation}

const
  cAdaptiveThresholdType: array [TocvAdaptiveThresholdType] of Integer = (CV_ADAPTIVE_THRESH_MEAN_C,
    CV_ADAPTIVE_THRESH_GAUSSIAN_C);

constructor TocvAdaptiveThresholdOperation.Create {(AOwner: TComponent)};
begin
  inherited;
  AdaptiveThresholdType := ADAPTIVE_THRESH_MEAN_C;
  BlockSize := 3;
  Param := 5;
end;

function TocvAdaptiveThresholdOperation.GetAdaptiveThresholdType: TocvAdaptiveThresholdType;
begin
  Result := TocvAdaptiveThresholdType(GetIntParam(1));
end;

procedure TocvAdaptiveThresholdOperation.SetAdaptiveThresholdType(const Value: TocvAdaptiveThresholdType);
begin
  SetIntParam(1, Integer(Value));
end;

function TocvAdaptiveThresholdOperation.DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
begin
  Destanation := TocvImage.Create(cvCreateImage(cvGetSize(Source.IpImage), IPL_DEPTH_8U, 1));
  cvAdaptiveThreshold(Source.GrayImage.IpImage, Destanation.IpImage, MaxValue, cAdaptiveThresholdType[AdaptiveThresholdType],
    cThreshold[ThresholdType], BlockSize, Param);
  Result := True;
end;

{TocvContoursOperation}

constructor TocvContoursOperation.Create {(AOwner: TComponent)};
begin
  inherited;
  CS := TCriticalSection.Create;
  FOffset := TocvPoint.Create;
  FContourDraw := TocvContourDraw.Create(Self);
  FApprox := TocvContourApprox.Create(Self);
  OperationClass := TocvThresholdOperation;
  With Preprocessing as TocvThresholdOperation do
  begin
    Threshold := 128;
    MaxValue := 255;
    ThresholdType := THRESH_BINARY_INV;
  end;
  RetrievalMode := RETR_LIST;
  ApproximationMethod := CHAIN_APPROX_SIMPLE;
  MinArea := 100;
end;

procedure TocvContoursOperation.CreateProperties;
begin
  if FOperationClass <> nil then
    FOperation := FOperationClass.Create(nil);
end;

destructor TocvContoursOperation.Destroy;
begin
  if Assigned(FOperation) then
    FOperation.Free;
  CS.Free;
  FOffset.Free;
  FContourDraw.Free;
  FApprox.Free;
  inherited;
end;

procedure TocvContoursOperation.DestroyProperties;
begin
  FreeAndNil(FOperation);
end;

function TocvContoursOperation.GetProperties: TocvCustomImageOperation;
begin
  if not Assigned(FOperation) then
    FOperation := TocvNoneOperation.Create(nil);
  Result := FOperation;
end;

function TocvContoursOperation.GetPropertiesClass: TocvImageOperationClass;
begin
  Result := TocvImageOperationClass(Preprocessing.ClassType);
end;

function TocvContoursOperation.GetPropertiesClassName: string;
begin
  Result := Preprocessing.ClassName;
end;

function TocvContoursOperation.LockTransform: Boolean;
begin
  Result := CS.TryEnter;
end;

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

procedure TocvContoursOperation.RecreateProperties;
begin
  DestroyProperties;
  CreateProperties;
end;

procedure TocvContoursOperation.SetProperties(const Value: TocvCustomImageOperation);
begin
  if (FOperation <> nil) and (Value <> nil) then
    FOperation.Assign(Value);
end;

procedure TocvContoursOperation.SetPropertiesClass(Value: TocvImageOperationClass);
begin
  if FOperationClass <> Value then
  begin
    FOperationClass := Value;
    RecreateProperties;
  end;
end;

procedure TocvContoursOperation.SetPropertiesClassName(const Value: string);
begin
  OperationClass := TocvImageOperationClass(GetRegisteredImageOperations.FindByClassName(Value));
end;

function TocvContoursOperation.DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
Var
  th_image: IocvImage;
  storage: pCvMemStorage;
  contoursCont: Integer;
  er, eg, eb: byte;
  hr, hg, hb: byte;
  s_contours: pCvSeq;
  area: Double;
begin
  Result := False;
  FContours := nil;
  th_image := nil;
  storage := cvCreateMemStorage(0);
  try
    Destanation := Source; // .Clone;
    if Preprocessing.Transform(Source, th_image) then
    begin
      contoursCont := cvFindContours(th_image.IpImage, storage, @Contours, SizeOf(TCvContour), Integer(RetrievalMode),
        Integer(ApproximationMethod), cvPoint(Offset.X, Offset.Y));
      if ApproxPoly.Enabled then
        FContours := cvApproxPoly(Contours, SizeOf(TCvContour), storage, CV_POLY_APPROX_DP, ApproxPoly.Eps,
          Integer(ApproxPoly.Recursive));
      DoNotifyContours(Destanation, contoursCont, Contours);
      if (contoursCont > 0) and ContourDraw.Enabled then
      begin
        GetRGBValue(ContourDraw.ExternalColor, er, eg, eb);
        GetRGBValue(ContourDraw.HoleColor, hr, hg, hb);
        if MinArea > 0 then
        begin
          s_contours := Contours;
          while (s_contours <> nil) do
          begin
            area := cvContourArea(s_contours, CV_WHOLE_SEQ);
            if abs(area) > MinArea then
              cvDrawContours(Destanation.IpImage, s_contours, CV_RGB(er, eg, eb), CV_RGB(hr, hg, hb), ContourDraw.MaxLevel,
                ContourDraw.Thickness, cLineType[ContourDraw.LineType], cvPoint(ContourDraw.Offset.X, ContourDraw.Offset.Y));
            s_contours := s_contours.h_next;
          end;
        end
        else
          cvDrawContours(Destanation.IpImage, FContours, CV_RGB(er, eg, eb), CV_RGB(hr, hg, hb), ContourDraw.MaxLevel,
            ContourDraw.Thickness, cLineType[ContourDraw.LineType], cvPoint(ContourDraw.Offset.X, ContourDraw.Offset.Y));
      end;
      Result := True;
    end;
  finally
    cvReleaseMemStorage(storage)
  end;
end;

procedure TocvContoursOperation.DoNotifyContours(const Image: IocvImage; const ContourCount: Integer; const Contours: pCvSeq);
begin
  if Assigned(OnContour) then
    OnContour(Self, Image, ContourCount, Contours);
end;

procedure TocvContoursOperation.UnlockTransform;
begin
  CS.Leave;
end;

function TocvContoursOperation._AddRef: Integer;
begin
  Result := -1;
end;

function TocvContoursOperation._Release: Integer;
begin
  Result := -1;
end;

{TocvRotateOperation}

procedure TocvRotateOperation.AssignTo(Dest: TPersistent);
begin
  inherited;
  if Dest is TocvRotateOperation then
  begin
    FCustomCenter := (Dest as TocvRotateOperation).FCustomCenter;
    FMethod := (Dest as TocvRotateOperation).FMethod;
    FWarpingFlag := (Dest as TocvRotateOperation).FWarpingFlag;
    FScale := (Dest as TocvRotateOperation).FScale;
  end;
end;

constructor TocvRotateOperation.Create(AOwner: TPersistent);
begin
  inherited;
  Angle := 90;
  FCustomCenter := TocvPoint.Create;
  RotateAroundCenter := True;
  Method := INTER_LINEAR;
  WarpingFlag := [WARP_FILL_OUTLIERS];
  Scale := 1;
end;

destructor TocvRotateOperation.Destroy;
begin
  FCustomCenter.Free;
  inherited;
end;

function TocvRotateOperation.DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
Var
  rot_mat: pCvMat;
  center: TcvPoint2D32f;
  D: pIplImage;
  M: Integer;
begin
  // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
  rot_mat := cvCreateMat(2, 3, CV_32FC1);
  // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
  if RotateAroundCenter then
  begin
    center.X := Source.IpImage^.width div 2;
    center.Y := Source.IpImage^.height div 2;
  end
  else
  begin
    center.X := CustomCenter.X;
    center.Y := CustomCenter.Y;
  end;
  cv2DRotationMatrix(center, Angle, Scale, rot_mat);
  // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
  D := cvCreateImage(cvGetSize(Source.IpImage), Source.IpImage^.depth, Source.IpImage^.nChannels);
  // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
  M := Integer(Method);
  if WARP_FILL_OUTLIERS in FWarpingFlag then
    M := M or CV_WARP_FILL_OUTLIERS;
  if WARP_INVERSE_MAP in FWarpingFlag then
    M := M or CV_WARP_INVERSE_MAP;
  cvWarpAffine(Source.IpImage, D, rot_mat, M, cvScalarAll(0));
  cvReleaseMat(rot_mat);
  Destanation := TocvImage.Create(D);
  Result := True;
end;

{TPersistentPoint}

procedure TocvPoint.AssignTo(Dest: TPersistent);
begin
  inherited;
  if Dest is TocvPoint then
    FPoint := (Dest as TocvPoint).FPoint;
end;

{TocvCountourDraw}

procedure TocvDraw.AssignTo(Dest: TPersistent);
begin
  inherited;
  if Dest is TocvDraw then
  begin
    FOffset.FPoint := (Dest as TocvDraw).FOffset.FPoint;
    FEnabled := (Dest as TocvDraw).FEnabled;
    FThickness := (Dest as TocvDraw).FThickness;
    FLineType := (Dest as TocvDraw).FLineType;
    FColor := (Dest as TocvDraw).FColor;
  end;
end;

constructor TocvDraw.Create(AOwner: TPersistent);
begin
  inherited Create;
  FOwner := AOwner;
  FOffset := TocvPoint.Create;
  FEnabled := True;
  FThickness := 1;
  FLineType := LT_AA;
  FColor := clGreen;
  FShift := 0;
end;

destructor TocvDraw.Destroy;
begin
  FOffset.Free;
  inherited;
end;

function TocvDraw.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

{TocvContourApprox}

procedure TocvContourApprox.AssignTo(Dest: TPersistent);
begin
  if Dest is TocvContourApprox then
  begin
    FEnabled := (Dest as TocvContourApprox).Enabled;
    FEps := (Dest as TocvContourApprox).Eps;
    FRecursive := (Dest as TocvContourApprox).Recursive;
  end
  else
    inherited;
end;

constructor TocvContourApprox.Create(AOwner: TPersistent);
begin
  inherited Create;
  FOwner := AOwner;
  FEnabled := True;
  FEps := 3;
  FRecursive := True;
end;

function TocvContourApprox.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

{TocvAbsDiff}

function TocvAbsDiff.DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
Var
  GrayImage: IocvImage;
begin
  GrayImage := Source.GrayImage;
  Destanation := GrayImage.Same;
  if Assigned(FPrevFrame) then
    cvAbsDiff(FPrevFrame.IpImage, GrayImage.IpImage, Destanation.IpImage);
  FPrevFrame := GrayImage;
  Result := True;
end;

{TocvFaceDetect}

constructor TocvFaceDetect.Create(AOwner: TPersistent);
begin
  inherited;
  FLockFrontalFaceChange := TCriticalSection.Create;
  FMinSize := TocvPoint.Create(30, 30);
  FMaxSize := TocvPoint.Create;
  FrontalFace := HCFFA;
  FDrawFace := TocvFaceDraw.Create(Self);
  Scale := 1.3;
  MinNeighbors := 3;
  Equalize := True;
end;

destructor TocvFaceDetect.Destroy;
begin
  FLockFrontalFaceChange.Free;
  FMinSize.Free;
  FMaxSize.Free;
  FDrawFace.Free;
  ReleaseCascade;
  inherited;
end;

function TocvFaceDetect.DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
Var
  storage: pCvMemStorage;
  gray: IocvImage;
  detected_objects: pCvSeq;
  i: Integer;
  cvr: pCvRect;
  r, g, b: byte;
  Faces: TocvFaces;
begin
  Destanation := Source;
  if Assigned(FCascade) then
  begin
    storage := cvCreateMemStorage(0);
    try
      gray := Source.GrayImage;
      if Equalize then
        cvEqualizeHist(gray.IpImage, gray.IpImage);
      detected_objects := cvHaarDetectObjects(gray.IpImage, FCascade, storage, Scale, MinNeighbors, GetHaarCascadeFlag,
        cvSize(MinSize.X, MinSize.Y), cvSize(MaxSize.X, MaxSize.Y));

      if Assigned(detected_objects) then
      begin

        if Assigned(OnFaces) then
        begin
          SetLength(Faces, detected_objects^.total);
          i := 0;
          While i < detected_objects^.total do
          begin
            cvr := pCvRect(cvGetSeqElem(detected_objects, i));
            Faces[i] := ocvRect(cvr^.X, cvr^.Y, (cvr^.X) + (cvr^.width), (cvr^.Y) + (cvr^.height));
            Inc(i);
          end;
          OnFaces(Self, Destanation, Faces);
        end;

        if DrawFace.Enabled then
        begin
          GetRGBValue(DrawFace.Color, r, g, b);
          i := 0;
          While i < detected_objects^.total do
          begin
            cvr := pCvRect(cvGetSeqElem(detected_objects, i));
            cvRectangle(Destanation.IpImage, cvPoint(cvr^.X, cvr^.Y), cvPoint((cvr^.X) + (cvr^.width), (cvr^.Y) + (cvr^.height)),
              CV_RGB(r, g, b), DrawFace.Thickness, cLineType[DrawFace.LineType], DrawFace.Shift);
            Inc(i);
          end;
        end;
      end;
      Result := True;
    finally
      cvReleaseMemStorage(storage);
    end;
  end
  else
    Result := False;
end;

function TocvFaceDetect.GetHaarCascadeFlag: Integer;
Var
  i: TocvHaarCascadeFlag;
  j: Integer;
begin
  Result := 0;
  j := 1;
  for i := HAAR_DO_CANNY_PRUNING to HAAR_DO_ROUGH_SEARCH do
  begin
    if i in FCascadeFlags then
      Result := Result or j;
    j := j * 2;
  end;
end;

procedure TocvFaceDetect.ReleaseCascade;
begin
  if Assigned(FCascade) then
    cvReleaseHaarClassifierCascade(FCascade);
  FCascade := nil;
end;

procedure TocvFaceDetect.SetFrontalFace(const Value: TocvHaarFrontalFace);
Type
  TFrontalFaceData = record
    Name: String;
    FileName: String;
  end;

const
  FrontalFaceXML: array [TocvHaarFrontalFace] of TFrontalFaceData =
  {} ((Name: 'HCFFA'; FileName: 'haarcascade_frontalface_alt.xml'),
    {} (Name: 'HCFFA2'; FileName: 'haarcascade_frontalface_alt2.xml'),
    {} (Name: 'HCFFD'; FileName: 'haarcascade_frontalface_default.xml'),
    {} (Name: 'HCFFAT'; FileName: 'haarcascade_frontalface_alt_tree.xml'));

  function TempPath: string;
  var
    BufSize: Cardinal;
  begin
    BufSize := GetTempPath(0, nil);
    SetLength(Result, BufSize);
    GetTempPath(BufSize, PChar(Result));
    Result := Trim(Result);
  end;

Var
  FullFileName: String;

begin
  FLockFrontalFaceChange.Enter;
  try
    if FFrontalFace <> Value then
    begin
      FFrontalFace := Value;
      ReleaseCascade;
    end;
    if not(csDesigning in ComponentState) then
    begin
      if not Assigned(FCascade) then
        try
          FullFileName := TempPath + FrontalFaceXML[FFrontalFace].FileName;
          if not FileExists(FullFileName) then
          begin
            with TResourceStream.Create(hInstance, FrontalFaceXML[FFrontalFace].Name, RT_RCDATA) do
              try
                SaveToFile(FullFileName);
              finally
                Free;
              end;
          end;
          if FileExists(FullFileName) then
            FCascade := cvLoad(c_str(FullFileName), nil, nil, nil);
        except
          ReleaseCascade;
        end;
    end;
  finally
    FLockFrontalFaceChange.Leave;
  end;
end;

constructor TocvPoint.Create(const AX, AY: Integer);
begin
  FPoint.X := AX;
  FPoint.Y := AY;
end;

{TocvContourDraw}

procedure TocvContourDraw.AssignTo(Dest: TPersistent);
begin
  inherited;
  if Dest is TocvContourDraw then
  begin
    FHoleColor := (Dest as TocvContourDraw).FHoleColor;
    FMaxLevel := (Dest as TocvContourDraw).FMaxLevel;
  end;
end;

constructor TocvContourDraw.Create(AOwner: TPersistent);
begin
  inherited;
  FHoleColor := clRed;
  FMaxLevel := 2;
end;

{TocvMatchTemplate}

procedure TocvMatchTemplate.AssignTo(Dest: TPersistent);
begin
  inherited;
  if Dest is TocvMatchTemplate then
  begin
    FMethod := (Dest as TocvMatchTemplate).FMethod;
  end;
end;

constructor TocvMatchTemplate.Create(AOwner: TPersistent);
begin
  inherited;
  FTemplate := TPicture.Create;
  FTemplate.OnChange := TemplateOnChange;
  FDrawRect := TocvDraw.Create(Self);
  FMethod := TM_CCOEFF_NORMED;
end;

destructor TocvMatchTemplate.Destroy;
begin
  if Assigned(FIPLTemplate) then
    cvReleaseImage(FIPLTemplate);
  FTemplate.Free;
  FDrawRect.Free;
  inherited;
end;

procedure TocvMatchTemplate.TemplateOnChange(Sender: TObject);
begin
  IPLTemplate := nil;
end;

function TocvMatchTemplate.DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
Var
  imgMat: pIplImage;
  p1, p2: TCvPoint;
  min: Double;
  r, g, b: byte;
begin
  Destanation := Source;
  if Assigned(IPLTemplate) then
  begin
    imgMat := cvCreateImage(cvSize(Source.IpImage^.width - IPLTemplate^.width + 1, Source.IpImage^.height - IPLTemplate^.height +
      1), IPL_DEPTH_32F, 1);
    cvMatchTemplate(Source.IpImage, IPLTemplate, imgMat, Integer(FMethod));

    if Assigned(OnMathTemplateRect) or DrawRect.Enabled then
    begin
      cvMinMaxLoc(imgMat, @min, @min, nil, @p1, nil);
      p2.X := p1.X + IPLTemplate^.width - 1;
      p2.Y := p1.Y + IPLTemplate^.height - 1;

      if Assigned(OnMathTemplateRect) then
        OnMathTemplateRect(Self, Source, ocvRect(p1.X, p1.Y, p2.X, p2.Y));

      if DrawRect.Enabled then
      begin
        GetRGBValue(DrawRect.Color, r, g, b);
        cvRectangle(Destanation.IpImage, p1, p2, CV_RGB(r, g, b));
      end;

    end;

    cvReleaseImage(imgMat);

    Result := True;
  end
  else
    Result := False;
end;

function TocvMatchTemplate.GetIPLTemplate: pIplImage;
begin
  if not Assigned(FIPLTemplate) then
  begin
    if not Template.Bitmap.Empty then
      FIPLTemplate := BitmapToIplImage(Template.Bitmap);
  end;
  Result := FIPLTemplate;
end;

procedure TocvMatchTemplate.SetFIPLTemplate(const Value: pIplImage);
begin
  if FIPLTemplate <> Value then
  begin
    if Assigned(FIPLTemplate) then
      cvReleaseImage(FIPLTemplate);
    FIPLTemplate := Value;
  end;
end;

initialization

GetRegisteredImageOperations.RegisterIOClass(TocvNoneOperation, 'None');
GetRegisteredImageOperations.RegisterIOClass(TocvGrayScaleOperation, 'GrayScale');
GetRegisteredImageOperations.RegisterIOClass(TovcCannyOperation, 'Canny');
GetRegisteredImageOperations.RegisterIOClass(TovcSmoothOperation, 'Smooth');
GetRegisteredImageOperations.RegisterIOClass(TovcErodeOperation, 'Erode');
GetRegisteredImageOperations.RegisterIOClass(TovcDilateOperation, 'Dilate');
GetRegisteredImageOperations.RegisterIOClass(TocvLaplaceOperation, 'Laplace');
GetRegisteredImageOperations.RegisterIOClass(TovcSobelOperation, 'Sobel');
GetRegisteredImageOperations.RegisterIOClass(TocvThresholdOperation, 'Threshold');
GetRegisteredImageOperations.RegisterIOClass(TocvAdaptiveThresholdOperation, 'AdaptiveThreshold');
GetRegisteredImageOperations.RegisterIOClass(TocvContoursOperation, 'Contours');
GetRegisteredImageOperations.RegisterIOClass(TocvRotateOperation, 'Rotate');
GetRegisteredImageOperations.RegisterIOClass(TocvAbsDiff, 'AbsDiff');
GetRegisteredImageOperations.RegisterIOClass(TocvFaceDetect, 'FaceDetect');
GetRegisteredImageOperations.RegisterIOClass(TocvMatchTemplate, 'MatchTemplate');

finalization

if Assigned(_RegisteredImageOperations) then
  FreeAndNil(_RegisteredImageOperations);

end.