Delphi-OpenCV/source/component/uOCVImageOperation.pas
Laentir Valetov 86b316eaf0 HoughLines and HoughCircles image operations
Signed-off-by: Laentir Valetov <laex@bk.ru>
2014-05-30 19:22:53 +04:00

3008 lines
91 KiB
ObjectPascal
Raw Blame History

// *****************************************************************
// 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 uOCVImageOperation;
{$ENDIF}
interface
uses
{$IFDEF VER15P}
Winapi.Windows,
Vcl.Graphics,
System.SysUtils,
System.Classes,
System.SyncObjs,
System.Types,
System.ZLib,
{$ELSE}
Windows,
Graphics,
SysUtils,
Classes,
SyncObjs,
{$IFNDEF VER5}
Types,
{$ENDIF VER5}
ZLib,
{$ENDIF VER15P}
uOCVTypes,
ocv.objdetect_c,
ocv.core.types_c;
type
{$IFDEF VER17P} // XE3..XE6
TArrayDouble = TArray<Double>;
TArrayInteger = TArray<Integer>;
TArrayBoolean = TArray<Boolean>;
{$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;
function GetIntParam(const index: Integer): Integer;
procedure SetFloatParam(const index: Integer; const Value: Double);
procedure SetIntParam(const index: Integer; const Value: Integer);
function GetBoolParam(const index: Integer): Boolean;
procedure SetBoolParam(const index: Integer; const Value: Boolean);
function LockTransform: Boolean;
procedure UnlockTransform;
function GetOwner: TPersistent; override;
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;
TocvGrayScaleOperation = class(TocvCustomImageOperation)
public
function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override;
end;
TovcCannyOperation = 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);
TovcCustomErodeDilateOperation = class(TocvCustomImageOperation)
protected
procedure AssignTo(Dest: TPersistent); override;
private
FMorphOp: TocvErodeDilateMode;
procedure SetMorphOp(const Value: TocvErodeDilateMode);
protected
public
constructor Create(AOwner: TPersistent); override;
published
property Radius: Integer index 0 Read GetIntParam write SetIntParam;
property Iterations: Integer index 1 Read GetIntParam write SetIntParam;
property MorphOp: TocvErodeDilateMode read FMorphOp write SetMorphOp default SHAPE_RECT;
end;
TovcErodeOperation = class(TovcCustomErodeDilateOperation)
public
function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override;
end;
TovcDilateOperation = class(TovcCustomErodeDilateOperation)
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;
TOnGetImage = procedure(Sender: TObject; Var Source2Image: IocvImage) of object;
TocvAddWeightedTransform = (awTransformSourse1, awTransformSourse2);
TovcAddWeightedOperation = class(TocvCustomImageOperation, IocvDataReceiver)
protected
procedure AssignTo(Dest: TPersistent); override;
private
FocvVideoSource: IocvDataSource;
FSrource2Image: IocvImage;
FOnGetImage: TOnGetImage;
FTransform: TocvAddWeightedTransform;
procedure SetOpenCVVideoSource(const Value: IocvDataSource);
public
constructor Create(AOwner: TPersistent); override;
function DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean; override;
protected
procedure TakeImage(const IplImage: IocvImage);
procedure SetVideoSource(const Value: TObject);
published
property VideoSource: IocvDataSource Read FocvVideoSource write SetOpenCVVideoSource;
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;
property OnGetImage: TOnGetImage read FOnGetImage write FOnGetImage;
property TransformType: TocvAddWeightedTransform Read FTransform write FTransform default awTransformSourse2;
end;
TovcSobelOperation = 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);
TovcSmoothOperation = class(TocvCustomImageOperation)
protected
procedure AssignTo(Dest: TPersistent); override;
private
FSmoothOperation: TocvSmoothOperations;
procedure SetSmoothOperation(const Value: TocvSmoothOperations);
public
constructor Create(AOwner: TPersistent); override;
function DoTransform(const Source: IocvImage; 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
FPoint: TPoint;
public
constructor Create(const AX: Integer = 0; const AY: Integer = 0);
published
property X: Integer read FPoint.X write FPoint.X;
property Y: Integer read FPoint.Y write FPoint.Y;
end;
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;
TovcCropOperation = 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;
TocvInterpolationMethod = (INTER_NN, INTER_LINEAR, INTER_CUBIC, INTER_AREA, INTER_LANCZOS4);
TocvInterpolationWarpingFlag = (WARP_FILL_OUTLIERS, WARP_INVERSE_MAP);
TocvInterpolationWarpingFlagSet = set of TocvInterpolationWarpingFlag;
TocvRotateOperation = class(TocvCustomImageOperation)
protected
procedure AssignTo(Dest: TPersistent); override;
private
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;
TovcHoughCirclesSmooth = 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: TovcHoughCirclesSmooth;
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: TovcHoughCirclesSmooth 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;
TocvHaarCascadeType = (hcEye, hcEyeTreeEyeGlasses, hcFrontalFaceAlt, hcFrontalFaceAlt2, hcFrontalFaceAltTree,
hcFrontalFaceDefaut, hcFullBody, hcLeftEye2Splits, hcLowerBody, hcMcsEyePairBig, hcMcsEyePairSmall, hcMcsLeftEar,
hcMcsLeftEye, hcMcsMouth, hcMcsNose, hcMcsRightEar, hcMcsRightEye, hcMcsUpperBody, hcProfileFace, hcRightEye2Splits, hcSmile,
hcUpperBody, hcPlateNumberRus);
TocvHaarCascadeFlag = (HAAR_DO_CANNY_PRUNING, HAAR_SCALE_IMAGE, HAAR_FIND_BIGGEST_OBJECT, HAAR_DO_ROUGH_SEARCH);
TocvHaarCascadeFlagSet = set of TocvHaarCascadeFlag;
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;
function GetHaarCascadeFlag: Integer;
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 1 Read GetBoolParam write SetBoolParam;
property Scale: Double index 0 Read GetFloatParam write SetFloatParam; // 1.3
property MinNeighbors: Integer index 0 Read GetIntParam write SetIntParam; // 3
property MinSize: 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 2 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;
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;
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
///
// Run utils\CompressHaar\uCompressHaar.dpr
// Add to serarch path \Delphi-OpenCV\resource\facedetectxml\
///
{$R haarcascade.rc haarcascade.res}
{$R haarcascade.res}
uses
ocv.core_c,
ocv.imgproc_c,
ocv.imgproc.types_c,
ocv.cvutils,
System.Math;
type
TPersistentAccessProtected = class(TPersistent);
TocvHaarCascadeRecord = record
Name: String;
FileName: String;
end;
//
// Run utils\CompressHaar\uCompressHaar.dpr
// Add to serarch path \Delphi-OpenCV\resource\facedetectxml\
//
{$I haarcascade.inc}
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;
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 (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;
finally
Destanation := nil;
UnlockTransform;
end;
end;
procedure TocvImageOperation.UnlockTransform;
begin
CS.Leave;
end;
{TovcImageOperationCanny}
constructor TovcCannyOperation.Create {(AOwner: TPersistent)};
begin
inherited;
Threshold1 := 10;
Threshold2 := 100;
ApertureSize := 3;
end;
function TovcCannyOperation.DoTransform(const Source: IocvImage; 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;
{TovcImageOperationSmooth}
Const
ocvSmoothOperations: array [TocvSmoothOperations] of Integer = (CV_BLUR_NO_SCALE, CV_BLUR, CV_GAUSSIAN, CV_MEDIAN,
CV_BILATERAL);
procedure TovcSmoothOperation.AssignTo(Dest: TPersistent);
begin
inherited;
if Dest is TovcSmoothOperation then
FSmoothOperation := (Dest as TovcSmoothOperation).FSmoothOperation;
end;
constructor TovcSmoothOperation.Create {(AOwner: TPersistent)};
begin
inherited;
FSmoothOperation := GAUSSIAN;
size1 := 3;
size2 := 3;
sigma1 := 0;
sigma2 := 0;
end;
procedure TovcSmoothOperation.SetSmoothOperation(const Value: TocvSmoothOperations);
begin
if LockTransform then
try
FSmoothOperation := Value;
finally
UnlockTransform;
end;
end;
function TovcSmoothOperation.DoTransform(const Source: IocvImage; 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;
{TovcCustomErodeDilate}
procedure TovcCustomErodeDilateOperation.AssignTo(Dest: TPersistent);
begin
inherited;
if Dest is TovcCustomErodeDilateOperation then
FMorphOp := (Dest as TovcCustomErodeDilateOperation).MorphOp;
end;
constructor TovcCustomErodeDilateOperation.Create {(AOwner: TComponent)};
begin
inherited;
Radius := 5;
Iterations := 5;
FMorphOp := SHAPE_RECT;
end;
procedure TovcCustomErodeDilateOperation.SetMorphOp(const Value: TocvErodeDilateMode);
begin
if LockTransform then
try
FMorphOp := Value;
finally
UnlockTransform;
end;
end;
const
EDMorpgOp: array [TocvErodeDilateMode] of Integer = (CV_SHAPE_RECT, CV_SHAPE_CROSS, CV_SHAPE_ELLIPSE, CV_SHAPE_CUSTOM);
{TovcErode}
function TovcErodeOperation.DoTransform(const Source: IocvImage; 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;
{TovcDilate}
function TovcDilateOperation.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;
{TovcSobel}
constructor TovcSobelOperation.Create {(AOwner: TComponent)};
begin
inherited;
XOrder := 1;
YOrder := 1;
Aperture := 3;
end;
function TovcSobelOperation.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
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
rot_mat := cvCreateMat(2, 3, CV_32FC1);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if RotateAroundCenter then
begin
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);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
D := cvCreateImage(cvGetSize(Source.IpImage), Source.IpImage^.depth, Source.IpImage^.nChannels);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
M := Integer(Method);
if WARP_FILL_OUTLIERS in FWarpingFlag then
M := M or CV_WARP_FILL_OUTLIERS;
if WARP_INVERSE_MAP in FWarpingFlag then
M := M or CV_WARP_INVERSE_MAP;
cvWarpAffine(Source.IpImage, D, rot_mat, M, 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
FPoint := (Dest as TocvPoint2D32i).FPoint;
end;
{TocvCountourDraw}
procedure TocvDraw.AssignTo(Dest: TPersistent);
begin
inherited;
if Dest is TocvDraw then
begin
FOffset.FPoint := (Dest as TocvDraw).FOffset.FPoint;
FEnabled := (Dest as TocvDraw).FEnabled;
FThickness := (Dest as TocvDraw).FThickness;
FLineType := (Dest as TocvDraw).FLineType;
FColor := (Dest as TocvDraw).FColor;
end;
end;
constructor TocvDraw.Create(AOwner: TPersistent);
begin
inherited Create;
FOwner := AOwner;
FOffset := 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;
r, g, b: byte;
begin
Destanation := Source;
if Assigned(FCascade) then
begin
storage := cvCreateMemStorage(0);
try
gray := Source.GrayImage;
if Equalize then
cvEqualizeHist(gray.IpImage, gray.IpImage);
detected_objects := cvHaarDetectObjects(gray.IpImage, FCascade, storage, Scale, MinNeighbors, GetHaarCascadeFlag,
cvSize(MinSize.X, MinSize.Y), cvSize(MaxSize.X, MaxSize.Y));
if Assigned(detected_objects) then
begin
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;
function TocvHaarCascade.GetHaarCascadeFlag: Integer;
Var
i: TocvHaarCascadeFlag;
j: Integer;
begin
Result := 0;
j := 1;
for i := HAAR_DO_CANNY_PRUNING to HAAR_DO_ROUGH_SEARCH do
begin
if i in FCascadeFlags then
Result := Result or j;
j := j * 2;
end;
end;
procedure 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
if not Assigned(FCascade) then
try
FullFileName := TempPath + FrontalFaceXML[FHaarCascade].FileName;
if not FileExists(FullFileName) then
begin
RS := TResourceStream.Create(hInstance, FrontalFaceXML[FHaarCascade].Name, RT_RCDATA);
DC := TZDecompressionStream.Create(RS);
FS := TFileStream.Create(FullFileName, fmCreate);
try
FS.CopyFrom(DC, DC.Size);
finally
DC.Free;
FS.Free;
RS.Free;
end;
end;
DoLoadHaarCascade(FullFileName);
except
ReleaseCascade;
end;
end;
finally
FLockFrontalFaceChange.Leave;
end;
end;
constructor TocvPoint2D32i.Create(const AX, AY: Integer);
begin
FPoint.X := AX;
FPoint.Y := AY;
end;
{TocvContourDraw}
procedure TocvContourDraw.AssignTo(Dest: TPersistent);
begin
inherited;
if Dest is TocvContourDraw then
begin
FHoleColor := (Dest as TocvContourDraw).FHoleColor;
FMaxLevel := (Dest as TocvContourDraw).FMaxLevel;
end;
end;
constructor TocvContourDraw.Create(AOwner: TPersistent);
begin
inherited;
FHoleColor := clRed;
FMaxLevel := 2;
end;
{TocvMatchTemplate}
procedure TocvMatchTemplate.AssignTo(Dest: TPersistent);
begin
inherited;
if Dest is TocvMatchTemplate then
begin
FMethod := (Dest as TocvMatchTemplate).FMethod;
end;
end;
constructor TocvMatchTemplate.Create(AOwner: TPersistent);
begin
inherited;
FTemplate := TPicture.Create;
FTemplate.OnChange := TemplateOnChange;
FDrawRect := TocvDraw.Create(Self);
FMethod := TM_CCOEFF_NORMED;
end;
destructor TocvMatchTemplate.Destroy;
begin
if Assigned(FIPLTemplate) then
cvReleaseImage(FIPLTemplate);
FTemplate.Free;
FDrawRect.Free;
inherited;
end;
procedure TocvMatchTemplate.TemplateOnChange(Sender: TObject);
begin
IPLTemplate := nil;
end;
function TocvMatchTemplate.DoTransform(const Source: IocvImage; 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 // <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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 := uOCVTypes.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;
{TovcCropOperation}
constructor TovcCropOperation.Create(AOwner: TPersistent);
begin
inherited;
FCropRect := TocvRect32i.Create;
end;
destructor TovcCropOperation.Destroy;
begin
FCropRect.Free;
inherited;
end;
function TovcCropOperation.DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean;
begin
if FCropRect.ocvRect.IsEmpty then
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;
{TovcAddWeightedOperation}
procedure TovcAddWeightedOperation.AssignTo(Dest: TPersistent);
begin
inherited;
if Dest is TovcAddWeightedOperation then
FTransform := (Dest as TovcAddWeightedOperation).FTransform;
end;
constructor TovcAddWeightedOperation.Create(AOwner: TPersistent);
begin
inherited;
Alpha := 0.5;
Beta := 0.5;
Gamma := 0;
FTransform := awTransformSourse2;
end;
function TovcAddWeightedOperation.DoTransform(const Source: IocvImage; out Destanation: IocvImage): Boolean;
Var
s1, s2: IocvImage;
begin
Result := True;
if Assigned(FOnGetImage) then
FOnGetImage(Self, FSrource2Image);
if Assigned(FSrource2Image) then
begin
try
if (Source.IpImage^.Width = FSrource2Image.IpImage^.Width) and (Source.IpImage^.Height = FSrource2Image.IpImage^.Height)
then
begin
s1 := Source;
s2 := FSrource2Image;
Destanation := Source.Same;
end
else if TransformType = awTransformSourse1 then
begin
s1 := FSrource2Image.Same;
s2 := FSrource2Image;
cvResize(Source.IpImage, s1.IpImage, 2);
Destanation := FSrource2Image.Same;
end
else if TransformType = awTransformSourse2 then
begin
s1 := Source;
s2 := Source.Same;
cvResize(FSrource2Image.IpImage, s2.IpImage, 2);
Destanation := Source.Same;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> ROI
cvAddWeighted(s1.IpImage, Alpha, s2.IpImage, Beta, Gamma, Destanation.IpImage);
except
Result := False;
end;
end
else
Destanation := Source;
end;
procedure TovcAddWeightedOperation.SetOpenCVVideoSource(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 TovcAddWeightedOperation.SetVideoSource(const Value: TObject);
begin
VideoSource := Value as TocvDataSource;
end;
procedure TovcAddWeightedOperation.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;
{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 := TovcHoughCirclesSmooth.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;
{TovcHoughCirclesSmooth}
procedure TovcHoughCirclesSmooth.AssignTo(Dest: TPersistent);
begin
inherited;
if Dest is TovcHoughCirclesSmooth then
begin
FSmoothOperation := (Dest as TovcHoughCirclesSmooth).FSmoothOperation;
Fsigma1 := (Dest as TovcHoughCirclesSmooth).Fsigma1;
Fsigma2 := (Dest as TovcHoughCirclesSmooth).Fsigma2;
Fsize1 := (Dest as TovcHoughCirclesSmooth).Fsize1;
Fsize2 := (Dest as TovcHoughCirclesSmooth).Fsize2;
FEnabled := (Dest as TovcHoughCirclesSmooth).FEnabled;
end;
end;
constructor TovcHoughCirclesSmooth.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;
initialization
GetRegisteredImageOperations.RegisterIOClass(TocvNoneOperation, 'None');
GetRegisteredImageOperations.RegisterIOClass(TocvGrayScaleOperation, 'GrayScale');
GetRegisteredImageOperations.RegisterIOClass(TovcCannyOperation, 'Canny');
GetRegisteredImageOperations.RegisterIOClass(TovcSmoothOperation, 'Smooth');
GetRegisteredImageOperations.RegisterIOClass(TovcErodeOperation, 'Erode');
GetRegisteredImageOperations.RegisterIOClass(TovcDilateOperation, 'Dilate');
GetRegisteredImageOperations.RegisterIOClass(TocvLaplaceOperation, 'Laplace');
GetRegisteredImageOperations.RegisterIOClass(TovcSobelOperation, 'Sobel');
GetRegisteredImageOperations.RegisterIOClass(TocvThresholdOperation, 'Threshold');
GetRegisteredImageOperations.RegisterIOClass(TocvAdaptiveThresholdOperation, 'AdaptiveThreshold');
GetRegisteredImageOperations.RegisterIOClass(TocvContoursOperation, 'Contours');
GetRegisteredImageOperations.RegisterIOClass(TocvRotateOperation, 'Rotate');
GetRegisteredImageOperations.RegisterIOClass(TocvAbsDiff, 'AbsDiff');
GetRegisteredImageOperations.RegisterIOClass(TocvHaarCascade, 'HaarCascade');
GetRegisteredImageOperations.RegisterIOClass(TocvMatchTemplate, 'MatchTemplate');
GetRegisteredImageOperations.RegisterIOClass(TocvMotionDetect, 'MotionDetect');
GetRegisteredImageOperations.RegisterIOClass(TovcCropOperation, 'Crop');
GetRegisteredImageOperations.RegisterIOClass(TovcAddWeightedOperation, 'AddWeighted');
GetRegisteredImageOperations.RegisterIOClass(TocvWarpPerspective, 'WarpPerspective');
GetRegisteredImageOperations.RegisterIOClass(TocvHoughCircles, 'HoughCircles');
GetRegisteredImageOperations.RegisterIOClass(TocvHoughLines, 'HoughLines');
finalization
if Assigned(_RegisteredImageOperations) then
FreeAndNil(_RegisteredImageOperations);
end.