Components...

Signed-off-by: Laentir Valetov <laex@bk.ru>
This commit is contained in:
Laentir Valetov 2014-05-11 04:42:34 +04:00
parent 518b549fb2
commit b29888306b
20 changed files with 1032 additions and 509 deletions

View File

@ -1,28 +1,26 @@
###Delphi-OpenCV
----------
* OpenCV version - 2.4.9<br>
* Development environment - Delphi XE2-XE6<br>
----------
#####Contributors:
```
Laentir Valetov
email: laex@bk.ru
Mikhail Grigorev
email: sleuthhound@gmail.com
Laentir Valetov (email: laex@bk.ru)
Mikhail Grigorev (email: sleuthhound@gmail.com)
```
####How to install:
1.Download the archive ```https://github.com/Laex/Delphi-OpenCV/archive/master.zip```<br>
2.Unzip it to a convenient directory, thus get the following directory structure
Download the archive [link][1].<br>
Unzip it to a convenient directory, thus get the following directory structure.<br>
```
<Directory, such as 'C:\OpenCV\' - <PROJECT_ROOT>>
<PROJECT_ROOT> - Directory, such as "C:\OpenCV\"
<bin>
<component>
<include>
<opencv_classes>
<samples>
```
3.Add the search path for the modules of the project in Delphi IDE (Tools-Options-Delphi Options-Library-Library path)
Add the search path for the modules of the project in Delphi IDE (Tools-Options-Delphi Options-Library-Library path)
```
<PROJECT_ROOT>\include
<PROJECT_ROOT>\include\calib3d
@ -40,8 +38,7 @@ email: sleuthhound@gmail.com
<PROJECT_ROOT>\include\video
<PROJECT_ROOT>\component
```
where ```<PROJECT_ROOT>``` directory, which was unzipped project.
where ```<PROJECT_ROOT>``` directory, which was unzipped project.<br>
Additionally, you can specify the path to the library header files FFMPEG
```
<PROJECT_ROOT>\include\ffmpeg
@ -56,8 +53,7 @@ Examples of using FFMPEG library header files are in the
```
<PROJECT_ROOT>\include\ffmpeg\examples
```
4.Open in Delphi IDE and compile:<br>
Open in Delphi IDE and compile:<br>
Examples of the use of certain functions and procedures
```
<PROJECT_ROOT>\samples\LibDemo\LibDemo.groupproj
@ -74,5 +70,12 @@ Examples of use of components.<br>
To install the components, open and install
```
<PROJECT_ROOT>\include\component\OpenCV.dpk
```
When installing the components in your PATH variable must be available should the library "opencv_*.dll".
Must also be installed visual C + + redistributable for Visual Studio 2012 is available on the [link][2]<br>
Examples of the use of components - open:
```
<PROJECT_ROOT>\samples\Components\cCameraCapture\cCameraCapture.dproj
```
[1]: https://github.com/Laex/Delphi-OpenCV/archive/master.zip
[2]: http://www.microsoft.com/en-US/download/details.aspx?id=30679

BIN
component/OpenCV.dcr Normal file

Binary file not shown.

View File

@ -24,6 +24,7 @@
package OpenCV;
{$R *.res}
{$R *.dcr}
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
{$ALIGN 8}
{$ASSERTIONS ON}
@ -32,21 +33,21 @@ package OpenCV;
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LOCALSYMBOLS OFF}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION OFF}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$REFERENCEINFO OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES ON}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DEFINE DEBUG}
{$DEFINE RELEASE}
{$ENDIF IMPLICITBUILDING}
{$IMPLICITBUILD ON}
@ -57,7 +58,7 @@ requires
contains
uOCVTypes in 'uOCVTypes.pas',
uOCVCamera in 'uOCVCamera.pas',
uOCVSource in 'uOCVSource.pas',
uOCVView in 'uOCVView.pas',
uOCVImageOperation in 'uOCVImageOperation.pas',
uOCVRegister in 'uOCVRegister.pas',

View File

@ -100,11 +100,15 @@
<DCCReference Include="vcl.dcp"/>
<DCCReference Include="DesignIDE.dcp"/>
<DCCReference Include="uOCVTypes.pas"/>
<DCCReference Include="uOCVCamera.pas"/>
<DCCReference Include="uOCVSource.pas"/>
<DCCReference Include="uOCVView.pas"/>
<DCCReference Include="uOCVImageOperation.pas"/>
<DCCReference Include="uOCVRegister.pas"/>
<DCCReference Include="uOCVIOProperties.pas"/>
<None Include="ModelSupport_OpenCV\default.txaPackage"/>
<None Include="ModelSupport_OpenCV\default.txvpck"/>
<None Include="ModelSupport_OpenCV\uOCVSource\default.txvpck"/>
<None Include="ModelSupport_OpenCV\uOCVSource\default.txaPackage"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
@ -175,6 +179,7 @@
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>
<ModelSupport>True</ModelSupport>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>

BIN
component/OpenCV.dres Normal file

Binary file not shown.

View File

@ -0,0 +1 @@
TocvCameraSource BITMAP "Resource\\TocvCameraSource.bmp"

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.7 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.7 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.7 KiB

36
component/readme_en.md Normal file
View File

@ -0,0 +1,36 @@
Delphi-OpenCV Components
------------------------
Visual and non-visual components for working with the library OpenCV.
Version: OpenCV 2.4.9
Package: OpenCV.dpk
Components:
TocvView
--------
Showcases the work of a visual component to display video camera images
TocvCamera
----------
Showcases the work of non-visual component connection to the camera and image transmission receivers TOpenCVCamera
TocvImageOperation
------------------
Component that handles images
Installation
------------
1. Add to system variable PATH path to DLL libraries OpenCV.
Also may need to specify a path to msvcp120d.dll, msvcp120.dll, msvcr100d.dll, msvcr100.dll ([link][1])
(if they are not in the same directory).
2. To install, open <PROJECT_ROOT>\component\OpenCV.dpk. Install package.
3. In the panel component will be part OpenCV.
4. Open the sample
> <PROJECT_ROOT>\Samples\Components\cCameraCapture\cCameraCapture.dpr
Run the sample.
*TODO:*
*Wanted beautiful icons for the components.*
[1]: http://www.microsoft.com/en-US/download/details.aspx?id=30679

View File

@ -1,48 +0,0 @@
*****************************************************************
* Delphi-OpenCV Demo *
* Copyright (C) 2013 Project Delphi-OpenCV *
*****************************************************************
Visual and non-visual components for working with the library OpenCV.
Version: OpenCV 2.4.9
Package: OpenCV.dpk
The demo version.
Components:
----- TocvView -------
Showcases the work of a visual component to display
video camera images
----- TocvCamera -----
Showcases the work of non-visual component connection
to the camera and image transmission receivers TOpenCVCamera
----- TocvImageOperation -----
Component that handles images
----- TocvSplitter -----
Transmits the image to multiple receivers
Attention! Components written in a very non-optimal and require
significant improvement. The use of real-world projects
is not recommended.
Further components will be refined and improved.
----- Installation -------
1. Add to system variable PATH path to DLL libraries OpenCV.
Also may need to specify a path to msvcp100d.dll and
msvcr100d.dll (if they are not in the same directory)
2. To install, open <PROJECT_ROOT>\component\OpenCV.dpk.
Install package.
3. In the panel component will be part OpenCV.
4. Open the sample
<PROJECT_ROOT>\Samples\Components\cCameraCapture\cCameraCapture.dpr
Run the sample.
TODO:
Wanted beautiful icons for the components.

View File

@ -1,299 +0,0 @@
(* /*****************************************************************
// Delphi-OpenCV Demo
// Copyright (C) 2013 Project Delphi-OpenCV
// ****************************************************************
// Contributor:
// Laentir Valetov
// email:laex@bk.ru
// ****************************************************************
// You may retrieve the latest version of this file at the GitHub,
// located at git://github.com/Laex/Delphi-OpenCV.git
// ****************************************************************
// The contents of this file are used with permission, subject to
// the Mozilla Public License Version 1.1 (the "License"); you may
// not use this file except in compliance with the License. You may
// obtain a copy of the License at
// http://www.mozilla.org/MPL/MPL-1_1Final.html
//
// Software distributed under the License is distributed on an
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
// implied. See the License for the specific language governing
// rights and limitations under the License.
********************************************************************)
unit uOCVCamera;
interface
uses
System.SysUtils,
System.Classes,
core.types_c,
highgui_c,
uOCVTypes;
type
TocvCameraCaptureSource =
//
(CAP_ANY {= 0} , // autodetect
CAP_CAM_0 {=0} , //
CAP_CAM_1 {=1} , //
CAP_CAM_2 {=2} , //
CAP_CAM_3 {=3} , //
CAP_CAM_4 {=4} , //
CAP_CAM_5 {=5} , //
CAP_MIL {= 100} , // MIL proprietary drivers
CAP_VFW {= 200} , // platform native
CAP_V4L {= 200} , //
CAP_V4L2 {= 200} , //
CAP_FIREWARE {= 300} , // IEEE 1394 drivers
CAP_FIREWIRE {= 300} , //
CAP_IEEE1394 {= 300} , //
CAP_DC1394 {= 300} , //
CAP_CMU1394 {= 300} , //
CAP_STEREO {= 400} , // TYZX proprietary drivers
CAP_TYZX {= 400} , //
TYZX_LEFT {= 400} , //
TYZX_RIGHT {= 401} , //
TYZX_COLOR {= 402} , //
TYZX_Z {= 403} , //
CAP_QT {= 500} , // QuickTime
CAP_UNICAP {= 600} , // Unicap drivers
CAP_DSHOW {= 700} , // DirectShow (via videoInput)
CAP_PVAPI {= 800} , // PvAPI, Prosilica GigE SDK
CAP_OPENNI {= 900} , // OpenNI (for Kinect)
CAP_OPENNI_ASUS {= 910} , // OpenNI (for Asus Xtion)
CAP_ANDROID {= 1000} , // Android
CAP_XIAPI {= 1100} , // XIMEA Camera API
CAP_AVFOUNDATION {= 1200} );
type
TocvCameraThread = class(TThread)
private const
ThreadSleepConst = 10;
private
FOnNotifyData: TOnOcvNotify;
protected
FCapture: pCvCapture;
procedure Execute; override;
public
property OnNotifyData: TOnOcvNotify Read FOnNotifyData write FOnNotifyData;
end;
TocvResolution = (r160x120, r320x240, r424x240, r640x360, r800x448, r960x544, r1280x720);
TocvCamera = class(TocvDataSource)
private
FEnabled: Boolean;
FCameraCaptureSource: TocvCameraCaptureSource;
FResolution: TocvResolution;
FOnImage: TOnOcvNotify;
procedure SetEnabled(const Value: Boolean);
procedure SetCameraCaptureSource(const Value: TocvCameraCaptureSource);
procedure SetResolution(const Value: TocvResolution);
procedure TerminateCameraThread;
procedure ReleaseCamera;
procedure SetCameraResolution;
protected
FCapture: pCvCapture;
FOpenCVCameraThread: TocvCameraThread;
procedure OnNotifyData(Sender: TObject; const IplImage: IocvImage);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Enabled: Boolean Read FEnabled write SetEnabled default False;
property CameraCaptureSource: TocvCameraCaptureSource read FCameraCaptureSource write SetCameraCaptureSource default CAP_ANY;
property Resolution: TocvResolution read FResolution write setResolution;
property OnImage: TOnOcvNotify read FOnImage write FOnImage;
end;
implementation
uses
core_c;
const
ocvCameraCaptureSource: array [TocvCameraCaptureSource] of Longint =
//
(CV_CAP_ANY, // autodetect
CV_CAP_CAM_0, //
CV_CAP_CAM_1, //
CV_CAP_CAM_2, //
CV_CAP_CAM_3, //
CV_CAP_CAM_4, //
CV_CAP_CAM_5, //
CV_CAP_MIL, // MIL proprietary drivers
CV_CAP_VFW, // platform native
CV_CAP_V4L, //
CV_CAP_V4L2, //
CV_CAP_FIREWARE, // IEEE 1394 drivers
CV_CAP_FIREWIRE, //
CV_CAP_IEEE1394, //
CV_CAP_DC1394, //
CV_CAP_CMU1394, //
CV_CAP_STEREO, // TYZX proprietary drivers
CV_CAP_TYZX, //
CV_TYZX_LEFT, //
CV_TYZX_RIGHT, //
CV_TYZX_COLOR, //
CV_TYZX_Z, //
CV_CAP_QT, // QuickTime
CV_CAP_UNICAP, // Unicap drivers
CV_CAP_DSHOW, // DirectShow (via videoInput)
CV_CAP_PVAPI, // PvAPI; Prosilica GigE SDK
CV_CAP_OPENNI, // OpenNI (for Kinect)
CV_CAP_OPENNI_ASUS, // OpenNI (for Asus Xtion)
CV_CAP_ANDROID, // Android
CV_CAP_XIAPI, // XIMEA Camera API
CV_CAP_AVFOUNDATION);
Type
TCameraResolution = record
cWidth, cHeight: Integer;
end;
Const
CameraResolution: array [TocvResolution] of TCameraResolution = ((cWidth: 160; cHeight: 120), (cWidth: 320; cHeight: 240),
(cWidth: 424; cHeight: 240), (cWidth: 640; cHeight: 360), (cWidth: 800; cHeight: 448), (cWidth: 960; cHeight: 544),
(cWidth: 1280; cHeight: 720));
{TOpenCVCameraThread}
procedure TocvCameraThread.Execute;
Var
frame: pIplImage;
begin
while not Terminated do
if Assigned(FCapture) then
begin
try
frame := cvQueryFrame(FCapture);
if Assigned(frame) then
begin
if Assigned(OnNotifyData) then
Synchronize(
procedure
begin
OnNotifyData(Self, TocvImage.CreateCopy(frame));
end);
Sleep(ThreadSleepConst);
end;
except
end;
end
else
Suspend;
end;
{TOpenCVCamera}
constructor TocvCamera.Create(AOwner: TComponent);
begin
inherited;
if not(csDesigning in ComponentState) then
begin
FOpenCVCameraThread := TocvCameraThread.Create(True);
FOpenCVCameraThread.OnNotifyData := OnNotifyData;
FEnabled := False;
FResolution := r160x120;
end;
end;
destructor TocvCamera.Destroy;
begin
TerminateCameraThread;
ReleaseCamera;
inherited;
end;
procedure TocvCamera.ReleaseCamera;
begin
if Assigned(FCapture) then
begin
cvReleaseCapture(FCapture);
FCapture := nil;
end;
end;
procedure TocvCamera.TerminateCameraThread;
begin
if Assigned(FOpenCVCameraThread) then
begin
FOpenCVCameraThread.Terminate;
FOpenCVCameraThread.Resume;
FOpenCVCameraThread.WaitFor;
FOpenCVCameraThread.Free;
FOpenCVCameraThread := Nil;
end;
end;
procedure TocvCamera.OnNotifyData(Sender: TObject; const IplImage: IocvImage);
begin
if Assigned(OnImage) then
OnImage(Self, IplImage);
NotifyReceiver(IplImage);
end;
procedure TocvCamera.SetCameraCaptureSource(const Value: TocvCameraCaptureSource);
Var
isEnabled: Boolean;
begin
if FCameraCaptureSource <> Value then
begin
isEnabled := Enabled;
if Assigned(FCapture) and FEnabled then
Enabled := False;
FCameraCaptureSource := Value;
Enabled := isEnabled;
end;
end;
procedure TocvCamera.SetEnabled(const Value: Boolean);
begin
if FEnabled <> Value then
begin
if not(csDesigning in ComponentState) then
begin
if Assigned(FCapture) and FEnabled then
begin
FOpenCVCameraThread.Suspend;
FOpenCVCameraThread.FCapture := nil;
cvReleaseCapture(FCapture);
FCapture := Nil;
end;
if Value then
begin
FCapture := cvCreateCameraCapture(ocvCameraCaptureSource[FCameraCaptureSource]);
SetCameraResolution;
FOpenCVCameraThread.FCapture := FCapture;
FOpenCVCameraThread.Resume;
end;
end;
FEnabled := Value;
end;
end;
procedure TocvCamera.SetCameraResolution;
begin
cvSetCaptureProperty(FCapture, CV_CAP_PROP_FRAME_WIDTH, CameraResolution[FResolution].cWidth);
cvSetCaptureProperty(FCapture, CV_CAP_PROP_FRAME_HEIGHT, CameraResolution[FResolution].cHeight);
end;
procedure TocvCamera.SetResolution(const Value: TocvResolution);
begin
if FResolution <> Value then
begin
FResolution := Value;
if Enabled then
begin
Enabled := False;
Enabled := True;
end;
end;
end;
end.

View File

@ -28,10 +28,26 @@ interface
Uses
System.Classes,
DesignEditors,
DesignIntf;
DesignIntf,
uOCVImageOperation;
Type
TImageOperationProperty = class(TClassProperty)
TImageOperationProperty = class(TComponentProperty)
private
FInstance: TPersistent;
protected
function GetInstance: TPersistent; virtual;
public
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
procedure GetProperties(Proc: TGetPropProc); override;
procedure GetValues(Proc: TGetStrProc); override;
procedure SetValue(const Value: string); override;
procedure Initialize; override;
property Instance: TPersistent read GetInstance;
end;
TImageOperationCollectionItemProperty = class(TClassProperty)
public
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
@ -39,12 +55,37 @@ Type
procedure SetValue(const Value: string); override;
end;
TImagePreprocessingProperty = class(TClassProperty)
TImagePreprocessingProperty = class(TImageOperationCollectionItemProperty)
public
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
// function GetAttributes: TPropertyAttributes; override;
// function GetValue: string; override;
procedure GetValues(Proc: TGetStrProc); override;
procedure SetValue(const Value: string); override;
// procedure SetValue(const Value: string); override;
end;
TocvIOPropertyChangeEvent = procedure(Sender: TObject; const PropName: string) of object;
TocvCustomImageOperationProperty = class(TocvCustomImageOperation)
private
FUpdateCount: Integer;
FOnChanging: TNotifyEvent;
FOnChanged: TNotifyEvent;
FOnChangingProperty: TocvIOPropertyChangeEvent;
FOnChangedProperty: TocvIOPropertyChangeEvent;
protected
procedure Changed; virtual;
procedure Changing; virtual;
procedure ChangedProperty(const PropName: string); virtual;
procedure ChangingProperty(const PropName: string); virtual;
procedure SetUpdateState(Updating: Boolean); virtual;
property UpdateCount: Integer read FUpdateCount;
public
procedure BeginUpdate; virtual;
procedure EndUpdate; virtual;
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
property OnChangedProperty: TocvIOPropertyChangeEvent read FOnChangedProperty write FOnChangedProperty;
property OnChangingProperty: TocvIOPropertyChangeEvent read FOnChangingProperty write FOnChangingProperty;
end;
implementation
@ -53,7 +94,6 @@ Uses
System.SysUtils,
System.TypInfo,
System.RTLConsts,
uOCVImageOperation,
uOCVTypes;
{TImageOperationProperty}
@ -61,7 +101,7 @@ Uses
function TImageOperationProperty.GetAttributes: TPropertyAttributes;
begin
Result := inherited GetAttributes;
Result := Result - [paReadOnly] + [paValueList, paSortList, paRevertable, paVolatileSubProperties];
Result := Result - [paReadOnly] + [paValueList, paSortList, paRevertable, paSubProperties, paVolatileSubProperties];
end;
function TImageOperationProperty.GetValue: string;
@ -98,16 +138,16 @@ end;
{TImagePreprocessingProperty}
function TImagePreprocessingProperty.GetAttributes: TPropertyAttributes;
begin
Result := inherited GetAttributes;
Result := Result - [paReadOnly] + [paValueList, paSortList, paRevertable, paVolatileSubProperties];
end;
//function TImagePreprocessingProperty.GetAttributes: TPropertyAttributes;
//begin
// Result := inherited GetAttributes;
// Result := Result - [paReadOnly] + [paValueList, paSortList, paRevertable, paSubProperties];
//end;
function TImagePreprocessingProperty.GetValue: string;
begin
Result := GetRegisteredImageOperations.GetNameByClass(TocvImageOperation(GetOrdValue).ClassType);
end;
//function TImagePreprocessingProperty.GetValue: string;
//begin
// Result := GetRegisteredImageOperations.GetNameByClass(TocvImageOperation(GetOrdValue).ClassType);
//end;
procedure TImagePreprocessingProperty.GetValues(Proc: TGetStrProc);
begin
@ -116,7 +156,151 @@ begin
Proc('AdaptiveThreshold');
end;
procedure TImagePreprocessingProperty.SetValue(const Value: string);
//procedure TImagePreprocessingProperty.SetValue(const Value: string);
//Var
// APropertiesClass: TocvImageOperationClass;
// I: Integer;
// AIntf: IocvEditorPropertiesContainer;
//begin
// APropertiesClass := GetRegisteredImageOperations.FindByName(Value);
// if APropertiesClass = nil then
// APropertiesClass := TocvImageOperationClass(GetRegisteredImageOperations.Objects[0]);
//
// for I := 0 to PropCount - 1 do
// if Supports(GetComponent(I), IocvEditorPropertiesContainer, AIntf) then
// AIntf.SetPropertiesClass(APropertiesClass);
//
// Modified;
//end;
{TocvCustomImageOperationProperty}
procedure TocvCustomImageOperationProperty.BeginUpdate;
begin
if FUpdateCount = 0 then
SetUpdateState(True);
Inc(FUpdateCount);
end;
procedure TocvCustomImageOperationProperty.Changed;
begin
if (FUpdateCount = 0) and Assigned(FOnChanged) then
FOnChanged(Self);
end;
procedure TocvCustomImageOperationProperty.ChangedProperty(const PropName: string);
begin
if Assigned(FOnChangedProperty) then
FOnChangedProperty(Self, PropName);
end;
procedure TocvCustomImageOperationProperty.Changing;
begin
if (FUpdateCount = 0) and Assigned(FOnChanging) then
FOnChanging(Self);
end;
procedure TocvCustomImageOperationProperty.ChangingProperty(const PropName: string);
begin
if Assigned(FOnChangingProperty) then
FOnChangingProperty(Self, PropName);
end;
procedure TocvCustomImageOperationProperty.EndUpdate;
begin
Dec(FUpdateCount);
if FUpdateCount = 0 then
SetUpdateState(False);
end;
procedure TocvCustomImageOperationProperty.SetUpdateState(Updating: Boolean);
begin
if Updating then
Changing
else
Changed;
end;
function TImageOperationProperty.GetInstance: TPersistent;
var
LInstance: TPersistent;
LPersistentPropertyName: string;
begin
if not Assigned(FInstance) then
begin
LInstance := GetComponent(0);
LPersistentPropertyName := GetName;
if IsPublishedProp(LInstance, LPersistentPropertyName) then
begin
FInstance := TPersistent(GetObjectProp(LInstance, LPersistentPropertyName));
end;
end;
Result := FInstance;
end;
procedure TImageOperationProperty.GetProperties(Proc: TGetPropProc);
begin
inherited;
end;
procedure TImageOperationProperty.Initialize;
var
LInstance: TPersistent;
LPersistentPropertyName: string;
begin
inherited Initialize;
LInstance := Instance;
LPersistentPropertyName := GetName;
if LInstance is TComponent then
begin
if (TComponent(LInstance).Name = '') and (TComponent(LInstance).Name <> LPersistentPropertyName) then
begin
TComponent(LInstance).Name := LPersistentPropertyName;
end;
end
else if LInstance is TocvCustomImageOperation then
begin
if (TocvCustomImageOperation(LInstance).Name = '') and (TocvCustomImageOperation(LInstance).Name <> LPersistentPropertyName)
then
begin
TocvCustomImageOperation(LInstance).Name := LPersistentPropertyName;
end;
end
// else
// if LInstance is TocvImageOperationCollectionItem then
// begin
// if (TocvImageOperationCollectionItem(LInstance).DisplayName = '') and (TocvImageOperationCollectionItem(LInstance).DisplayName <> LPersistentPropertyName)
// then
// begin
// TocvImageOperationCollectionItem(LInstance).DisplayName := LPersistentPropertyName;
// end;
// end;
end;
{TImageOperationCollectionItemProperty}
function TImageOperationCollectionItemProperty.GetAttributes: TPropertyAttributes;
begin
Result := inherited GetAttributes;
Result := Result - [paReadOnly] + [paValueList, paSortList, paRevertable, paVolatileSubProperties];
end;
function TImageOperationCollectionItemProperty.GetValue: string;
begin
Result := GetRegisteredImageOperations.GetNameByClass(TocvImageOperation(GetOrdValue).ClassType);
end;
procedure TImageOperationCollectionItemProperty.GetValues(Proc: TGetStrProc);
var
I: Integer;
rIO: TRegisteredImageOperations;
begin
rIO := GetRegisteredImageOperations;
for I := 0 to rIO.Count - 1 do
Proc(rIO[I]);
end;
procedure TImageOperationCollectionItemProperty.SetValue(const Value: string);
Var
APropertiesClass: TocvImageOperationClass;
I: Integer;
@ -136,10 +320,11 @@ end;
initialization
RegisterPropertyEditor(TypeInfo(TocvCustomImageOperation), TocvImageOperation, 'Operation', TImageOperationProperty);
RegisterPropertyEditor(TypeInfo(TocvCustomImageOperation), TocvImageOperationCollectionItem, 'Operation',
TImageOperationProperty);
RegisterPropertyEditor(TypeInfo(TocvCustomImageOperation), TocvImageOperationCollectionItem, 'Operation',TImageOperationCollectionItemProperty);
//RegisterPropertyEditor(TypeInfo(TocvCustomImageOperation), TocvImageOperationCollectionItem, 'Operation',TImageOperationProperty);
RegisterPropertyEditor(TypeInfo(TocvCustomImageOperation), TocvContoursOperation, 'Preprocessing', TImagePreprocessingProperty);
UnlistPublishedProperty(TocvCustomImageOperation, 'Name');
UnlistPublishedProperty(TocvImageOperation, 'OperationClassName');
UnlistPublishedProperty(TocvImageOperationCollectionItem, 'OperationClassName');
UnlistPublishedProperty(TocvContoursOperation, 'OperationClassName');

View File

@ -37,32 +37,40 @@ uses
type
TocvCustomImageOperation = class(TPersistent)
TocvCustomImageOperation = class(TComponent)
protected
procedure AssignTo(Dest: TPersistent); override;
private
CS: TCriticalSection;
FOwner: TPersistent; // TComponent;
FCriticalSection: TCriticalSection;
FOwner: TPersistent;
FFloatParams: TArray<Double>;
FIntParams: TArray<Integer>;
FBoolParams: TArray<Boolean>;
FOnAfterPaint: TOnOcvNotify;
FOnBeforePaint: TOnOcvNotify;
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);
protected
function LockTransform: Boolean;
procedure UnlockTransform;
function GetOwner: TPersistent; override;
function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean; virtual;
property FloatParams[const index: Integer]: Double Read GetFloatParam write SetFloatParam;
property IntParams[const index: Integer]: Integer Read GetIntParam write SetIntParam;
property BoolParams[const index: Integer]: Boolean Read GetBoolParam write SetBoolParam;
public
constructor Create(AOwner: TPersistent); virtual;
constructor Create(AOwner: TPersistent); reintroduce; virtual;
destructor Destroy; override;
function Transform(const Source: IocvImage; var Destanation: IocvImage): Boolean; virtual;
function GetNamePath: string; override;
property Name;
published
property OnAfterPaint: TOnOcvNotify read FOnAfterPaint write FOnAfterPaint;
property OnBeforePaint: TOnOcvNotify read FOnBeforePaint write FOnBeforePaint;
end;
TocvImageOperationClass = class of TocvCustomImageOperation;
@ -293,6 +301,8 @@ type
FOffset: TocvPoint;
FContourDraw: TocvContourDraw;
FApprox: TocvContourApprox;
FOnContour: TOnOcvContour;
FContours: pCvSeq;
function LockTransform: Boolean;
procedure UnlockTransform;
procedure CreateProperties;
@ -315,6 +325,7 @@ type
destructor Destroy; override;
function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean; override;
property OperationClass: TocvImageOperationClass read GetPropertiesClass write SetPropertiesClass;
property Contours: pCvSeq read FContours;
published
property OperationClassName: string read GetPropertiesClassName write SetPropertiesClassName;
property Preprocessing: TocvCustomImageOperation read GetProperties write SetProperties;
@ -322,8 +333,10 @@ type
property ApproximationMethod: TocvContourApproximationMethods read FApproximationMethod write FApproximationMethod
default CHAIN_APPROX_SIMPLE;
property Offset: TocvPoint read FOffset write FOffset;
property MinArea: Integer index 0 Read GetIntParam write SetIntParam;
property ContourDraw: TocvContourDraw read FContourDraw write FContourDraw;
property ApproxPoly: TocvContourApprox read FApprox write FApprox;
property OnContour: TOnOcvContour read FOnContour write FOnContour;
end;
TocvImageOperationCollectionItem = class(TCollectionItem, IocvEditorPropertiesContainer)
@ -331,6 +344,9 @@ type
CS: TCriticalSection;
FOperation: TocvCustomImageOperation;
FOperationClass: TocvImageOperationClass;
FOnAfterPaint: TOnOcvNotify;
FOnBeforePaint: TOnOcvNotify;
FOwner: TCollection;
function LockTransform: Boolean;
procedure UnlockTransform;
procedure CreateProperties;
@ -344,6 +360,7 @@ type
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;
@ -354,9 +371,12 @@ type
function DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
procedure Assign(Source: TPersistent); override;
property OperationClass: TocvImageOperationClass read GetPropertiesClass write SetPropertiesClass;
published
property OperationClassName: string read GetPropertiesClassName write SetPropertiesClassName;
property Operation: TocvCustomImageOperation read GetProperties write SetProperties;
property OnAfterPaint: TOnOcvNotify read FOnAfterPaint write FOnAfterPaint;
property OnBeforePaint: TOnOcvNotify read FOnBeforePaint write FOnBeforePaint;
end;
TocvImageOperationCollection = class(TOwnedCollection);
@ -367,9 +387,7 @@ type
FOperation: TocvCustomImageOperation;
FOperationClass: TocvImageOperationClass;
FOperations: TocvImageOperationCollection;
FOnBeforeTransorm: TOnOcvNotify;
FOnAfterTransorm: TOnOcvNotify;
FOnContour: TOnOcvContour;
FUseCollection: Boolean;
function LockTransform: Boolean;
procedure UnlockTransform;
procedure CreateProperties;
@ -379,13 +397,11 @@ type
procedure SetProperties(const Value: TocvCustomImageOperation);
procedure SetPropertiesClass(Value: TocvImageOperationClass);
procedure SetPropertiesClassName(const Value: string);
procedure SetUseCollection(const Value: Boolean);
protected
procedure TakeImage(const IplImage: IocvImage); override;
function GetProperties: TocvCustomImageOperation;
function GetPropertiesClass: TocvImageOperationClass;
procedure DoNotifyAfterTransform(Sender: TObject; const IplImage: IocvImage);
procedure DoNotifyBeforeTransform(Sender: TObject; const IplImage: IocvImage);
procedure DoNotifyContour(Sender: TObject; const IplImage: IocvImage; const ContourCount: Integer; const Contours: pCvSeq);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -394,9 +410,7 @@ type
property OperationClassName: string read GetPropertiesClassName write SetPropertiesClassName;
property Operation: TocvCustomImageOperation read GetProperties write SetProperties;
property Operations: TocvImageOperationCollection Read FOperations write FOperations;
property OnBeforeTransorm: TOnOcvNotify read FOnBeforeTransorm write FOnBeforeTransorm;
property OnAfterTransorm: TOnOcvNotify read FOnAfterTransorm write FOnAfterTransorm;
property OnContour: TOnOcvContour read FOnContour write FOnContour;
property OperationsEnabled: Boolean read FUseCollection write SetUseCollection default True;
end;
TRegisteredImageOperations = class(TStringList)
@ -416,6 +430,9 @@ Uses
imgproc_c,
imgproc.types_c;
type
TPersistentAccessProtected = class(TPersistent);
Var
_RegisteredImageOperations: TRegisteredImageOperations = nil;
@ -465,11 +482,25 @@ 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;
@ -511,55 +542,22 @@ var
begin
if LockTransform then
try
if FOperations.Count > 0 then
Destanation := IplImage;
if OperationsEnabled and (FOperations.Count > 0) then
begin
Destanation := IplImage;
for i := 0 to FOperations.Count - 1 do
begin
DoNotifyBeforeTransform(FOperations.Items[i], IplImage);
if not(FOperations.Items[i] as TocvImageOperationCollectionItem).DoTransform(Destanation, Destanation) then
Exit;
DoNotifyAfterTransform(FOperation, Destanation);
end;
NotifyReceiver(Destanation);
end
else
begin
if Assigned(FOperation) then
begin
DoNotifyBeforeTransform(FOperation, IplImage);
if FOperation.DoTransform(IplImage, Destanation) then
begin
DoNotifyAfterTransform(FOperation, Destanation);
NotifyReceiver(Destanation);
end;
end;
end;
else if Assigned(FOperation) then
FOperation.DoTransform(IplImage, Destanation);
NotifyReceiver(Destanation);
finally
Destanation := nil;
UnlockTransform;
end;
end;
procedure TocvImageOperation.DoNotifyBeforeTransform(Sender: TObject; const IplImage: IocvImage);
begin
if Assigned(OnBeforeTransorm) then
OnBeforeTransorm(Sender, IplImage);
end;
procedure TocvImageOperation.DoNotifyContour(Sender: TObject; const IplImage: IocvImage; const ContourCount: Integer;
const Contours: pCvSeq);
begin
if Assigned(OnContour) then
OnContour(Sender, IplImage, ContourCount, Contours);
end;
procedure TocvImageOperation.DoNotifyAfterTransform(Sender: TObject; const IplImage: IocvImage);
begin
if Assigned(OnAfterTransorm) then
OnAfterTransorm(Sender, IplImage);
end;
procedure TocvImageOperation.UnlockTransform;
begin
CS.Leave;
@ -614,20 +612,25 @@ end;
constructor TocvCustomImageOperation.Create(AOwner: TPersistent);
begin
inherited Create;
if AOwner is TComponent then
inherited Create(AOwner as TComponent)
else
inherited Create(nil);
SetSubComponent(True);
FOwner := AOwner;
CS := TCriticalSection.Create;
FCriticalSection := TCriticalSection.Create;
end;
destructor TocvCustomImageOperation.Destroy;
begin
CS.Free;
FCriticalSection.Free;
inherited;
end;
function TocvCustomImageOperation.DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
begin
Result := False;
end;
function TocvCustomImageOperation.GetBoolParam(const index: Integer): Boolean;
@ -635,7 +638,7 @@ begin
if (index >= 0) and (index < Length(FBoolParams)) then
Result := FBoolParams[index]
else
Result := false;
Result := False;
end;
function TocvCustomImageOperation.GetFloatParam(const index: Integer): Double;
@ -654,9 +657,34 @@ begin
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 := CS.TryEnter;
Result := FCriticalSection.TryEnter;
end;
procedure TocvCustomImageOperation.SetBoolParam(const index: Integer; const Value: Boolean);
@ -700,7 +728,11 @@ begin
Result := LockTransform;
if Result then
try
if Assigned(OnBeforePaint) then
OnBeforePaint(Self, Source);
Result := DoTransform(Source, Destanation);
if Result and Assigned(OnAfterPaint) then
OnAfterPaint(Self, Source);
finally
UnlockTransform;
end;
@ -708,7 +740,7 @@ end;
procedure TocvCustomImageOperation.UnlockTransform;
begin
CS.Leave;
FCriticalSection.Leave;
end;
{TovcImageOperationSmooth}
@ -909,13 +941,17 @@ 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;
@ -936,6 +972,11 @@ begin
Result := GetRegisteredImageOperations.GetNameByClass(FOperation.ClassType);
end;
function TocvImageOperationCollectionItem.GetOwner: TPersistent;
begin
Result := FOwner;
end;
function TocvImageOperationCollectionItem.GetProperties: TocvCustomImageOperation;
begin
if not Assigned(FOperation) then
@ -994,7 +1035,8 @@ end;
function TocvImageOperationCollectionItem.DoTransform(const Source: IocvImage; var Destanation: IocvImage): Boolean;
begin
if LockTransform then
Result := LockTransform;
if Result then
try
Result := Assigned(FOperation) and FOperation.DoTransform(Source, Destanation)
finally
@ -1103,6 +1145,7 @@ begin
end;
RetrievalMode := RETR_LIST;
ApproximationMethod := CHAIN_APPROX_SIMPLE;
MinArea := 100;
end;
procedure TocvContoursOperation.CreateProperties;
@ -1200,15 +1243,15 @@ const
Var
th_image: IocvImage;
Contours: pCvSeq;
storage: pCvMemStorage;
contoursCont: Integer;
RGBColor: TColor;
er, eg, eb: byte;
hr, hg, hb: byte;
s_contours: pCvSeq;
area: Double;
begin
Result := false;
Contours := nil;
Result := False;
FContours := nil;
th_image := nil;
storage := cvCreateMemStorage(0);
try
@ -1218,15 +1261,28 @@ begin
contoursCont := cvFindContours(th_image.IpImage, storage, @Contours, SizeOf(TCvContour), Integer(RetrievalMode),
Integer(ApproximationMethod), cvPoint(Offset.X, Offset.Y));
if ApproxPoly.Enabled then
Contours := cvApproxPoly(Contours, SizeOf(TCvContour), storage, CV_POLY_APPROX_DP, ApproxPoly.Eps,
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);
cvDrawContours(Destanation.IpImage, 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));
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;
@ -1236,22 +1292,9 @@ begin
end;
procedure TocvContoursOperation.DoNotifyContours(const Image: IocvImage; const ContourCount: Integer; const Contours: pCvSeq);
Var
NotifyTarget: TocvImageOperation;
begin
if FOwner is TocvImageOperation then
NotifyTarget := FOwner as TocvImageOperation
else {}
if
{} (FOwner is TocvImageOperationCollectionItem) and
{} ((FOwner as TocvImageOperationCollectionItem).GetOwner is TocvImageOperationCollection) and
{} (((FOwner as TocvImageOperationCollectionItem).GetOwner as TocvImageOperationCollection).Owner is TocvImageOperation) then
NotifyTarget := ((FOwner as TocvImageOperationCollectionItem).GetOwner as TocvImageOperationCollection)
.Owner as TocvImageOperation
else
NotifyTarget := nil;
if Assigned(NotifyTarget) then
NotifyTarget.DoNotifyContour(Self, Image, ContourCount, Contours);
if Assigned(OnContour) then
OnContour(Self, Image, ContourCount, Contours);
end;
procedure TocvContoursOperation.UnlockTransform;

View File

@ -31,16 +31,17 @@ implementation
Uses
DesignIntf,
System.Classes,
uOCVCamera,
uOCVSource,
uOCVView,
uOCVImageOperation;
procedure Register;
begin
RegisterComponents('OpenCV', [TocvImageOperation]);
RegisterComponents('OpenCV', [TocvCamera]);
RegisterComponents('OpenCV', [TocvView]);
RegisterClasses([TocvNoneOperation, TocvGrayScaleOperation, TovcCannyOperation, TovcSmoothOperation, TovcErodeOperation, TovcDilateOperation, TocvLaplaceOperation, TovcSobelOperation, TocvThresholdOperation, TocvAdaptiveThresholdOperation, TocvContoursOperation, TocvRotateOperation]);
RegisterComponents('OpenCV', [TocvImageOperation,TocvCameraSource,TocvView,TocvFileSource,TocvIPCamSource]);
RegisterClasses([ TocvNoneOperation, TocvGrayScaleOperation, TovcCannyOperation,
TovcSmoothOperation, TovcErodeOperation, TovcDilateOperation,
TocvLaplaceOperation, TovcSobelOperation, TocvThresholdOperation,
TocvAdaptiveThresholdOperation, TocvContoursOperation, TocvRotateOperation]);
end;
end.

536
component/uOCVSource.pas Normal file
View File

@ -0,0 +1,536 @@
(* /*****************************************************************
// Delphi-OpenCV Demo
// Copyright (C) 2013 Project Delphi-OpenCV
// ****************************************************************
// Contributor:
// Laentir Valetov
// email:laex@bk.ru
// ****************************************************************
// You may retrieve the latest version of this file at the GitHub,
// located at git://github.com/Laex/Delphi-OpenCV.git
// ****************************************************************
// The contents of this file are used with permission, subject to
// the Mozilla Public License Version 1.1 (the "License"); you may
// not use this file except in compliance with the License. You may
// obtain a copy of the License at
// http://www.mozilla.org/MPL/MPL-1_1Final.html
//
// Software distributed under the License is distributed on an
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
// implied. See the License for the specific language governing
// rights and limitations under the License.
********************************************************************)
unit uOCVSource;
interface
uses
System.SysUtils,
System.Classes,
System.SyncObjs,
core.types_c,
highgui_c,
uOCVTypes;
type
TocvCameraCaptureSource =
//
(CAP_ANY {= 0} , // autodetect
CAP_CAM_0 {=0} , //
CAP_CAM_1 {=1} , //
CAP_CAM_2 {=2} , //
CAP_CAM_3 {=3} , //
CAP_CAM_4 {=4} , //
CAP_CAM_5 {=5} , //
CAP_MIL {= 100} , // MIL proprietary drivers
CAP_VFW {= 200} , // platform native
CAP_V4L {= 200} , //
CAP_V4L2 {= 200} , //
CAP_FIREWARE {= 300} , // IEEE 1394 drivers
CAP_FIREWIRE {= 300} , //
CAP_IEEE1394 {= 300} , //
CAP_DC1394 {= 300} , //
CAP_CMU1394 {= 300} , //
CAP_STEREO {= 400} , // TYZX proprietary drivers
CAP_TYZX {= 400} , //
TYZX_LEFT {= 400} , //
TYZX_RIGHT {= 401} , //
TYZX_COLOR {= 402} , //
TYZX_Z {= 403} , //
CAP_QT {= 500} , // QuickTime
CAP_UNICAP {= 600} , // Unicap drivers
CAP_DSHOW {= 700} , // DirectShow (via videoInput)
CAP_PVAPI {= 800} , // PvAPI, Prosilica GigE SDK
CAP_OPENNI {= 900} , // OpenNI (for Kinect)
CAP_OPENNI_ASUS {= 910} , // OpenNI (for Asus Xtion)
CAP_ANDROID {= 1000} , // Android
CAP_XIAPI {= 1100} , // XIMEA Camera API
CAP_AVFOUNDATION {= 1200} );
type
TocvCustomSourceThread = class(TThread)
private
FOnNotifyData: TOnOcvNotify;
FOnNoData: TNotifyEvent;
FThreadDelay: Integer;
FLock: TCriticalSection;
procedure SetCapture(const Value: pCvCapture); virtual;
protected
FCapture: pCvCapture;
public
constructor Create(CreateSuspended: Boolean);
destructor Destroy; override;
property OnNoData: TNotifyEvent Read FOnNoData write FOnNoData;
property OnNotifyData: TOnOcvNotify Read FOnNotifyData write FOnNotifyData;
property Capture: pCvCapture read FCapture write SetCapture;
end;
TocvCaptureThread = class(TocvCustomSourceThread)
protected
procedure Execute; override;
end;
TocvCustomSource = class(TocvDataSource)
protected
FCapture: pCvCapture;
FSourceThread: TocvCustomSourceThread;
FThreadDelay: Integer;
procedure OnNotifyData(Sender: TObject; const IplImage: IocvImage);
procedure SetEnabled(Value: Boolean); virtual;
procedure Loaded; override;
private
FEnabled: Boolean;
FOnImage: TOnOcvNotify;
procedure TerminateSourceThread;
procedure ReleaseSource;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Enabled: Boolean Read FEnabled write SetEnabled default False;
property OnImage: TOnOcvNotify read FOnImage write FOnImage;
end;
TocvResolution = (r160x120, r320x240, r424x240, r640x360, r800x448, r960x544, r1280x720);
TocvCameraSource = class(TocvCustomSource)
protected
procedure SetEnabled(Value: Boolean); override;
private
FCaptureSource: TocvCameraCaptureSource;
FResolution: TocvResolution;
procedure SetCameraSource(const Value: TocvCameraCaptureSource);
procedure SetResolution(const Value: TocvResolution);
procedure SetCameraResolution;
public
constructor Create(AOwner: TComponent); override;
published
property Camera: TocvCameraCaptureSource read FCaptureSource write SetCameraSource default CAP_ANY;
property Resolution: TocvResolution read FResolution write SetResolution;
end;
TocvFileSource = class(TocvCustomSource)
protected
procedure SetEnabled(Value: Boolean); override;
procedure OnNoData(Sender: TObject);
private
FFileName: TFileName;
FLoop: Boolean;
FOnEndOfFile: TNotifyEvent;
FDelay: Integer;
procedure SetFileName(const Value: TFileName);
procedure SetDelay(const Value: Integer);
public
constructor Create(AOwner: TComponent); override;
published
property Delay: Integer read FDelay write SetDelay default (1000 div 25);
property FileName: TFileName read FFileName write SetFileName;
property Loop: Boolean read FLoop write FLoop default True;
property OnEndOfFile: TNotifyEvent read FOnEndOfFile Write FOnEndOfFile;
end;
TocvIPCamSource = class(TocvCustomSource)
private
FPort: Word;
FPassword: string;
FIP: string;
FUserName: String;
FPostfix: string;
protected
procedure SetEnabled(Value: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
published
property UserName: String read FUserName write FUserName;
property Password: string read FPassword write FPassword;
property IP: string read FIP write FIP;
property Postfix: string read FPostfix write FPostfix; {TODO: Need rename}
property Port: Word read FPort write FPort default 554;
end;
implementation
uses
core_c;
const
ocvCameraCaptureSource: array [TocvCameraCaptureSource] of Longint =
//
(CV_CAP_ANY, // autodetect
CV_CAP_CAM_0, //
CV_CAP_CAM_1, //
CV_CAP_CAM_2, //
CV_CAP_CAM_3, //
CV_CAP_CAM_4, //
CV_CAP_CAM_5, //
CV_CAP_MIL, // MIL proprietary drivers
CV_CAP_VFW, // platform native
CV_CAP_V4L, //
CV_CAP_V4L2, //
CV_CAP_FIREWARE, // IEEE 1394 drivers
CV_CAP_FIREWIRE, //
CV_CAP_IEEE1394, //
CV_CAP_DC1394, //
CV_CAP_CMU1394, //
CV_CAP_STEREO, // TYZX proprietary drivers
CV_CAP_TYZX, //
CV_TYZX_LEFT, //
CV_TYZX_RIGHT, //
CV_TYZX_COLOR, //
CV_TYZX_Z, //
CV_CAP_QT, // QuickTime
CV_CAP_UNICAP, // Unicap drivers
CV_CAP_DSHOW, // DirectShow (via videoInput)
CV_CAP_PVAPI, // PvAPI; Prosilica GigE SDK
CV_CAP_OPENNI, // OpenNI (for Kinect)
CV_CAP_OPENNI_ASUS, // OpenNI (for Asus Xtion)
CV_CAP_ANDROID, // Android
CV_CAP_XIAPI, // XIMEA Camera API
CV_CAP_AVFOUNDATION);
Type
TCameraResolution = record
cWidth, cHeight: Integer;
end;
Const
CameraResolution: array [TocvResolution] of TCameraResolution = ((cWidth: 160; cHeight: 120), (cWidth: 320; cHeight: 240),
(cWidth: 424; cHeight: 240), (cWidth: 640; cHeight: 360), (cWidth: 800; cHeight: 448), (cWidth: 960; cHeight: 544),
(cWidth: 1280; cHeight: 720));
{TOpenCVCameraThread}
procedure TocvCaptureThread.Execute;
Var
frame: pIplImage;
begin
while not Terminated do
if Assigned(FCapture) then
begin
try
FLock.Enter;
try
frame := cvQueryFrame(FCapture);
finally
FLock.Leave;
end;
if not Terminated then
begin
if Assigned(frame) then
begin
if Assigned(OnNotifyData) then
Synchronize(
procedure
begin
OnNotifyData(Self, TocvImage.CreateClone(frame));
end);
Sleep(FThreadDelay);
end
else if Assigned(OnNoData) then
OnNoData(Self);
end;
except
end;
end
else
Suspend;
end;
{TOpenCVCamera}
constructor TocvCameraSource.Create(AOwner: TComponent);
begin
inherited;
FEnabled := False;
FResolution := r160x120;
end;
procedure TocvCameraSource.SetCameraSource(const Value: TocvCameraCaptureSource);
Var
isEnabled: Boolean;
begin
if FCaptureSource <> Value then
begin
isEnabled := Enabled;
if Assigned(FCapture) and FEnabled then
Enabled := False;
FCaptureSource := Value;
Enabled := isEnabled;
end;
end;
procedure TocvCameraSource.SetEnabled(Value: Boolean);
begin
if FEnabled <> Value then
begin
if not(csDesigning in ComponentState) then
begin
if Assigned(FCapture) and FEnabled then
begin
FSourceThread.Capture := nil;
cvReleaseCapture(FCapture);
FCapture := Nil;
end;
if Value then
begin
FCapture := cvCreateCameraCapture(ocvCameraCaptureSource[FCaptureSource]);
if Assigned(FCapture) then
begin
SetCameraResolution;
FSourceThread.Capture := FCapture;
FSourceThread.Resume;
end;
end;
end;
FEnabled := Value;
end;
end;
procedure TocvCameraSource.SetCameraResolution;
begin
cvSetCaptureProperty(FCapture, CV_CAP_PROP_FRAME_WIDTH, CameraResolution[FResolution].cWidth);
cvSetCaptureProperty(FCapture, CV_CAP_PROP_FRAME_HEIGHT, CameraResolution[FResolution].cHeight);
end;
procedure TocvCameraSource.SetResolution(const Value: TocvResolution);
begin
if FResolution <> Value then
begin
FResolution := Value;
if Enabled then
begin
Enabled := False;
Enabled := True;
end;
end;
end;
{TocvCustomSource}
constructor TocvCustomSource.Create(AOwner: TComponent);
begin
inherited;
if not(csDesigning in ComponentState) then
begin
FSourceThread := TocvCaptureThread.Create(True);
FSourceThread.OnNotifyData := OnNotifyData;
FSourceThread.FThreadDelay := FThreadDelay;
FSourceThread.FreeOnTerminate := True;
end;
FThreadDelay := 10;
FEnabled := False;
end;
destructor TocvCustomSource.Destroy;
begin
TerminateSourceThread;
ReleaseSource;
inherited;
end;
procedure TocvCustomSource.Loaded;
begin
inherited;
if Enabled and (not Assigned(FCapture)) then
begin
// Hack
FEnabled := False;
Enabled := True;
end;
end;
procedure TocvCustomSource.OnNotifyData(Sender: TObject; const IplImage: IocvImage);
begin
if Assigned(OnImage) then
OnImage(Self, IplImage);
NotifyReceiver(IplImage);
end;
procedure TocvCustomSource.SetEnabled(Value: Boolean);
begin
end;
procedure TocvCustomSource.TerminateSourceThread;
begin
if Assigned(FSourceThread) then
begin
FSourceThread.Terminate;
if FSourceThread.Suspended then
FSourceThread.Resume;
FSourceThread := Nil;
end;
end;
procedure TocvCustomSource.ReleaseSource;
begin
if Assigned(FCapture) then
begin
cvReleaseCapture(FCapture);
FCapture := nil;
end;
end;
{TocvFileSourceclass}
constructor TocvFileSource.Create(AOwner: TComponent);
begin
inherited;
FLoop := True;
FDelay := (1000 div 25);
end;
procedure TocvFileSource.OnNoData(Sender: TObject);
begin
if Assigned(FOnEndOfFile) then
FOnEndOfFile(Self);
if Loop then
begin
Enabled := False;
Enabled := True;
end;
end;
procedure TocvFileSource.SetDelay(const Value: Integer);
begin
if FDelay <> Value then
begin
FDelay := Value;
if Assigned(FSourceThread) then
FSourceThread.FThreadDelay := FDelay;
end;
end;
procedure TocvFileSource.SetEnabled(Value: Boolean);
begin
if FEnabled <> Value then
begin
if not(csDesigning in ComponentState) then
begin
if Assigned(FCapture) and FEnabled then
begin
FSourceThread.Capture := nil;
cvReleaseCapture(FCapture);
FCapture := Nil;
end;
if Value then
begin
FCapture := cvCreateFileCapture(PAnsiChar(AnsiString(FileName)));
if Assigned(FCapture) then
begin
FSourceThread.Capture := FCapture;
FSourceThread.Resume;
end;
end;
end;
FEnabled := Value;
end;
end;
procedure TocvFileSource.SetFileName(const Value: TFileName);
Var
_Enabled: Boolean;
begin
if FFileName <> Value then
begin
_Enabled := Enabled;
Enabled := False;
FFileName := Value;
Enabled := _Enabled;
end;
end;
{TocvCustomSourceThread}
constructor TocvCustomSourceThread.Create(CreateSuspended: Boolean);
begin
inherited;
FThreadDelay := 10;
FLock := TCriticalSection.Create;
end;
destructor TocvCustomSourceThread.Destroy;
begin
FLock.Free;
inherited;
end;
procedure TocvCustomSourceThread.SetCapture(const Value: pCvCapture);
begin
FLock.Enter;
try
FCapture := Value;
finally
FLock.Leave;
end;
end;
{TocvIPCamSource}
constructor TocvIPCamSource.Create(AOwner: TComponent);
begin
inherited;
FPort := 554;
end;
procedure TocvIPCamSource.SetEnabled(Value: Boolean);
Var
IPCam: AnsiString;
begin
if FEnabled <> Value then
begin
if not(csDesigning in ComponentState) then
begin
if Assigned(FCapture) and FEnabled then
begin
FSourceThread.Capture := nil;
cvReleaseCapture(FCapture);
FCapture := Nil;
end;
if Value then
begin
IPCam := 'rtsp://';
if Length(Trim(UserName)) <> 0 then
IPCam := IPCam + Trim(UserName) + ':' + Trim(Password) + '@';
IPCam := IPCam + IP + ':' + Port.ToString;
if Length(Trim(Postfix)) > 0 then
begin
if (IPCam[Length(IPCam)] <> '/') and (Postfix[1] <> '/') then
IPCam := IPCam + '/';
IPCam := IPCam + Postfix;
end;
FCapture := cvCreateFileCapture(PAnsiChar(IPCam));
if Assigned(FCapture) then
begin
FSourceThread.Capture := FCapture;
FSourceThread.Resume;
end;
end;
end;
FEnabled := Value;
end;
end;
end.

View File

@ -50,7 +50,7 @@ Type
function GetisGray: Boolean;
public
constructor Create(const AImage: pIplImage);
constructor CreateCopy(const AImage: pIplImage);
constructor CreateClone(const AImage: pIplImage);
destructor Destroy; override;
function GrayImage: IocvImage;
function Clone: IocvImage;
@ -241,7 +241,7 @@ end;
function TocvImage.Clone: IocvImage;
begin
Result := TocvImage.CreateCopy(FImage);
Result := TocvImage.CreateClone(FImage);
end;
constructor TocvImage.Create(const AImage: pIplImage);
@ -249,7 +249,7 @@ begin
FImage := AImage;
end;
constructor TocvImage.CreateCopy(const AImage: pIplImage);
constructor TocvImage.CreateClone(const AImage: pIplImage);
begin
FImage := cvCloneImage(AImage);
end;

View File

@ -5,7 +5,7 @@
<FrameworkType>VCL</FrameworkType>
<MainSource>cCameraCapture.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Release</Config>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType>

View File

@ -4,8 +4,8 @@ object MainForm: TMainForm
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'OpenCV - Component demo'
ClientHeight = 499
ClientWidth = 466
ClientHeight = 550
ClientWidth = 616
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
@ -18,15 +18,15 @@ object MainForm: TMainForm
PixelsPerInch = 96
TextHeight = 13
object lbl1: TLabel
Left = 308
Left = 8
Top = 8
Width = 79
Height = 13
Caption = 'Image operation'
end
object cbb1: TComboBox
Left = 308
Top = 24
Left = 93
Top = 5
Width = 145
Height = 21
Style = csDropDownList
@ -44,8 +44,8 @@ object MainForm: TMainForm
'Threshold')
end
object chk1: TCheckBox
Left = 308
Top = 60
Left = 8
Top = 29
Width = 97
Height = 17
Caption = 'Camera enabled'
@ -56,34 +56,88 @@ object MainForm: TMainForm
end
object ocvw1: TocvView
Left = 8
Top = 8
Top = 52
Width = 285
Height = 229
VideoSource = ocvcmr1
VideoSource = ocvcmrsrc1
end
object ocvw2: TocvView
Left = 8
Top = 255
Top = 307
Width = 285
Height = 229
VideoSource = ocvmgprtn1
end
object ocvcmr1: TocvCamera
Resolution = r320x240
Left = 328
Top = 104
object ocvw3: TocvView
Left = 316
Top = 307
Width = 285
Height = 229
VideoSource = ocvflsrc1
end
object ocvw4: TocvView
Left = 316
Top = 52
Width = 285
Height = 229
VideoSource = ocvpcmsrc1
end
object ocvmgprtn1: TocvImageOperation
VideoSource = ocvcmr1
OperationClassName = 'TocvRotateOperation'
Operation.Angle = 45
Operation.RotateAroundCenter = False
Operation.CustomCenter.X = 50
Operation.CustomCenter.Y = 50
Operation.Method = INTER_LANCZOS4
Operation.Scale = 0.500000000000000000
Operations = <>
Left = 328
Top = 164
VideoSource = ocvcmrsrc1
OperationClassName = 'TocvContoursOperation'
Operation.OperationClassName = 'TocvAdaptiveThresholdOperation'
Operation.Preprocessing.MaxValue = 250.000000000000000000
Operation.Preprocessing.BlockSize = 3
Operation.Preprocessing.Param = 5.000000000000000000
Operation.Offset.X = 0
Operation.Offset.Y = 0
Operation.MinArea = 100
Operation.ContourDraw.Thickness = 1
Operation.ContourDraw.Offset.X = 0
Operation.ContourDraw.Offset.Y = 0
Operation.ApproxPoly.Eps = 3.000000000000000000
Operations = <
item
OperationClassName = 'TocvContoursOperation'
Operation.OperationClassName = 'TocvThresholdOperation'
Operation.Preprocessing.MaxValue = 255.000000000000000000
Operation.Preprocessing.ThresholdType = THRESH_BINARY_INV
Operation.Preprocessing.Threshold = 128.000000000000000000
Operation.Offset.X = 0
Operation.Offset.Y = 0
Operation.MinArea = 100
Operation.ContourDraw.Thickness = 1
Operation.ContourDraw.Offset.X = 0
Operation.ContourDraw.Offset.Y = 0
Operation.ApproxPoly.Eps = 3.000000000000000000
end
item
OperationClassName = 'TocvNoneOperation'
end>
OperationsEnabled = False
Left = 24
Top = 316
end
object ocvflsrc1: TocvFileSource
Enabled = True
Delay = 120
FileName = '.\Resource\768x576.avi'
Left = 336
Top = 328
end
object ocvcmrsrc1: TocvCameraSource
Enabled = True
Resolution = r160x120
Left = 32
Top = 64
end
object ocvpcmsrc1: TocvIPCamSource
Enabled = True
UserName = 'admin'
Password = 'admin'
IP = '10.1.1.202'
Postfix = 'cam/realmonitor?channel=1&subtype=0'
Left = 336
Top = 68
end
end

View File

@ -28,7 +28,7 @@ interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, uOCVTypes, uOCVImageOperation,
core.types_c, uOCVCamera, uOCVView, Vcl.StdCtrls, Vcl.ExtCtrls;
core.types_c, uOCVSource, uOCVView, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TMainForm = class(TForm)
@ -36,9 +36,13 @@ type
cbb1: TComboBox;
chk1: TCheckBox;
ocvw1: TocvView;
ocvcmr1: TocvCamera;
ocvmgprtn1: TocvImageOperation;
ocvw2: TocvView;
ocvflsrc1: TocvFileSource;
ocvw3: TocvView;
ocvcmrsrc1: TocvCameraSource;
ocvw4: TocvView;
ocvpcmsrc1: TocvIPCamSource;
procedure FormCreate(Sender: TObject);
procedure cbb1Change(Sender: TObject);
procedure chk1Click(Sender: TObject);
@ -60,14 +64,15 @@ end;
procedure TMainForm.chk1Click(Sender: TObject);
begin
ocvcmr1.Enabled := chk1.Checked;
ocvcmrsrc1.Enabled := chk1.Checked;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
cbb1.Items.Assign(GetRegisteredImageOperations);
cbb1.ItemIndex := cbb1.Items.IndexOf(GetRegisteredImageOperations.GetNameByClass(ocvmgprtn1.OperationClass));
ocvcmr1.Enabled := True;
// ocvcmrsrc1.Enabled := True;
// ocvpcmsrc1.Enabled := True;
end;
end.