Fixed some bugs

* Fixed a number of exported function "initModule_nonfree" in module "nonfree.pas"
* Added comments in English in the project "cv_ExtractSURF.dpr"

Signed-off-by: Laex <laex@bk.ru>
This commit is contained in:
Laex 2014-02-24 23:18:30 +04:00
parent bbd74e1339
commit e0e112613c
17 changed files with 531 additions and 166 deletions

View File

@ -1,6 +1,26 @@
// JCL_DEBUG_EXPERT_GENERATEJDBG OFF
// JCL_DEBUG_EXPERT_INSERTJDBG OFF
// JCL_DEBUG_EXPERT_DELETEMAPFILE OFF
// *****************************************************************
// 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.
// *******************************************************************
package OpenCV;
{$R *.res}
@ -33,7 +53,7 @@ package OpenCV;
requires
rtl,
vcl,
designide;
DesignIDE;
contains
uOCVTypes in 'uOCVTypes.pas',
@ -41,6 +61,7 @@ contains
uOCVView in 'uOCVView.pas',
uOCVImageOperation in 'uOCVImageOperation.pas',
uOCVRegister in 'uOCVRegister.pas',
uOCVSplitter in 'uOCVSplitter.pas';
uOCVSplitter in 'uOCVSplitter.pas',
uOCVIOProperties in 'uOCVIOProperties.pas';
end.

View File

@ -2,7 +2,7 @@
<PropertyGroup>
<ProjectGuid>{67FAAD9E-2FAD-44C3-8F98-56827C3D1CE8}</ProjectGuid>
<MainSource>OpenCV.dpk</MainSource>
<ProjectVersion>15.2</ProjectVersion>
<ProjectVersion>15.3</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
@ -97,13 +97,14 @@
</DelphiCompile>
<DCCReference Include="rtl.dcp"/>
<DCCReference Include="vcl.dcp"/>
<DCCReference Include="designide.dcp"/>
<DCCReference Include="DesignIDE.dcp"/>
<DCCReference Include="uOCVTypes.pas"/>
<DCCReference Include="uOCVCamera.pas"/>
<DCCReference Include="uOCVView.pas"/>
<DCCReference Include="uOCVImageOperation.pas"/>
<DCCReference Include="uOCVRegister.pas"/>
<DCCReference Include="uOCVSplitter.pas"/>
<DCCReference Include="uOCVIOProperties.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>

View File

@ -193,7 +193,6 @@ begin
if not(csDesigning in ComponentState) then
begin
FOpenCVCameraThread := TocvCameraThread.Create(True);
// FOpenCVCameraThread.Priority := tpHigher;
FOpenCVCameraThread.OnNotifyData := OnNotifyData;
FEnabled := False;
FResolution := r160x120;

View File

@ -0,0 +1,194 @@
// *****************************************************************
// 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 uOCVIOProperties;
interface
Uses
System.Classes,
DesignEditors,
DesignIntf;
Type
TImageOperationProperty = class(TClassProperty)
public
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
procedure GetValues(Proc: TGetStrProc); override;
procedure SetValue(const Value: string); override;
end;
TVideoSourceProperty = class(TInterfaceProperty)
private
FGetValuesStrProc: TGetStrProc;
protected
procedure ReceiveComponentNames(const S: string);
public
function GetAttributes: TPropertyAttributes; override;
procedure GetValues(Proc: TGetStrProc); override;
procedure SetValue(const Value: string); override;
function GetValue: string; override;
end;
implementation
Uses
VCL.Dialogs,
System.SysUtils,
System.TypInfo,
System.RTLConsts,
uOCVImageOperation,
uOCVSplitter,
uOCVTypes;
{ TImageOperationProperty }
function TImageOperationProperty.GetAttributes: TPropertyAttributes;
begin
Result := inherited GetAttributes;
Result := Result - [paReadOnly] + [paValueList, paSortList, paRevertable, paVolatileSubProperties];
end;
function TImageOperationProperty.GetValue: string;
begin
Result := GetRegisteredImageOperations.GetNameByClass(TocvImageOperation(GetOrdValue).ClassType);
end;
procedure TImageOperationProperty.GetValues(Proc: TGetStrProc);
var
i: Integer;
rIO: TRegisteredImageOperations;
begin
rIO := GetRegisteredImageOperations;
for i := 0 to rIO.Count - 1 do
Proc(rIO[i]);
end;
procedure TImageOperationProperty.SetValue(const Value: string);
Var
APropertiesClass: TocvImageOperationClass;
i: Integer;
AIntf: IocvEditorPropertiesContainer;
begin
APropertiesClass := GetRegisteredImageOperations.FindByClassName(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;
{ TVideoSourceProperty }
function TVideoSourceProperty.GetAttributes: TPropertyAttributes;
begin
Result := inherited GetAttributes;
Result := Result - [paReadOnly] + [paValueList, paSortList, paRevertable];
end;
function TVideoSourceProperty.GetValue: string;
Var
AInterface: IInterface;
ICR: IocvDataSource;
begin
AInterface := GetIntfValue;
if (AInterface <> nil) and Supports(AInterface, IocvDataSource, ICR) then
Result := ICR.GetName
else
Result := '';
end;
procedure TVideoSourceProperty.GetValues(Proc: TGetStrProc);
begin
FGetValuesStrProc := Proc;
try
Designer.GetComponentNames(GetTypeData(TypeInfo(TComponent)), ReceiveComponentNames);
finally
FGetValuesStrProc := nil;
end;
end;
procedure TVideoSourceProperty.ReceiveComponentNames(const S: string);
var
Temp: TComponent;
Intf: IInterface;
i: Integer;
begin
Temp := Designer.GetComponent(S);
if Assigned(FGetValuesStrProc) and Assigned(Temp) then
begin
if Supports(TObject(Temp), GetTypeData(GetPropType)^.Guid, Intf) then
FGetValuesStrProc(S);
if not HasInstance(Temp) then
if Temp is TocvSplitter then
for i := 0 to (Temp as TocvSplitter).Channels.Count - 1 do
FGetValuesStrProc(S + '[' + i.ToString + ']');
end;
end;
procedure TVideoSourceProperty.SetValue(const Value: string);
var
Intf: IInterface;
Component: TComponent;
CompName: string;
n1, n2, ChanIndex: Integer;
SpComp: TocvSplitter;
begin
if Value = '' then
Intf := nil
else
begin
if Pos('[', Value) <> 0 then
begin
CompName := Copy(Value, 1, Pos('[', Value) - 1);
n1 := Pos('[', Value);
n2 := Pos(']', Value);
ChanIndex := Copy(Value, n1 + 1, n2 - n1 - 1).ToInteger;
SpComp := Designer.GetComponent(CompName) as TocvSplitter;
if Assigned(SpComp) and (ChanIndex < SpComp.Channels.Count) then
Intf := SpComp.Channels[ChanIndex]
else
raise EDesignPropertyError.CreateRes(@SInvalidPropertyValue);
end
else
begin
Component := Designer.GetComponent(Value);
if (Component = nil) or (not Supports(TObject(Component), GetTypeData(GetPropType)^.Guid, Intf)) then
raise EDesignPropertyError.CreateRes(@SInvalidPropertyValue);
end;
end;
SetIntfValue(Intf);
end;
initialization
RegisterPropertyEditor(TypeInfo(TocvCustomImageOperation), TocvImageOperation, 'Properties', TImageOperationProperty);
RegisterPropertyEditor(TypeInfo(string), TocvImageOperation, 'PropertiesClassName', nil);
RegisterPropertyEditor(TypeInfo(IocvDataSource), nil, 'VideoSource', TVideoSourceProperty);
end.

View File

@ -37,11 +37,12 @@ type
TocvCustomImageOperation = class(TPersistent)
private
CS: TCriticalSection;
FOwner: TComponent;
protected
procedure LockTransform;
procedure UnlockTransform;
public
constructor Create; virtual;
constructor Create(AOwner: TComponent); virtual;
destructor Destroy; override;
function Transform(const Source: pIplImage; var Destanation: pIplImage): Boolean; virtual; abstract;
end;
@ -70,7 +71,7 @@ type
procedure SetThreshold2(const Value: double);
protected
public
constructor Create; override;
constructor Create(AOwner: TComponent); override;
function Transform(const Source: pIplImage; var Destanation: pIplImage): Boolean; override;
published
property Threshold1: double Read FThreshold1 write SetThreshold1;
@ -95,7 +96,7 @@ type
procedure SetSize2(const Value: Integer);
procedure SetSmoothOperation(const Value: TocvSmoothOperations);
public
constructor Create; override;
constructor Create(AOwner: TComponent); override;
function Transform(const Source: pIplImage; var Destanation: pIplImage): Boolean; override;
published
property sigma1: double read FSigma1 write SetSigma1;
@ -105,118 +106,137 @@ type
property SmoothOperation: TocvSmoothOperations read FSmoothOperation write SetSmoothOperation default GAUSSIAN;
end;
TcvImageOperations = (ioNone, ioGrayScale, ioCanny, ioSmooth);
IocvEditorPropertiesContainer = interface
['{418F88DD-E35D-4425-BF24-E753E83D35D6}']
function GetProperties: TocvCustomImageOperation;
function GetPropertiesClass: TocvImageOperationClass;
procedure SetPropertiesClass(Value: TocvImageOperationClass);
end;
Const
cvImageOperation: array [TcvImageOperations] of TocvImageOperationClass = (TocvImageOperation_None, TocvImageOperation_GrayScale,
TovcImageOperation_Canny, TovcImageOperation_Smooth);
function GetImageOperationByImageOperationClass(const ImageOperationClass: TClass): TcvImageOperations;
Type
TocvImageOperation = class(TocvDataSourceAndReceiver)
TocvImageOperation = class(TocvDataSourceAndReceiver, IocvEditorPropertiesContainer)
private
CS: TCriticalSection;
FOperation: TcvImageOperations;
FOperationParams: TocvCustomImageOperation;
FProperties: TocvCustomImageOperation;
FPropertiesClass: TocvImageOperationClass;
procedure LockTransform;
procedure UnlockTransform;
procedure SetOperationParams(const Value: TocvCustomImageOperation);
procedure SetOperations(const Value: TcvImageOperations);
procedure CreateProperties;
procedure DestroyProperties;
procedure RecreateProperties;
function GetPropertiesClassName: string;
procedure SetProperties(const Value: TocvCustomImageOperation);
procedure SetPropertiesClass(Value: TocvImageOperationClass);
procedure SetPropertiesClassName(const Value: string);
protected
procedure TakeImage(const IplImage: pIplImage); override;
function GetProperties: TocvCustomImageOperation;
function GetPropertiesClass: TocvImageOperationClass;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property PropertiesClass: TocvImageOperationClass read GetPropertiesClass write SetPropertiesClass;
published
property Operation: TcvImageOperations Read FOperation write SetOperations;
property OperationParams: TocvCustomImageOperation Read FOperationParams write SetOperationParams;
property PropertiesClassName: string read GetPropertiesClassName write SetPropertiesClassName;
property Properties: TocvCustomImageOperation read GetProperties write SetProperties;
end;
TRegisteredImageOperations = class(TStringList)
public
function FindByClassName(const ClassName: String): TocvImageOperationClass;
function GetNameByClass(const IOClass: TClass): String;
procedure RegisterIOClass(const IOClass: TClass; const ClassName: String);
end;
function GetRegisteredImageOperations: TRegisteredImageOperations;
implementation
Uses
VCL.Forms,
core_c,
imgproc_c,
imgproc.types_c;
function GetImageOperationByImageOperationClass(const ImageOperationClass: TClass): TcvImageOperations;
Var
i: TcvImageOperations;
_RegisteredImageOperations: TRegisteredImageOperations = nil;
function GetRegisteredImageOperations: TRegisteredImageOperations;
begin
Result := ioNone;
for i := Low(cvImageOperation) to High(cvImageOperation) do
if cvImageOperation[i] = ImageOperationClass then
Exit(i);
if not Assigned(_RegisteredImageOperations) then
_RegisteredImageOperations := TRegisteredImageOperations.Create;
Result := _RegisteredImageOperations;
end;
{ TocvImageOperation }
procedure TocvImageOperation.SetOperationParams(const Value: TocvCustomImageOperation);
Var
io: TcvImageOperations;
procedure TocvImageOperation.SetProperties(const Value: TocvCustomImageOperation);
begin
if Value <> FOperationParams then
if (FProperties <> nil) and (Value <> nil) then
FProperties.Assign(Value);
end;
procedure TocvImageOperation.SetPropertiesClass(Value: TocvImageOperationClass);
begin
if FPropertiesClass <> Value then
begin
LockTransform;
try
Operation := GetImageOperationByImageOperationClass(Value.ClassType);
// if csDesigning in ComponentState then
// if (Owner is TForm) and (TForm(Owner).Designer <> nil) then
// TForm(Owner).Designer.Notification(Self, opRemove);
FOperationParams.Assign(Value);
// if csDesigning in ComponentState then
// if (Owner is TForm) and (TForm(Owner).Designer <> nil) then
// TForm(Owner).Designer.Notification(Self, opInsert);
finally
UnlockTransform;
end;
FPropertiesClass := Value;
RecreateProperties;
end;
end;
procedure TocvImageOperation.SetOperations(const Value: TcvImageOperations);
procedure TocvImageOperation.CreateProperties;
begin
if FOperation <> Value then
begin
FOperation := Value;
if Assigned(FOperationParams) then
begin
if csDesigning in ComponentState then
if (Owner is TForm) and (TForm(Owner).Designer <> nil) then
TForm(Owner).Designer.Notification(Self, opRemove);
FreeAndNil(FOperationParams);
end;
if FPropertiesClass <> nil then
FProperties := FPropertiesClass.Create(Self);
end;
FOperationParams := cvImageOperation[FOperation].Create;
procedure TocvImageOperation.DestroyProperties;
begin
FreeAndNil(FProperties);
end;
if csDesigning in ComponentState then
if (Owner is TForm) and (TForm(Owner).Designer <> nil) then
TForm(Owner).Designer.Notification(Self, opInsert);
end;
procedure TocvImageOperation.RecreateProperties;
begin
DestroyProperties;
CreateProperties;
end;
procedure TocvImageOperation.SetPropertiesClassName(const Value: string);
begin
PropertiesClass := TocvImageOperationClass(GetRegisteredImageOperations.FindByClassName(Value));
end;
constructor TocvImageOperation.Create(AOwner: TComponent);
begin
inherited;
CS := TCriticalSection.Create;
FOperationParams := TocvImageOperation_None.Create;
FOperation := ioNone;
end;
destructor TocvImageOperation.Destroy;
begin
LockTransform;
if Assigned(FOperationParams) then
FreeAndNil(FOperationParams);
if Assigned(FProperties) then
FreeAndNil(FProperties);
CS.Free;
inherited;
end;
function TocvImageOperation.GetProperties: TocvCustomImageOperation;
begin
if not Assigned(FProperties) then
FProperties := TocvImageOperation_None.Create(Self);
Result := FProperties;
end;
function TocvImageOperation.GetPropertiesClass: TocvImageOperationClass;
begin
Result := TocvImageOperationClass(Properties.ClassType);
end;
function TocvImageOperation.GetPropertiesClassName: string;
begin
Result := Properties.ClassName;
end;
procedure TocvImageOperation.LockTransform;
begin
CS.Enter;
@ -226,7 +246,7 @@ procedure TocvImageOperation.TakeImage(const IplImage: pIplImage);
var
Destanation: pIplImage;
begin
if Assigned(FOperationParams) and FOperationParams.Transform(IplImage, Destanation) then
if Assigned(FProperties) and FProperties.Transform(IplImage, Destanation) then
begin
LockTransform;
try
@ -334,15 +354,11 @@ end;
{ TCustomOpenCVImgOperation }
constructor TocvCustomImageOperation.Create { (AOwner: TPersistent) };
constructor TocvCustomImageOperation.Create(AOwner: TComponent);
begin
inherited Create;
// FOwner := AOwner;
FOwner := AOwner;
CS := TCriticalSection.Create;
// SetLength(
// FValues,
// 10);
// FOwner := AOwner;
end;
destructor TocvCustomImageOperation.Destroy;
@ -351,16 +367,6 @@ begin
inherited;
end;
// function TocvCustomImageOperation.GetOwner: TPersistent;
// begin
// Result := FOwner;
// end;
// function TocvCustomImageOperation.GetOwner: TPersistent;
// begin
// Result := FOwner;
// end;
procedure TocvCustomImageOperation.LockTransform;
begin
CS.Enter;
@ -464,8 +470,48 @@ begin
end;
end;
{ TRegisteredImageOperations }
function TRegisteredImageOperations.FindByClassName(const ClassName: String): TocvImageOperationClass;
Var
i: Integer;
begin
i := IndexOf(ClassName);
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;
initialization
RegisterClasses([TocvImageOperation_None, TocvImageOperation_GrayScale, TovcImageOperation_Canny, TovcImageOperation_Smooth]);
GetRegisteredImageOperations.RegisterIOClass(TocvImageOperation_None, 'None');
GetRegisteredImageOperations.RegisterIOClass(TocvImageOperation_GrayScale, 'GrayScale');
GetRegisteredImageOperations.RegisterIOClass(TovcImageOperation_Canny, 'Canny');
GetRegisteredImageOperations.RegisterIOClass(TovcImageOperation_Smooth, 'Smooth');
finalization
if Assigned(_RegisteredImageOperations) then
FreeAndNil(_RegisteredImageOperations);
end.

View File

@ -1,3 +1,25 @@
// *****************************************************************
// 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 uOCVRegister;
interface

View File

@ -43,22 +43,26 @@ Type
function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
function GetName: string;
published
property Name: String read FName write FName;
constructor Create(Collection: TCollection); override;
property Name: String read GetName write FName;
end;
TocvChannelCollection = class(TCollection)
private
FOwner: TComponent;
function GetOCVItem(Index: Integer): IocvDataSource;
public
constructor Create(const AOwner: TComponent; const ItemClass: TCollectionItemClass);
property OCVChannel[Index: Integer]: IocvDataSource read GetOCVItem; default;
end;
TocvSplitter = class(TocvDataReceiver)
private
FChannels: TocvChannelCollection;
FocvVideoSource: TocvDataSource;
procedure SetOpenCVVideoSource(const Value: TocvDataSource);
FocvVideoSource: IocvDataSource;
procedure SetOpenCVVideoSource(const Value: IocvDataSource);
procedure SetChannels(const Value: TocvChannelCollection);
protected
procedure TakeImage(const IplImage: pIplImage); override;
@ -66,18 +70,20 @@ Type
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property VideoSource: TocvDataSource Read FocvVideoSource write SetOpenCVVideoSource;
property VideoSource: IocvDataSource Read FocvVideoSource write SetOpenCVVideoSource;
property Channels: TocvChannelCollection read FChannels write SetChannels;
end;
implementation
Uses System.SysUtils;
{ TocvSplitter }
constructor TocvSplitter.Create(AOwner: TComponent);
begin
inherited;
FChannels := TocvChannelCollection.Create(TocvChannel);
FChannels := TocvChannelCollection.Create(Self, TocvChannel);
end;
destructor TocvSplitter.Destroy;
@ -91,7 +97,7 @@ begin
FChannels.Assign(Value);
end;
procedure TocvSplitter.SetOpenCVVideoSource(const Value: TocvDataSource);
procedure TocvSplitter.SetOpenCVVideoSource(const Value: IocvDataSource);
begin
if FocvVideoSource <> Value then
begin
@ -113,6 +119,19 @@ end;
{ TocvChannel }
constructor TocvChannel.Create(Collection: TCollection);
begin
inherited;
Name;
end;
function TocvChannel.GetName: string;
begin
if Length(Trim(FName)) = 0 then
FName := (Collection as TocvChannelCollection).FOwner.Name + '[' + ID.ToString + ']';
Result := FName;
end;
procedure TocvChannel.NotifyReceiver(const IplImage: pIplImage);
begin
if Assigned(FOpenCVVideoReceiver) then
@ -155,6 +174,12 @@ end;
{ TocvChannelCollection }
constructor TocvChannelCollection.Create(const AOwner: TComponent; const ItemClass: TCollectionItemClass);
begin
inherited Create(ItemClass);
FOwner := AOwner;
end;
function TocvChannelCollection.GetOCVItem(Index: Integer): IocvDataSource;
begin
Result := TocvChannel(inherited GetItem(Index));

View File

@ -1,25 +1,25 @@
(* /*****************************************************************
// 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.
******************************************************************* *)
// *****************************************************************
// 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 uOCVTypes;
@ -42,6 +42,7 @@ Type
IocvDataSource = interface
['{80640C0A-6828-42F8-83E7-DA5FD9036DFF}']
procedure SetReceiver(const OpenCVVideoReceiver: IocvDataReceiver);
function GetName: string;
end;
TocvReceiverList = TList<IocvDataReceiver>;
@ -52,6 +53,7 @@ Type
protected
FOpenCVVideoReceiver: IocvDataReceiver;
procedure NotifyReceiver(const IplImage: pIplImage); virtual;
function GetName: string; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -110,6 +112,11 @@ begin
inherited;
end;
function TocvDataSource.GetName: string;
begin
Result := Name;
end;
procedure TocvDataSource.NotifyReceiver(const IplImage: pIplImage);
begin
if Assigned(FOpenCVVideoReceiver) then
@ -170,7 +177,7 @@ end;
procedure TocvDataReceiver.SetVideoSource(const Value: TObject);
begin
VideoSource := Value as TocvDataSource;
VideoSource := Value as TocvDataSource;
end;
procedure TocvDataReceiver.TakeImage(const IplImage: pIplImage);

View File

@ -1,6 +1,6 @@
program ffmpeg_sample_player;
{.$APPTYPE CONSOLE}
{ .$APPTYPE CONSOLE }
{$R *.res}
{$include ffmpeg.inc}
@ -65,7 +65,6 @@ begin
av_register_all();
avformat_network_init();
// Init SDL with video support
err := SDL_Init(SDL_INIT_VIDEO);
if (err < 0) then
@ -113,7 +112,7 @@ begin
Halt(1);
end;
screen := SDL_SetVideoMode(codec_context^.width, codec_context^.height, 0, 0);
screen := SDL_SetVideoMode(codec_context^.width, codec_context^.height, 0, 0 { SDL_FULLSCREEN } );
if (screen = nil) then
begin
WriteLn('Couldn''t set video mode');
@ -122,8 +121,8 @@ begin
bmp := SDL_CreateYUVOverlay(codec_context^.width, codec_context^.height, SDL_YV12_OVERLAY, screen);
img_convert_context := sws_getCachedContext(nil, codec_context^.width, codec_context^.height, codec_context^.pix_fmt,
codec_context^.width, codec_context^.height, AV_PIX_FMT_YUV420P, SWS_BICUBIC, nil, nil, nil);
img_convert_context := sws_getCachedContext(nil, codec_context^.width, codec_context^.height, codec_context^.pix_fmt, codec_context^.width, codec_context^.height, AV_PIX_FMT_YUV420P, SWS_BICUBIC,
nil, nil, nil);
if (img_convert_context = nil) then
begin
WriteLn('Cannot initialize the conversion context');

View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{4A70D321-10C0-4AAE-9C24-FAA11F93CC66}</ProjectGuid>
<ProjectVersion>15.2</ProjectVersion>
<ProjectVersion>15.3</ProjectVersion>
<FrameworkType>None</FrameworkType>
<MainSource>ffmpeg_sample_player.dpr</MainSource>
<Base>True</Base>
@ -136,6 +136,7 @@
<DCC_RemoteDebug>true</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<Debugger_RunParams>rtsp://10.1.1.201/Streaming/Channels/1?transportmode=unicast</Debugger_RunParams>
<VerInfo_Locale>1033</VerInfo_Locale>
<Manifest_File>None</Manifest_File>
<DCC_RemoteDebug>false</DCC_RemoteDebug>

View File

@ -105,6 +105,6 @@ implementation
Uses uLibName;
function initModule_nonfree; external Nonfree_DLL index 979;
function initModule_nonfree; external Nonfree_DLL index 1025;
end.

View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{32F0B620-F9A6-4081-8E87-C89FF09CAD04}</ProjectGuid>
<ProjectVersion>15.1</ProjectVersion>
<ProjectVersion>15.3</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>cCameraCapture.dpr</MainSource>
<Base>True</Base>

View File

@ -51,7 +51,7 @@ object MainForm: TMainForm
end
object ocvw1: TocvView
Left = 8
Top = 8
Top = 4
Width = 294
Height = 269
end
@ -60,14 +60,16 @@ object MainForm: TMainForm
Top = 296
Width = 294
Height = 269
VideoSource = ocvmgprtn1
end
object ocvcmr1: TocvCamera
Resolution = r800x448
Enabled = True
Resolution = r1280x720
Left = 368
Top = 132
end
object ocvmgprtn1: TocvImageOperation
Operation = ioNone
PropertiesClassName = 'TocvImageOperation_None'
Left = 368
Top = 228
end
@ -75,8 +77,10 @@ object MainForm: TMainForm
VideoSource = ocvcmr1
Channels = <
item
Name = 'ocvspltr1[0]'
end
item
Name = 'ocvspltr1[1]'
end>
Left = 368
Top = 180

View File

@ -1,3 +1,26 @@
// *****************************************************************
// 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 uMainForm;
interface
@ -31,9 +54,14 @@ implementation
{$R *.dfm}
Const
IOClass: array [0 .. 3] of TocvImageOperationClass = (
{ } TocvImageOperation_None, TocvImageOperation_GrayScale,
{ } TovcImageOperation_Canny, TovcImageOperation_Smooth);
procedure TMainForm.cbb1Change(Sender: TObject);
begin
ocvmgprtn1.Operation := TcvImageOperations(cbb1.ItemIndex);
ocvmgprtn1.PropertiesClass := IOClass[cbb1.ItemIndex];
end;
procedure TMainForm.chk1Click(Sender: TObject);
@ -44,12 +72,11 @@ end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
ocvw1.VideoSource := ocvspltr1.Channels[0];
ocvmgprtn1.VideoSource := ocvspltr1.Channels[1];
ocvw2.VideoSource := ocvmgprtn1;
cbb1.ItemIndex := Integer(ocvmgprtn1.Operation);
cbb1.ItemIndex := 0;
chk1.Checked := ocvcmr1.Enabled;
ocvmgprtn1.PropertiesClass := IOClass[cbb1.ItemIndex];
end;
end.

View File

@ -24,9 +24,6 @@
// http://blog.vidikon.com/?p=213
// *************************************************************** *)
// JCL_DEBUG_EXPERT_GENERATEJDBG OFF
// JCL_DEBUG_EXPERT_INSERTJDBG OFF
// JCL_DEBUG_EXPERT_DELETEMAPFILE OFF
program cv_ExtractSURF;
{$APPTYPE CONSOLE}
@ -46,6 +43,7 @@ uses
nonfree;
// cðàâíåíèå äâóõ îcîáåííîcòåé
// comparison of the two features
function compareSURFDescriptors(const d1: PSingle; const d2: PSingle; best: Double; length: Integer): Double;
var
total_cost: Double;
@ -70,8 +68,8 @@ begin
end;
// cðàâíèâàåò îäíó îcîáåííîcòü îáúåêòà âcåìè îcîáåííîcòÿìè cöåíû
function naiveNearestNeighbor(const vec: PSingle; laplacian: Integer; const model_keypoints: pCvSeq;
const model_descriptors: pCvSeq): Integer;
// compares one feature of the scene with all the features
function naiveNearestNeighbor(const vec: PSingle; laplacian: Integer; const model_keypoints: pCvSeq; const model_descriptors: pCvSeq): Integer;
Var
length, i, neighbor: Integer;
d, dist1, dist2: Double;
@ -84,9 +82,11 @@ begin
dist1 := 1E6;
dist2 := 1E6;;
// Íà÷àëüíàÿ îcîáåííîcòü cöåíû
// The initial feature scenes
cvStartReadSeq(model_keypoints, @kreader, 0);
cvStartReadSeq(model_descriptors, @reader, 0);
// Ïåðåáîð âcåõ îcîáåííîcòåé cöåíû
// Iterating through all features of the scene
for i := 0 to model_descriptors.total - 1 do
begin
kp := pCvSURFPoint(kreader.ptr);
@ -94,13 +94,16 @@ begin
CV_NEXT_SEQ_ELEM(kreader.seq.elem_size, kreader);
CV_NEXT_SEQ_ELEM(reader.seq.elem_size, reader);
// Äëÿ ócêîðåíèÿ cíà÷àëà cðàâíèâàåòcÿ ëàïëccèàí îcîáåííîcòåé
// To accelerate the first compared Laplacian features
if (laplacian <> kp.laplacian) then
continue;
// cðàâíåíèå îcîáåííîcòåé
// comparison of the features
d := compareSURFDescriptors(vec, mvec, dist2, length);
if (d < dist1) then
begin
// Íàéäåíà ëó÷øåå cîâïàäåíèå îcîáåííîcòåé
// Found a better match features
dist2 := dist1;
dist1 := d;
neighbor := i;
@ -115,8 +118,8 @@ begin
end;
// Ôóíêöèÿ èùåò cîâïàäàþùèå ïàðû
procedure findPairs(const objectKeypoints: pCvSeq; const objectDescriptors: pCvSeq; const imageKeypoints: pCvSeq;
const imageDescriptors: pCvSeq; Var ptpairs: TArray<Integer>);
// Function searches for matching pairs
procedure findPairs(const objectKeypoints: pCvSeq; const objectDescriptors: pCvSeq; const imageKeypoints: pCvSeq; const imageDescriptors: pCvSeq; Var ptpairs: TArray<Integer>);
var
i: Integer;
reader, kreader: TCvSeqReader;
@ -125,10 +128,12 @@ var
nearest_neighbor: Integer;
begin
// Ócòàíîâêà íà÷àëüíîé îcîáåííîcòè îáúåêòà ðccïîçíàâàíèÿ
// Sets the initial features of object recognition
cvStartReadSeq(objectKeypoints, @kreader);
cvStartReadSeq(objectDescriptors, @reader);
SetLength(ptpairs, 0);
// Ïåðåáîð âcåõ îcîáåííîcòåòåé îáúåêòà
// Iterating through all features of the object
for i := 0 to objectDescriptors.total - 1 do
begin
kp := pCvSURFPoint(kreader.ptr);
@ -136,10 +141,12 @@ begin
CV_NEXT_SEQ_ELEM(kreader.seq.elem_size, kreader);
CV_NEXT_SEQ_ELEM(reader.seq.elem_size, reader);
// cðàâíåíèå òåêóùåé îcîáåííîcòè âcåìè îcîáåííîcòÿìè èç cöåíû
// comparison of the current features with all the features of the scene
nearest_neighbor := naiveNearestNeighbor(descriptor, kp.laplacian, imageKeypoints, imageDescriptors);
if (nearest_neighbor >= 0) then
begin
// Íàøëîcü cîâïàäåíèå îcîáåííîcòåé
// Match the features found
SetLength(ptpairs, length(ptpairs) + 2);
ptpairs[High(ptpairs) - 1] := i;
ptpairs[High(ptpairs)] := nearest_neighbor;
@ -147,9 +154,9 @@ begin
end;
end;
// * Ãðóáîå íàõîæäåíèå ìåcòîïîëîæåíèÿ îáúåêòà * /
function locatePlanarObject(const objectKeypoints: pCvSeq; const objectDescriptors: pCvSeq;
const imageKeypoints: pCvSeq; const imageDescriptors: pCvSeq; const src_corners: TArray<TCvPoint>;
// Ãðóáîå íàõîæäåíèå ìåcòîïîëîæåíèÿ îáúåêòà
// Finding rough position of the object
function locatePlanarObject(const objectKeypoints: pCvSeq; const objectDescriptors: pCvSeq; const imageKeypoints: pCvSeq; const imageDescriptors: pCvSeq; const src_corners: TArray<TCvPoint>;
dst_corners: TArray<TCvPoint>): Integer;
var
@ -163,17 +170,19 @@ var
begin
_h := cvMat(3, 3, CV_64F, @h);
// Èùåì ïàðû îcîáåííîcòåé íà îáåèõ êàðòèíêàõ, êîòîðûå cîîòâåòcòâóþò
// äðóã äðóãó
// Èùåì ïàðû îcîáåííîcòåé íà îáåèõ êàðòèíêàõ, êîòîðûå cîîòâåòcòâóþò äðóã äðóãó
// We are looking for a pair of features on each image that correspond to each other
findPairs(objectKeypoints, objectDescriptors, imageKeypoints, imageDescriptors, ptpairs);
n := length(ptpairs) div 2;
// Åcëè ïàð ìàëî, çíà÷èò íàäî âûõîäèòü îáúåêò íå íàéäåí
// If found little pair, then have to go - object not found
if (n < 4) then
Exit(0);
// Âûäåëÿåì ïàìÿòü
SetLength(pt1, n);
SetLength(pt2, n);
// c÷èòûâàåì êîîðäèíàòû «îcîáûõ»òî÷åê
// read the coordinates of the "singular" points
for i := 0 to n - 1 do
begin
pt1[i] := pCvSURFPoint(cvGetSeqElem(objectKeypoints, ptpairs[i * 2])).pt;
@ -181,14 +190,17 @@ begin
end;
// Ïî ïîëó÷åííûì âåêòîðàì cîçäà¸ì ìàòðèö
// Using computed vectors - creating a matrix
_pt1 := cvMat(1, n, CV_32FC2, @pt1[0]);
_pt2 := cvMat(1, n, CV_32FC2, @pt2[0]);
// Íàõîäèì òðàícôîðìàöèþ ìåæäó ècõîäíûì èçîáðàæåíèåì è c òåì, êîòîðîå
// èùåì
// Íàõîäèì òðàícôîðìàöèþ ìåæäó ècõîäíûì èçîáðàæåíèåì è c òåì, êîòîðîå èùåì
// Find the transformation between the original image and the fact that looking
if (cvFindHomography(@_pt1, @_pt2, @_h, CV_RANSAC, 5) = 0) then
Exit(0);
// Ïî ïîëó÷åííîìó çíà÷åíèþ òðàícôîðìàöèè (â ìàòðèöó _h) íàõîäèì
// êîîðäèíàòû ÷åòûð¸õóãîëüíèêà, õàðàêòåðèçóþùåãî îáúåêò
// Using the values transformation (in the matrix _h) find
// the coordinates of a quadrilateral, indicative of the object
for i := 0 to 3 do
begin
x := src_corners[i].x;
@ -306,12 +318,14 @@ begin
try
initModule_nonfree;
// Èíèöèàëèçàöèÿ ïàðàìåòðîâ
// initialization parameters
object_filename := iif(ParamCount = 2, ParamStr(1), 'resource\box.png');
scene_filename := iif(ParamCount = 2, ParamStr(2), 'resource\box_in_scene.png');
storage := cvCreateMemStorage(0);
cvNamedWindow('Object', 1);
cvNamedWindow('Object Correspond', 1);
// Çàãðóçêà èçîáðàæåíèé
// Loading Images
_object := cvLoadImage(pcvChar(@object_filename[1]), CV_LOAD_IMAGE_GRAYSCALE);
image := cvLoadImage(pcvChar(@scene_filename[1]), CV_LOAD_IMAGE_GRAYSCALE);
@ -322,24 +336,29 @@ begin
Halt;
end;
// Ïåðåâîä â ãðàäàöèè cåðîãî
// Translation grayscale
object_color := cvCreateImage(cvGetSize(_object), 8, 3);
cvCvtColor(_object, object_color, CV_GRAY2BGR);
// Èíèöèàëèçàöèÿ còðóêòóðû CvSURFParams c ðàçìåðîì äåcêðèïòîðîâ â 128
// ýëåìåíòîâ
// Èíèöèàëèçàöèÿ còðóêòóðû CvSURFParams c ðàçìåðîì äåcêðèïòîðîâ â 128 ýëåìåíòîâ
// Initialization of the structure CvSURFParams c size descriptors 128 items
params := CvSURFParams(500, 1);
// Çccåêàåì âðåìÿ
// Çàcåêàåì âðåìÿ
// note the time
tt := cvGetTickCount();
// Èùåì îcîáåííîcòè îáúåêòà ðccïîçíàâàíèÿ
// We are looking for particular object recognition
cvExtractSURF(_object, nil, @objectKeypoints, @objectDescriptors, storage, params);
WriteLn(Format('Object Descriptors: %d', [objectDescriptors.total]));
// Èùåì îcîáåííîcòè cöåíû
// We are looking for particular scenes
cvExtractSURF(image, nil, @imageKeypoints, @imageDescriptors, storage, params);
WriteLn(Format('Image Descriptors: %d', [imageDescriptors.total]));
// cêîëüêî ïîòðåáîâàëîcü âðåìåíè (Ó ìåíÿ 167 ìèëëè cåêóíä)
// how long it took (I 167 milliseconds)
tt := cvGetTickCount() - tt;
WriteLn(Format('Extraction time = %gms', [tt / (cvGetTickFrequency() * 1000)]));
// Ócòàíàâëèâàåì ãðàíèöû èçîáðàæåíèé, âíóòðè êîòîðûõ áóäóò cðàâíèâàòücÿ
// îcîáåííîcòè
// Ócòàíàâëèâàåì ãðàíèöû èçîáðàæåíèé, âíóòðè êîòîðûõ áóäóò cðàâíèâàòücÿ îcîáåííîcòè
// Set the image borders, within which features will be compared
SetLength(src_corners, 4);
src_corners[0] := cvPoint(0, 0);
src_corners[1] := cvPoint(_object.width, 0);
@ -348,6 +367,8 @@ begin
SetLength(dst_corners, 4);
// cîçäàíèå äîïîëíèòåëüíîãî èçîáðàæåíèå (â í¸ì áóäåò cöåíà è îáúåêò)
// Çàïócòèòå ïðèìåð è ïîéì¸òå î ÷¸ì ðå÷ü
// creation of an additional image (it will be a scene and object)
// Run the example and you will understand what I mean
correspond := cvCreateImage(cvSize(image.width, _object.height + image.height), 8, 1);
cvSetImageROI(correspond, cvRect(0, 0, _object.width, _object.height));
cvCopy(_object, correspond);
@ -355,10 +376,11 @@ begin
cvCopy(image, correspond);
cvResetImageROI(correspond);
// Âûçûâàåì ôóíêöèþ, íàõîäÿùóþ îáúåêò íà ýêðàíå
if (locatePlanarObject(objectKeypoints, objectDescriptors, imageKeypoints, imageDescriptors, src_corners,
dst_corners) <> 0) then
// Call the function that retrieves the object on the screen
if (locatePlanarObject(objectKeypoints, objectDescriptors, imageKeypoints, imageDescriptors, src_corners, dst_corners) <> 0) then
begin
// Îáâîäèì íóæíûé ÷åòûð¸õóãîëüíèê
// Draw out the desired quadrangle
for i := 0 to 3 do
begin
r1 := dst_corners[i mod 4];
@ -366,24 +388,24 @@ begin
cvLine(correspond, cvPoint(r1.x, r1.y + _object.height), cvPoint(r2.x, r2.y + _object.height), colors[8]);
end;
end;
// Åcëè â ýòîì ìåcòå âûâåcòè ðåçóëüòàò íà ýêðàí, òî ïîëó÷èòücÿ òî, ÷òî
// ïîêàçàíî íà ðècóíêå 23.3.
// Åcëè â ýòîì ìåcòå âûâåcòè ðåçóëüòàò íà ýêðàí, òî ïîëó÷èòücÿ òî, ÷òî ïîêàçàíî íà ðècóíêå 23.3.
// cíîâà èùóòcÿ âcå cîâïàäàþùèå ïàðû îcîáåííîcòåé â îáåèõ êàðòèíêàõ
// again finds all the matching pairs of features in both pictures
findPairs(objectKeypoints, objectDescriptors, imageKeypoints, imageDescriptors, ptpairs);
// Ìåæäó ïàðàìè îcîáåííîcòåé íà ðècóíêå ïðîâîäÿòcÿ ïðÿìûå
// Between pairs of features in the figure are held straight
i := 0;
While i < length(ptpairs) do
begin
_r1 := pCvSURFPoint(cvGetSeqElem(objectKeypoints, ptpairs[i]));
_r2 := pCvSURFPoint(cvGetSeqElem(imageKeypoints, ptpairs[i + 1]));
cvLine(correspond, cvPointFrom32f(_r1.pt), cvPoint(cvRound(_r2.pt.x), cvRound(_r2.pt.y + _object.height)),
colors[8]);
cvLine(correspond, cvPointFrom32f(_r1.pt), cvPoint(cvRound(_r2.pt.x), cvRound(_r2.pt.y + _object.height)), colors[8]);
i := i + 2;
end;
// Ðåçóëüòàò ìîæíî ïîcìîòðåòü íà ðècíóêå 23.4.
cvShowImage('Object Correspond', correspond);
// Âûäåëÿåì îcîáåííîcòèî îêðóæíîcòÿìè (Ðèc. 23.5)
// Highlight features of circles
for i := 0 to objectKeypoints.total - 1 do
begin
r := pCvSURFPoint(cvGetSeqElem(objectKeypoints, i));

View File

@ -7,7 +7,7 @@
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Console</AppType>
<FrameworkType>None</FrameworkType>
<ProjectVersion>15.2</ProjectVersion>
<ProjectVersion>15.3</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">

View File

@ -21,9 +21,6 @@
// rights and limitations under the License.
// *************************************************************** *)
// JCL_DEBUG_EXPERT_GENERATEJDBG OFF
// JCL_DEBUG_EXPERT_INSERTJDBG OFF
// JCL_DEBUG_EXPERT_DELETEMAPFILE OFF
program cv_ExtractSURF;
{$APPTYPE CONSOLE}