// ***************************************************************** // 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. // ******************************************************************* {$IFNDEF CLR} {$I Opencv.inc} unit ocv.comp.ImageOperation; {$ENDIF} interface uses {$IFDEF HAS_UNITSCOPE} {$IFDEF MSWINDOWS} Winapi.Windows, {$ENDIF MSWINDOWS} Vcl.Graphics, System.SysUtils, System.Classes, System.SyncObjs, System.Types, System.ZLib, {$ELSE} {$IFDEF MSWINDOWS} Windows, {$ENDIF MSWINDOWS} Graphics, SysUtils, Classes, SyncObjs, {$IFNDEF DELPHI5} Types, {$ENDIF} ZLib, {$ENDIF} ocv.comp.Types, ocv.comp.proc, ocv.objdetect_c, ocv.core.types_c, ocv.imgproc.types_c; type {$IFDEF DELPHIXE3_UP} // XE3..XE6 TArrayDouble = TArray; TArrayInteger = TArray; TArrayBoolean = TArray; {$ELSE} // D7...XE2 TArrayDouble = Array of Double; TArrayInteger = Array of Integer; TArrayBoolean = Array of Boolean; {$ENDIF} TocvCustomImageOperation = class(TComponent) protected procedure AssignTo(Dest: TPersistent); override; private FCriticalSection: TCriticalSection; FOwner: TPersistent; FFloatParams: TArrayDouble; FIntParams: TArrayInteger; FBoolParams: TArrayBoolean; FOnAfterTransform: TOnOcvAfterTransform; FOnBeforeTransform: TOnOcvBeforeTransform; protected function GetFloatParam(const index: Integer): Double; virtual; function GetIntParam(const index: Integer): Integer; virtual; function GetBoolParam(const index: Integer): Boolean; virtual; procedure SetFloatParam(const index: Integer; const Value: Double); procedure SetIntParam(const index: Integer; const Value: Integer); procedure SetBoolParam(const index: Integer; const Value: Boolean); function LockTransform: Boolean; procedure UnlockTransform; function GetOwner: TPersistent; override; 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; function GetNamePath: string; override; function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; virtual; property Name; published property OnAfterTransform: TOnOcvAfterTransform read FOnAfterTransform write FOnAfterTransform; property OnBeforeTransform: TOnOcvBeforeTransform read FOnBeforeTransform write FOnBeforeTransform; end; TocvImageOperationClass = class of TocvCustomImageOperation; IocvEditorPropertiesContainer = interface ['{418F88DD-E35D-4425-BF24-E753E83D35D6}'] function GetProperties: TocvCustomImageOperation; function GetPropertiesClass: TocvImageOperationClass; procedure SetPropertiesClass(Value: TocvImageOperationClass); end; TocvCustomImageOperationWithNestedOperation = class(TocvCustomImageOperation, IocvEditorPropertiesContainer) private FOperation: TocvCustomImageOperation; FOperationClass: TocvImageOperationClass; CS: TCriticalSection; protected function LockTransform: Boolean; procedure UnlockTransform; // --------------------------------------------- procedure CreateProperties; procedure DestroyProperties; procedure RecreateProperties; // --------------------------------------------- function GetPropertiesClassName: string; procedure SetPropertiesClassName(const Value: string); function GetProperties: TocvCustomImageOperation; procedure SetProperties(const Value: TocvCustomImageOperation); function GetPropertiesClass: TocvImageOperationClass; virtual; procedure SetPropertiesClass(Value: TocvImageOperationClass); property Operation: TocvCustomImageOperation read GetProperties write SetProperties; public constructor Create(AOwner: TPersistent); override; destructor Destroy; override; property OperationClass: TocvImageOperationClass read GetPropertiesClass write SetPropertiesClass; published property OperationClassName: string read GetPropertiesClassName write SetPropertiesClassName; end; TocvNoneOperation = class(TocvCustomImageOperation) public function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; end; TocvInterpolationMethod = (INTER_NN, INTER_LINEAR, INTER_CUBIC, INTER_AREA, INTER_LANCZOS4); TocvResizeOperation = class(TocvCustomImageOperation) private FInterpolation: TocvInterpolationMethod; protected procedure AssignTo(Dest: TPersistent); override; public constructor Create(AOwner: TPersistent); override; function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; published property DestWidth: Integer index 0 Read GetIntParam write SetIntParam; property DestHeight: Integer index 1 Read GetIntParam write SetIntParam; property Interpolation: TocvInterpolationMethod read FInterpolation write FInterpolation default INTER_LINEAR; end; TocvColorConversion = (BGR2BGRA, RGB2RGBA, BGRA2BGR, RGBA2RGB, BGR2RGBA, RGB2BGRA, RGBA2BGR, BGRA2RGB, BGR2RGB, RGB2BGR, BGRA2RGBA, RGBA2BGRA, BGR2GRAY, RGB2GRAY, GRAY2BGR, GRAY2RGB, GRAY2BGRA, GRAY2RGBA, BGRA2GRAY, RGBA2GRAY, BGR2BGR565, RGB2BGR565, BGR5652BGR, BGR5652RGB, BGRA2BGR565, RGBA2BGR565, BGR5652BGRA, BGR5652RGBA, GRAY2BGR565, BGR5652GRAY, BGR2BGR555, RGB2BGR555, BGR5552BGR, BGR5552RGB, BGRA2BGR555, RGBA2BGR555, BGR5552BGRA, BGR5552RGBA, GRAY2BGR555, BGR5552GRAY, BGR2XYZ, RGB2XYZ, XYZ2BGR, XYZ2RGB, BGR2YCrCb, RGB2YCrCb, YCrCb2BGR, YCrCb2RGB, BGR2HSV, RGB2HSV, BGR2Lab, RGB2Lab, BayerBG2BGR, BayerGB2BGR, BayerRG2BGR, BayerGR2BGR, BayerBG2RGB, BayerGB2RGB, BayerRG2RGB, BayerGR2RGB, BGR2Luv, RGB2Luv, BGR2HLS, RGB2HLS, HSV2BGR, HSV2RGB, Lab2BGR, Lab2RGB, Luv2BGR, Luv2RGB, HLS2BGR, HLS2RGB, BayerBG2BGR_VNG, BayerGB2BGR_VNG, BayerRG2BGR_VNG, BayerGR2BGR_VNG, BayerBG2RGB_VNG, BayerGB2RGB_VNG, BayerRG2RGB_VNG, BayerGR2RGB_VNG, BGR2HSV_FULL, RGB2HSV_FULL, BGR2HLS_FULL, RGB2HLS_FULL, HSV2BGR_FULL, HSV2RGB_FULL, HLS2BGR_FULL, HLS2RGB_FULL, LBGR2Lab, LRGB2Lab, LBGR2Luv, LRGB2Luv, Lab2LBGR, Lab2LRGB, Luv2LBGR, Luv2LRGB, BGR2YUV, RGB2YUV, YUV2BGR, YUV2RGB, BayerBG2GRAY, BayerGB2GRAY, BayerRG2GRAY, BayerGR2GRAY, // YUV 4:2:0 formats family; YUV2RGB_NV12, YUV2BGR_NV12, YUV2RGB_NV21, YUV2BGR_NV21, YUV420sp2RGB, YUV420sp2BGR, YUV2RGBA_NV12, YUV2BGRA_NV12, YUV2RGBA_NV21, YUV2BGRA_NV21, YUV420sp2RGBA, YUV420sp2BGRA, YUV2RGB_YV12, YUV2BGR_YV12, YUV2RGB_IYUV, YUV2BGR_IYUV, YUV2RGB_I420, YUV2BGR_I420, YUV420p2RGB, YUV420p2BGR, YUV2RGBA_YV12, YUV2BGRA_YV12, YUV2RGBA_IYUV, YUV2BGRA_IYUV, YUV2RGBA_I420, YUV2BGRA_I420, YUV420p2RGBA, YUV420p2BGRA, YUV2GRAY_420, YUV2GRAY_NV21, YUV2GRAY_NV12, YUV2GRAY_YV12, YUV2GRAY_IYUV, YUV2GRAY_I420, YUV420sp2GRAY, YUV420p2GRAY, // YUV 4:2:2 formats family; YUV2RGB_UYVY, YUV2BGR_UYVY, YUV2RGB_Y422, YUV2BGR_Y422, YUV2RGB_UYNV, YUV2BGR_UYNV, YUV2RGBA_UYVY, YUV2BGRA_UYVY, YUV2RGBA_Y422, YUV2BGRA_Y422, YUV2RGBA_UYNV, YUV2BGRA_UYNV, YUV2RGB_YUY2, YUV2BGR_YUY2, YUV2RGB_YVYU, YUV2BGR_YVYU, YUV2RGB_YUYV, YUV2BGR_YUYV, YUV2RGB_YUNV, YUV2BGR_YUNV, YUV2RGBA_YUY2, YUV2BGRA_YUY2, YUV2RGBA_YVYU, YUV2BGRA_YVYU, YUV2RGBA_YUYV, YUV2BGRA_YUYV, YUV2RGBA_YUNV, YUV2BGRA_YUNV, YUV2GRAY_UYVY, YUV2GRAY_YUY2, YUV2GRAY_Y422, YUV2GRAY_UYNV, YUV2GRAY_YVYU, YUV2GRAY_YUYV, YUV2GRAY_YUNV, // alpha premultiplication; RGBA2mRGBA, mRGBA2RGBA, COLORCVT_MAX); TocvIPLDepth = (DEPTH_1U, DEPTH_8U, DEPTH_16U, DEPTH_32F, DEPTH_64F, DEPTH_8S, DEPTH_16S, DEPTH_32S); TocvCvtColorOperation = class(TocvCustomImageOperation) private const cIPLDepth: array [TocvIPLDepth] of Integer = (IPL_DEPTH_1U, IPL_DEPTH_8U, IPL_DEPTH_16U, IPL_DEPTH_32F, IPL_DEPTH_64F, (IPL_DEPTH_SIGN or 8), IPL_DEPTH_16S, IPL_DEPTH_32S); cColorConversion: array [TocvColorConversion] of Integer = (CV_BGR2BGRA, CV_RGB2RGBA, CV_BGRA2BGR, CV_RGBA2RGB, CV_BGR2RGBA, CV_RGB2BGRA, CV_RGBA2BGR, CV_BGRA2RGB, CV_BGR2RGB, CV_RGB2BGR, CV_BGRA2RGBA, CV_RGBA2BGRA, CV_BGR2GRAY, CV_RGB2GRAY, CV_GRAY2BGR, CV_GRAY2RGB, CV_GRAY2BGRA, CV_GRAY2RGBA, CV_BGRA2GRAY, CV_RGBA2GRAY, CV_BGR2BGR565, CV_RGB2BGR565, CV_BGR5652BGR, CV_BGR5652RGB, CV_BGRA2BGR565, CV_RGBA2BGR565, CV_BGR5652BGRA, CV_BGR5652RGBA, CV_GRAY2BGR565, CV_BGR5652GRAY, CV_BGR2BGR555, CV_RGB2BGR555, CV_BGR5552BGR, CV_BGR5552RGB, CV_BGRA2BGR555, CV_RGBA2BGR555, CV_BGR5552BGRA, CV_BGR5552RGBA, CV_GRAY2BGR555, CV_BGR5552GRAY, CV_BGR2XYZ, CV_RGB2XYZ, CV_XYZ2BGR, CV_XYZ2RGB, CV_BGR2YCrCb, CV_RGB2YCrCb, CV_YCrCb2BGR, CV_YCrCb2RGB, CV_BGR2HSV, CV_RGB2HSV, CV_BGR2Lab, CV_RGB2Lab, CV_BayerBG2BGR, CV_BayerGB2BGR, CV_BayerRG2BGR, CV_BayerGR2BGR, CV_BayerBG2RGB, CV_BayerGB2RGB, CV_BayerRG2RGB, CV_BayerGR2RGB, CV_BGR2Luv, CV_RGB2Luv, CV_BGR2HLS, CV_RGB2HLS, CV_HSV2BGR, CV_HSV2RGB, CV_Lab2BGR, CV_Lab2RGB, CV_Luv2BGR, CV_Luv2RGB, CV_HLS2BGR, CV_HLS2RGB, CV_BayerBG2BGR_VNG, CV_BayerGB2BGR_VNG, CV_BayerRG2BGR_VNG, CV_BayerGR2BGR_VNG, CV_BayerBG2RGB_VNG, CV_BayerGB2RGB_VNG, CV_BayerRG2RGB_VNG, CV_BayerGR2RGB_VNG, CV_BGR2HSV_FULL, CV_RGB2HSV_FULL, CV_BGR2HLS_FULL, CV_RGB2HLS_FULL, CV_HSV2BGR_FULL, CV_HSV2RGB_FULL, CV_HLS2BGR_FULL, CV_HLS2RGB_FULL, CV_LBGR2Lab, CV_LRGB2Lab, CV_LBGR2Luv, CV_LRGB2Luv, CV_Lab2LBGR, CV_Lab2LRGB, CV_Luv2LBGR, CV_Luv2LRGB, CV_BGR2YUV, CV_RGB2YUV, CV_YUV2BGR, CV_YUV2RGB, CV_BayerBG2GRAY, CV_BayerGB2GRAY, CV_BayerRG2GRAY, CV_BayerGR2GRAY, // YUV 4:2:0 formats family; CV_YUV2RGB_NV12, CV_YUV2BGR_NV12, CV_YUV2RGB_NV21, CV_YUV2BGR_NV21, CV_YUV420sp2RGB, CV_YUV420sp2BGR, CV_YUV2RGBA_NV12, CV_YUV2BGRA_NV12, CV_YUV2RGBA_NV21, CV_YUV2BGRA_NV21, CV_YUV420sp2RGBA, CV_YUV420sp2BGRA, CV_YUV2RGB_YV12, CV_YUV2BGR_YV12, CV_YUV2RGB_IYUV, CV_YUV2BGR_IYUV, CV_YUV2RGB_I420, CV_YUV2BGR_I420, CV_YUV420p2RGB, CV_YUV420p2BGR, CV_YUV2RGBA_YV12, CV_YUV2BGRA_YV12, CV_YUV2RGBA_IYUV, CV_YUV2BGRA_IYUV, CV_YUV2RGBA_I420, CV_YUV2BGRA_I420, CV_YUV420p2RGBA, CV_YUV420p2BGRA, CV_YUV2GRAY_420, CV_YUV2GRAY_NV21, CV_YUV2GRAY_NV12, CV_YUV2GRAY_YV12, CV_YUV2GRAY_IYUV, CV_YUV2GRAY_I420, CV_YUV420sp2GRAY, CV_YUV420p2GRAY, // YUV 4:2:2 formats family; CV_YUV2RGB_UYVY, CV_YUV2BGR_UYVY, CV_YUV2RGB_Y422, CV_YUV2BGR_Y422, CV_YUV2RGB_UYNV, CV_YUV2BGR_UYNV, CV_YUV2RGBA_UYVY, CV_YUV2BGRA_UYVY, CV_YUV2RGBA_Y422, CV_YUV2BGRA_Y422, CV_YUV2RGBA_UYNV, CV_YUV2BGRA_UYNV, CV_YUV2RGB_YUY2, CV_YUV2BGR_YUY2, CV_YUV2RGB_YVYU, CV_YUV2BGR_YVYU, CV_YUV2RGB_YUYV, CV_YUV2BGR_YUYV, CV_YUV2RGB_YUNV, CV_YUV2BGR_YUNV, CV_YUV2RGBA_YUY2, CV_YUV2BGRA_YUY2, CV_YUV2RGBA_YVYU, CV_YUV2BGRA_YVYU, CV_YUV2RGBA_YUYV, CV_YUV2BGRA_YUYV, CV_YUV2RGBA_YUNV, CV_YUV2BGRA_YUNV, CV_YUV2GRAY_UYVY, CV_YUV2GRAY_YUY2, CV_YUV2GRAY_Y422, CV_YUV2GRAY_UYNV, CV_YUV2GRAY_YVYU, CV_YUV2GRAY_YUYV, CV_YUV2GRAY_YUNV, // alpha premultiplication; CV_RGBA2mRGBA, CV_mRGBA2RGBA, CV_COLORCVT_MAX); private FColorConversion: TocvColorConversion; // FAutoCalcParams: Boolean; FChannels: Integer; FDepth: TocvIPLDepth; public constructor Create(AOwner: TPersistent); override; // procedure CalculateImageParams(const Source: IocvImage); function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; published // property AutoCalcParams: Boolean read FAutoCalcParams write FAutoCalcParams default True; property ColorConversion: TocvColorConversion read FColorConversion write FColorConversion default RGB2GRAY; property Depth: TocvIPLDepth Read FDepth write FDepth; property Channels: Integer read FChannels write FChannels; end; TocvGrayScaleOperation = class(TocvCvtColorOperation) public function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; property ColorConversion; property Depth; property Channels; end; TocvCannyOperation = class(TocvCustomImageOperation) public constructor Create(AOwner: TPersistent); override; function DoTransform(const Source: IocvImage; out 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); TocvCustomErodeDilateOperation = 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; TocvErodeOperation = class(TocvCustomErodeDilateOperation) public function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; end; TocvDilateOperation = class(TocvCustomErodeDilateOperation) public function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; end; TocvLaplaceOperation = class(TocvCustomImageOperation) public constructor Create(AOwner: TPersistent); override; function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; published property Aperture: Integer index 0 Read GetIntParam write SetIntParam; end; TocvScalar = class(TPersistent) protected procedure AssignTo(Dest: TPersistent); override; private FCvScalar: TCvScalar; function GetScalar(const index: Integer): Double; procedure SetScalar(const index: Integer; const Value: Double); public property CvScalar: TCvScalar read FCvScalar write FCvScalar; property Scalar[const Index: Integer]: Double read GetScalar write SetScalar; published property Val0: Double index 0 read GetScalar write SetScalar; property Val1: Double index 1 read GetScalar write SetScalar; property Val2: Double index 2 read GetScalar write SetScalar; property Val3: Double index 3 read GetScalar write SetScalar; end; TOnGetImage = procedure(Sender: TObject; Var Source2Image: IocvImage) of object; TocvCommonMathOperation = class(TocvCustomImageOperation, IocvDataReceiver) private FocvVideoSource: IocvDataSource; FSrource2Image: IocvImage; FOnGetImage: TOnGetImage; FOnGetMaskImage: TOnGetImage; FTransformInterpolation: TocvInterpolationMethod; procedure SetVideoSource_Source2(const Value: IocvDataSource); procedure DoGetSourceImage(Var Image: IocvImage); procedure DoGetMaskImage(Var Image: IocvImage); procedure GetImagesForTransorm(out Source1: IocvImage; out Source2, Mask: IocvImage); // -------------------------------------- property VideoSource: IocvDataSource Read FocvVideoSource write SetVideoSource_Source2; property OnGetSourceImage: TOnGetImage read FOnGetImage write FOnGetImage; property OnGetMaskImage: TOnGetImage read FOnGetMaskImage write FOnGetMaskImage; property TransformInterpolation: TocvInterpolationMethod read FTransformInterpolation write FTransformInterpolation default INTER_CUBIC; public constructor Create(AOwner: TPersistent); override; protected procedure TakeImage(const IplImage: IocvImage); procedure SetVideoSource(const Value: TObject); published end; TocvAddWeightedOperation = class(TocvCommonMathOperation) public constructor Create(AOwner: TPersistent); override; function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; published property VideoSource; property OnGetSourceImage; property TransformInterpolation; property Alpha: Double index 0 Read GetFloatParam write SetFloatParam; property Beta: Double index 1 Read GetFloatParam write SetFloatParam; property Gamma: Double index 2 Read GetFloatParam write SetFloatParam; end; TocvLogicType = (ioAdd, ioSub, ioAnd, ioOr, ioXor); TocvLogicOperation = class(TocvCommonMathOperation) protected procedure AssignTo(Dest: TPersistent); override; private FOperation: TocvLogicType; public constructor Create(AOwner: TPersistent); override; function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; published property VideoSource; property OnGetSourceImage; property OnGetMaskImage; property TransformInterpolation; property Operation: TocvLogicType read FOperation write FOperation default ioAdd; end; TocvLogicSType = (ioAddS, ioSubS, ioSubRS, ioXorS); TocvLogicSOperation = class(TocvCommonMathOperation) protected procedure AssignTo(Dest: TPersistent); override; private FOperation: TocvLogicSType; FValue: TocvScalar; public constructor Create(AOwner: TPersistent); override; destructor Destroy; override; function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; published property OnGetMaskImage; property TransformInterpolation; property Operation: TocvLogicSType read FOperation write FOperation default ioAddS; property Value: TocvScalar read FValue write FValue; end; TocvSobelOperation = class(TocvCustomImageOperation) public constructor Create(AOwner: TPersistent); override; function DoTransform(const Source: IocvImage; out 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); TocvSmoothOperation = 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; out 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 SmoothType: 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; out 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; out 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; TocvPoint2D32i = class(TPersistent) protected procedure AssignTo(Dest: TPersistent); override; private FSize: TcvSize; public constructor Create(const AX: Integer = 0; const AY: Integer = 0); property Size: TcvSize read FSize write FSize; published property X: Integer read FSize.Width write FSize.Width; property Y: Integer read FSize.height write FSize.height; end; TocvPoint2D32f = class(TPersistent) protected procedure AssignTo(Dest: TPersistent); override; private FX, FY: Single; public constructor Create(const AX: Single = 0; const AY: Single = 0); published property X: Single read FX write FX; property Y: Single read FY write FY; end; TocvRect32i = class(TPersistent) protected procedure AssignTo(Dest: TPersistent); override; private FRight: Integer; FBottom: Integer; FTop: Integer; FLeft: Integer; function GetHeight: Integer; function GetOcvRect: TocvRect; function GetWidth: Integer; procedure SetHeight(const Value: Integer); procedure SetOcvRect(const Value: TocvRect); procedure SetWidth(const Value: Integer); function GetCvRect: TCvRect; procedure SetCvRect(const Value: TCvRect); public published property Left: Integer read FLeft write FLeft; property Top: Integer read FTop write FTop; property Bottom: Integer read FBottom write FBottom; property Right: Integer read FRight write FRight; property Width: Integer read GetWidth write SetWidth; property height: Integer read GetHeight write SetHeight; property ocvRect: TocvRect read GetOcvRect write SetOcvRect; property cvRect: TCvRect read GetCvRect write SetCvRect; end; TocvCropOperation = class(TocvCustomImageOperation) private FCropRect: TocvRect32i; public constructor Create(AOwner: TPersistent); override; destructor Destroy; override; function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; published property CropRect: TocvRect32i read FCropRect write FCropRect; end; TocvInRangeSOperation = class(TocvCustomImageOperation) protected procedure AssignTo(Dest: TPersistent); override; private FLower: TocvScalar; FUpper: TocvScalar; public constructor Create(AOwner: TPersistent); override; destructor Destroy; override; function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; published property Lower: TocvScalar read FLower write FLower; property Upper: TocvScalar read FUpper write FUpper; end; // TocvLogicType = // ( // ioAdd, // ioAddS, // ioSub, // ioSubS, // ioSubRS, // ioMul, // ioDiv, // ioScaleAdd, // ioAXPY // ); // // TocvMathLogicOperation = class(TocvCustomImageOperation) // public // constructor Create(AOwner: TPersistent); override; // destructor Destroy; override; // function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; // published // end; TocvInterpolationWarpingFlag = (WARP_FILL_OUTLIERS, WARP_INVERSE_MAP); TocvInterpolationWarpingFlagSet = set of TocvInterpolationWarpingFlag; TocvRotateOperation = class(TocvCustomImageOperation) protected procedure AssignTo(Dest: TPersistent); override; private FCenter: TocvPoint2D32f; FMethod: TocvInterpolationMethod; FWarpingFlag: TocvInterpolationWarpingFlagSet; FFillColor: TColor; public constructor Create(AOwner: TPersistent); override; destructor Destroy; override; function DoTransform(const Source: IocvImage; out 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: TocvPoint2D32f Read FCenter write FCenter; property Method: TocvInterpolationMethod read FMethod write FMethod default INTER_LINEAR; property WarpingFlag: TocvInterpolationWarpingFlagSet read FWarpingFlag write FWarpingFlag default [WARP_FILL_OUTLIERS]; property Scale: Double index 0 Read GetFloatParam write SetFloatParam; property FillColor: TColor read FFillColor write FFillColor default clBlack; end; TocvQuad = class(TPersistent) protected procedure AssignTo(Dest: TPersistent); override; public type TOcvQuadPoints = array [0 .. 3] of TocvPoint2D32f; TCvPoint2D32fArray = array [0 .. 3] of TCvPoint2D32f; protected FPoints: TOcvQuadPoints; function ShaIsConvexQuadrangle: Boolean; private function GetPoints(const index: Integer): TocvPoint2D32f; procedure SetPoints(const index: Integer; const Value: TocvPoint2D32f); function GetCvQuad: TCvPoint2D32fArray; public constructor Create; destructor Destroy; override; property Points[const Index: Integer]: TocvPoint2D32f read GetPoints write SetPoints; property Quad: TOcvQuadPoints read FPoints; property cvQuad: TCvPoint2D32fArray read GetCvQuad; published property TopLeft: TocvPoint2D32f index 0 read GetPoints write SetPoints; property TopRight: TocvPoint2D32f index 1 read GetPoints write SetPoints; property BottomLeft: TocvPoint2D32f index 2 read GetPoints write SetPoints; property BottomRight: TocvPoint2D32f index 3 read GetPoints write SetPoints; end; TocvWarpPerspective = class(TocvCustomImageOperation) protected procedure AssignTo(Dest: TPersistent); override; private FSourceQuad: TocvQuad; FDestQuad: TocvQuad; FMethod: TocvInterpolationMethod; FWarpingFlag: TocvInterpolationWarpingFlagSet; FFillColor: TColor; public constructor Create(AOwner: TPersistent); override; destructor Destroy; override; function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; published property SourceQuad: TocvQuad read FSourceQuad write FSourceQuad; property DestQuad: TocvQuad read FDestQuad write FDestQuad; property Method: TocvInterpolationMethod read FMethod write FMethod default INTER_LINEAR; property WarpingFlag: TocvInterpolationWarpingFlagSet read FWarpingFlag write FWarpingFlag default [WARP_FILL_OUTLIERS]; property FullSourceImage: Boolean index 0 Read GetBoolParam write SetBoolParam; property FillColor: TColor Read FFillColor write FFillColor; end; TocvAbsDiff = class(TocvCustomImageOperation) protected FPrevFrame: IocvImage; public function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; end; TocvDraw = class(TPersistent) protected FColor: TColor; procedure AssignTo(Dest: TPersistent); override; function GetOwner: TPersistent; override; private FOwner: TPersistent; FOffset: TocvPoint2D32i; FEnabled: Boolean; FThickness: Integer; FLineType: TocvLineType; FShift: Integer; function GetCvLineType: Integer; function GetCvColor: TCvScalar; 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; property cvLineType: Integer read GetCvLineType; property cvColor: TCvScalar read GetCvColor; 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: TocvPoint2D32i read FOffset write FOffset; end; TocvDrawColor = class(TocvDraw) published property Color; 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; out 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; TocvMotionDetectCalcRectType = (mdBoundingRect, mdMinAreaRect); TocvContourApproximationMethods = (CHAIN_CODE, CHAIN_APPROX_NONE, CHAIN_APPROX_SIMPLE, CHAIN_APPROX_TC89_L1, CHAIN_APPROX_TC89_KCOS, LINK_RUNS); TocvDrawMotionRect = TocvDrawColor; TocvMotionDetect = class(TocvCustomImageOperationWithNestedOperation) protected procedure AssignTo(Dest: TPersistent); override; function GetPropertiesClass: TocvImageOperationClass; override; private FCalcRectType: TocvMotionDetectCalcRectType; FPrevFrame: IocvImage; FSmoothOperation: TocvSmoothOperations; FDrawMotionRect: TocvDrawMotionRect; FOnMotion: TOnOcvRects; FContours: pCvSeq; public constructor Create(AOwner: TPersistent); override; destructor Destroy; override; function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; property MotionRects: pCvSeq Read FContours; published property RemoveSmallObject: Boolean index 0 Read GetBoolParam write SetBoolParam; property MinObjectSize: Integer index 0 Read GetIntParam write SetIntParam; property CalcRectType: TocvMotionDetectCalcRectType read FCalcRectType write FCalcRectType default mdBoundingRect; property Smooth: TocvSmoothOperations read FSmoothOperation write FSmoothOperation default BLUR; property Threshold: TocvCustomImageOperation read GetProperties write SetProperties; property DrawMotionRect: TocvDrawMotionRect read FDrawMotionRect Write FDrawMotionRect; property OnMotion: TOnOcvRects read FOnMotion write FOnMotion; property NotifyOnlyWhenFound: Boolean index 1 Read GetBoolParam write SetBoolParam; end; TocvHoughTransform = (HOUGH_STANDARD, HOUGH_PROBABILISTIC, HOUGH_MULTI_SCALE, HOUGH_GRADIENT); TocvDrawHoughCircles = TocvDrawColor; TocvHoughCirclesSmooth = class(TPersistent) protected procedure AssignTo(Dest: TPersistent); override; private FSmoothOperation: TocvSmoothOperations; Fsigma1: Double; Fsigma2: Double; Fsize1: Integer; Fsize2: Integer; FEnabled: Boolean; public constructor Create; published property sigma1: Double Read Fsigma1 write Fsigma1; property sigma2: Double Read Fsigma2 write Fsigma2; property size1: Integer Read Fsize1 write Fsize1 default 0; property size2: Integer Read Fsize2 write Fsize2 default 0; property SmoothType: TocvSmoothOperations read FSmoothOperation write FSmoothOperation default GAUSSIAN; property Enabled: Boolean read FEnabled write FEnabled default True; end; TocvHoughCircles = class(TocvCustomImageOperation) protected procedure AssignTo(Dest: TPersistent); override; private FHoughTransform: TocvHoughTransform; FDrawCircle: TocvDrawHoughCircles; FOnCircles: TOnOcvCircles; FSmooth: TocvHoughCirclesSmooth; public constructor Create(AOwner: TPersistent); override; destructor Destroy; override; function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; published property Method: TocvHoughTransform read FHoughTransform write FHoughTransform default HOUGH_GRADIENT; property InverseRatio: Double index 0 Read GetFloatParam write SetFloatParam; property MinDist: Double index 1 Read GetFloatParam write SetFloatParam; property Param1: Double index 2 Read GetFloatParam write SetFloatParam; property Param2: Double index 3 Read GetFloatParam write SetFloatParam; property MinRadius: Integer index 0 Read GetIntParam write SetIntParam; property MaxRadius: Integer index 1 Read GetIntParam write SetIntParam; property DrawCircle: TocvDrawHoughCircles read FDrawCircle write FDrawCircle; property OnCircles: TOnOcvCircles read FOnCircles write FOnCircles; property NotifyOnlyWhenFound: Boolean index 0 Read GetBoolParam write SetBoolParam; property Smooth: TocvHoughCirclesSmooth read FSmooth write FSmooth; end; TocvHoughLinesCanny = class(TPersistent) protected procedure AssignTo(Dest: TPersistent); override; private FThreshold1: Double; FThreshold2: Double; FApertureSize: Integer; public constructor Create; published property Threshold1: Double read FThreshold1 write FThreshold1; property Threshold2: Double read FThreshold2 write FThreshold2; property ApertureSize: Integer read FApertureSize write FApertureSize default 3; end; TocvDrawHoughLines = TocvDrawColor; TocvHoughLines = class(TocvCustomImageOperation) protected procedure AssignTo(Dest: TPersistent); override; private FHoughTransform: TocvHoughTransform; FCanny: TocvHoughLinesCanny; FOnLines: TOnOcvLines; FDrawLines: TocvDrawHoughLines; public constructor Create(AOwner: TPersistent); override; destructor Destroy; override; function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; published property Method: TocvHoughTransform read FHoughTransform write FHoughTransform default HOUGH_PROBABILISTIC; property Rho: Double index 0 Read GetFloatParam write SetFloatParam; property Theta: Double index 1 Read GetFloatParam write SetFloatParam; property Param1: Double index 2 Read GetFloatParam write SetFloatParam; property Param2: Double index 3 Read GetFloatParam write SetFloatParam; property Threshold: Integer index 0 Read GetIntParam write SetIntParam; property Canny: TocvHoughLinesCanny Read FCanny write FCanny; property OnLines: TOnOcvLines read FOnLines write FOnLines; property DrawLines: TocvDrawHoughLines read FDrawLines write FDrawLines; property NotifyOnlyWhenFound: Boolean index 0 Read GetBoolParam write SetBoolParam; end; TocvHaarCascadeDraw = class(TocvDraw) published property Color; property Shift; end; TocvHaarCascade = class(TocvCustomImageOperation) private FHaarCascade: TocvHaarCascadeType; FLockFrontalFaceChange: TCriticalSection; FCascade: pCvHaarClassifierCascade; FMinSize: TocvPoint2D32i; FMaxSize: TocvPoint2D32i; FDrawHaarCascade: TocvHaarCascadeDraw; FCascadeFlags: TocvHaarCascadeFlagSet; FOnHaarCascade: TOnOcvHaarCascade; FCustomHaarCascade: TFileName; FHaarRects: TocvRects; procedure SetHaarCascade(const Value: TocvHaarCascadeType); procedure ReleaseCascade; procedure SetCustomHaarCascade(const Value: TFileName); procedure DoLoadHaarCascade(const FileName: String); protected FPrevFrame: IocvImage; public constructor Create(AOwner: TPersistent); override; destructor Destroy; override; function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; property HaarRects: TocvRects read FHaarRects; published property CustomHaarCascade: TFileName read FCustomHaarCascade write SetCustomHaarCascade; property HaarCascade: TocvHaarCascadeType read FHaarCascade write SetHaarCascade default hcFrontalFaceAlt; property Equalize: Boolean index 0 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: TocvPoint2D32i read FMinSize write FMinSize; // CV_DEFAULT(cvSize(0,0)) property MaxSize: TocvPoint2D32i read FMaxSize write FMaxSize; // {CV_DEFAULT(cvSize(0,0))} property DrawHaarCascade: TocvHaarCascadeDraw read FDrawHaarCascade write FDrawHaarCascade; property CascadeFlags: TocvHaarCascadeFlagSet read FCascadeFlags write FCascadeFlags default []; property OnHaarCascade: TOnOcvHaarCascade read FOnHaarCascade write FOnHaarCascade; property NotifyOnlyWhenFound: Boolean index 1 Read GetBoolParam write SetBoolParam; 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); 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(TocvCustomImageOperationWithNestedOperation) private FRetrievalMode: TocvContourRetrievalModes; FApproximationMethod: TocvContourApproximationMethods; FOffset: TocvPoint2D32i; FContourDraw: TocvContourDraw; FApprox: TocvContourApprox; FOnContour: TOnOcvContour; FContours: pCvSeq; procedure DoNotifyContours(const Image: IocvImage; const ContourCount: Integer; const Contours: pCvSeq); public constructor Create(AOwner: TPersistent); override; destructor Destroy; override; function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override; property Contours: pCvSeq read FContours; published 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: TocvPoint2D32i 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; FOwner: TCollection; FOnAfterTransform: TOnOcvAfterTransform; FOnBeforeTransform: TOnOcvBeforeTransform; 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 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; function GetNamePath: string; override; procedure Assign(Source: TPersistent); override; function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; virtual; property OperationClass: TocvImageOperationClass read GetPropertiesClass write SetPropertiesClass; published property OperationClassName: string read GetPropertiesClassName write SetPropertiesClassName; property Operation: TocvCustomImageOperation read GetProperties write SetProperties; property OnAfterTransform: TOnOcvAfterTransform read FOnAfterTransform write FOnAfterTransform; property OnBeforeTransform: TOnOcvBeforeTransform read FOnBeforeTransform write FOnBeforeTransform; end; TocvImageOperationCollection = class(TOwnedCollection) protected FOnBeforeEachOperation: TOnOcvNotifyCollectionItem; FOnAfterEachOperation: TOnOcvNotifyCollectionItem; public function Transform(const Source: IocvImage; out Destanation: IocvImage): Boolean; end; TocvImageOperation = class(TocvDataSourceAndReceiver, IocvEditorPropertiesContainer) private CS: TCriticalSection; FOperation: TocvCustomImageOperation; FOperationClass: TocvImageOperationClass; FOperations: TocvImageOperationCollection; FUseCollection: Boolean; FOnAfterEachOperation: TOnOcvNotifyCollectionItem; FOnBeforeEachOperation: TOnOcvNotifyCollectionItem; FEnabled: 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); procedure SetOnAfterEachOperation(const Value: TOnOcvNotifyCollectionItem); procedure SetOnBeforeEachOperation(const Value: TOnOcvNotifyCollectionItem); protected function GetProperties: TocvCustomImageOperation; function GetPropertiesClass: TocvImageOperationClass; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure TakeImage(const IplImage: IocvImage); 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; property OnBeforeEachOperation: TOnOcvNotifyCollectionItem read FOnBeforeEachOperation write SetOnBeforeEachOperation; property OnAfterEachOperation: TOnOcvNotifyCollectionItem read FOnAfterEachOperation write SetOnAfterEachOperation; property Enabled: Boolean read FEnabled Write FEnabled 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 uses ocv.core_c, ocv.imgproc_c, ocv.cvutils, {$IFDEF HAS_UNITSCOPE} System.Math; {$ELSE} Math; {$ENDIF} // {$IFNDEF haarcascadeinc} // {$DEFINE haarcascadeinc} // // Type // TocvHaarCascadeRecord = record // Name: String; // FileName: String; // end; // /// // // Run utils\CompressHaar\uCompressHaar.dpr // // Add to serarch path \Delphi-OpenCV\resource\facedetectxml\ // /// // {$R haarcascade.rc haarcascade.res} // {$R haarcascade.res} // {$I haarcascade.inc} // {$ENDIF} type TPersistentAccessProtected = class(TPersistent); Var _RegisteredImageOperations: TRegisteredImageOperations = nil; function GetRegisteredImageOperations: TRegisteredImageOperations; begin if not Assigned(_RegisteredImageOperations) then _RegisteredImageOperations := TRegisteredImageOperations.Create; Result := _RegisteredImageOperations; end; { TocvImageOperation } procedure TocvImageOperation.SetOnAfterEachOperation(const Value: TOnOcvNotifyCollectionItem); begin FOnAfterEachOperation := Value; Operations.FOnAfterEachOperation := Value; end; procedure TocvImageOperation.SetOnBeforeEachOperation(const Value: TOnOcvNotifyCollectionItem); begin FOnBeforeEachOperation := Value; Operations.FOnBeforeEachOperation := Value; end; 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; FEnabled := 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; ContinueTransform: Boolean; begin if LockTransform then try if Enabled then begin if (OperationsEnabled and (Operations.Count > 0) and Operations.Transform(IplImage, Destanation)) then NotifyReceiver(Destanation) else begin ContinueTransform := True; if Assigned(OnBeforeEachOperation) then OnBeforeEachOperation(nil, Operation, nil, IplImage, ContinueTransform); if not ContinueTransform then NotifyReceiver(IplImage) else if Operation.Transform(IplImage.Clone, Destanation) then begin if Assigned(OnAfterEachOperation) then OnAfterEachOperation(nil, Operation, nil, Destanation, ContinueTransform); NotifyReceiver(Destanation); end else NotifyReceiver(IplImage); end; end else NotifyReceiver(IplImage); finally Destanation := nil; UnlockTransform; end; end; procedure TocvImageOperation.UnlockTransform; begin CS.Leave; end; { TocvImageOperationCanny } constructor TocvCannyOperation.Create { (AOwner: TPersistent) }; begin inherited; Threshold1 := 10; Threshold2 := 100; ApertureSize := 3; end; function TocvCannyOperation.DoTransform(const Source: IocvImage; out 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; out Destanation: IocvImage): Boolean; begin Destanation := Source.GrayImage; Result := True; end; { TocvImageOperationNone } function TocvNoneOperation.DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; begin Destanation := Source; Result := True; end; { TCustomOpenCVImgOperation } procedure TocvCustomImageOperation.AssignTo(Dest: TPersistent); begin inherited; if Dest is TocvCustomImageOperation then begin FFloatParams := (Dest as TocvCustomImageOperation).FFloatParams; FIntParams := (Dest as TocvCustomImageOperation).FIntParams; FBoolParams := (Dest as TocvCustomImageOperation).FBoolParams; end; 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; out 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 ContinueTransform: Boolean; begin Result := LockTransform; if Result then try ContinueTransform := True; if Assigned(OnBeforeTransform) then OnBeforeTransform(Self, Source, ContinueTransform); if ContinueTransform then Result := DoTransform(Source.Clone, Destanation) else begin Destanation := Source; Result := True; end; if Result and Assigned(OnAfterTransform) then OnAfterTransform(Self, Destanation); finally UnlockTransform; end else Destanation := Source; end; procedure TocvCustomImageOperation.UnlockTransform; begin FCriticalSection.Leave; end; { TocvImageOperationSmooth } Const ocvSmoothOperations: array [TocvSmoothOperations] of Integer = (CV_BLUR_NO_SCALE, CV_BLUR, CV_GAUSSIAN, CV_MEDIAN, CV_BILATERAL); procedure TocvSmoothOperation.AssignTo(Dest: TPersistent); begin inherited; if Dest is TocvSmoothOperation then FSmoothOperation := (Dest as TocvSmoothOperation).FSmoothOperation; end; constructor TocvSmoothOperation.Create { (AOwner: TPersistent) }; begin inherited; FSmoothOperation := GAUSSIAN; size1 := 3; size2 := 3; sigma1 := 0; sigma2 := 0; end; procedure TocvSmoothOperation.SetSmoothOperation(const Value: TocvSmoothOperations); begin if LockTransform then try FSmoothOperation := Value; finally UnlockTransform; end; end; function TocvSmoothOperation.DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; Var Image: pIplImage; begin Image := cvCloneImage(Source.IpImage); cvSmooth(Source.IpImage, Image, ocvSmoothOperations[SmoothType], size1, size2, sigma1, sigma2); Destanation := TocvImage.Create(Image); Result := True; end; { TRegisteredImageOperations } function TRegisteredImageOperations.FindByClassName(const ClassName: String): TocvImageOperationClass; Var i: Integer; begin Result := nil; 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; { TocvCustomErodeDilate } procedure TocvCustomErodeDilateOperation.AssignTo(Dest: TPersistent); begin inherited; if Dest is TocvCustomErodeDilateOperation then FMorphOp := (Dest as TocvCustomErodeDilateOperation).MorphOp; end; constructor TocvCustomErodeDilateOperation.Create { (AOwner: TComponent) }; begin inherited; Radius := 5; Iterations := 5; FMorphOp := SHAPE_RECT; end; procedure TocvCustomErodeDilateOperation.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); { TocvErode } function TocvErodeOperation.DoTransform(const Source: IocvImage; out 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; { TocvDilate } function TocvDilateOperation.DoTransform(const Source: IocvImage; out 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; out 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; { TocvSobel } constructor TocvSobelOperation.Create { (AOwner: TComponent) }; begin inherited; XOrder := 1; YOrder := 1; Aperture := 3; end; function TocvSobelOperation.DoTransform(const Source: IocvImage; out 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.GetNamePath: string; begin Result := inherited GetNamePath + Format('Operations%d', [Index]); 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; out Destanation: IocvImage): Boolean; Var ContinueTransform: Boolean; begin Result := LockTransform; if Result then try ContinueTransform := True; if Assigned(OnBeforeTransform) then OnBeforeTransform(Self, Source, ContinueTransform); Result := ContinueTransform and Operation.DoTransform(Source, Destanation); if Result and Assigned(OnAfterTransform) then OnAfterTransform(Self, Destanation); 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; out Destanation: IocvImage): Boolean; begin Destanation := Source.GrayImage.Same; 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; out 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; FOffset := TocvPoint2D32i.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; destructor TocvContoursOperation.Destroy; begin FOffset.Free; FContourDraw.Free; FApprox.Free; inherited; end; function TocvContoursOperation.DoTransform(const Source: IocvImage; out 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; { TocvRotateOperation } procedure TocvRotateOperation.AssignTo(Dest: TPersistent); begin inherited; if Dest is TocvRotateOperation then begin FCenter := (Dest as TocvRotateOperation).FCenter; FMethod := (Dest as TocvRotateOperation).FMethod; FWarpingFlag := (Dest as TocvRotateOperation).FWarpingFlag; FFillColor := (Dest as TocvRotateOperation).FFillColor end; end; constructor TocvRotateOperation.Create(AOwner: TPersistent); begin inherited; Angle := 90; FCenter := TocvPoint2D32f.Create; RotateAroundCenter := True; Method := INTER_LINEAR; WarpingFlag := [WARP_FILL_OUTLIERS]; Scale := 1; FFillColor := clBlack; end; destructor TocvRotateOperation.Destroy; begin FCenter.Free; inherited; end; function TocvRotateOperation.DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; Var rot_mat: pCvMat; cvCenter: TCvPoint2D32f; D: pIplImage; M: Integer; begin // Матрица трансформации rot_mat := cvCreateMat(2, 3, CV_32FC1); // Вращение относительно центра изображения if RotateAroundCenter then begin cvCenter.X := Source.IpImage^.Width div 2; cvCenter.Y := Source.IpImage^.height div 2; end else begin cvCenter.X := CustomCenter.X; cvCenter.Y := CustomCenter.Y; end; cv2DRotationMatrix(cvCenter, Angle, Scale, rot_mat); // Создаем изображение D := cvCreateImage(cvGetSize(Source.IpImage), Source.IpImage^.Depth, Source.IpImage^.nChannels); // Выполняем вращение 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, ColorToCvRGB(FillColor)); cvReleaseMat(rot_mat); Destanation := TocvImage.Create(D); Result := True; end; { TPersistentPoint } procedure TocvPoint2D32i.AssignTo(Dest: TPersistent); begin inherited; if Dest is TocvPoint2D32f then FSize := (Dest as TocvPoint2D32i).FSize; end; { TocvCountourDraw } procedure TocvDraw.AssignTo(Dest: TPersistent); begin inherited; if Dest is TocvDraw then begin FOffset.FSize := (Dest as TocvDraw).FOffset.FSize; 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 := TocvPoint2D32i.Create; FEnabled := True; FThickness := 1; FLineType := LT_AA; FColor := clGreen; FShift := 0; end; destructor TocvDraw.Destroy; begin FOffset.Free; inherited; end; function TocvDraw.GetCvColor: TCvScalar; begin Result := ColorToCvRGB(Color); end; function TocvDraw.GetCvLineType: Integer; begin Result := cLineType[LineType]; 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; out 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 TocvHaarCascade.Create(AOwner: TPersistent); begin inherited; FLockFrontalFaceChange := TCriticalSection.Create; FMinSize := TocvPoint2D32i.Create(30, 30); FMaxSize := TocvPoint2D32i.Create; HaarCascade := hcFrontalFaceAlt; FDrawHaarCascade := TocvHaarCascadeDraw.Create(Self); Scale := 1.3; MinNeighbors := 3; Equalize := True; NotifyOnlyWhenFound := False; end; destructor TocvHaarCascade.Destroy; begin FLockFrontalFaceChange.Free; FMinSize.Free; FMaxSize.Free; FDrawHaarCascade.Free; ReleaseCascade; inherited; end; function TocvHaarCascade.DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; Var storage: pCvMemStorage; gray: IocvImage; detected_objects: pCvSeq; i: Integer; cvr: pCvRect; begin Destanation := Source; Result := ocvHaarCascadeTransform( { } Source, { } FCascade, { } FHaarRects, { } MinSize.Size, { } MaxSize.Size, { } Equalize, { } Scale, { } MinNeighbors, { } CascadeFlags); if Result then begin if Assigned(OnHaarCascade) and ((not NotifyOnlyWhenFound) or (Length(FHaarRects) > 0)) then OnHaarCascade(Self, Destanation, FHaarRects); if DrawHaarCascade.Enabled then for i := 0 to High(FHaarRects) do Destanation.Canvas.Rectangle(FHaarRects[i].Left, FHaarRects[i].Top, FHaarRects[i].Right, FHaarRects[i].Bottom, DrawHaarCascade.Color, DrawHaarCascade.Thickness, DrawHaarCascade.LineType, DrawHaarCascade.Shift); end; // 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 // SetLength(FHaarRects, detected_objects^.total); // i := 0; // While i < detected_objects^.total do // begin // cvr := pCvRect(cvGetSeqElem(detected_objects, i)); // FHaarRects[i] := ocvRect(cvr^.X, cvr^.Y, (cvr^.X) + (cvr^.Width), (cvr^.Y) + (cvr^.height)); // Inc(i); // end; // // if Assigned(OnHaarCascade) and ((not NotifyOnlyWhenFound) or (detected_objects^.total > 0)) then // OnHaarCascade(Self, Destanation, FHaarRects); // // if DrawHaarCascade.Enabled then // begin // GetRGBValue(DrawHaarCascade.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), DrawHaarCascade.Thickness, cLineType[DrawHaarCascade.LineType], DrawHaarCascade.Shift); // Inc(i); // end; // end; // end; // Result := True; // finally // cvReleaseMemStorage(storage); // end; // end // else // Result := False; end; procedure TocvHaarCascade.ReleaseCascade; begin if Assigned(FCascade) then cvReleaseHaarClassifierCascade(FCascade); FCascade := nil; end; procedure TocvHaarCascade.SetCustomHaarCascade(const Value: TFileName); begin if FCustomHaarCascade <> Value then begin FCustomHaarCascade := Value; DoLoadHaarCascade(FCustomHaarCascade); end; end; procedure TocvHaarCascade.DoLoadHaarCascade(const FileName: String); begin ReleaseCascade; if FileExists(FileName) then FCascade := cvLoad(c_str(FileName), nil, nil, nil); end; procedure TocvHaarCascade.SetHaarCascade(const Value: TocvHaarCascadeType); 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; RS: TResourceStream; DC: TZDecompressionStream; FS: TFileStream; begin FLockFrontalFaceChange.Enter; try if FHaarCascade <> Value then begin FHaarCascade := Value; ReleaseCascade; end; if not(csDesigning in ComponentState) then begin ReleaseCascade; FCascade := ocvLoadHaarCascade(FHaarCascade); end; finally FLockFrontalFaceChange.Leave; end; end; constructor TocvPoint2D32i.Create(const AX, AY: Integer); begin X := AX; 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; out 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; { TocvMotionDetect } procedure TocvMotionDetect.AssignTo(Dest: TPersistent); begin inherited; if Dest is TocvMotionDetect then begin FCalcRectType := (Dest as TocvMotionDetect).FCalcRectType; end; end; constructor TocvMotionDetect.Create(AOwner: TPersistent); begin inherited; RemoveSmallObject := True; MinObjectSize := 100; FSmoothOperation := BLUR; FDrawMotionRect := TocvDrawMotionRect.Create(Self); OperationClass := TocvThresholdOperation; With (Operation as TocvThresholdOperation) do begin Threshold := 25; MaxValue := 255; end; NotifyOnlyWhenFound := False; end; destructor TocvMotionDetect.Destroy; begin FDrawMotionRect.Free; inherited; end; function TocvMotionDetect.DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; Var CurrentGrayImage: IocvImage; DifferenceImage: IocvImage; storage: pCvMemStorage; area: Double; ThresholdImage: IocvImage; black, white: TCvScalar; c: pCvSeq; Rects: TocvRects; Rect: TCvRect; Rect2d: TCvBox2D; i: Integer; r, g, b: byte; begin Destanation := Source; CurrentGrayImage := Source.GrayImage; if not Assigned(FPrevFrame) then FPrevFrame := CurrentGrayImage; DifferenceImage := CurrentGrayImage.Same; cvAbsDiff(FPrevFrame.IpImage, CurrentGrayImage.IpImage, DifferenceImage.IpImage); cvSmooth(DifferenceImage.IpImage, DifferenceImage.IpImage, Integer(Smooth)); if Threshold.DoTransform(DifferenceImage, ThresholdImage) then begin // img_out := DifferenceImage.Clone; storage := cvCreateMemStorage(0); FContours := AllocMem(SizeOf(TCvSeq)); try cvFindContours(ThresholdImage.IpImage, storage, @FContours, SizeOf(TCvContour), CV_RETR_LIST, CV_CHAIN_APPROX_SIMPLE, cvPoint(0, 0)); black := CV_RGB(0, 0, 0); white := CV_RGB(255, 255, 255); while (FContours <> nil) do begin area := cvContourArea(FContours, CV_WHOLE_SEQ); if (abs(area) <= MinObjectSize) and RemoveSmallObject then // Если площадь меньше порога, то удаляем cvDrawContours(ThresholdImage.IpImage, FContours, black, black, -1, CV_FILLED, 8, cvPoint(0, 0)) else cvDrawContours(ThresholdImage.IpImage, FContours, white, white, -1, CV_FILLED, 8, cvPoint(0, 0)); FContours := FContours.h_next; // Переходим к следующему контуру end; cvClearMemStorage(storage); SetLength(Rects, 0); cvFindContours(ThresholdImage.IpImage, storage, @FContours, SizeOf(TCvContour), CV_RETR_LIST, CV_CHAIN_APPROX_NONE, cvPoint(0, 0)); if Assigned(FContours) then begin c := FContours; i := 0; while (c <> nil) do begin SetLength(Rects, i + 1); if CalcRectType = mdBoundingRect then begin Rect := cvBoundingRect(c, 0); Rects[i] := ocvRect(Rect.X, Rect.Y, Rect.X + Rect.Width, Rect.Y + Rect.height); end else if CalcRectType = mdMinAreaRect then begin Rect2d := cvMinAreaRect2(c); Rects[i] := ocvRect(Round(Rect2d.Center.X - Rect2d.Size.Width / 2), Round(Rect2d.Center.Y - Rect2d.Size.height / 2), Round(Rect2d.Center.X + Rect2d.Size.Width / 2), Round(Rect2d.Center.Y + Rect2d.Size.height / 2)); end; if DrawMotionRect.Enabled then begin GetRGBValue(DrawMotionRect.Color, r, g, b); cvRectangle(Destanation.IpImage, cvPoint(Rects[i].Left, Rects[i].Top), cvPoint(Rects[i].Right, Rects[i].Bottom), CV_RGB(r, g, b), DrawMotionRect.Thickness, cLineType[DrawMotionRect.LineType], DrawMotionRect.Shift); end; Inc(i); c := c.h_next; end; end; if Assigned(OnMotion) and ((not NotifyOnlyWhenFound) or (Length(Rects) > 0)) then OnMotion(Self, Destanation, Rects); finally cvReleaseMemStorage(storage); end; end; FPrevFrame := CurrentGrayImage; Result := True; end; function TocvMotionDetect.GetPropertiesClass: TocvImageOperationClass; begin if not Assigned(FOperation) then Result := TocvThresholdOperation else Result := inherited; end; { TocvCustomImageOperationWithNestedOperation } constructor TocvCustomImageOperationWithNestedOperation.Create(AOwner: TPersistent); begin inherited; CS := TCriticalSection.Create; end; procedure TocvCustomImageOperationWithNestedOperation.CreateProperties; begin FOperation := FOperationClass.Create(Self); end; function TocvCustomImageOperationWithNestedOperation.GetProperties: TocvCustomImageOperation; begin if not Assigned(FOperation) then FOperation := OperationClass.Create(Self); Result := FOperation; end; function TocvCustomImageOperationWithNestedOperation.GetPropertiesClass: TocvImageOperationClass; begin if Assigned(FOperation) then Result := TocvImageOperationClass(FOperation.ClassType) else Result := TocvNoneOperation; end; destructor TocvCustomImageOperationWithNestedOperation.Destroy; begin CS.Free; DestroyProperties; inherited; end; procedure TocvCustomImageOperationWithNestedOperation.DestroyProperties; begin if Assigned(FOperation) then FreeAndNil(FOperation); end; function TocvCustomImageOperationWithNestedOperation.GetPropertiesClassName: string; begin Result := Operation.ClassName; end; procedure TocvCustomImageOperationWithNestedOperation.RecreateProperties; begin DestroyProperties; CreateProperties; end; procedure TocvCustomImageOperationWithNestedOperation.SetProperties(const Value: TocvCustomImageOperation); begin if (FOperation <> nil) and (Value <> nil) then FOperation.Assign(Value); end; procedure TocvCustomImageOperationWithNestedOperation.SetPropertiesClass(Value: TocvImageOperationClass); begin if FOperationClass <> Value then begin FOperationClass := Value; RecreateProperties; end; end; procedure TocvCustomImageOperationWithNestedOperation.SetPropertiesClassName(const Value: string); begin OperationClass := TocvImageOperationClass(GetRegisteredImageOperations.FindByClassName(Value)); end; function TocvCustomImageOperationWithNestedOperation.LockTransform: Boolean; begin Result := CS.TryEnter; end; procedure TocvCustomImageOperationWithNestedOperation.UnlockTransform; begin CS.Leave; end; { TocvRectPersistent } procedure TocvRect32i.AssignTo(Dest: TPersistent); begin inherited; if Dest is TocvRect32i then begin FRight := (Dest as TocvRect32i).FRight; FBottom := (Dest as TocvRect32i).FBottom; FTop := (Dest as TocvRect32i).FTop; FLeft := (Dest as TocvRect32i).FLeft; end; end; function TocvRect32i.GetCvRect: TCvRect; begin Result := ocv.core.types_c.cvRect(Left, Top, Width, height); end; function TocvRect32i.GetHeight: Integer; begin Result := Bottom - Top; end; function TocvRect32i.GetOcvRect: TocvRect; begin Result := ocv.comp.Types.ocvRect(Left, Top, Right, Bottom); end; function TocvRect32i.GetWidth: Integer; begin Result := Right - Left; end; procedure TocvRect32i.SetCvRect(const Value: TCvRect); begin Left := Value.X; Top := Value.Y; Width := Value.Width; height := Value.height; end; procedure TocvRect32i.SetHeight(const Value: Integer); begin Bottom := Top + Value; end; procedure TocvRect32i.SetOcvRect(const Value: TocvRect); begin FLeft := Value.Left; FTop := Value.Top; FRight := Value.Right; FBottom := Value.Bottom; end; procedure TocvRect32i.SetWidth(const Value: Integer); begin FRight := FLeft + Value; end; { TocvCropOperation } constructor TocvCropOperation.Create(AOwner: TPersistent); begin inherited; FCropRect := TocvRect32i.Create; end; destructor TocvCropOperation.Destroy; begin FCropRect.Free; inherited; end; function TocvCropOperation.DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; begin {$IFDEF DELPHIXE2_UP} if FCropRect.ocvRect.IsEmpty then {$ELSE} if IsRectEmpty(FCropRect.ocvRect) then {$ENDIF} Destanation := Source else Destanation := Source.Crop(FCropRect.cvRect); Result := True; end; { TocvImageOperationCollection } function TocvImageOperationCollection.Transform(const Source: IocvImage; out Destanation: IocvImage): Boolean; function iif(const index: Integer): TObject; begin if (index < 0) or (index >= Count) then Result := nil else Result := (Items[index] as TocvImageOperationCollectionItem).Operation; end; Var i: Integer; ContinueTransform: Boolean; begin Destanation := Source; ContinueTransform := True; Result := True; for i := 0 to Count - 1 do begin if Assigned(FOnBeforeEachOperation) then FOnBeforeEachOperation(iif(i - 1), iif(i), iif(i + 1), Destanation, ContinueTransform); if not ContinueTransform then Break; Result := (Items[i] as TocvImageOperationCollectionItem).DoTransform(Destanation.Clone, Destanation); if not Result then Break; if Assigned(FOnAfterEachOperation) then begin FOnAfterEachOperation(iif(i - 1), iif(i), iif(i + 1), Destanation, ContinueTransform); if not ContinueTransform then Break; end; end; end; { TocvAddWeightedOperation } constructor TocvCommonMathOperation.Create(AOwner: TPersistent); begin inherited; FTransformInterpolation := INTER_CUBIC; end; procedure TocvCommonMathOperation.DoGetMaskImage(var Image: IocvImage); begin Image := nil; if Assigned(FOnGetMaskImage) then FOnGetMaskImage(Self, Image); end; procedure TocvCommonMathOperation.DoGetSourceImage(var Image: IocvImage); begin FCriticalSection.Enter; try Image := FSrource2Image; finally UnlockTransform; end; if Assigned(FOnGetImage) then FOnGetImage(Self, Image); end; procedure TocvCommonMathOperation.GetImagesForTransorm(out Source1: IocvImage; out Source2, Mask: IocvImage); Var s1, s2, M: IocvImage; begin Source1 := VideoSource.Image; DoGetSourceImage(s2); DoGetMaskImage(M); if Assigned(s2) and ((s1.Width <> s2.Width) or (s1.height <> s2.height)) then begin Source2 := s1.Same; cvResize(s2.IpImage, Source2.IpImage, Integer(TransformInterpolation)); end else Source2 := s2; if Assigned(M) and ((s1.Width <> M.Width) or (s1.height <> M.height)) then begin Mask := s1.Same; cvResize(M.IpImage, Mask.IpImage, Integer(TransformInterpolation)); end else Mask := M; end; procedure TocvCommonMathOperation.SetVideoSource_Source2(const Value: IocvDataSource); begin if FocvVideoSource <> Value then begin if Assigned(FocvVideoSource) then FocvVideoSource.RemoveReceiver(Self); FocvVideoSource := Value; if Assigned(FocvVideoSource) then FocvVideoSource.AddReceiver(Self); end; end; procedure TocvCommonMathOperation.SetVideoSource(const Value: TObject); begin VideoSource := Value as TocvDataSource; end; procedure TocvCommonMathOperation.TakeImage(const IplImage: IocvImage); begin if LockTransform then try FSrource2Image := IplImage; finally UnlockTransform; end; end; { TocvWarpAffine } procedure TocvWarpPerspective.AssignTo(Dest: TPersistent); begin inherited; if Dest is TocvWarpPerspective then begin FMethod := (Dest as TocvWarpPerspective).FMethod; FWarpingFlag := (Dest as TocvWarpPerspective).FWarpingFlag; FFillColor := (Dest as TocvWarpPerspective).FFillColor; FSourceQuad.AssignTo((Dest as TocvWarpPerspective).FSourceQuad); FDestQuad.AssignTo((Dest as TocvWarpPerspective).FDestQuad); end; end; constructor TocvWarpPerspective.Create(AOwner: TPersistent); begin inherited; FSourceQuad := TocvQuad.Create; FDestQuad := TocvQuad.Create; Method := INTER_LINEAR; WarpingFlag := [WARP_FILL_OUTLIERS]; FullSourceImage := True; FFillColor := clBlack; end; destructor TocvWarpPerspective.Destroy; begin FSourceQuad.Free; FDestQuad.Free; inherited; end; function TocvWarpPerspective.DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; Var dst: pIplImage; srcQuad, dstQuad: TocvQuad.TCvPoint2D32fArray; warp_matrix: pCvMat; begin if DestQuad.ShaIsConvexQuadrangle then begin if FullSourceImage or (not SourceQuad.ShaIsConvexQuadrangle) then begin srcQuad[0].X := 0; // src Top left srcQuad[0].Y := 0; srcQuad[1].X := Source.Width - 1; // src Top right srcQuad[1].Y := 0; srcQuad[2].X := 0; // src Bottom left srcQuad[2].Y := Source.height - 1; srcQuad[3].X := Source.Width - 1; // src Bot right srcQuad[3].Y := Source.height - 1; end else srcQuad := SourceQuad.cvQuad; dstQuad := DestQuad.cvQuad; warp_matrix := cvCreateMat(3, 3, CV_32FC1); dst := cvCloneImage(Source.IpImage); cvGetPerspectiveTransform(@srcQuad, @dstQuad, warp_matrix); cvWarpPerspective(Source.IpImage, dst, warp_matrix, CV_INTER_LINEAR or CV_WARP_FILL_OUTLIERS, ColorToCvRGB(FillColor)); Destanation := TocvImage.Create(dst); end else Destanation := Source; Result := True; end; { TocvAddWeightedOperation } constructor TocvAddWeightedOperation.Create(AOwner: TPersistent); begin inherited; Alpha := 0.5; Beta := 0.5; Gamma := 0; end; function TocvAddWeightedOperation.DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; Var s1, s2, M: IocvImage; begin GetImagesForTransorm(s1, s2, M); try Destanation := s1.Same; // Источники должны иметь один размер или ROI cvAddWeighted(s1.IpImage, Alpha, s2.IpImage, Beta, Gamma, Destanation.IpImage); Result := True; except Destanation := Source; Result := False; end; end; { TocvQuad } procedure TocvQuad.AssignTo(Dest: TPersistent); Var i: Integer; begin inherited; if Dest is TocvQuad then for i := 0 to 3 do FPoints[i].AssignTo((Dest as TocvQuad).FPoints[i]); end; constructor TocvQuad.Create; Var i: Integer; begin inherited; for i := 0 to 3 do FPoints[i] := TocvPoint2D32f.Create; end; destructor TocvQuad.Destroy; Var i: Integer; begin for i := 0 to 3 do FPoints[i].Free; inherited; end; function TocvQuad.GetCvQuad: TCvPoint2D32fArray; Var i: Integer; begin for i := 0 to 3 do begin Result[i].X := FPoints[i].X; Result[i].Y := FPoints[i].Y; end; end; function TocvQuad.GetPoints(const index: Integer): TocvPoint2D32f; begin if (index >= 0) and (index < 4) then Result := FPoints[index] else Result := nil; end; function TocvQuad.ShaIsConvexQuadrangle: Boolean; begin Result := True; // --------------------------------- // Procedure GetVector(const i: byte; var P: TCvPoint2D32f); // begin // P.X := FPoints[(i + 1) and 3].X - FPoints[i and 3].X; // P.Y := FPoints[(i + 1) and 3].Y - FPoints[i and 3].Y; // end; // // Var // Q: Boolean; // v1, v2: TCvPoint2D32f; // T, Z, P: Double; // i: Integer; // begin // GetVector(3, v1); // GetVector(0, v2); // T := v1.X * v2.Y - v2.X * v1.Y; // Z := Sign(T); // P := 1.0; // i := 0; // Q := True; // while (Q and (i < 4)) do // begin // GetVector(i, v1); // GetVector(i + 1, v2); // T := v1.X * v2.Y - v2.X * v1.Y; // P := P * Z * Sign(T); // if (P < 0) then // Q := False; // Inc(i); // end; // Result := Q; // --------------------------------- // --------------------------------- // function ShaIsSameDirection(const t0, t1, t2: TocvPoint2D32f; var dir: Integer): Boolean; // const // MinInt = -1 xor MaxInt; // var // S: Integer; // begin; // S := Trunc((t1.X - t0.X) * (t2.Y - t0.Y) - (t2.X - t0.X) * (t1.Y - t0.Y)); // if S = 0 then // Result := True // else // begin; // S := S or MaxInt; // Result := (S xor dir) <> MinInt; // dir := S; // end; // end; // var // dir: Integer; // begin; // dir := 0; // Result := ShaIsSameDirection(P0, P1, P2, dir) and ShaIsSameDirection(P1, P2, P3, dir) and ShaIsSameDirection(P2, P3, P0, dir) // and ShaIsSameDirection(P3, P0, P1, dir) and (dir <> 0); // --------------------------------- end; procedure TocvQuad.SetPoints(const index: Integer; const Value: TocvPoint2D32f); begin if (index >= 0) and (index < 4) then FPoints[index] := Value; end; { TocvPoint2D32f } procedure TocvPoint2D32f.AssignTo(Dest: TPersistent); begin inherited; if Dest is TocvPoint2D32f then begin FX := (Dest as TocvPoint2D32f).FX; FY := (Dest as TocvPoint2D32f).FY; end; end; constructor TocvPoint2D32f.Create(const AX, AY: Single); begin FX := AX; FY := AY; end; { TocvHoughCircles } procedure TocvHoughCircles.AssignTo(Dest: TPersistent); begin inherited; if Dest is TocvHoughCircles then begin FHoughTransform := (Dest as TocvHoughCircles).FHoughTransform; end; end; constructor TocvHoughCircles.Create(AOwner: TPersistent); begin inherited; FHoughTransform := HOUGH_GRADIENT; InverseRatio := 1; MinDist := 100; Param1 := 100; Param2 := 100; MinRadius := 0; MaxRadius := 0; FDrawCircle := TocvDrawHoughCircles.Create(Self); NotifyOnlyWhenFound := False; FSmooth := TocvHoughCirclesSmooth.Create; FSmooth.SmoothType := GAUSSIAN; FSmooth.size1 := 5; FSmooth.size2 := 5; FSmooth.sigma1 := 0; FSmooth.sigma2 := 0; end; destructor TocvHoughCircles.Destroy; begin FDrawCircle.Free; FSmooth.Free; inherited; end; function TocvHoughCircles.DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; type TFloatArray = array [0 .. 10] of Single; pFloatArray = ^TFloatArray; Var results: pCvSeq; storage: pCvMemStorage; Circles: TocvCircles; i: Integer; p: pFloatArray; D: IocvImage; begin SetLength(Circles, 0); Destanation := Source; try storage := cvCreateMemStorage(0); results := nil; try if Smooth.Enabled then begin D := Source.Same; cvSmooth(Source.IpImage, D.IpImage, ocvSmoothOperations[Smooth.SmoothType], Smooth.size1, Smooth.size2, Smooth.sigma1, Smooth.sigma2); end else D := Source; results := cvHoughCircles(D.GrayImage.IpImage, storage, Integer(Method), InverseRatio, MinDist, Param1, Param2, MinRadius, MaxRadius); if Assigned(results) then begin SetLength(Circles, results^.total); for i := 0 to results^.total - 1 do begin p := pFloatArray(cvGetSeqElem(results, i)); Circles[i].cX := cvRound(p^[0]); Circles[i].cY := cvRound(p^[1]); Circles[i].Radius := cvRound(p^[2]); if DrawCircle.Enabled then cvCircle(Destanation.IpImage, cvPoint(Circles[i].cX, Circles[i].cY), Circles[i].Radius, DrawCircle.cvColor, DrawCircle.Thickness, DrawCircle.cvLineType, DrawCircle.Shift); end; end; finally cvReleaseMemStorage(storage); end; except end; if Assigned(OnCircles) and ((Length(Circles) > 0) or (not NotifyOnlyWhenFound)) then OnCircles(Self, Destanation, Circles); end; { TocvHoughLines } procedure TocvHoughLines.AssignTo(Dest: TPersistent); begin inherited; if Dest is TocvHoughLines then begin FHoughTransform := (Dest as TocvHoughLines).FHoughTransform end; end; constructor TocvHoughLines.Create(AOwner: TPersistent); begin inherited; FHoughTransform := HOUGH_PROBABILISTIC; Rho := 1; Theta := CV_PI / 180; Param1 := 50; Param2 := 10; Threshold := 50; FCanny := TocvHoughLinesCanny.Create; FDrawLines := TocvDrawHoughLines.Create(Self); NotifyOnlyWhenFound := True; end; destructor TocvHoughLines.Destroy; begin FCanny.Free; FDrawLines.Free; inherited; end; function TocvHoughLines.DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; Var lines: pCvSeq; line: pCvPointArray; storage: pCvMemStorage; SG, D: IocvImage; i: Integer; ocvlines: TocvLines; begin lines := nil; SetLength(ocvlines, 0); Destanation := Source; try storage := cvCreateMemStorage(0); try SG := Source.GrayImage; D := SG.Same; cvCanny(SG.IpImage, D.IpImage, Canny.Threshold1, Canny.Threshold2, Canny.ApertureSize); lines := cvHoughLines2(D.IpImage, storage, Integer(Method), Rho, Theta, Threshold, Param1, Param2); if Assigned(lines) then begin SetLength(ocvlines, lines^.total); for i := 0 to lines^.total - 1 do begin line := pCvPointArray(cvGetSeqElem(lines, i)); ocvlines[i].S := line^[0]; ocvlines[i].E := line^[1]; if DrawLines.Enabled then cvLine(Destanation.IpImage, line^[0], line^[1], DrawLines.cvColor, DrawLines.Thickness, DrawLines.cvLineType, DrawLines.Shift); end; end; if Assigned(OnLines) and ((Length(ocvlines) > 0) or (not NotifyOnlyWhenFound)) then OnLines(Self, Destanation, ocvlines); finally cvReleaseMemStorage(storage); end; except end; end; { TocvHoughCirclesSmooth } procedure TocvHoughCirclesSmooth.AssignTo(Dest: TPersistent); begin inherited; if Dest is TocvHoughCirclesSmooth then begin FSmoothOperation := (Dest as TocvHoughCirclesSmooth).FSmoothOperation; Fsigma1 := (Dest as TocvHoughCirclesSmooth).Fsigma1; Fsigma2 := (Dest as TocvHoughCirclesSmooth).Fsigma2; Fsize1 := (Dest as TocvHoughCirclesSmooth).Fsize1; Fsize2 := (Dest as TocvHoughCirclesSmooth).Fsize2; FEnabled := (Dest as TocvHoughCirclesSmooth).FEnabled; end; end; constructor TocvHoughCirclesSmooth.Create; begin inherited; FSmoothOperation := GAUSSIAN; Fsigma1 := 0; Fsigma2 := 0; Fsize1 := 5; Fsize2 := 5; FEnabled := True; end; { TocvHoughLinesCanny } procedure TocvHoughLinesCanny.AssignTo(Dest: TPersistent); begin inherited; if Dest is TocvHoughLinesCanny then begin FThreshold1 := (Dest as TocvHoughLinesCanny).FThreshold1; FThreshold2 := (Dest as TocvHoughLinesCanny).FThreshold2; FApertureSize := (Dest as TocvHoughLinesCanny).FApertureSize; end; end; constructor TocvHoughLinesCanny.Create; begin inherited; FThreshold1 := 50; FThreshold2 := 200; FApertureSize := 3; end; { TocvInRangeOperation } procedure TocvInRangeSOperation.AssignTo(Dest: TPersistent); begin inherited; if Dest is TocvInRangeSOperation then begin FLower := (Dest as TocvInRangeSOperation).FLower; FUpper := (Dest as TocvInRangeSOperation).FUpper; end; end; constructor TocvInRangeSOperation.Create(AOwner: TPersistent); begin inherited; FLower := TocvScalar.Create; FUpper := TocvScalar.Create; end; destructor TocvInRangeSOperation.Destroy; begin FLower.Free; FUpper.Free; inherited; end; function TocvInRangeSOperation.DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; begin Result := FLower.CvScalar < FUpper.CvScalar; if Result then begin Destanation := Source.Clone.GrayImage; try cvInRangeS(Source.IpImage, FLower.CvScalar, FUpper.CvScalar, Destanation.IpImage); except Result := False; end; end; end; { TocvScalar } procedure TocvScalar.AssignTo(Dest: TPersistent); begin inherited; if Dest is TocvScalar then FCvScalar := (Dest as TocvScalar).FCvScalar; end; function TocvScalar.GetScalar(const index: Integer): Double; begin if (index >= 0) and (index < 4) then Result := FCvScalar.val[index] else Result := 0; end; procedure TocvScalar.SetScalar(const index: Integer; const Value: Double); begin if (index >= 0) and (index < 4) then FCvScalar.val[index] := Value; end; { TocvCvtColorOperation } constructor TocvCvtColorOperation.Create(AOwner: TPersistent); begin inherited; FColorConversion := RGB2GRAY; FDepth := DEPTH_8U; FChannels := 1; // FAutoCalcParams := True; end; function TocvCvtColorOperation.DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; Var iImage: pIplImage; begin // if FAutoCalcParams then // CalculateImageParams(Source); iImage := cvCreateImage(cvGetSize(Source.IpImage), cIPLDepth[Depth], Channels); try cvCvtColor(Source.IpImage, iImage, cColorConversion[ColorConversion]); Destanation := TocvImage.Create(iImage); Result := True; except Destanation := Source; Result := False; end; end; // procedure TocvCvtColorOperation.CalculateImageParams(const Source: IocvImage); // Var // scn, Depth: Integer; // code: Integer; // dcn: Integer; // begin // scn := Source.IpImage^.nChannels; // dcn := scn; // Depth := Source.IpImage^.Depth; // code := CVColorConversion[ColorConversion]; // case code of // CV_BGR2BGRA, CV_RGB2BGRA, CV_BGRA2BGR, CV_RGBA2BGR, CV_RGB2BGR, CV_BGRA2RGBA: // begin // if (code = CV_BGR2BGRA) or (code = CV_RGB2BGRA) or (code = CV_BGRA2RGBA) then // dcn := 4 // else // dcn := 3; // end; // CV_BGR2BGR565, CV_BGR2BGR555, CV_RGB2BGR565, CV_RGB2BGR555, CV_BGRA2BGR565, CV_BGRA2BGR555, CV_RGBA2BGR565, CV_RGBA2BGR555: // begin // Assert((scn = 3) or (scn = 4) and (Depth = IPL_DEPTH_8U)); // end; // CV_BGR5652BGR, CV_BGR5552BGR, CV_BGR5652RGB, CV_BGR5552RGB, CV_BGR5652BGRA, CV_BGR5552BGRA, CV_BGR5652RGBA, CV_BGR5552RGBA: // begin // if (dcn <= 0) then // if (code = CV_BGR5652BGRA) or (code = CV_BGR5552BGRA) or (code = CV_BGR5652RGBA) or (code = CV_BGR5552RGBA) then // dcn := 4 // else // dcn := 3; // Assert((scn = 2) and (Depth = IPL_DEPTH_8U)); // end; // CV_BGR2GRAY, CV_BGRA2GRAY, CV_RGB2GRAY, CV_RGBA2GRAY: // begin // Assert(scn = 3) or (scn = 4); // dcn := 1; // end; // CV_BGR5652GRAY, CV_BGR5552GRAY: // begin // Assert((scn = 2) and (Depth = IPL_DEPTH_8U)); // dcn := 1; // end; // end; // end; { TocvResizeOperation } procedure TocvResizeOperation.AssignTo(Dest: TPersistent); begin inherited; if Dest is TocvResizeOperation then FInterpolation := (Dest as TocvResizeOperation).FInterpolation; end; constructor TocvResizeOperation.Create(AOwner: TPersistent); begin inherited; FInterpolation := INTER_LINEAR; end; function TocvResizeOperation.DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; Var D: pIplImage; begin Destanation := Source; if (DestWidth <> 0) and (DestHeight <> 0) then try D := cvCreateImage(cvSize(DestWidth, DestHeight), Source.IpImage^.Depth, Source.IpImage^.nChannels); cvResize(Source.IpImage, D, Integer(Interpolation)); Destanation := TocvImage.Create(D); Result := True; except Result := False; end; end; { TocvMathLogicOperation } procedure TocvLogicOperation.AssignTo(Dest: TPersistent); begin inherited; if Dest is TocvLogicOperation then FOperation := (Dest as TocvLogicOperation).FOperation; end; constructor TocvLogicOperation.Create(AOwner: TPersistent); begin inherited; FOperation := ioAdd; end; function TocvLogicOperation.DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; Var s1, s2, M: IocvImage; _m: pIplImage; begin GetImagesForTransorm(s1, s2, M); try Destanation := s1.Same; if Assigned(M) then _m := M.IpImage else _m := nil; case Operation of ioAdd: cvAdd(s1.IpImage, s2.IpImage, Destanation.IpImage, _m); ioSub: cvSub(s1.IpImage, s2.IpImage, Destanation.IpImage, _m); ioAnd: cvAnd(s1.IpImage, s2.IpImage, Destanation.IpImage, _m); ioOr: cvOr(s1.IpImage, s2.IpImage, Destanation.IpImage, _m); ioXor: cvXor(s1.IpImage, s2.IpImage, Destanation.IpImage, _m); end; Result := True; except Destanation := Source; Result := False; end; end; { TocvLogicSOperation } procedure TocvLogicSOperation.AssignTo(Dest: TPersistent); begin inherited; if Dest is TocvLogicSOperation then FOperation := (Dest as TocvLogicSOperation).FOperation; end; constructor TocvLogicSOperation.Create(AOwner: TPersistent); begin inherited; FValue := TocvScalar.Create; FOperation := ioAddS; end; destructor TocvLogicSOperation.Destroy; begin FValue.Free; inherited; end; function TocvLogicSOperation.DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; Var s1, s2, M: IocvImage; _m: pIplImage; begin GetImagesForTransorm(s1, s2, M); try Destanation := s1.Same; if Assigned(M) then _m := M.IpImage else _m := nil; case Operation of ioAddS: cvAddS(s1.IpImage, Value.CvScalar, Destanation.IpImage, _m); ioSubS: cvSubS(s1.IpImage, Value.CvScalar, Destanation.IpImage, _m); ioSubRS: cvSubRS(s1.IpImage, Value.CvScalar, Destanation.IpImage, _m); ioXorS: cvXorS(s1.IpImage, Value.CvScalar, Destanation.IpImage, _m); end; Result := True; except Destanation := Source; Result := False; end; end; initialization GetRegisteredImageOperations.RegisterIOClass(TocvNoneOperation, 'None'); GetRegisteredImageOperations.RegisterIOClass(TocvGrayScaleOperation, 'GrayScale'); GetRegisteredImageOperations.RegisterIOClass(TocvCannyOperation, 'Canny'); GetRegisteredImageOperations.RegisterIOClass(TocvSmoothOperation, 'Smooth'); GetRegisteredImageOperations.RegisterIOClass(TocvErodeOperation, 'Erode'); GetRegisteredImageOperations.RegisterIOClass(TocvDilateOperation, 'Dilate'); GetRegisteredImageOperations.RegisterIOClass(TocvLaplaceOperation, 'Laplace'); GetRegisteredImageOperations.RegisterIOClass(TocvSobelOperation, 'Sobel'); GetRegisteredImageOperations.RegisterIOClass(TocvThresholdOperation, 'Threshold'); GetRegisteredImageOperations.RegisterIOClass(TocvAdaptiveThresholdOperation, 'AdaptiveThreshold'); GetRegisteredImageOperations.RegisterIOClass(TocvContoursOperation, 'Contours'); GetRegisteredImageOperations.RegisterIOClass(TocvRotateOperation, 'Rotate'); GetRegisteredImageOperations.RegisterIOClass(TocvAbsDiff, 'AbsDiff'); GetRegisteredImageOperations.RegisterIOClass(TocvHaarCascade, 'HaarCascade'); GetRegisteredImageOperations.RegisterIOClass(TocvMatchTemplate, 'MatchTemplate'); GetRegisteredImageOperations.RegisterIOClass(TocvMotionDetect, 'MotionDetect'); GetRegisteredImageOperations.RegisterIOClass(TocvCropOperation, 'Crop'); GetRegisteredImageOperations.RegisterIOClass(TocvAddWeightedOperation, 'AddWeighted'); GetRegisteredImageOperations.RegisterIOClass(TocvWarpPerspective, 'WarpPerspective'); GetRegisteredImageOperations.RegisterIOClass(TocvHoughCircles, 'HoughCircles'); GetRegisteredImageOperations.RegisterIOClass(TocvHoughLines, 'HoughLines'); GetRegisteredImageOperations.RegisterIOClass(TocvInRangeSOperation, 'InRangeS'); GetRegisteredImageOperations.RegisterIOClass(TocvCvtColorOperation, 'ColorOperation'); GetRegisteredImageOperations.RegisterIOClass(TocvResizeOperation, 'Resize'); GetRegisteredImageOperations.RegisterIOClass(TocvLogicOperation, 'Logic'); GetRegisteredImageOperations.RegisterIOClass(TocvLogicSOperation, 'LogicS'); finalization if Assigned(_RegisteredImageOperations) then FreeAndNil(_RegisteredImageOperations); end.