Delphi/Delphi-OpenCV
1
0
Fork 0
mirror of https://github.com/Laex/Delphi-OpenCV.git synced 2024-11-15 07:45:53 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Example with OpenGL

Browse Source 
Signed-off-by: Laex <laex@bk.ru>
This commit is contained in:
Laex 2013-10-06 13:48:40 +04:00
parent 9fba5056b2
commit 4049cda768
32 changed files with 22504 additions and 779 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitignore vendored
View File

@ -1,6 +1,5 @@
Win32
__history
-*.*
*.dcu
*.local
*.exe
@ -12,6 +11,7 @@ __history
*.skincfg
*.otares
/!DS!
/!Work!
/bin/StereoSample/Aloe/*.png
/bin/StereoSample/Aloe/dmin.txt
/bin/Result/*.jpg
@ -38,4 +38,4 @@ __history
*.vlb
/bin/carnumdetect.ini
/bin/*.bsc
/Bin/vclFaceRecogData
/Bin/vclFaceRecogData

BIN
Bin/glut32.dll Normal file
View File

Binary file not shown.

92
include/core/Core.types_c.pas
View File

@ -82,9 +82,9 @@
// ************************************************************************************************* *)
{$IFDEF DEBUG}
{$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O-,P+,Q+,R+,S-,T-,U-,V+,W+,X+,Y+,Z1}
{$A8,B-,C+,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O-,P+,Q+,R+,S-,T-,U-,V+,W+,X+,Y+,Z1}
{$ELSE}
{$A8,B-,C-,D-,E-,F-,G+,H+,I+,J-,K-,L-,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y-,Z1}
{$A8,B-,C-,D-,E-,F-,G+,H+,I+,J+,K-,L-,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y-,Z1}
{$ENDIF}
{$WARN SYMBOL_DEPRECATED OFF}
{$WARN SYMBOL_PLATFORM OFF}
@ -93,6 +93,7 @@
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$POINTERMATH ON}
unit Core.types_c;
interface
@ -358,6 +359,8 @@ type
height: Integer;
end;
TA4CVChar = array [0 .. 3] of CVChar;
TIplImage = packed record
nSize: Integer; (* sizeof(IplImage) *)
id: Integer; (* version (=0) *)
@ -365,8 +368,8 @@ type
alphaChannel: Integer; (* Ignored by OpenCV *)
depth: Integer; (* Pixel depth in bits: Pixel depth in bits: IPL_DEPTH_8U, IPL_DEPTH_8S, IPL_DEPTH_16S,
IPL_DEPTH_32S, IPL_DEPTH_32F and IPL_DEPTH_64F are supported. *)
colorModel: array [0 .. 3] of CVChar; (* Ignored by OpenCV *)
channelSeq: array [0 .. 3] of CVChar; (* ditto *)
colorModel: TA4CVChar; (* Ignored by OpenCV *)
channelSeq: TA4CVChar; (* ditto *)
dataOrder: Integer; (* 0 - interleaved color channels, 1 - separate color channels. *)
origin: Integer; (* 0 - top-left origin, *)
align: Integer; (* Alignment of image rows (4 or 8). *)
@ -869,7 +872,9 @@ type
end;
type
CvMemStoragePos = packed record
pCvMemStoragePos = ^TCvMemStoragePos;
TCvMemStoragePos = packed record
top: pCvMemBlock;
free_space: Integer;
end;
@ -1148,10 +1153,10 @@ const
{$EXTERNALSYM CV_SEQ_ELTYPE_BITS}
CV_SEQ_ELTYPE_MASK = (1 shl CV_SEQ_ELTYPE_BITS) - 1;
{$EXTERNALSYM CV_SEQ_ELTYPE_MASK}
// CV_SEQ_ELTYPE_POINT = CV_32SC2; (* (x,y) *)
// {$EXTERNALSYM CV_SEQ_ELTYPE_POINT}
// CV_SEQ_ELTYPE_CODE = CV_8UC1; (* freeman code: 0..7 *)
// {$EXTERNALSYM CV_SEQ_ELTYPE_CODE}
CV_SEQ_ELTYPE_POINT: Integer = 0; // CV_32SC2; (* (x,y) *)
{$EXTERNALSYM CV_SEQ_ELTYPE_POINT}
CV_SEQ_ELTYPE_CODE: Integer = 0; // CV_8UC1; (* freeman code: 0..7 *)
{$EXTERNALSYM CV_SEQ_ELTYPE_CODE}
CV_SEQ_ELTYPE_GENERIC = 0;
{$EXTERNALSYM CV_SEQ_ELTYPE_GENERIC}
CV_SEQ_ELTYPE_PTR = CV_USRTYPE1;
@ -1168,8 +1173,8 @@ const
{$EXTERNALSYM CV_SEQ_ELTYPE_TRIAN_ATR}
CV_SEQ_ELTYPE_CONNECTED_COMP = 0; (* connected component *)
{$EXTERNALSYM CV_SEQ_ELTYPE_CONNECTED_COMP}
// CV_SEQ_ELTYPE_POINT3D = CV_32FC3; (* (x,y,z) *)
// {$EXTERNALSYM CV_SEQ_ELTYPE_POINT3D}
CV_SEQ_ELTYPE_POINT3D: Integer = 0; // CV_32FC3; (* (x,y,z) *)
{$EXTERNALSYM CV_SEQ_ELTYPE_POINT3D}
CV_SEQ_KIND_BITS = 2;
{$EXTERNALSYM CV_SEQ_KIND_BITS}
CV_SEQ_KIND_MASK = ((1 shl CV_SEQ_KIND_BITS) - 1) shl CV_SEQ_ELTYPE_BITS;
@ -1205,26 +1210,26 @@ const
CV_ORIENTED_GRAPH = (CV_SEQ_KIND_GRAPH or CV_GRAPH_FLAG_ORIENTED);
{$EXTERNALSYM CV_ORIENTED_GRAPH}
(* point sets *)
// CV_SEQ_POINT_SET = (CV_SEQ_KIND_GENERIC or CV_SEQ_ELTYPE_POINT);
// {$EXTERNALSYM CV_SEQ_POINT_SET}
// CV_SEQ_POINT3D_SET = (CV_SEQ_KIND_GENERIC or CV_SEQ_ELTYPE_POINT3D);
// {$EXTERNALSYM CV_SEQ_POINT3D_SET}
// CV_SEQ_POLYLINE = (CV_SEQ_KIND_CURVE or CV_SEQ_ELTYPE_POINT);
// {$EXTERNALSYM CV_SEQ_POLYLINE}
// CV_SEQ_POLYGON = (CV_SEQ_FLAG_CLOSED or CV_SEQ_POLYLINE);
// {$EXTERNALSYM CV_SEQ_POLYGON}
// CV_SEQ_CONTOUR = CV_SEQ_POLYGON;
// {$EXTERNALSYM CV_SEQ_CONTOUR}
// CV_SEQ_SIMPLE_POLYGON = (CV_SEQ_FLAG_SIMPLE or CV_SEQ_POLYGON);
// {$EXTERNALSYM CV_SEQ_SIMPLE_POLYGON}
CV_SEQ_POINT_SET: Integer = 0; // (CV_SEQ_KIND_GENERIC or CV_SEQ_ELTYPE_POINT);
{$EXTERNALSYM CV_SEQ_POINT_SET}
CV_SEQ_POINT3D_SET: Integer = 0; // (CV_SEQ_KIND_GENERIC or CV_SEQ_ELTYPE_POINT3D);
{$EXTERNALSYM CV_SEQ_POINT3D_SET}
CV_SEQ_POLYLINE: Integer = 0; // (CV_SEQ_KIND_CURVE or CV_SEQ_ELTYPE_POINT);
{$EXTERNALSYM CV_SEQ_POLYLINE}
CV_SEQ_POLYGON: Integer = 0; // (CV_SEQ_FLAG_CLOSED or CV_SEQ_POLYLINE);
{$EXTERNALSYM CV_SEQ_POLYGON}
CV_SEQ_CONTOUR: Integer = 0; // CV_SEQ_POLYGON;
{$EXTERNALSYM CV_SEQ_CONTOUR}
CV_SEQ_SIMPLE_POLYGON: Integer = 0; // (CV_SEQ_FLAG_SIMPLE or CV_SEQ_POLYGON);
{$EXTERNALSYM CV_SEQ_SIMPLE_POLYGON}
(* chain-coded curves *)
// CV_SEQ_CHAIN = (CV_SEQ_KIND_CURVE or CV_SEQ_ELTYPE_CODE);
// {$EXTERNALSYM CV_SEQ_CHAIN}
// CV_SEQ_CHAIN_CONTOUR = (CV_SEQ_FLAG_CLOSED or CV_SEQ_CHAIN);
// {$EXTERNALSYM CV_SEQ_CHAIN_CONTOUR}
// (* binary tree for the contour *)
// CV_SEQ_POLYGON_TREE = (CV_SEQ_KIND_BIN_TREE or CV_SEQ_ELTYPE_TRIAN_ATR);
// {$EXTERNALSYM CV_SEQ_POLYGON_TREE}
CV_SEQ_CHAIN: Integer = 0; // (CV_SEQ_KIND_CURVE or CV_SEQ_ELTYPE_CODE);
{$EXTERNALSYM CV_SEQ_CHAIN}
CV_SEQ_CHAIN_CONTOUR: Integer = 0; // (CV_SEQ_FLAG_CLOSED or CV_SEQ_CHAIN);
{$EXTERNALSYM CV_SEQ_CHAIN_CONTOUR}
(* binary tree for the contour *)
CV_SEQ_POLYGON_TREE = (CV_SEQ_KIND_BIN_TREE or CV_SEQ_ELTYPE_TRIAN_ATR);
{$EXTERNALSYM CV_SEQ_POLYGON_TREE}
(* sequence of the connected components *)
CV_SEQ_CONNECTED_COMP = (CV_SEQ_KIND_GENERIC or CV_SEQ_ELTYPE_CONNECTED_COMP);
{$EXTERNALSYM CV_SEQ_CONNECTED_COMP}
@ -1251,11 +1256,11 @@ function CV_IS_SEQ_CLOSED(const Seq: pCvSeq): Boolean; inline;
/// / >> Following declaration is a macro definition!
// const
// CV_IS_SEQ_CONVEX(seq)0;
//
/// / >> Following declaration is a macro definition!
// const
// Following declaration is a macro definition!
// CV_IS_SEQ_HOLE(seq)(((seq)^.flags and CV_SEQ_FLAG_HOLE) <> 0);
//
function CV_IS_SEQ_HOLE(const Seq: pCvSeq): Boolean; inline;
/// / >> Following declaration is a macro definition!
// const
// CV_IS_SEQ_SIMPLE(seq)1;
@ -2667,4 +2672,23 @@ begin
Result := (Seq^.flags and CV_SEQ_FLAG_CLOSED) <> 0;
end;
function CV_IS_SEQ_HOLE(const Seq: pCvSeq): Boolean; inline;
begin
Result := (Seq^.flags and CV_SEQ_FLAG_HOLE) <> 0;
end;
initialization
CV_SEQ_ELTYPE_POINT := CV_32SC2;
CV_SEQ_ELTYPE_CODE := CV_8UC1;
CV_SEQ_ELTYPE_POINT3D := CV_32FC3;
CV_SEQ_POINT_SET := (CV_SEQ_KIND_GENERIC or CV_SEQ_ELTYPE_POINT);
CV_SEQ_POINT3D_SET := (CV_SEQ_KIND_GENERIC or CV_SEQ_ELTYPE_POINT3D);
CV_SEQ_POLYLINE := (CV_SEQ_KIND_CURVE or CV_SEQ_ELTYPE_POINT);
CV_SEQ_POLYGON := (CV_SEQ_FLAG_CLOSED or CV_SEQ_POLYLINE);
CV_SEQ_CONTOUR := CV_SEQ_POLYGON;
CV_SEQ_SIMPLE_POLYGON := (CV_SEQ_FLAG_SIMPLE or CV_SEQ_POLYGON);
CV_SEQ_CHAIN := (CV_SEQ_KIND_CURVE or CV_SEQ_ELTYPE_CODE);
CV_SEQ_CHAIN_CONTOUR := (CV_SEQ_FLAG_CLOSED or CV_SEQ_CHAIN);
end.

2
include/core/core_c.pas
View File

@ -973,7 +973,7 @@ function cvCreateMemStorage(block_size: Integer = 0): pCvMemStorage; cdecl;
{ Creates a memory storage that will borrow memory blocks from parent storage
CVAPI(CvMemStorage*) cvCreateChildMemStorage( CvMemStorage* parent );
}
function cvCreateChildMemStorage(block_size: Integer = 0): pCvMemStorage; cdecl;
function cvCreateChildMemStorage(parent:pCvMemStorage): pCvMemStorage; cdecl;
{ Releases memory storage. All the children of a parent must be released before
the parent. A child storage returns all the blocks to parent when it is released

137
include/imgproc/imgproc_c.pas
View File

@ -453,6 +453,66 @@ const
CV_CHAIN_APPROX_TC89_KCOS = 4;
CV_LINK_RUNS = 5;
type
pCvContourInfo = ^TCvContourInfo;
TCvContourInfo = packed record
flags: Integer;
next: pCvContourInfo; // next contour with the same mark value */
parent: pCvContourInfo; // information about parent contour */
contour: pCvSeq; // corresponding contour (may be 0, if rejected) */
rect: TCvRect; // bounding rectangle */
origin: TCvPoint; // origin point (where the contour was traced from) */
is_hole: Integer; // hole flag */
end;
(*
Structure that is used for sequental retrieving contours from the image.
It supports both hierarchical and plane variants of Suzuki algorithm.
*)
pCvContourScanner = ^TCvContourScanner;
TCvContourScanner = packed record
storage1: pCvMemStorage; // contains fetched contours */
storage2: pCvMemStorage; // contains approximated contours
// (! = storage1 if approx_method2 ! = approx_method1) * / cinfo_storage: pCvMemStorage;
// contains _CvContourInfo nodes */
cinfo_set: pCvSet; // set of _CvContourInfo nodes */
initial_pos: TCvMemStoragePos; // starting storage pos */
backup_pos: TCvMemStoragePos; // beginning of the latest approx. contour */
backup_pos2: TCvMemStoragePos; // ending of the latest approx. contour */
img0: pByte; // image origin */
img: pByte; // current image row */
img_step: Integer; // image step */
img_size: TCvSize; // ROI size */
offset: TCvPoint; // ROI offset: coordinates, added to each contour point */
pt: TCvPoint; // current scanner position */
lnbd: TCvPoint; // position of the last met contour */
nbd: Integer; // current mark val */
l_cinfo: pCvContourInfo; // information about latest approx. contour */
cinfo_temp: TCvContourInfo; // temporary var which is used in simple modes */
frame_info: TCvContourInfo; // information about frame */
frame: TCvSeq; // frame itself */
approx_method1: Integer; // approx method when tracing */
approx_method2: Integer; // final approx method */
mode: Integer; // contour scanning mode:
// 0 - external only
// 1 - all the contours w/o any hierarchy
// 2 - connected components (i.e. two-level structure -
// external contours and holes),
// 3 - full hierarchy;
// 4 - connected components of a multi-level image
subst_flag: Integer;
seq_type1: Integer; // type of fetched contours */
header_size1: Integer; // hdr size of fetched contours */
elem_size1: Integer; // elem size of fetched contours */
seq_type2: Integer; // */
header_size2: Integer; // the same for approx. contours */
elem_size2: Integer; // */
cinfo_table: array [0 .. 127] of pCvContourInfo;
end;
{
/* Retrieves outer and optionally inner boundaries of white (non-zero) connected
components in the black (zero) background */
@ -468,36 +528,40 @@ const
function cvFindContours(
{ } image: pIplImage;
{ } storage: PCvMemStorage;
{ } storage: pCvMemStorage;
{ } first_contour: pCvSeq;
{ } header_size: Integer { = SizeOf(TCvContour) };
{ } mode: Integer { = CV_RETR_LIST };
{ } method: Integer { = CV_CHAIN_APPROX_SIMPLE };
{ } offset: TCvPoint { =cvPoint(0,0) } ): Integer; cdecl;
//
// (* Initalizes contour retrieving process.
// Calls cvStartFindContours.
// Calls cvFindNextContour until null cPointer is returned
// or some other condition becomes true.
// Calls cvEndFindContours at the end. *)
(* Initalizes contour retrieving process.
Calls cvStartFindContours.
Calls cvFindNextContour until null pointer is returned
or some other condition becomes true.
Calls cvEndFindContours at the end. *)
// CVAPI(CvContourScanner) cvStartFindContours( CvArr* image, CvMemStorage* storage,
// function header_size CV_DEFAULT(
// v1: CvContour));
// mode CV_DEFAULT(CV_RETR_LIST): Integer;
// method CV_DEFAULT(CV_CHAIN_APPROX_SIMPLE): Integer;
// offset CV_DEFAULT(cvPoint(0: CvPoint;
// v5: ))): Integer;
//
// (* Retrieves next contour *)
// CVAPI(CvSeq) cvFindNextContour( CvContourScanner scanner ): Pointer;
//
//
// (* Substitutes the last retrieved contour with the new one
// (if the substitutor is null, the last retrieved contour is removed from the tree) *) then
// CVAPI(procedure) cvSubstituteContour(
// v1: var Releases contour scanner and returns pointer to the first outer contour *)CVAPI(CvSeq) cvEndFindContours( CvContourScanner* scanner);
//
// int header_size CV_DEFAULT(sizeof(CvContour)),
// int mode CV_DEFAULT(CV_RETR_LIST),
// int method CV_DEFAULT(CV_CHAIN_APPROX_SIMPLE),
// CvPoint offset CV_DEFAULT(cvPoint(0,0)));
function cvStartFindContours(image: pCvArr; storage: pCvMemStorage; header_size: Integer { =sizeof(TCvContour)) };
mode: Integer {= CV_RETR_LIST }; method: Integer { =CV_CHAIN_APPROX_SIMPLE }; offset: TCvPoint { =cvPoint(0,0) } )
: pCvContourScanner; cdecl;
// * Retrieves next contour */
// CVAPI(CvSeq*) cvFindNextContour( CvContourScanner scanner );
function cvFindNextContour(scanner: pCvContourScanner): pCvSeq; cdecl;
(* Substitutes the last retrieved contour with the new one
(if the substitutor is null, the last retrieved contour is removed from the tree) *)
// CVAPI(void) cvSubstituteContour( CvContourScanner scanner, CvSeq* new_contour );
procedure cvSubstituteContour(scanner: pCvContourScanner; new_contour: pCvSeq); cdecl;
// * Releases contour scanner and returns pointer to the first outer contour */
// CVAPI(CvSeq*) cvEndFindContours( CvContourScanner* scanner );
function cvEndFindContours(Var scanner: pCvContourScanner): pCvSeq; cdecl;
// (* Approximates a single Freeman chain or a tree of chains to polygonal curves *)
// CVAPI(CvSeq) cvApproxChains( CvSeq* src_seq, CvMemStorage* storage,
// function method CV_DEFAULT(
@ -529,7 +593,7 @@ function cvFindContours(
function cvApproxPoly(
{ } const src_seq: pCvSeq;
{ } header_size: Integer;
{ } storage: PCvMemStorage;
{ } storage: pCvMemStorage;
{ } method: Integer;
{ } eps: double;
{ } recursive: Integer = 0): pCvSeq; cdecl;
@ -565,7 +629,7 @@ function cvContourArea(const contour: pCvArr; slice: TCvSlice { = CV_WHOLE_SEQ }
// (* Finds minimum area rotated rectangle bounding a set of points *)
// CVAPI(CvBox2D) cvMinAreaRect2( const CvArr* points, CvMemStorage* storage CV_DEFAULT(NULL));
function cvMinAreaRect2(points: pCvArr; storage: PCvMemStorage = nil): TCvBox2D; cdecl;
function cvMinAreaRect2(points: pCvArr; storage: pCvMemStorage = nil): TCvBox2D; cdecl;
// (* Finds minimum enclosing circle for a set of points *)
// CVAPI(int) cvMinEnclosingCircle( const CvArr* points,CvPoint2D32f* center, float* radius );
@ -599,7 +663,7 @@ function cvCheckContourConvexity(const contour: pCvSeq): Integer; cdecl;
CVAPI(CvSeq) cvConvexityDefects( CvArr* contour, CvArr* convexhull,
CvMemStorage* storage CV_DEFAULT(0)): Pointer;
}
function cvConvexityDefects(contour: pCvSeq; convexhull: pCvSeq; storage: PCvMemStorage = nil): pCvSeq; cdecl;
function cvConvexityDefects(contour: pCvSeq; convexhull: pCvSeq; storage: pCvMemStorage = nil): pCvSeq; cdecl;
// (* Fits ellipse into a set of 2d points *)
// CVAPI(CvBox2D) cvFitEllipse2( CvArr* points );
@ -637,10 +701,10 @@ procedure cvBoxPoints(box: TCvBox2D; pt: TBoxPoints); cdecl;
float** ranges CV_DEFAULT(NULL),
int uniform CV_DEFAULT(1));
}
function cvCreateHist(dims: Integer; sizes: PInteger; _type: Integer; ranges: pFloat = nil;
uniform: Integer = 1): pCvHistogram; cdecl; overload;
//function cvCreateHist(dims: Integer; sizes: PInteger; _type: Integer; ranges: ppFloat = nil;
// uniform: Integer = 1): pCvHistogram; cdecl; overload;
function cvCreateHist(dims: Integer; sizes: PInteger; _type: Integer; ranges: Pointer = nil; uniform: Integer = 1)
: pCvHistogram; cdecl;
// function cvCreateHist(dims: Integer; sizes: PInteger; _type: Integer; ranges: ppFloat = nil;
// uniform: Integer = 1): pCvHistogram; cdecl; overload;
// (* Assignes histogram bin ranges *)
@ -1013,13 +1077,7 @@ function cvConvexityDefects; external imgproc_Dll;
procedure cvPyrDown; external imgproc_Dll;
procedure cvPyrUp; external imgproc_Dll;
function cvCheckContourConvexity; external imgproc_Dll;
//function cvCreateHist(dims: Integer; sizes: PInteger; _type: Integer; ranges: pSingleArray2D = nil;
// uniform: Integer = 1): pCvHistogram; external imgproc_Dll;
//function cvCreateHist(dims: Integer; sizes: PInteger; _type: Integer; ranges: ppFloat = nil;
// uniform: Integer = 1): pCvHistogram; external imgproc_Dll;
function cvCreateHist(dims: Integer; sizes: PInteger; _type: Integer; ranges: pFloat = nil;
uniform: Integer = 1): pCvHistogram; external imgproc_Dll;
function cvCreateHist; external imgproc_Dll;
procedure cvCalcHist;
begin
@ -1050,4 +1108,9 @@ procedure cvUndistort2; external imgproc_Dll;
function cvGetAffineTransform; external imgproc_Dll;
procedure cvUndistortPoints; external imgproc_Dll;
function cvStartFindContours; external imgproc_Dll;
function cvFindNextContour; external imgproc_Dll;
procedure cvSubstituteContour; external imgproc_Dll;
function cvEndFindContours; external imgproc_Dll;
end.

2
samples/Classes/IPCamVideoCapture/Class_IPCamVideoCapture.dpr
View File

@ -61,7 +61,7 @@ end;
Var
// See http://www.ispyconnect.com/
filename: pCVChar ='rtsp://192.168.0.202:554/cam/realmonitor?channel=1&subtype=0';
filename: pCVChar ='rtsp://192.168.0.202:554/cam/realmonitor?channel=1&subtype=0&unicast=true&proto=Onvif';
camera: IVideoCapture;
cameraFrame: IMat = nil;

78
samples/LibDemo.groupproj
View File

@ -174,6 +174,24 @@
<Projects Include="LibDemo\cvPosit\Posit.dproj">
<Dependencies/>
</Projects>
<Projects Include="LibDemo\cvCalcHist\cv_CalcHist2.dproj">
<Dependencies/>
</Projects>
<Projects Include="LibDemo\cvDFT\cv_DFT.dproj">
<Dependencies/>
</Projects>
<Projects Include="LibDemo\cvFindContours\cv_FindContours3.dproj">
<Dependencies/>
</Projects>
<Projects Include="LibDemo\cvMatchShapes\cv_MatchShapes2.dproj">
<Dependencies/>
</Projects>
<Projects Include="LibDemo\cvSegmentImage\cv_SegmentImage.dproj">
<Dependencies/>
</Projects>
<Projects Include="LibDemo\cvSum\cv_Sum.dproj">
<Dependencies/>
</Projects>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Default.Personality.12</Borland.Personality>
@ -695,14 +713,68 @@
<Target Name="Posit:Make">
<MSBuild Projects="LibDemo\cvPosit\Posit.dproj" Targets="Make"/>
</Target>
<Target Name="cv_CalcHist2">
<MSBuild Projects="LibDemo\cvCalcHist\cv_CalcHist2.dproj"/>
</Target>
<Target Name="cv_CalcHist2:Clean">
<MSBuild Projects="LibDemo\cvCalcHist\cv_CalcHist2.dproj" Targets="Clean"/>
</Target>
<Target Name="cv_CalcHist2:Make">
<MSBuild Projects="LibDemo\cvCalcHist\cv_CalcHist2.dproj" Targets="Make"/>
</Target>
<Target Name="cv_DFT">
<MSBuild Projects="LibDemo\cvDFT\cv_DFT.dproj"/>
</Target>
<Target Name="cv_DFT:Clean">
<MSBuild Projects="LibDemo\cvDFT\cv_DFT.dproj" Targets="Clean"/>
</Target>
<Target Name="cv_DFT:Make">
<MSBuild Projects="LibDemo\cvDFT\cv_DFT.dproj" Targets="Make"/>
</Target>
<Target Name="cv_FindContours3">
<MSBuild Projects="LibDemo\cvFindContours\cv_FindContours3.dproj"/>
</Target>
<Target Name="cv_FindContours3:Clean">
<MSBuild Projects="LibDemo\cvFindContours\cv_FindContours3.dproj" Targets="Clean"/>
</Target>
<Target Name="cv_FindContours3:Make">
<MSBuild Projects="LibDemo\cvFindContours\cv_FindContours3.dproj" Targets="Make"/>
</Target>
<Target Name="cv_MatchShapes2">
<MSBuild Projects="LibDemo\cvMatchShapes\cv_MatchShapes2.dproj"/>
</Target>
<Target Name="cv_MatchShapes2:Clean">
<MSBuild Projects="LibDemo\cvMatchShapes\cv_MatchShapes2.dproj" Targets="Clean"/>
</Target>
<Target Name="cv_MatchShapes2:Make">
<MSBuild Projects="LibDemo\cvMatchShapes\cv_MatchShapes2.dproj" Targets="Make"/>
</Target>
<Target Name="cv_SegmentImage">
<MSBuild Projects="LibDemo\cvSegmentImage\cv_SegmentImage.dproj"/>
</Target>
<Target Name="cv_SegmentImage:Clean">
<MSBuild Projects="LibDemo\cvSegmentImage\cv_SegmentImage.dproj" Targets="Clean"/>
</Target>
<Target Name="cv_SegmentImage:Make">
<MSBuild Projects="LibDemo\cvSegmentImage\cv_SegmentImage.dproj" Targets="Make"/>
</Target>
<Target Name="cv_Sum">
<MSBuild Projects="LibDemo\cvSum\cv_Sum.dproj"/>
</Target>
<Target Name="cv_Sum:Clean">
<MSBuild Projects="LibDemo\cvSum\cv_Sum.dproj" Targets="Clean"/>
</Target>
<Target Name="cv_Sum:Make">
<MSBuild Projects="LibDemo\cvSum\cv_Sum.dproj" Targets="Make"/>
</Target>
<Target Name="Build">
<CallTarget Targets="cv_GoodFeaturesToTrack;cv_GoodFeaturesToTrack_Video;cv_AdaptiveSkinDetector;cv_AddWeighted;cv_And;cv_CalcHist;cv_CalcOpticalFlowPyrLK;cv_Canny;cv_CodeBook;cv_CopyMakeBorder;cv_CreateCameraCapture;cv_CreateFGDStatModel;cv_CreateGaussianBGModel;cv_CreateStructuringElementEx;cv_CreateTrackbar;cv_CreateVideoWriter;cv_CvtColor;cv_CvtPixToPlane;cv_ExtractSURF;cv_ExtractSURF2;cv_FindContours;cv_FindContours2;cv_FloodFill;cv_GetSubRect;cv_HoughCircles;cv_HoughLines2;cv_InRangeS;cv_Integral;cv_Laplace;cv_LinearPolar;cv_LoadHaarClassifierCascade;cv_LoadImage;cv_LoadImage2;cv_LoadVideo;cv_MatchShapes;cv_MatchTemplate;cv_MorphologyEx;cv_Motion;cv_PyrSegmentation;cv_RandInt;cv_Resize;cv_Save;cv_SetImageROI;cv_SetImageROI2;cv_SetMouseCallback;cv_Smooth;cv_SnakeImage;cv_Sobel;cv_Sub;cv_WarpAffine;cv_WarpPerspective;cvErode_cvDilate;cvSetImageROI_cvAddWeighted;cvSplit_cvMerge;cvThreshold_cvAdaptiveThreshold;latentsvmdetect;Posit"/>
<CallTarget Targets="cv_GoodFeaturesToTrack;cv_GoodFeaturesToTrack_Video;cv_AdaptiveSkinDetector;cv_AddWeighted;cv_And;cv_CalcHist;cv_CalcOpticalFlowPyrLK;cv_Canny;cv_CodeBook;cv_CopyMakeBorder;cv_CreateCameraCapture;cv_CreateFGDStatModel;cv_CreateGaussianBGModel;cv_CreateStructuringElementEx;cv_CreateTrackbar;cv_CreateVideoWriter;cv_CvtColor;cv_CvtPixToPlane;cv_ExtractSURF;cv_ExtractSURF2;cv_FindContours;cv_FindContours2;cv_FloodFill;cv_GetSubRect;cv_HoughCircles;cv_HoughLines2;cv_InRangeS;cv_Integral;cv_Laplace;cv_LinearPolar;cv_LoadHaarClassifierCascade;cv_LoadImage;cv_LoadImage2;cv_LoadVideo;cv_MatchShapes;cv_MatchTemplate;cv_MorphologyEx;cv_Motion;cv_PyrSegmentation;cv_RandInt;cv_Resize;cv_Save;cv_SetImageROI;cv_SetImageROI2;cv_SetMouseCallback;cv_Smooth;cv_SnakeImage;cv_Sobel;cv_Sub;cv_WarpAffine;cv_WarpPerspective;cvErode_cvDilate;cvSetImageROI_cvAddWeighted;cvSplit_cvMerge;cvThreshold_cvAdaptiveThreshold;latentsvmdetect;Posit;cv_CalcHist2;cv_DFT;cv_FindContours3;cv_MatchShapes2;cv_SegmentImage;cv_Sum"/>
</Target>
<Target Name="Clean">
<CallTarget Targets="cv_GoodFeaturesToTrack:Clean;cv_GoodFeaturesToTrack_Video:Clean;cv_AdaptiveSkinDetector:Clean;cv_AddWeighted:Clean;cv_And:Clean;cv_CalcHist:Clean;cv_CalcOpticalFlowPyrLK:Clean;cv_Canny:Clean;cv_CodeBook:Clean;cv_CopyMakeBorder:Clean;cv_CreateCameraCapture:Clean;cv_CreateFGDStatModel:Clean;cv_CreateGaussianBGModel:Clean;cv_CreateStructuringElementEx:Clean;cv_CreateTrackbar:Clean;cv_CreateVideoWriter:Clean;cv_CvtColor:Clean;cv_CvtPixToPlane:Clean;cv_ExtractSURF:Clean;cv_ExtractSURF2:Clean;cv_FindContours:Clean;cv_FindContours2:Clean;cv_FloodFill:Clean;cv_GetSubRect:Clean;cv_HoughCircles:Clean;cv_HoughLines2:Clean;cv_InRangeS:Clean;cv_Integral:Clean;cv_Laplace:Clean;cv_LinearPolar:Clean;cv_LoadHaarClassifierCascade:Clean;cv_LoadImage:Clean;cv_LoadImage2:Clean;cv_LoadVideo:Clean;cv_MatchShapes:Clean;cv_MatchTemplate:Clean;cv_MorphologyEx:Clean;cv_Motion:Clean;cv_PyrSegmentation:Clean;cv_RandInt:Clean;cv_Resize:Clean;cv_Save:Clean;cv_SetImageROI:Clean;cv_SetImageROI2:Clean;cv_SetMouseCallback:Clean;cv_Smooth:Clean;cv_SnakeImage:Clean;cv_Sobel:Clean;cv_Sub:Clean;cv_WarpAffine:Clean;cv_WarpPerspective:Clean;cvErode_cvDilate:Clean;cvSetImageROI_cvAddWeighted:Clean;cvSplit_cvMerge:Clean;cvThreshold_cvAdaptiveThreshold:Clean;latentsvmdetect:Clean;Posit:Clean"/>
<CallTarget Targets="cv_GoodFeaturesToTrack:Clean;cv_GoodFeaturesToTrack_Video:Clean;cv_AdaptiveSkinDetector:Clean;cv_AddWeighted:Clean;cv_And:Clean;cv_CalcHist:Clean;cv_CalcOpticalFlowPyrLK:Clean;cv_Canny:Clean;cv_CodeBook:Clean;cv_CopyMakeBorder:Clean;cv_CreateCameraCapture:Clean;cv_CreateFGDStatModel:Clean;cv_CreateGaussianBGModel:Clean;cv_CreateStructuringElementEx:Clean;cv_CreateTrackbar:Clean;cv_CreateVideoWriter:Clean;cv_CvtColor:Clean;cv_CvtPixToPlane:Clean;cv_ExtractSURF:Clean;cv_ExtractSURF2:Clean;cv_FindContours:Clean;cv_FindContours2:Clean;cv_FloodFill:Clean;cv_GetSubRect:Clean;cv_HoughCircles:Clean;cv_HoughLines2:Clean;cv_InRangeS:Clean;cv_Integral:Clean;cv_Laplace:Clean;cv_LinearPolar:Clean;cv_LoadHaarClassifierCascade:Clean;cv_LoadImage:Clean;cv_LoadImage2:Clean;cv_LoadVideo:Clean;cv_MatchShapes:Clean;cv_MatchTemplate:Clean;cv_MorphologyEx:Clean;cv_Motion:Clean;cv_PyrSegmentation:Clean;cv_RandInt:Clean;cv_Resize:Clean;cv_Save:Clean;cv_SetImageROI:Clean;cv_SetImageROI2:Clean;cv_SetMouseCallback:Clean;cv_Smooth:Clean;cv_SnakeImage:Clean;cv_Sobel:Clean;cv_Sub:Clean;cv_WarpAffine:Clean;cv_WarpPerspective:Clean;cvErode_cvDilate:Clean;cvSetImageROI_cvAddWeighted:Clean;cvSplit_cvMerge:Clean;cvThreshold_cvAdaptiveThreshold:Clean;latentsvmdetect:Clean;Posit:Clean;cv_CalcHist2:Clean;cv_DFT:Clean;cv_FindContours3:Clean;cv_MatchShapes2:Clean;cv_SegmentImage:Clean;cv_Sum:Clean"/>
</Target>
<Target Name="Make">
<CallTarget Targets="cv_GoodFeaturesToTrack:Make;cv_GoodFeaturesToTrack_Video:Make;cv_AdaptiveSkinDetector:Make;cv_AddWeighted:Make;cv_And:Make;cv_CalcHist:Make;cv_CalcOpticalFlowPyrLK:Make;cv_Canny:Make;cv_CodeBook:Make;cv_CopyMakeBorder:Make;cv_CreateCameraCapture:Make;cv_CreateFGDStatModel:Make;cv_CreateGaussianBGModel:Make;cv_CreateStructuringElementEx:Make;cv_CreateTrackbar:Make;cv_CreateVideoWriter:Make;cv_CvtColor:Make;cv_CvtPixToPlane:Make;cv_ExtractSURF:Make;cv_ExtractSURF2:Make;cv_FindContours:Make;cv_FindContours2:Make;cv_FloodFill:Make;cv_GetSubRect:Make;cv_HoughCircles:Make;cv_HoughLines2:Make;cv_InRangeS:Make;cv_Integral:Make;cv_Laplace:Make;cv_LinearPolar:Make;cv_LoadHaarClassifierCascade:Make;cv_LoadImage:Make;cv_LoadImage2:Make;cv_LoadVideo:Make;cv_MatchShapes:Make;cv_MatchTemplate:Make;cv_MorphologyEx:Make;cv_Motion:Make;cv_PyrSegmentation:Make;cv_RandInt:Make;cv_Resize:Make;cv_Save:Make;cv_SetImageROI:Make;cv_SetImageROI2:Make;cv_SetMouseCallback:Make;cv_Smooth:Make;cv_SnakeImage:Make;cv_Sobel:Make;cv_Sub:Make;cv_WarpAffine:Make;cv_WarpPerspective:Make;cvErode_cvDilate:Make;cvSetImageROI_cvAddWeighted:Make;cvSplit_cvMerge:Make;cvThreshold_cvAdaptiveThreshold:Make;latentsvmdetect:Make;Posit:Make"/>
<CallTarget Targets="cv_GoodFeaturesToTrack:Make;cv_GoodFeaturesToTrack_Video:Make;cv_AdaptiveSkinDetector:Make;cv_AddWeighted:Make;cv_And:Make;cv_CalcHist:Make;cv_CalcOpticalFlowPyrLK:Make;cv_Canny:Make;cv_CodeBook:Make;cv_CopyMakeBorder:Make;cv_CreateCameraCapture:Make;cv_CreateFGDStatModel:Make;cv_CreateGaussianBGModel:Make;cv_CreateStructuringElementEx:Make;cv_CreateTrackbar:Make;cv_CreateVideoWriter:Make;cv_CvtColor:Make;cv_CvtPixToPlane:Make;cv_ExtractSURF:Make;cv_ExtractSURF2:Make;cv_FindContours:Make;cv_FindContours2:Make;cv_FloodFill:Make;cv_GetSubRect:Make;cv_HoughCircles:Make;cv_HoughLines2:Make;cv_InRangeS:Make;cv_Integral:Make;cv_Laplace:Make;cv_LinearPolar:Make;cv_LoadHaarClassifierCascade:Make;cv_LoadImage:Make;cv_LoadImage2:Make;cv_LoadVideo:Make;cv_MatchShapes:Make;cv_MatchTemplate:Make;cv_MorphologyEx:Make;cv_Motion:Make;cv_PyrSegmentation:Make;cv_RandInt:Make;cv_Resize:Make;cv_Save:Make;cv_SetImageROI:Make;cv_SetImageROI2:Make;cv_SetMouseCallback:Make;cv_Smooth:Make;cv_SnakeImage:Make;cv_Sobel:Make;cv_Sub:Make;cv_WarpAffine:Make;cv_WarpPerspective:Make;cvErode_cvDilate:Make;cvSetImageROI_cvAddWeighted:Make;cvSplit_cvMerge:Make;cvThreshold_cvAdaptiveThreshold:Make;latentsvmdetect:Make;Posit:Make;cv_CalcHist2:Make;cv_DFT:Make;cv_FindContours3:Make;cv_MatchShapes2:Make;cv_SegmentImage:Make;cv_Sum:Make"/>
</Target>
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
</Project>

648
samples/LibDemo/cvCalcHist/-Work/uclahe.pas Normal file
View File

@ -0,0 +1,648 @@
// *****************************************************************************
// Contrast Limited Adaptive Histogram Equalization (CLAHE) for OpenCV
// -----------------------------------------------------------------------------
// Original CLAHE implementation by Karel Zuiderveld, karel@cv.ruu.nl
// in 'Graphics Gems IV', Academic Press, 1994.
// -----------------------------------------------------------------------------
// Converted to OpenCV format by Toby Breckon, toby.breckon@cranfield.ac.uk
// Copyright (c) 2009 School of Engineering, Cranfield University
// License : LGPL - http://www.gnu.org/licenses/lgpl.html
// -----------------------------------------------------------------------------
// Improved by Shervin Emami on 17th Nov 2010, shervin.emami@gmail.com
// http://www.shervinemami.co.cc/
// *****************************************************************************
// **************************************************************************************************
// 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
// **************************************************************************************************
// License:
// The contents of this file are 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/
//
// 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.
//
// Alternatively, the contents of this file may be used under the terms of the
// GNU Lesser General Public License (the 'LGPL License'), in which case the
// provisions of the LGPL License are applicable instead of those above.
// If you wish to allow use of your version of this file only under the terms
// of the LGPL License and not to allow others to use your version of this file
// under the MPL, indicate your decision by deleting the provisions above and
// replace them with the notice and other provisions required by the LGPL
// License. If you do not delete the provisions above, a recipient may use
// your version of this file under either the MPL or the LGPL License.
//
// For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
// **************************************************************************************************
// The Initial Developer of the Original Code:
// OpenCV: open source computer vision library
// Homepage: http://opencv.org
// Online docs: http://docs.opencv.org
// Q&A forum: http://answers.opencv.org
// Dev zone: http://code.opencv.org
// **************************************************************************************************
// Original: https://github.com/joshdoe/opencv-clahe/blob/master/clahe.cpp
// **************************************************************************************************
{$POINTERMATH ON}
unit uclahe;
interface
Uses
core.types_c;
const
// CLAHE input/output range flag definitions
CV_CLAHE_RANGE_FULL =0;
CV_CLAHE_RANGE_INPUT= 1;
procedure cvCLAdaptEqualize(src:pIplImage; dst:pIplImage;
xdivs:Cardinal; ydivs:Cardinal; bins:Cardinal;
limit:float; range:Integer);
implementation
Uses
core_c,
imgproc_c;
type
// type defs. for Graphic Gemms Code - see later
kz_pixel_t = byte; (* for 8 bit-per-pixel images *)
pkz_pixel_t=^kz_pixel_t;
const
uiNR_OF_GREY = 256;
(************* Prototype of Graphic Gemms CLAHE function. *********************)
function CLAHE(pImage:pkz_pixel_t; uiXRes:Cardinal;
uiYRes:Cardinal; Min:kz_pixel_t;
Max:kz_pixel_t; uiNrX:Cardinal; uiNrY:Cardinal;
uiNrBins:Cardinal; fCliplimit:float):Integer; forward;
// *****************************************************************************
// General Notes:
//
// The number of 'effective' greylevels in the output image is set by bins; selecting
// a small value (eg. 128) speeds up processing and still produce an output image of
// good quality. The output image will have the same minimum and maximum value as the input
// image. A clip limit smaller than 1 (?? is this correct ) results in
// standard (non-contrast limited) AHE.
// cvAdaptEqualize(src, dst, xdivs, ydivs, bins)
//
// perform adaptive histogram equalization (AHE)
//
// src - pointer to source image (must be single channel 8-bit)
// dst - pointer to destination image (must be single channel 8-bit)
// xdivs - number of cell divisions to use in vertical (x) direction (MIN=2 MAX := 16)
// ydivs - number of cell divisions to use in vertical (y) direction (MIN=2 MAX := 16)
// bins - number of histogram bins to use per division
// range - either of CV_CLAHE_RANGE_INPUT or CV_CLAHE_RANGE_FULL to limit the output
// pixel range to the min/max range of the input image or the full range of the
// pixel depth (8-bit in this case)
procedure cvAdaptEqualize(src:pIplImage; dst:pIplImage;
xdivs:Cardinal; ydivs:Cardinal; bins:Cardinal; range:Integer);
begin
// call CLAHE with negative limit (as flag value) to perform AHE (no limits)
cvCLAdaptEqualize(src, dst, xdivs, ydivs, bins, -1.0, range);
end;
// cvCLAdaptEqualize(src, dst, xdivs, ydivs, bins, limit)
//
// perform contrast limited adaptive histogram equalization (CLAHE)
//
// src - pointer to source image (must be single channel 8-bit)
// dst - pointer to destination image (must be single channel 8-bit)
// xdivs - number of cell divisions to use in vertical (x) direction (MIN=2 MAX := 16)
// ydivs - number of cell divisions to use in vertical (y) direction (MIN=2 MAX := 16)
// bins - number of histogram bins to use per division (MIN=2 MAX := 256)
// limit - contrast limit for localised changes in contrast
// (limit >= 0 gives standard AHE without contrast limiting)
// range - either of CV_CLAHE_RANGE_INPUT or CV_CLAHE_RANGE_FULL to limit the output
// pixel range to the min/max range of the input image or the full range of the
// pixel depth (8-bit in this case)
procedure cvCLAdaptEqualize(src:pIplImage; dst:pIplImage;
xdivs:Cardinal; ydivs:Cardinal; bins:Cardinal;
limit:float; range:Integer);
Var
min_val, max_val:Double;
min, max:Byte;
_type:Integer;
enlarged :Integer;
origW : integer;
origH :integer;
tmpDst :pIplImage;
newW:Integer;
newH:Integer;
enlargedDst:pIplImage;
begin
// check the inputs to the function
if (src = nil) or (dst = nil) then
cvError( CV_StsUnsupportedFormat, 'cvCLAdaptEqualize','nil value passed as image to function',nil,0 );
_type := cvGetElemType( src );
if( _type <> CV_8UC1 ) then
cvError( CV_StsUnsupportedFormat, 'cvCLAdaptEqualize', 'Only 8uC1 images are supported' );
_type := cvGetElemType( src );
if( _type <> CV_8UC1 ) then
cvError( CV_StsUnsupportedFormat, 'cvCLAdaptEqualize', 'Only 8uC1 images are supported' );
//if( !CV_ARE_SIZES_EQ( src, dst )) // Modified by Shervin Emami, 17Nov2010.
if (src^.width <> dst^.width )or( src^.height <> dst^.height) then
cvError( CV_StsUnmatchedSizes, 'cvCLAdaptEqualize', 'src and dst images must be equal sizes' );
if (((xdivs < 2) )or( (xdivs > 16)) )or( ((ydivs < 2) )or( (ydivs > 16))) then
cvError( CV_StsBadFlag, 'cvCLAdaptEqualize', 'xdivs and ydivs must in range (MIN=2 MAX := 16)' );
if ((bins < 2) )or( (bins > 256)) then
cvError( CV_StsBadFlag, 'cvCLAdaptEqualize', 'bins must in range (MIN=2 MAX := 256)' );
// copy src to dst for in-place CLAHE.
cvCopy(src, dst);
// If the dimensions of the image are not a multiple of the xdivs and ydivs, then enlarge the image to be a correct size and then shrink the image.
// Also make sure the image is aligned to 8 pixels width, so that OpenCV won't add extra padding to the image.
// Added by Shervin Emami, 17Nov2010.
enlarged := 0;
origW := dst^.width;
origH := dst^.height;
tmpDst := nil;
if ((dst^.width and (8-1))<>0 )or( (dst^.height and (8-1))<>0 )or( (dst^.width mod xdivs)<>0 )or( (dst^.height mod ydivs)<>0) then begin
newW := ((dst^.width + 8-1) and -8); // Align to 8 pixels, so that widthStep hopefully equals width.
newW := ((newW + xdivs-1) and -xdivs); // Also align for CLAHE.
newH := ((dst^.height + ydivs-1) and -ydivs);
//std::cout << 'w=' << dst^.width << ', h=' << dst^.height << '. new w := ' << newW << ', h := ' << newH << std::endl;
enlargedDst := cvCreateImage(cvSize(newW, newH), dst^.depth, dst^.nChannels);
cvResize(dst, enlargedDst, CV_INTER_CUBIC);
//cvReleaseImage(&dst);
tmpDst := dst;
dst := enlargedDst; // Use the enlarged image instead of the original dst image.
enlarged := 1; // signal that we need to shrink later!
end;
// Check if OpenCV adds padding bytes on each row. Added by Shervin Emami, 17Nov2010.
if (dst^.width <> dst^.widthStep) then
cvError( CV_StsBadFlag, 'cvCLAdaptEqualize', 'dst^.widthStep should be the same as dst^.width. The IplImage has padding, so use a larger image.' );
// check number of xdivs and ydivs is a multiple of image dimensions
if (dst^.width mod xdivs)<>0 then
cvError( CV_StsBadFlag, 'cvCLAdaptEqualize', 'xdiv must be an integer multiple of image width ' );
if (dst^.height mod ydivs)<>0 then
cvError( CV_StsBadFlag, 'cvCLAdaptEqualize', 'ydiv must be an integer multiple of image height ' );
// get the min and max values of the image
if (range = CV_CLAHE_RANGE_INPUT) then begin
cvMinMaxLoc(dst, @min_val, @max_val);
min := Trunc(min_val);
max := Trunc(max_val);
end else begin
min := 0;
max := 255;
end;
// call CLHAHE for in-place CLAHE
//int rcode =
CLAHE(pkz_pixel_t(dst^.imageData), dst^.width,
dst^.height, min, max, xdivs, ydivs,
bins, limit);
//printf('RCODE %i\n', rcode);
// If the dst image was enlarged to fit the alignment, then shrink it back now.
// Added by Shervin Emami, 17Nov2010.
if (enlarged<>0) then begin
//std::cout << 'w=' << dst^.width << ', h=' << dst^.height << '. orig w=' << origW << ', h=' << origH << std::endl;
cvResize(dst, tmpDst, CV_INTER_CUBIC); // Shrink the enlarged image back into the original dst image.
cvReleaseImage(dst); // Free the enlarged image.
end;
end;
// *****************************************************************************
(*
* ANSI C code from the article
* 'Contrast Limited Adaptive Histogram Equalization'
* by Karel Zuiderveld, karel@cv.ruu.nl
* in 'Graphics Gems IV', Academic Press, 1994
*
*
* These functions implement Contrast Limited Adaptive Histogram Equalization.
* The main routine (CLAHE) expects an input image that is stored contiguously in
* memory; the CLAHE output image overwrites the original input image and has the
* same minimum and maximum values (which must be provided by the user).
* This implementation assumes that the X- and Y image resolutions are an integer
* multiple of the X- and Y sizes of the contextual regions. A check on various other
* error conditions is performed.
*
* #define the symbol BYTE_IMAGE to make this implementation suitable for
* 8-bit images. The maximum number of contextual regions can be redefined
* by changing uiMAX_REG_X and/or uiMAX_REG_Y; the use of more than 256
* contextual regions is not recommended.
*
* The code is ANSI-C and is also C++ compliant.
*
* Author: Karel Zuiderveld, Computer Vision Research Group,
* Utrecht, The Netherlands (karel@cv.ruu.nl)
*)
(*
EULA: The Graphics Gems code is copyright-protected. In other words, you cannot
claim the text of the code as your own and resell it. Using the code is permitted
in any program, product, or library, non-commercial or commercial. Giving credit
is not required, though is a nice gesture. The code comes as-is, and if there are
any flaws or problems with any Gems code, nobody involved with Gems - authors,
editors, publishers, or webmasters - are to be held responsible. Basically,
don't be a jerk, and remember that anything free comes with no guarantee.
- http://tog.acm.org/resources/GraphicsGems/ (August 2009)
*)
(*********************** Local prototypes ************************)
procedure ClipHistogram (pulHistogram:PCardinal;
uiNrGreylevels:Cardinal; ulClipLimit:Cardinal);forward;
procedure MakeHistogram (pImage:pkz_pixel_t; uiXRes:Cardinal;
uiSizeX:Cardinal; uiSizeY:Cardinal;
pulHistogram:pCardinal;
uiNrGreylevels:Cardinal; pLookupTable:pkz_pixel_t);forward;
procedure MapHistogram (pulHistogram:pCardinal; Min:kz_pixel_t; Max:kz_pixel_t;
uiNrGreylevels:Cardinal; ulNrOfPixels:Cardinal);forward;
procedure MakeLut (pLUT:pkz_pixel_t; Min:kz_pixel_t; Max:kz_pixel_t; uiNrBins:cardinal); forward;
procedure Interpolate (pImage:pkz_pixel_t; uiXRes:Integer; pulMapLU:pCardinal;
pulMapRU:PCardinal; pulMapLB:pCardinal; pulMapRB:pCardinal;
uiXSize:Cardinal; uiYSize:Cardinal; pLUT:pkz_pixel_t);forward;
// *****************************************************************************
(************** Start of actual code **************)
const
uiMAX_REG_X :Cardinal= 16; (* max. # contextual regions in x-direction *)
uiMAX_REG_Y :Cardinal= 16; (* max. # contextual regions in y-direction *)
(************************** main function CLAHE ******************)
function CLAHE(pImage:pkz_pixel_t; uiXRes:Cardinal;
uiYRes:Cardinal; Min:kz_pixel_t;
Max:kz_pixel_t; uiNrX:Cardinal; uiNrY:Cardinal;
uiNrBins:Cardinal; fCliplimit:float):Integer;
(* pImage - Pointer to the input/output image
* uiXRes - Image resolution in the X direction
* uiYRes - Image resolution in the Y direction
* Min - Minimum greyvalue of input image (also becomes minimum of output image)
* Max - Maximum greyvalue of input image (also becomes maximum of output image)
* uiNrX - Number of contextial regions in the X direction (min 2, max uiMAX_REG_X)
* uiNrY - Number of contextial regions in the Y direction (min 2, max uiMAX_REG_Y)
* uiNrBins - Number of greybins for histogram ('dynamic range')
* float fCliplimit - Normalized cliplimit (higher values give more contrast)
* The number of 'effective' greylevels in the output image is set by uiNrBins; selecting
* a small value (eg. 128) speeds up processing and still produce an output image of
* good quality. The output image will have the same minimum and maximum value as the input
* image. A clip limit smaller than 1 results in standard (non-contrast limited) AHE.
*)
Var
uiX, uiY:Cardinal; (* counters *)
uiXSize, uiYSize, uiSubX, uiSubY:Cardinal; (* size of context. reg. and subimages *)
uiXL, uiXR, uiYU, uiYB:Cardinal; (* auxiliary variables interpolation routine *)
ulClipLimit, ulNrPixels:Cardinal;(* clip limit and region pixel count *)
pImPointer:pkz_pixel_t; (* pointer to image *)
aLUT:array[0..uiNR_OF_GREY] of kz_pixel_t; (* lookup table used for scaling of input image *)
pulHist, pulMapArray:pCardinal; (* pointer to histogram and mappings*)
pulLU, pulLB, pulRU, pulRB:pCardinal; (* auxiliary pointers interpolation *)
begin
if (uiNrX > uiMAX_REG_X) then Exit(-1); (* # of regions x-direction too large *)
if (uiNrY > uiMAX_REG_Y) then Exit(-2); (* # of regions y-direction too large *)
if (uiXRes mod uiNrX)<>0 then Exit(-3); (* x-resolution no multiple of uiNrX *)
if (uiYRes mod uiNrY)<>0 then Exit(-4); (* y-resolution no multiple of uiNrY #TPB FIX *)
// #ifndef BYTE_IMAGE (* #TPB FIX *)
//if (Max >= uiNR_OF_GREY) return -5; (* maximum too large *)
//#endif
if (Min >= Max) then Exit(-6); (* minimum equal or larger than maximum *)
if (uiNrX < 2 )or( uiNrY < 2) then Exit(-7);(* at least 4 contextual regions required *)
if (fCliplimit = 1.0) then Exit(0); (* is OK, immediately returns original image. *)
if (uiNrBins = 0) then uiNrBins := 128; (* default value when not specified *)
GetMem(pulMapArray,sizeof(Cardinal)*uiNrX*uiNrY*uiNrBins);
if (pulMapArray = nil) then Exit(-8); (* Not enough memory! (try reducing uiNrBins) *)
uiXSize := uiXRes div uiNrX;
uiYSize := uiYRes div uiNrY; (* Actual size of contextual regions *)
ulNrPixels := uiXSize * uiYSize;
if(fCliplimit > 0.0) then begin (* Calculate actual cliplimit *)
ulClipLimit := Trunc(fCliplimit * (uiXSize * uiYSize) / uiNrBins);
if ulClipLimit < 1 then
ulClipLimit := 1;
end
else ulClipLimit := 1 shl 14; (* Large value, do not clip (AHE) *)
MakeLut(@aLUT, Min, Max, uiNrBins); (* Make lookup table for mapping of greyvalues *)
(* Calculate greylevel mappings for each contextual region *)
pImPointer := pImage;
for uiY := 0 to uiNrY-1 do
begin
for uiX := 0 to uiNrX-1 do
begin
pulHist := @pulMapArray[uiNrBins * (uiY * uiNrX + uiX)];
MakeHistogram(pImPointer,uiXRes,uiXSize,uiYSize,pulHist,uiNrBins,@aLUT);
ClipHistogram(pulHist, uiNrBins, ulClipLimit);
MapHistogram(pulHist, Min, Max, uiNrBins, ulNrPixels);
pImPointer :=pImPointer+ uiXSize;
end;
pImPointer :=pImPointer+ (uiYSize - 1) * uiXRes; (* skip lines, set pointer *)
end;
(* Interpolate greylevel mappings to get CLAHE image *)
pImPointer := pImage;
for uiY := 0 to uiNrY do begin
if (uiY = 0) then begin (* special case: top row *)
uiSubY := uiYSize shr 1;
uiYU := 0;
uiYB := 0;
end
else begin
if (uiY = uiNrY) then begin (* special case: bottom row *)
uiSubY := uiYSize shr 1;
uiYU := uiNrY-1;
uiYB := uiYU;
end
else begin (* default values *)
uiSubY := uiYSize;
uiYU := uiY - 1;
uiYB := uiYU + 1;
end;
end;
for uiX := 0 to uiNrX do begin
if (uiX = 0) then begin (* special case: left column *)
uiSubX := uiXSize shr 1; uiXL := 0; uiXR := 0;
end
else begin
if (uiX = uiNrX) then begin (* special case: right column *)
uiSubX := uiXSize shr 1; uiXL := uiNrX - 1; uiXR := uiXL;
end
else begin (* default values *)
uiSubX := uiXSize; uiXL := uiX - 1; uiXR := uiXL + 1;
end;
end;
pulLU := @pulMapArray[uiNrBins * (uiYU * uiNrX + uiXL)];
pulRU := @pulMapArray[uiNrBins * (uiYU * uiNrX + uiXR)];
pulLB := @pulMapArray[uiNrBins * (uiYB * uiNrX + uiXL)];
pulRB := @pulMapArray[uiNrBins * (uiYB * uiNrX + uiXR)];
Interpolate(pImPointer,uiXRes,pulLU,pulRU,pulLB,pulRB,uiSubX,uiSubY,@aLUT);
pImPointer :=pImPointer+ uiSubX; (* set pointer on next matrix *)
end;
pImPointer :=pImPointer+ (uiSubY - 1) * uiXRes;
end;
freemem(pulMapArray); (* free space for histograms *)
Result:=0; (* return status OK *)
end;
procedure ClipHistogram (pulHistogram:PCardinal;
uiNrGreylevels:Cardinal; ulClipLimit:Cardinal);
(* This function performs clipping of the histogram and redistribution of bins.
* The histogram is clipped and the number of excess pixels is counted. Afterwards
* the excess pixels are equally redistributed across the whole histogram (providing
* the bin count is smaller than the cliplimit).
*)
Var
pulBinPointer, pulEndPointer, pulHisto:pCardinal;
ulNrExcess, ulUpper, ulBinIncr, ulStepSize, i:Cardinal;
ulOldNrExcess:CArdinal; // #IAC Modification
lBinExcess:Integer;
begin
ulNrExcess := 0; pulBinPointer := pulHistogram;
for i := 0 to uiNrGreylevels-1 do
begin (* calculate total number of excess pixels *)
lBinExcess := pulBinPointer[i] - ulClipLimit;
if (lBinExcess > 0) then ulNrExcess :=ulNrExcess+lBinExcess; (* excess in current bin *)
end;;
(* Second part: clip histogram and redistribute excess pixels in each bin *)
ulBinIncr := ulNrExcess div uiNrGreylevels; (* average binincrement *)
ulUpper := ulClipLimit - ulBinIncr; (* Bins larger than ulUpper set to cliplimit *)
for i := 0 to uiNrGreylevels-1 do begin
if (pulHistogram[i] > ulClipLimit) then pulHistogram[i] := ulClipLimit (* clip bin *)
else begin
if (pulHistogram[i] > ulUpper) then begin (* high bin count *)
ulNrExcess :=ulNrExcess- pulHistogram[i] - ulUpper; pulHistogram[i]:=ulClipLimit;
end
else begin (* low bin count *)
ulNrExcess :=ulNrExcess- ulBinIncr; pulHistogram[i] :=pulHistogram[i]+ ulBinIncr;
end;
end;
end;
// while (ulNrExcess) begin (* Redistribute remaining excess *)
// pulEndPointer := &pulHistogram[uiNrGreylevels]; pulHisto := pulHistogram;
//
// while (ulNrExcess )and( pulHisto < pulEndPointer) begin
// ulStepSize := uiNrGreylevels / ulNrExcess;
// if (ulStepSize < 1) ulStepSize := 1; (* stepsize at least 1 *)
// for (pulBinPointer=pulHisto; pulBinPointer < pulEndPointer )and( ulNrExcess;
// pulBinPointer += ulStepSize) begin
// if (*pulBinPointer < ulClipLimit) begin
// (*pulBinPointer)++; ulNrExcess--; (* reduce excess *)
// end;
// end;
// pulHisto++; (* restart redistributing on other bin location *)
// end;
//end;
(* ####
IAC Modification:
In the original version of the loop below (commented out above) it was possible for an infinite loop to get
created. If there was more pixels to be redistributed than available space then the
while loop would never end. This problem has been fixed by stopping the loop when all
pixels have been redistributed OR when no pixels where redistributed in the previous iteration.
This change allows very low clipping levels to be used.
*)
repeat (* Redistribute remaining excess *)
pulEndPointer := @pulHistogram[uiNrGreylevels]; pulHisto := pulHistogram;
ulOldNrExcess := ulNrExcess; (* Store number of excess pixels for test later. *)
while (ulNrExcess<>0)and( pulHisto < pulEndPointer) do
begin
ulStepSize := uiNrGreylevels div ulNrExcess;
if (ulStepSize < 1) then
ulStepSize := 1; (* stepsize at least 1 *)
pulBinPointer:=pulHisto;
while (pulBinPointer < pulEndPointer )and( ulNrExcess<>0) do
begin
if (pulBinPointer^ < ulClipLimit) then
begin
Inc(pulBinPointer^); Dec(ulNrExcess); (* reduce excess *)
end;
pulBinPointer :=pulBinPointer+ ulStepSize;
end;
Inc(pulHisto); (* restart redistributing on other bin location *)
end;
until (ulNrExcess=0) or (ulNrExcess >= ulOldNrExcess);
(* Finish loop when we have no more pixels or we can't redistribute any more pixels *)
end;
procedure MakeHistogram (pImage:pkz_pixel_t; uiXRes:Cardinal;
uiSizeX:Cardinal; uiSizeY:Cardinal;
pulHistogram:pCardinal;
uiNrGreylevels:Cardinal; pLookupTable:pkz_pixel_t);
(* This function classifies the greylevels present in the array image into
* a greylevel histogram. The pLookupTable specifies the relationship
* between the greyvalue of the pixel (typically between 0 and 4095) and
* the corresponding bin in the histogram (usually containing only 128 bins).
*)
Var
pImagePointer:pkz_pixel_t;
i:Cardinal;
begin
for i := 0 to uiNrGreylevels-1 do pulHistogram[i] := 0; (* clear histogram *)
for i := 0 to uiSizeY-1 do begin
pImagePointer := @pImage[uiSizeX];
while (pImage < pImagePointer) do
begin
Inc(pulHistogram[pLookupTable[pImage^]]);
Inc(pImage);
end;
pImagePointer := pImagePointer+uiXRes;
pImage := @pImagePointer[-uiSizeX];
end;
end;
procedure MapHistogram (pulHistogram:pCardinal; Min:kz_pixel_t; Max:kz_pixel_t;
uiNrGreylevels:Cardinal; ulNrOfPixels:Cardinal);
(* This function calculates the equalized lookup table (mapping) by
* cumulating the input histogram. Note: lookup table is rescaled in range [Min..Max].
*)
Var
i, ulSum :Cardinal;
fScale:float;
ulMin:CArdinal;
begin
ulSum := 0;
fScale := (Max - Min) / ulNrOfPixels;
ulMin := Min;
for i := 0 to uiNrGreylevels-1 do
begin
ulSum :=ulSum+ pulHistogram[i]; pulHistogram[i]:=Trunc(ulMin+ulSum*fScale);
if (pulHistogram[i] > Max) then pulHistogram[i] := Max;
end;
end;
procedure MakeLut (pLUT:pkz_pixel_t; Min:kz_pixel_t; Max:kz_pixel_t; uiNrBins:cardinal);
(* To speed up histogram clipping, the input image [Min,Max] is scaled down to
* [0,uiNrBins-1]. This function calculates the LUT.
*)
Var
i:Integer;
BinSize:kz_pixel_t;
begin
BinSize := Trunc((1 + (Max - Min) / uiNrBins));
for i := Min to Max do pLUT[i] := (i - Min) div BinSize;
end;
procedure Interpolate (pImage:pkz_pixel_t; uiXRes:Integer; pulMapLU:pCardinal;
pulMapRU:PCardinal; pulMapLB:pCardinal; pulMapRB:pCardinal;
uiXSize:Cardinal; uiYSize:Cardinal; pLUT:pkz_pixel_t);
(* pImage - pointer to input/output image
* uiXRes - resolution of image in x-direction
* pulMap* - mappings of greylevels from histograms
* uiXSize - uiXSize of image submatrix
* uiYSize - uiYSize of image submatrix
* pLUT - lookup table containing mapping greyvalues to bins
* This function calculates the new greylevel assignments of pixels within a submatrix
* of the image with size uiXSize and uiYSize. This is done by a bilinear interpolation
* between four different mappings in order to eliminate boundary artifacts.
* It uses a division; since division is often an expensive operation, I added code to
* perform a logical shift instead when feasible.
*)
VAr
uiIncr:Cardinal;
GreyValue:kz_pixel_t;
uiNum:Cardinal;
uiXCoef, uiYCoef, uiXInvCoef, uiYInvCoef, uiShift:Cardinal;
begin
uiIncr := uiXRes-uiXSize; (* Pointer increment after processing row *)
uiNum := uiXSize*uiYSize; (* Normalization factor *)
uiShift := 0;
if (uiNum and (uiNum - 1))<>0 then (* If uiNum is not a power of two, use division *)
begin
uiYInvCoef := uiYSize;
for uiYCoef := 0 to uiYSize-1 do
begin
uiXInvCoef := uiXSize;
for uiXCoef := 0 to uiXSize-1 do
begin
GreyValue := pLUT[pImage^]; (* get histogram bin value *)
pImage^ := ((uiYInvCoef * (uiXInvCoef*pulMapLU[GreyValue]
+ uiXCoef * pulMapRU[GreyValue])
+ uiYCoef * (uiXInvCoef * pulMapLB[GreyValue]
+ uiXCoef * pulMapRB[GreyValue])) div uiNum);
Inc(pImage);
Dec(uiXInvCoef);
end;
Dec(uiYInvCoef);
pImage :=pImage+uiIncr;
end;
end
else begin (* avoid the division and use a right shift instead *)
while uiNum <>0 do (* Calculate 2log of uiNum *)
begin
Inc(uiShift);
uiNum:=uiNum shr 1;
end;
uiYInvCoef := uiYSize;
for uiYCoef := 0 to uiYSize-1 do
begin
uiXInvCoef := uiXSize;
for uiXCoef := 0 to uiXSize-1 do
begin
GreyValue := pLUT[pImage^]; (* get histogram bin value *)
pImage^ := ((uiYInvCoef* (uiXInvCoef * pulMapLU[GreyValue]
+ uiXCoef * pulMapRU[GreyValue])
+ uiYCoef * (uiXInvCoef * pulMapLB[GreyValue]
+ uiXCoef * pulMapRB[GreyValue])) shr uiShift);
Inc(pImage);
Dec(uiXInvCoef);
end;
Dec(uiYInvCoef);
pImage:=pImage+uiIncr;
end;
end;
end;
end.

61
samples/LibDemo/cvCalcHist/cv_CalcHist2.dpr
View File

@ -109,7 +109,6 @@ begin
end;
Const
windowName = 'CL Adaptive Histogram Equalization'; // window name
windowName1 = 'Grayscale'; // window name
windowNameH1 = 'Adaptive Equalised Histogram'; // window name
windowNameH2 = 'Original Histogram'; // window name
@ -155,9 +154,9 @@ begin
// create window object (use flag=0 to allow resize, 1 to auto fix size)
cvNamedWindow(
windowName,
1); // flag set to 1 by Shervin Emami, 17Nov2010.
// cvNamedWindow(
// windowName,
// 1); // flag set to 1 by Shervin Emami, 17Nov2010.
cvNamedWindow(
windowName1,
1); // flag set to 1 by Shervin Emami, 17Nov2010.
@ -172,30 +171,30 @@ begin
'Simple Histogram Equalization',
1); // Added by Shervin Emami, 17Nov2010.
cvCreateTrackbar(
'X cells',
windowName,
@xdivs,
16,
nil);
cvCreateTrackbar(
'Y cells',
windowName,
@ydivs,
16,
nil);
cvCreateTrackbar(
'bins',
windowName,
@bins,
256,
nil);
cvCreateTrackbar(
'limit (x 0.1)',
windowName,
@limit_counter,
30,
nil);
// cvCreateTrackbar(
// 'X cells',
// windowName,
// @xdivs,
// 16,
// nil);
// cvCreateTrackbar(
// 'Y cells',
// windowName,
// @ydivs,
// 16,
// nil);
// cvCreateTrackbar(
// 'bins',
// windowName,
// @bins,
// 256,
// nil);
// cvCreateTrackbar(
// 'limit (x 0.1)',
// windowName,
// @limit_counter,
// 30,
// nil);
// define required images for intermediate processing
// (if using a capture object we need to get a frame first to get the size)
@ -309,9 +308,9 @@ begin
// display image in window
cvShowImage(
windowName,
eqImg);
// cvShowImage(
// windowName,
// eqImg);
cvShowImage(
windowName1,
grayImg);

2
samples/LibDemo/cvCalcHist/cv_CalcHist2.dproj
View File

@ -1,6 +1,6 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{9892133E-8867-4ABB-8751-07F7A78B96C3}</ProjectGuid>
<ProjectGuid>{EF5C3DA9-7A87-4A4E-B2B7-ED8B18619FA3}</ProjectGuid>
<MainSource>cv_CalcHist2.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>

2
samples/LibDemo/cvDFT/cv_DFT.dproj
View File

@ -1,6 +1,6 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{E6555AEC-7F21-4A66-8EBC-8DD64AE99F97}</ProjectGuid>
<ProjectGuid>{4104141B-E8AE-40B0-84F2-01C0147F3C3F}</ProjectGuid>
<MainSource>cv_DFT.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>

2
samples/LibDemo/cvFindContours/cv_FindContours3.dproj
View File

@ -1,6 +1,6 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{C1473E41-922F-4F1D-B7E2-3EE58D9B9F7D}</ProjectGuid>
<ProjectGuid>{A7633F76-8F3B-4C33-B954-F5C1987547C1}</ProjectGuid>
<MainSource>cv_FindContours3.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>

130
samples/LibDemo/cvGoodFeaturesToTrack/cv_GoodFeaturesToTrack.dpr
View File

@ -1,28 +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.
******************************************************************* *)
// 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.
// *******************************************************************
program cv_GoodFeaturesToTrack;
{$APPTYPE CONSOLE}
@ -36,7 +34,6 @@ uses
imgproc_c,
imgproc.types_c;
Const
ImgFilename = 'resource\pic5.bmp';
@ -47,31 +44,79 @@ type
var
img1, img2, eig, temp: PIplImage;
points: array [0 .. 1] of PPointsArr;
pointsRow1: TPointsArr;
points : array [0 .. 1] of PPointsArr;
pointsRow1 : TPointsArr;
ipar1, count, j: integer;
begin
try
ipar1 := 100;
img1 := cvLoadImage(ImgFilename, CV_LOAD_IMAGE_UNCHANGED);
img2 := cvCreateImage(cvGetSize(img1), IPL_DEPTH_8U, 1);
cvCvtColor(img1, img2, CV_RGB2GRAY);
eig := cvCreateImage(cvGetSize(img2), 32, 1);
temp := cvCreateImage(cvGetSize(img2), 32, 1);
img1 := cvLoadImage(
ImgFilename,
CV_LOAD_IMAGE_UNCHANGED);
img2 := cvCreateImage(
cvGetSize(img1),
IPL_DEPTH_8U,
1);
cvCvtColor(
img1,
img2,
CV_RGB2GRAY);
eig := cvCreateImage(
cvGetSize(img2),
32,
1);
temp := cvCreateImage(
cvGetSize(img2),
32,
1);
points[0] := @pointsRow1[0];
count:=250;
cvGoodFeaturesToTrack(img2, eig, temp, @points[0][0], @ipar1, 0.05, 10, nil, 5, 0, 0.09);
cvFindCornerSubPix(img2, @points[0][0], count, cvSize(5, 5), cvSize(-1, -1),
count := 250;
cvGoodFeaturesToTrack(
img2,
eig,
temp,
@points[0][0],
@ipar1,
0.05,
10,
nil,
5,
0,
0.09);
cvFindCornerSubPix(
img2,
@points[0][0],
count,
cvSize(5, 5),
cvSize(-1, -1),
cvTermCriteria(CV_TERMCRIT_ITER or CV_TERMCRIT_EPS, 20, 0.03));
for j := 0 to ipar1 - 1 do
begin
cvCircle(img1, cvPointFrom32f(points[0][j]), 3, CV_RGB(0, 255, 255), -1, 8, 0);
cvCircle(img1, cvPointFrom32f(points[0][j]), 8, CV_RGB(255, 0, 0), -1, 8, 0);
cvCircle(
img1,
cvPointFrom32f(points[0][j]),
3,
CV_RGB(0, 255, 255),
-1,
8,
0);
cvCircle(
img1,
cvPointFrom32f(points[0][j]),
8,
CV_RGB(255, 0, 0),
-1,
8,
0);
end;
cvNamedWindow('bb', 1);
cvShowImage('bb', img1);
cvNamedWindow(
'bb',
1);
cvShowImage(
'bb',
img1);
cvWaitKey(0);
cvReleaseImage(img1);
cvReleaseImage(img2);
@ -80,7 +125,10 @@ begin
cvDestroyAllWindows;
except
on E: Exception do
WriteLn(E.ClassName, ': ', E.Message);
WriteLn(
E.ClassName,
': ',
E.Message);
end;
end.

2
samples/LibDemo/cvMatchShapes/cv_MatchShapes.dproj
View File

@ -1,6 +1,6 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{DD703319-D321-48D2-A8C7-33C4A17C8DE6}</ProjectGuid>
<ProjectGuid>{182C3EB2-6F37-4B58-B352-D10DC7C6CB17}</ProjectGuid>
<MainSource>cv_MatchShapes.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>

2
samples/LibDemo/cvSegmentImage/cv_SegmentImage.dproj
View File

@ -1,6 +1,6 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{E6555AEC-7F21-4A66-8EBC-8DD64AE99F97}</ProjectGuid>
<ProjectGuid>{E6A4B7A1-B3A2-4C22-944E-3C7244B1DD26}</ProjectGuid>
<MainSource>cv_SegmentImage.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>

2
samples/LibDemo/cvSum/cv_Sum.dproj
View File

@ -1,6 +1,6 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{1182C644-116C-49CE-9AA6-86129B93A971}</ProjectGuid>
<ProjectGuid>{6E82B8F0-7F0C-4B32-BADA-80AA57FAF93A}</ProjectGuid>
<MainSource>cv_Sum.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>

32
samples/MultiDemo.groupproj
View File

@ -66,7 +66,10 @@
<Projects Include="MultiDemo\VideoProcessing\VideoProcessing.dproj">
<Dependencies/>
</Projects>
<Projects Include="MultiDemo\FaceRecog\FaceRecog.dproj">
<Projects Include="MultiDemo\FaceDetect\FaceDetect2.dproj">
<Dependencies/>
</Projects>
<Projects Include="MultiDemo\ObjectTracking\ObjectTrack.dproj">
<Dependencies/>
</Projects>
</ItemGroup>
@ -266,23 +269,32 @@
<Target Name="VideoProcessing:Make">
<MSBuild Projects="MultiDemo\VideoProcessing\VideoProcessing.dproj" Targets="Make"/>
</Target>
<Target Name="FaceRecog">
<MSBuild Projects="MultiDemo\FaceRecog\FaceRecog.dproj"/>
<Target Name="FaceDetect2">
<MSBuild Projects="MultiDemo\FaceDetect\FaceDetect2.dproj"/>
</Target>
<Target Name="FaceRecog:Clean">
<MSBuild Projects="MultiDemo\FaceRecog\FaceRecog.dproj" Targets="Clean"/>
<Target Name="FaceDetect2:Clean">
<MSBuild Projects="MultiDemo\FaceDetect\FaceDetect2.dproj" Targets="Clean"/>
</Target>
<Target Name="FaceRecog:Make">
<MSBuild Projects="MultiDemo\FaceRecog\FaceRecog.dproj" Targets="Make"/>
<Target Name="FaceDetect2:Make">
<MSBuild Projects="MultiDemo\FaceDetect\FaceDetect2.dproj" Targets="Make"/>
</Target>
<Target Name="ObjectTrack">
<MSBuild Projects="MultiDemo\ObjectTracking\ObjectTrack.dproj"/>
</Target>
<Target Name="ObjectTrack:Clean">
<MSBuild Projects="MultiDemo\ObjectTracking\ObjectTrack.dproj" Targets="Clean"/>
</Target>
<Target Name="ObjectTrack:Make">
<MSBuild Projects="MultiDemo\ObjectTracking\ObjectTrack.dproj" Targets="Make"/>
</Target>
<Target Name="Build">
<CallTarget Targets="simplAR;CameraCalibrate;CameraCaptureAndFindContours;CameraShift;CarNumDetect;FaceDetect;fback_c;FrameRecon;HandsDetect;HelloWorld;IPCamVideoCapture;LockWorkstation;minarea;mmdt;MotionDetect;Squares;Stereo;TrackColor;TwoCameras_C;TwoCameras_C_Thread;VideoProcessing;FaceRecog"/>
<CallTarget Targets="simplAR;CameraCalibrate;CameraCaptureAndFindContours;CameraShift;CarNumDetect;FaceDetect;fback_c;FrameRecon;HandsDetect;HelloWorld;IPCamVideoCapture;LockWorkstation;minarea;mmdt;MotionDetect;Squares;Stereo;TrackColor;TwoCameras_C;TwoCameras_C_Thread;VideoProcessing;FaceDetect2;ObjectTrack"/>
</Target>
<Target Name="Clean">
<CallTarget Targets="simplAR:Clean;CameraCalibrate:Clean;CameraCaptureAndFindContours:Clean;CameraShift:Clean;CarNumDetect:Clean;FaceDetect:Clean;fback_c:Clean;FrameRecon:Clean;HandsDetect:Clean;HelloWorld:Clean;IPCamVideoCapture:Clean;LockWorkstation:Clean;minarea:Clean;mmdt:Clean;MotionDetect:Clean;Squares:Clean;Stereo:Clean;TrackColor:Clean;TwoCameras_C:Clean;TwoCameras_C_Thread:Clean;VideoProcessing:Clean;FaceRecog:Clean"/>
<CallTarget Targets="simplAR:Clean;CameraCalibrate:Clean;CameraCaptureAndFindContours:Clean;CameraShift:Clean;CarNumDetect:Clean;FaceDetect:Clean;fback_c:Clean;FrameRecon:Clean;HandsDetect:Clean;HelloWorld:Clean;IPCamVideoCapture:Clean;LockWorkstation:Clean;minarea:Clean;mmdt:Clean;MotionDetect:Clean;Squares:Clean;Stereo:Clean;TrackColor:Clean;TwoCameras_C:Clean;TwoCameras_C_Thread:Clean;VideoProcessing:Clean;FaceDetect2:Clean;ObjectTrack:Clean"/>
</Target>
<Target Name="Make">
<CallTarget Targets="simplAR:Make;CameraCalibrate:Make;CameraCaptureAndFindContours:Make;CameraShift:Make;CarNumDetect:Make;FaceDetect:Make;fback_c:Make;FrameRecon:Make;HandsDetect:Make;HelloWorld:Make;IPCamVideoCapture:Make;LockWorkstation:Make;minarea:Make;mmdt:Make;MotionDetect:Make;Squares:Make;Stereo:Make;TrackColor:Make;TwoCameras_C:Make;TwoCameras_C_Thread:Make;VideoProcessing:Make;FaceRecog:Make"/>
<CallTarget Targets="simplAR:Make;CameraCalibrate:Make;CameraCaptureAndFindContours:Make;CameraShift:Make;CarNumDetect:Make;FaceDetect:Make;fback_c:Make;FrameRecon:Make;HandsDetect:Make;HelloWorld:Make;IPCamVideoCapture:Make;LockWorkstation:Make;minarea:Make;mmdt:Make;MotionDetect:Make;Squares:Make;Stereo:Make;TrackColor:Make;TwoCameras_C:Make;TwoCameras_C_Thread:Make;VideoProcessing:Make;FaceDetect2:Make;ObjectTrack:Make"/>
</Target>
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
</Project>

2
samples/MultiDemo/Augmented reality/simplAR.dpr
View File

@ -247,7 +247,7 @@ begin
cvLine(image, pp[3], pp[0], CV_RGB(255, 255, 0), 2);
// or simply
// cvDrawChessboardCorners(image, b_size, corners, corner_count, found);
cvDrawChessboardCorners(image, b_size, corners, corner_count, found);
cvShowImage('Video', image);
end;

367
samples/MultiDemo/FaceRecog/FaceRecog.dpr
View File

@ -1,367 +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.
// *******************************************************************
// Original: http://pebibyte.wordpress.com/2011/01/21/simple-face-recognition-using-opencv/
// *******************************************************************
program FaceRecog;
{$APPTYPE CONSOLE}
{$POINTERMATH ON}
{$R *.res}
uses
System.Character,
System.SysUtils,
System.Classes,
highgui_c,
core_c,
Core.types_c,
imgproc_c,
imgproc.types_c,
legacy,
cvUtils,
objdetect;
Var
/// / Global variables
nTrainFaces : Integer = 0; // number of training images
nEigens : Integer = 0; // number of eigenvalues
faceImgArr : array of pIplImage; // array of face images
personNumTruthMat : pCvMat = nil; // array of person numbers
pAvgTrainImg : pIplImage = nil; // the average image
eigenVectArr : array of pIplImage; // eigenvectors
eigenValMat : pCvMat = nil; // eigenvalues
projectedTrainFaceMat: pCvMat = nil; // projected training faces
function loadFaceImgArray(const Filename: String): Integer;
Var
S: TStringList;
i: Integer;
begin
Result := 0;
S := TStringList.Create;
try
if FileExists(Filename) then
begin
S.LoadFromFile(Filename);
Result := S.Count;
SetLength(
faceImgArr,
Result);
personNumTruthMat := cvCreateMat(
1,
Result,
CV_32SC1);
for i := 0 to Result - 1 do
begin
PInteger(personNumTruthMat^.data)[i] := i;
faceImgArr[i] := cvLoadImage(
c_str(S[i]),
CV_LOAD_IMAGE_GRAYSCALE);
end;
end;
finally
S.Free;
end;
end;
procedure doPCA();
Var
i : Integer;
calcLimit : TCvTermCriteria;
faceImgSize: TCvSize;
begin
// set the number of eigenvalues to use
nEigens := nTrainFaces - 1;
// allocate the eigenvector images
faceImgSize.width := faceImgArr[0]^.width;
faceImgSize.height := faceImgArr[0]^.height;
SetLength(
eigenVectArr,
nEigens);
for i := 0 to nEigens - 1 do
eigenVectArr[i] := cvCreateImage(
faceImgSize,
IPL_DEPTH_32F,
1);
// allocate the eigenvalue array
eigenValMat := cvCreateMat(
1,
nEigens,
CV_32FC1);
// allocate the averaged image
pAvgTrainImg := cvCreateImage(
faceImgSize,
IPL_DEPTH_32F,
1);
// set the PCA termination criterion
calcLimit := cvTermCriteria(
CV_TERMCRIT_ITER,
nEigens,
1);
// compute average image, eigenvalues, and eigenvectors
cvCalcEigenObjects(
nTrainFaces,
faceImgArr,
eigenVectArr,
CV_EIGOBJ_NO_CALLBACK,
0,
0,
@calcLimit,
pAvgTrainImg,
pFloat(eigenValMat^.data));
end;
procedure StoreTrainingData();
Var
fileStorage: pCvFileStorage;
i : Integer;
varname : AnsiString;
begin
// create a file-storage interface
fileStorage := cvOpenFileStorage(
'faces\facedata.xml',
0,
CV_STORAGE_WRITE);
// store all the data
cvWriteInt(
fileStorage,
'nEigens',
nEigens);
cvWriteInt(
fileStorage,
'nTrainFaces',
nTrainFaces);
cvWrite(
fileStorage,
'trainPersonNumMat',
personNumTruthMat,
cvAttrList(0, 0));
cvWrite(
fileStorage,
'eigenValMat',
eigenValMat,
cvAttrList(0, 0));
cvWrite(
fileStorage,
'projectedTrainFaceMat',
projectedTrainFaceMat,
cvAttrList(0, 0));
cvWrite(
fileStorage,
'avgTrainImg',
pAvgTrainImg,
cvAttrList(0, 0));
for i := 0 to nEigens - 1 do
begin
varname := 'eigenVect_' + IntToStr(i);
cvWrite(
fileStorage,
c_str(varname),
eigenVectArr[i],
cvAttrList(0, 0));
end;
// release the file-storage interface
cvReleaseFileStorage(fileStorage);
end;
procedure learn;
var
i: Integer;
begin
// load training data
nTrainFaces := loadFaceImgArray(ParamStr(2));
if (nTrainFaces < 2) then
begin
WriteLn('Need 2 or more training faces');
WriteLn(
'Input file contains only ',
nTrainFaces);
Exit;
end;
// do PCA on the training faces
doPCA;
// project the training images onto the PCA subspace
projectedTrainFaceMat := cvCreateMat(
nTrainFaces,
nEigens,
CV_32FC1);
for i := 0 to nTrainFaces - 1 do
begin
cvEigenDecomposite(
faceImgArr[i],
nEigens,
eigenVectArr,
0,
0,
pAvgTrainImg,
pFloat(projectedTrainFaceMat^.data) + i * nEigens);
end;
// store the recognition data as an xml file
storeTrainingData();
end;
function loadTrainingData(Var pTrainPersonNumMat: pCvMat): Boolean;
Var
fileStorage: pCvFileStorage;
i : Integer;
varname : String;
begin
// create a file-storage interface
fileStorage := cvOpenFileStorage(
'faces\facedata.xml',
0,
CV_STORAGE_READ);
if not Assigned(fileStorage) then
begin
WriteLn('Can''t open facedata.xml');
Exit(False);
end;
nEigens := cvReadIntByName(
fileStorage,
0,
'nEigens',
0);
nTrainFaces := cvReadIntByName(
fileStorage,
0,
'nTrainFaces',
0);
pTrainPersonNumMat := pCvMat(cvReadByName(fileStorage, 0, 'trainPersonNumMat', 0));
eigenValMat := pCvMat(cvReadByName(fileStorage, 0, 'eigenValMat', 0));
projectedTrainFaceMat := pCvMat(cvReadByName(fileStorage, 0, 'projectedTrainFaceMat', 0));
pAvgTrainImg := pIplImage(cvReadByName(fileStorage, 0, 'avgTrainImg', 0));
SetLength(
eigenVectArr,
nEigens);
for i := 0 to nEigens - 1 do
begin
varname := 'eigenVect_' + IntToStr(i);
eigenVectArr[i] := pIplImage(cvReadByName(fileStorage, 0, c_str(varname), 0));
end;
// release the file-storage interface
cvReleaseFileStorage(fileStorage);
Result := True;
end;
function findNearestNeighbor(projectedTestFace: array of Float): Integer;
Var
leastDistSq : double;
i, iTrain, iNearest: Integer;
distSq : double;
d_i : Float;
begin
leastDistSq := DBL_MAX;
iNearest := 0;
for iTrain := 0 to nTrainFaces - 1 do
begin
distSq := 0;
for i := 0 to nEigens - 1 do
begin
d_i := projectedTestFace[i] - pFloat(projectedTrainFaceMat^.data)[iTrain * nEigens + i];
distSq := distSq + d_i * d_i / pFloat(eigenValMat^.data)[i];
end;
if (distSq < leastDistSq) then
begin
leastDistSq := distSq;
iNearest := iTrain;
end;
end;
Result := iNearest;
end;
function Recognize(const TestFace:pIplImage;Var ParsonName:String):Boolean;
Var
i, nTestFaces : Integer; // the number of test images
trainPersonNumMat : pCvMat; // the person numbers during training
projectedTestFace : array of Float;
iNearest, nearest, truth: Integer;
begin
nTestFaces := 0; // the number of test images
trainPersonNumMat := nil; // the person numbers during training
projectedTestFace := nil;
// load the saved training data
if not loadTrainingData(trainPersonNumMat) then
Exit(False);
// project the test images onto the PCA subspace
SetLength(
projectedTestFace,
nEigens);
// project the test image onto the PCA subspace
cvEigenDecomposite(
TestFace,
nEigens,
@eigenVectArr[0],
CV_EIGOBJ_NO_CALLBACK,
nil,
pAvgTrainImg,
@projectedTestFace[0]);
iNearest := findNearestNeighbor(projectedTestFace);
truth := PInteger(personNumTruthMat^.data)[iNearest];
nearest := PInteger(trainPersonNumMat^.data)[iNearest];
end;
procedure printUsage();
begin
WriteLn('Usage: eigenface <command>');
WriteLn(' Valid commands are');
WriteLn(' train faces\train.txt');
WriteLn(' test faces\test.txt');
end;
begin
try
// validate that an input was specified
if ParamCount <> 2 then
printUsage()
else if SameText(ParamStr(1), 'train') then
learn
else if SameText(ParamStr(1), 'test') then
recognize
else
WriteLn(
'Unknown command: ',
ParamStr(1));
except
on E: Exception do
WriteLn(
E.ClassName,
': ',
E.Message);
end;
end.

141
samples/MultiDemo/FaceRecog/FaceRecog.dproj
View File

@ -1,141 +0,0 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{6E9B04C9-6DA3-4D05-AD4A-0BB6739E538D}</ProjectGuid>
<MainSource>FaceRecog.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Console</AppType>
<FrameworkType>None</FrameworkType>
<ProjectVersion>14.6</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_E>false</DCC_E>
<DCC_S>false</DCC_S>
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace>
<Manifest_File>None</Manifest_File>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
<DCC_ExeOutput>..\..\..\bin\</DCC_ExeOutput>
<VerInfo_Locale>1049</VerInfo_Locale>
<DCC_N>false</DCC_N>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=;CFBundleDisplayName=;CFBundleIdentifier=;CFBundleVersion=;CFBundlePackageType=;CFBundleSignature=;CFBundleAllowMixedLocalizations=;CFBundleExecutable=</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>false</DCC_DebugInformation>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_Optimize>false</DCC_Optimize>
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<Debugger_RunParams>test faces\test.txt</Debugger_RunParams>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">FaceRecog.dpr</Source>
</Source>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">0</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
<VersionInfo Name="Private">False</VersionInfo>
<VersionInfo Name="DLL">False</VersionInfo>
<VersionInfo Name="Locale">1049</VersionInfo>
<VersionInfo Name="CodePage">1251</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName"/>
<VersionInfoKeys Name="FileDescription"/>
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName"/>
<VersionInfoKeys Name="LegalCopyright"/>
<VersionInfoKeys Name="LegalTrademarks"/>
<VersionInfoKeys Name="OriginalFilename"/>
<VersionInfoKeys Name="ProductName"/>
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments"/>
<VersionInfoKeys Name="CFBundleName"/>
<VersionInfoKeys Name="CFBundleDisplayName"/>
<VersionInfoKeys Name="CFBundleIdentifier"/>
<VersionInfoKeys Name="CFBundleVersion"/>
<VersionInfoKeys Name="CFBundlePackageType"/>
<VersionInfoKeys Name="CFBundleSignature"/>
<VersionInfoKeys Name="CFBundleAllowMixedLocalizations"/>
<VersionInfoKeys Name="CFBundleExecutable"/>
</VersionInfoKeys>
</Delphi.Personality>
<Platforms>
<Platform value="OSX32">False</Platform>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>

BIN
samples/MultiDemo/FaceRecog/FaceRecog.res
View File

Binary file not shown.

60
samples/MultiDemo/IPCamVideoCapture/IPCamVideoCapture.dpr
View File

@ -1,28 +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.
******************************************************************* *)
// 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.
// ******************************************************************
program IPCamVideoCapture;
uses
@ -35,7 +33,8 @@ uses
const
// See http://www.ispyconnect.com
VIDEO_FILE_NAME = 'rtsp://192.168.0.200:554/mpeg4';
VIDEO_FILE_NAME = 'rtsp://192.168.0.202:554/cam/realmonitor?channel=1&subtype=0&unicast=true&proto=Onvif';
//'rtsp://192.168.0.200:554/mpeg4';
// declare escape char
ESCAPE_CHAR = 27;
@ -78,7 +77,9 @@ begin
// is is called...)
if Assigned(frame) then
// show frame in window
cvShowImage('video', frame);
cvShowImage(
'video',
frame);
// wait for user key, delay is in msec so 1000msec = 1sec wait period
key := cvWaitKey(10);
end;
@ -89,7 +90,10 @@ begin
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
Writeln(
E.ClassName,
': ',
E.Message);
end;
end.

703
samples/MultiDemo/ObjectTracking/!Work/ObjectTrack.dpr Normal file
View File

@ -0,0 +1,703 @@
// *****************************************************************
// Delphi-OpenCV Class 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.
// *******************************************************************
program ObjectTrack;
{$APPTYPE CONSOLE}
{$POINTERMATH ON}
{$R *.res}
uses
System.Math,
System.SysUtils,
System.Classes,
core_c,
highgui_c,
imgproc_c,
imgproc.types_c,
core.types_c,
cvUtils;
// default capture width and height
const
FRAME_WIDTH = 640;
FRAME_HEIGHT = 480;
// max number of objects to be detected in frame
MAX_NUM_OBJECTS = 50;
// minimum and maximum object area
MIN_OBJECT_AREA = 20 * 20;
MAX_OBJECT_AREA = FRAME_HEIGHT * FRAME_WIDTH / 1.5;
// names that will appear at the top of each window
windowName = 'Original Image';
windowName1 = 'HSV Image';
windowName2 = 'Thresholded Image';
windowName3 = 'After Morphological Operations';
trackbarWindowName = 'Trackbars';
Var
// initial min and max HSV filter values.
// these will be changed using trackbars
H_MIN : integer = 170; // 0;
H_MAX : integer = 180;
CH_MAX: integer = 256;
S_MIN : integer = 160; // 0;
S_MAX : integer = 256;
CS_MAX: integer = 256;
V_MIN : integer = 60; // 0;
V_MAX : integer = 256;
CV_MAX: integer = 256;
procedure on_trackbar(i: integer); cdecl;
begin
// This function gets called whenever a
// trackbar position is changed
end;
procedure createTrackbars;
begin
// create window for trackbars
cvNamedWindow(
trackbarWindowName,
0);
/// /create memory to store trackbar name on window
// char TrackbarName[50];
// sprintf( TrackbarName, 'H_MIN', H_MIN);
// sprintf( TrackbarName, 'H_MAX', H_MAX);
// sprintf( TrackbarName, 'S_MIN', S_MIN);
// sprintf( TrackbarName, 'S_MAX', S_MAX);
// sprintf( TrackbarName, 'V_MIN', V_MIN);
// sprintf( TrackbarName, 'V_MAX', V_MAX);
// create trackbars and insert them into window
// 3 parameters are: the address of the variable that is changing when the trackbar is moved(eg.H_LOW),
// the max value the trackbar can move (eg. H_HIGH),
// and the function that is called whenever the trackbar is moved(eg. on_trackbar)
// ----> ----> ---->
cvCreateTrackbar(
'H_MIN',
trackbarWindowName,
@H_MIN,
CH_MAX,
on_trackbar);
cvCreateTrackbar(
'H_MAX',
trackbarWindowName,
@H_MAX,
CH_MAX,
on_trackbar);
cvCreateTrackbar(
'S_MIN',
trackbarWindowName,
@S_MIN,
CS_MAX,
on_trackbar);
cvCreateTrackbar(
'S_MAX',
trackbarWindowName,
@S_MAX,
CS_MAX,
on_trackbar);
cvCreateTrackbar(
'V_MIN',
trackbarWindowName,
@V_MIN,
CV_MAX,
on_trackbar);
cvCreateTrackbar(
'V_MAX',
trackbarWindowName,
@V_MAX,
CV_MAX,
on_trackbar);
end;
procedure drawObject(x: integer; y: integer; frame: pIplImage);
Var
font: TCvFont;
begin
// use some of the openCV drawing functions to draw crosshairs
// on your tracked image!
// added 'if' and 'else' statements to prevent
// memory errors from writing off the screen (ie. (-25,-25) is not within the window!)
cvCircle(
frame,
cvPoint(x, y),
20,
cvScalar(0, 255, 0),
2);
if (y - 25) > 0 then
cvLine(
frame,
cvPoint(x, y),
cvPoint(x, y - 25),
cvScalar(0, 255, 0),
2)
else
cvLine(
frame,
cvPoint(x, y),
cvPoint(x, 0),
cvScalar(0, 255, 0),
2);
if (y + 25) < FRAME_HEIGHT then
cvLine(
frame,
cvPoint(x, y),
cvPoint(x, y + 25),
cvScalar(0, 255, 0),
2)
else
cvLine(
frame,
cvPoint(x, y),
cvPoint(x, FRAME_HEIGHT),
cvScalar(0, 255, 0),
2);
if (x - 25) > 0 then
cvLine(
frame,
cvPoint(x, y),
cvPoint(x - 25, y),
cvScalar(0, 255, 0),
2)
else
cvLine(
frame,
cvPoint(x, y),
cvPoint(0, y),
cvScalar(0, 255, 0),
2);
if (x + 25) < FRAME_WIDTH then
cvLine(
frame,
cvPoint(x, y),
cvPoint(x + 25, y),
cvScalar(0, 255, 0),
2)
else
cvLine(
frame,
cvPoint(x, y),
cvPoint(FRAME_WIDTH, y),
cvScalar(0, 255, 0),
2);
cvInitFont(
@font,
CV_FONT_HERSHEY_COMPLEX,
1.0,
1.0,
0,
1,
CV_AA);
cvPutText(
frame,
c_str(intToStr(x) + ',' + intToStr(y)),
cvPoint(x, y + 30),
@font,
cvScalar(0, 255, 0));
end;
procedure morphOps(thresh: pIplImage);
Var
erodeElement, dilateElement: pIplConvKernel;
begin
// create structuring element that will be used to "dilate" and "erode" image.
// the element chosen here is a 3px by 3px rectangle
erodeElement := cvCreateStructuringElementEx(
3,
3,
1,
1,
CV_SHAPE_RECT);
// dilate with larger element so make sure object is nicely visible
dilateElement := cvCreateStructuringElementEx(
8,
8,
3,
3,
CV_SHAPE_RECT);
cvErode(
thresh,
thresh,
erodeElement,
2);
cvDilate(
thresh,
thresh,
dilateElement,
2);
cvReleaseStructuringElement(erodeElement);
cvReleaseStructuringElement(dilateElement);
end;
Type
TContours = TArray<TArray<pCvPoint2D32f>>;
TVec4<T> = array [0 .. 3] of T;
TVec4i = TVec4<integer>;
THierarchy = TArray<TVec4i>;
function Vec4i(const v0, v1, v2, v3: integer): TVec4i;
begin
Result[0] := v0;
Result[1] := v1;
Result[2] := v2;
Result[3] := v3;
end;
procedure cfindContours(image: pIplImage; Var _contours: TContours; Var _hierarchy: THierarchy; mode, method: integer;
offset: TcvPoint);
Var
storage : pCvMemStorage;
_cimage : pIplImage;
_ccontours : pCvSeq;
all_contours, ps: pCvSeq;
j, i, total : integer;
tree_iterator : TCvTreeNodeIterator;
h_next, //
h_prev, //
v_next, //
v_prev: integer;
reader : TCvSeqReader;
Count : integer;
begin
storage := cvCreateMemStorage(0);
_cimage := cvCloneImage(image);
_ccontours := nil;
// SetLength(
// _hierarchy,
// 0);
cvFindContours(
_cimage,
storage,
@_ccontours,
sizeof(TCvContour),
mode,
method,
offset);
if not Assigned(_ccontours) then
begin
cvReleaseMemStorage(storage);
cvReleaseImage(_cimage);
SetLength(
_contours,
0);
Exit;
end;
all_contours := cvTreeToNodeSeq(
_ccontours,
sizeof(TCvSeq),
storage);
ps := all_contours;
total := 0;
While Assigned(ps) do
begin
Inc(total);
ps := ps^.h_next;
end;
SetLength(
_contours,
total);
SetLength(
_hierarchy,
total);
cvInitTreeNodeIterator(
tree_iterator,
all_contours,
3);
ps := cvNextTreeNode(@tree_iterator);
j := 0;
while Assigned(ps) do
begin
// pCvContour(ps)^.color := i;
Count := ps^.total;
cvStartReadSeq(
ps,
@reader);
if not CV_IS_SEQ_CLOSED(ps) then
Count := Count - 1;
SetLength(
_contours[j],
Count);
for i := 0 to Count - 1 do
begin
CV_READ_SEQ_ELEM(
@_contours[j][i],
reader,
sizeof(_contours[j][0]));
end;
ps := cvNextTreeNode(@tree_iterator);
Inc(j);
end;
// for i := 0 to total - 1 do
// begin
// ps := cvNextTreeNode(@tree_iterator);
// pCvContour(ps)^.color := i;
// Count := ps^.total;
// cvStartReadSeq(
// ps,
// @reader);
// if not CV_IS_SEQ_CLOSED(ps) then
// Count := Count - 1;
// CV_READ_SEQ_ELEM(
// pt,
// reader);
//
// _contours[i] := AllocMem(ps^.total * sizeof(TCvPoint2D32f));
// // Mat ci = _contours.getMat(i);
// // return (flags & Mat::CONTINUOUS_FLAG) != 0;
// // CV_Assert(ci.isContinuous());
// if ps^.h_next <> nil then
// cvCvtSeqToArray(
// ps,
// @_contours[i],
// CV_WHOLE_SEQ);
//
// h_next := ifthen(
// Assigned(ps^.h_next),
// pCvContour(ps^.h_next)^.color,
// -1);
// h_prev := ifthen(
// Assigned(ps^.h_prev),
// pCvContour(ps^.h_prev)^.color,
// -1);
// v_next := ifthen(
// Assigned(ps^.v_next),
// pCvContour(ps^.v_next)^.color,
// -1);
// v_prev := ifthen(
// Assigned(ps^.v_prev),
// pCvContour(ps^.v_prev)^.color,
// -1);
// _hierarchy[i] := Vec4i(
// h_next,
// h_prev,
// v_next,
// v_prev);
// end;
end;
Var
// Matrix to store each frame of the webcam feed
cameraFeed: pIplImage;
procedure findContours(const image: pIplImage; var contours: TContours; Var hierarchy: THierarchy;
mode, method: integer);
Var
_hierarchy : pCvMemStorage;
_contours : pCvSeq;
dst_th : pIplImage;
contoursCont: integer;
l_pt0, l_pt1: TcvPoint;
l_reader : TCvSeqReader;
l_iterator : TCvTreeNodeIterator;
i : integer;
begin
_hierarchy := cvCreateMemStorage(0);
dst_th := cvCreateImage(
cvGetSize(image),
IPL_DEPTH_8U,
1);
cvThreshold(
image,
dst_th,
128,
255,
// CV_THRESH_BINARY_INV
CV_THRESH_BINARY);
cvSmooth(
dst_th, // function input
dst_th, // function output
CV_GAUSSIAN, // use Gaussian filter (average nearby pixels, with closest pixels weighted more)
9, // smoothing filter window width
9); // smoothing filter window height
_contours := nil;
SetLength(
contours,
0);
SetLength(
hierarchy,
0);
contoursCont := cvFindContours(
dst_th,
_hierarchy,
@_contours,
sizeof(TCvContour),
mode,
method,
cvPoint(0, 0));
// cvInitTreeNodeIterator(
// l_iterator,
// _contours,
// 1);
// _contours := cvNextTreeNode(@l_iterator);
// while Assigned(_contours) do
// begin
// cvStartReadSeq(
// _contours,
// @l_reader,
// 0);
// // Ïåðâàÿ òî÷êà
// CV_READ_SEQ_ELEM(
// @l_pt0,
// l_reader,
// sizeof(l_pt0));
// // l_pts1.push_back(l_pt0);
// for i := 0 to _contours^.total - 1 do
// begin
// // Ïîñëåäóþùèå òî÷êè
// CV_READ_SEQ_ELEM(
// @l_pt1,
// l_reader,
// sizeof(l_pt0));
// cvLine(
// cameraFeed,
// l_pt0,
// l_pt1,
// CV_RGB(0, 255, 0),
// 2);
// l_pt0 := l_pt1;
// // l_pts1.push_back(l_pt0);
// end;
// _contours := cvNextTreeNode(@l_iterator);
// end;
if contoursCont > 0 then
While Assigned(_contours) do
begin
// if CV_IS_SEQ_CLOSED(_contours) then
cvDrawContours(
cameraFeed,
_contours,
CV_RGB(52, 201, 36),
CV_RGB(36, 201, 197),
-1,
CV_FILLED,
CV_AA,
cvPoint(0, 0)); // ðèñóåì êîíòóð
_contours := _contours^.h_next;
end;
cvReleaseMemStorage(_hierarchy);
cvReleaseImage(dst_th);
end;
procedure trackFilteredObject(Var x, y: integer; threshold: pIplImage; var cameraFeed: pIplImage);
Var
temp, dst: pIplImage;
index : integer;
// these two vectors needed for output of findContours
contours : TContours;
hierarchy : THierarchy;
refArea : double;
objectFound: Boolean;
numObjects : integer;
area : double;
// moment : IMoments;
begin
// find contours of filtered image using openCV findContours function
findContours(
threshold,
contours,
hierarchy,
CV_RETR_EXTERNAL,
CV_CHAIN_APPROX_SIMPLE);
// use moments method to find our filtered object
refArea := 0;
objectFound := false;
//
// // if hierarchy.block_size>0 then
// begin
// numObjects := Length(hierarchy);
// // if number of objects greater than MAX_NUM_OBJECTS we have a noisy filter
// if (numObjects < MAX_NUM_OBJECTS) then
// begin
// index := 0;
// While index >= 0 do
// begin
// moment := Moments((cv: : Mat)contours[index]);
// area := moment.m00;
// // if the area is less than 20 px by 20px then it is probably just noise
// // if the area is the same as the 3/2 of the image size, probably just a bad filter
// // we only want the object with the largest area so we safe a reference area each
// // iteration and compare it to the area in the next iteration.
// if (area > MIN_OBJECT_AREA) and (area < MAX_OBJECT_AREA) and (area > refArea) then
// begin
// x := moment.m10 / area;
// y := moment.m01 / area;
// objectFound = true;
// end
// else
// objectFound = false;
// index := hierarchy[index][0];
// end;
// // let user know you found an object
// if (objectFound = = true) then
// begin
// putText(
// cameraFeed,
// 'Tracking Object',
// cvPoint(0, 50),
// 2,
// 1,
// cvScalar(0, 255, 0),
// 2);
// // draw object location on screen
// drawObject(
// x,
// y,
// cameraFeed);
// end;
//
// end
// else
// putText(
// cameraFeed,
// 'TOO MUCH NOISE! ADJUST FILTER',
// cvPoint(0, 50),
// 1,
// 2,
// cvScalar(0, 0, 255),
// 2);
// end;
end;
Var
// some boolean variables for different functionality within this program
trackObjects: Boolean = true;
useMorphOps : Boolean = true;
// matrix storage for HSV image
HSV: pIplImage = nil;
// matrix storage for binary threshold image
threshold: pIplImage = nil;
// x and y values for the location of the object
x: integer = 0;
y: integer = 0;
// video capture object to acquire webcam feed
capture: pCvCapture;
begin
try
// create slider bars for HSV filtering
createTrackbars();
// open capture object at location zero (default location for webcam)
capture := cvCreateCameraCapture(CV_CAP_ANY);
Assert(Assigned(capture));
// set height and width of capture frame
cvSetCaptureProperty(
capture,
CV_CAP_PROP_FRAME_WIDTH,
FRAME_WIDTH);
cvSetCaptureProperty(
capture,
CV_CAP_PROP_FRAME_HEIGHT,
FRAME_HEIGHT);
// start an infinite loop where webcam feed is copied to cameraFeed matrix
// all of our operations will be performed within this loop
while true do
begin
// store image to matrix
repeat
cameraFeed := cvQueryFrame(capture);
until Assigned(cameraFeed);
// convert frame from BGR to HSV colorspace
if not Assigned(HSV) then
HSV := cvCreateImage(
cvGetSize(cameraFeed),
8,
3);
cvCvtColor(
cameraFeed,
HSV,
CV_BGR2HSV);
// filter HSV image between values and store filtered image to
// threshold matrix
if not Assigned(threshold) then
threshold := cvCreateImage(
cvGetSize(cameraFeed),
8,
1);
cvInRangeS(
HSV,
cvScalar(H_MIN, S_MIN, V_MIN),
cvScalar(H_MAX, S_MAX, V_MAX),
threshold);
// perform morphological operations on thresholded image to eliminate noise
// and emphasize the filtered object(s)
if useMorphOps then
morphOps(threshold);
// pass in thresholded frame to our object tracking function
// this function will return the x and y coordinates of the
// filtered object
if trackObjects then
trackFilteredObject(
x,
y,
threshold,
cameraFeed);
// show frames
cvShowImage(
windowName2,
threshold);
cvShowImage(
windowName,
cameraFeed);
cvShowImage(
windowName1,
HSV);
// delay 30ms so that screen can refresh.
// image will not appear without this waitKey() command
if cvWaitKey(30) = 27 then
Break;
end;
if Assigned(capture) then
cvReleaseCapture(capture);
if Assigned(HSV) then
cvReleaseImage(HSV);
if Assigned(threshold) then
cvReleaseImage(threshold);
except
on E: Exception do
WriteLn(
E.ClassName,
': ',
E.Message);
end;
end.

18
samples/VCLDemo.groupproj
View File

@ -18,6 +18,9 @@
<Projects Include="VCLDemo\vclIPCameraCapture\VCLIPCameraCapture.dproj">
<Dependencies/>
</Projects>
<Projects Include="VCLDemo\vclOpenCVandOpenGL\vclOCVaOGL.dproj">
<Dependencies/>
</Projects>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Default.Personality.12</Borland.Personality>
@ -71,14 +74,23 @@
<Target Name="VCLIPCameraCapture:Make">
<MSBuild Projects="VCLDemo\vclIPCameraCapture\VCLIPCameraCapture.dproj" Targets="Make"/>
</Target>
<Target Name="vclOCVaOGL">
<MSBuild Projects="VCLDemo\vclOpenCVandOpenGL\vclOCVaOGL.dproj"/>
</Target>
<Target Name="vclOCVaOGL:Clean">
<MSBuild Projects="VCLDemo\vclOpenCVandOpenGL\vclOCVaOGL.dproj" Targets="Clean"/>
</Target>
<Target Name="vclOCVaOGL:Make">
<MSBuild Projects="VCLDemo\vclOpenCVandOpenGL\vclOCVaOGL.dproj" Targets="Make"/>
</Target>
<Target Name="Build">
<CallTarget Targets="VCLCameraCapture;VCLChessboardCorners;vclColorTracking;vclPCArecognition;VCLIPCameraCapture"/>
<CallTarget Targets="VCLCameraCapture;VCLChessboardCorners;vclColorTracking;vclPCArecognition;VCLIPCameraCapture;vclOCVaOGL"/>
</Target>
<Target Name="Clean">
<CallTarget Targets="VCLCameraCapture:Clean;VCLChessboardCorners:Clean;vclColorTracking:Clean;vclPCArecognition:Clean;VCLIPCameraCapture:Clean"/>
<CallTarget Targets="VCLCameraCapture:Clean;VCLChessboardCorners:Clean;vclColorTracking:Clean;vclPCArecognition:Clean;VCLIPCameraCapture:Clean;vclOCVaOGL:Clean"/>
</Target>
<Target Name="Make">
<CallTarget Targets="VCLCameraCapture:Make;VCLChessboardCorners:Make;vclColorTracking:Make;vclPCArecognition:Make;VCLIPCameraCapture:Make"/>
<CallTarget Targets="VCLCameraCapture:Make;VCLChessboardCorners:Make;vclColorTracking:Make;vclPCArecognition:Make;VCLIPCameraCapture:Make;vclOCVaOGL:Make"/>
</Target>
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
</Project>

4
samples/VCLDemo/vclChessboardCorners/MainForm.dfm
View File

@ -50,7 +50,7 @@ object FormMain: TFormMain
Width = 75
Height = 25
Caption = 'Active'
TabOrder = 1
TabOrder = 2
OnClick = ButtonARClick
end
object ButtonShow: TButton
@ -59,7 +59,7 @@ object FormMain: TFormMain
Width = 75
Height = 25
Caption = 'Show cap. >>'
TabOrder = 2
TabOrder = 1
OnClick = ButtonShowClick
end
end

207
samples/VCLDemo/vclChessboardCorners/MainForm.pas
View File

@ -1,34 +1,43 @@
(* /*****************************************************************
// Delphi-OpenCV Demo
// Copyright (C) 2013 Project Delphi-OpenCV
// ****************************************************************
// Contributor:
// Samuele Trentin
// ****************************************************************
// 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.
******************************************************************* *)
// 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:
// Samuele Trentin
// ****************************************************************
// 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 MainForm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, highgui_c, core.types_c, Vcl.ExtCtrls, Vcl.StdCtrls;
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
highgui_c,
core.types_c,
Vcl.ExtCtrls,
Vcl.StdCtrls;
type
TFormMain = class(TForm)
@ -45,11 +54,11 @@ type
procedure ButtonShowClick(Sender: TObject);
private
{ Private declarations }
FCamCapture: pCvCapture;
FFrameBitmap: TBitmap;
FOverlaySize: TCvSize;
FbAR2D: boolean;
FCorner: array[0..100] of TCvPoint2D32f;
FCamCapture : pCvCapture;
FFrameBitmap : TBitmap;
FOverlaySize : TCvSize;
FbAR2D : boolean;
FCorner : array [0 .. 100] of TCvPoint2D32f;
FOverlayImage: pIplImage;
procedure OnIdle(Sender: TObject; var Done: boolean);
public
@ -62,17 +71,22 @@ var
implementation
{$R *.dfm}
uses
core_c, cvUtils, calib3d_c, imgproc_c, imgproc.types_c;
core_c,
cvUtils,
calib3d_c,
imgproc_c,
imgproc.types_c;
const
nWidthGrid= 9;
nWidthGrid = 9;
nHeightGrid = 6;
procedure TFormMain.ButtonCloseClick(Sender: TObject);
begin
Application.OnIdle := nil;
FbAR2D := False;
FbAR2D := False;
Close;
end;
@ -81,17 +95,17 @@ begin
ButtonShowClick(Self);
// Initialization
FbAR2D := False;
FbAR2D := False;
FOverlaySize.height := nHeightGrid - 1;
FOverlaySize.width := nWidthGrid - 1;
FOverlayImage := cvLoadImage('Resource\baboon.jpg');
FOverlaySize.width := nWidthGrid - 1;
FOverlayImage := cvLoadImage('Resource\baboon.jpg');
// Link to the first camera available
FCamCapture := cvCreateCameraCapture(CV_CAP_ANY);
if Assigned(FCamCapture) then
begin
// Structure for treating the images captured by camera
FFrameBitmap := TBitmap.Create;
FFrameBitmap := TBitmap.Create;
FFrameBitmap.PixelFormat := pf24bit;
// Show frame captured..
@ -111,11 +125,11 @@ end;
procedure TFormMain.OnIdle(Sender: TObject; var Done: boolean);
Var
frame: pIplImage;
nResult: Integer;
frame : pIplImage;
nResult : Integer;
resizeImg, blankImg, negImg, copyImg, greyImg: pIplImage;
p, q: pCvPoint2D32f;
warp_matrix: pCvMat;
p, q : pCvPoint2D32f;
warp_matrix : pCvMat;
begin
// Retrieve frame
frame := cvQueryFrame(FCamCapture);
@ -124,7 +138,9 @@ begin
// Show input
if ImageCaptured.Visible then
begin
IplImage2Bitmap(frame, FFrameBitmap);
IplImage2Bitmap(
frame,
FFrameBitmap);
ImageCaptured.Picture.Bitmap.Assign(FFrameBitmap);
end;
@ -133,17 +149,34 @@ begin
begin
try
// Create gray image from source
greyImg := cvCreateImage(cvGetSize(frame), IPL_DEPTH_8U, 1);
cvCvtColor(frame, greyImg, CV_BGR2GRAY);
nResult := cvCheckChessboard(greyImg, CvSize(nWidthGrid, nHeightGrid));
greyImg := cvCreateImage(
cvGetSize(frame),
IPL_DEPTH_8U,
1);
cvCvtColor(
frame,
greyImg,
CV_BGR2GRAY);
nResult := cvCheckChessboard(
greyImg,
CvSize(nWidthGrid, nHeightGrid));
if nResult > 0 then
begin
nResult := cvFindChessboardCorners(greyImg, FOverlaySize, @FCorner);
nResult := cvFindChessboardCorners(
greyImg,
FOverlaySize,
@FCorner);
if nResult > 0 then
begin
try
// Identifies the pattern from the gray image and saves the valid group of corners
cvFindCornerSubPix(greyImg, @FCorner, 40, CvSize(11,11), CvSize(-1,-1), CvTermCriteria(CV_TERMCRIT_EPS+CV_TERMCRIT_ITER, 40, 0.1));
cvFindCornerSubPix(
greyImg,
@FCorner,
40,
CvSize(11, 11),
CvSize(-1, -1),
CvTermCriteria(CV_TERMCRIT_EPS + CV_TERMCRIT_ITER, 40, 0.1));
// Set the source points
q := AllocMem(SizeOf(TCvPoint2D32f) * 4);
@ -164,7 +197,7 @@ begin
p := AllocMem(SizeOf(TCvPoint2D32f) * 4);
// Src Top right
p[0].x := FCorner[0].x;
p[0].y := FCorner[0].Y;
p[0].y := FCorner[0].y;
// Src Top left
p[1].x := FCorner[nWidthGrid - 2].x;
p[1].y := FCorner[nWidthGrid - 2].y;
@ -172,37 +205,72 @@ begin
p[2].x := FCorner[(nWidthGrid - 1) * (nHeightGrid - 2)].x;
p[2].y := FCorner[(nWidthGrid - 1) * (nHeightGrid - 2)].y;
// Src Bot right
p[3].x := FCorner[(nWidthGrid - 1) * (nHeightGrid - 1) -1].x;
p[3].y := FCorner[(nWidthGrid - 1) * (nHeightGrid - 1) -1].y;
p[3].x := FCorner[(nWidthGrid - 1) * (nHeightGrid - 1) - 1].x;
p[3].y := FCorner[(nWidthGrid - 1) * (nHeightGrid - 1) - 1].y;
// Create the transformation matrix
warp_matrix := cvCreateMat(3, 3, CV_32FC1);
cvGetPerspectiveTransform(q, p, warp_matrix);
warp_matrix := cvCreateMat(
3,
3,
CV_32FC1);
cvGetPerspectiveTransform(
q,
p,
warp_matrix);
// Support structures
blankImg := cvCreateImage(cvGetSize(FOverlayImage), FOverlayImage.depth, FOverlayImage.nChannels);
negImg := cvCreateImage(cvGetSize(frame), frame.depth, frame.nChannels);
copyImg := cvCreateImage(cvGetSize(frame), frame.depth, frame.nChannels);
blankImg := cvCreateImage(
cvGetSize(FOverlayImage),
FOverlayImage.depth,
FOverlayImage.nChannels);
negImg := cvCreateImage(
cvGetSize(frame),
frame.depth,
frame.nChannels);
copyImg := cvCreateImage(
cvGetSize(frame),
frame.depth,
frame.nChannels);
// Transform overlay image
cvWarpPerspective(FOverlayImage, negImg, warp_matrix, CV_INTER_LINEAR or CV_WARP_FILL_OUTLIERS, cvScalarAll(0));
cvWarpPerspective(
FOverlayImage,
negImg,
warp_matrix,
CV_INTER_LINEAR or CV_WARP_FILL_OUTLIERS,
cvScalarAll(0));
// Set to white
cvSet(blankImg, cvScalarAll(255));
cvSet(
blankImg,
cvScalarAll(255));
// Transform blank image
cvWarpPerspective(blankImg, copyImg, warp_matrix, CV_INTER_LINEAR or CV_WARP_FILL_OUTLIERS, cvScalarAll(0));
cvWarpPerspective(
blankImg,
copyImg,
warp_matrix,
CV_INTER_LINEAR or CV_WARP_FILL_OUTLIERS,
cvScalarAll(0));
// Invert image
cvNot(copyImg, copyImg);
cvNot(
copyImg,
copyImg);
// Join Frame and overlay image
cvAnd(copyImg, frame, copyImg);
cvOr(copyImg, negImg, frame);
cvAnd(
copyImg,
frame,
copyImg);
cvOr(
copyImg,
negImg,
frame);
// Show output
IplImage2Bitmap(frame, FFrameBitmap);
IplImage2Bitmap(
frame,
FFrameBitmap);
ImageOut.Picture.Bitmap.Assign(FFrameBitmap);
finally
FreeMem(q);
@ -230,7 +298,7 @@ begin
ButtonAR.Caption := 'Disable'
else
ButtonAR.Caption := 'Active';
FbAR2D := not FbAR2D;
FbAR2D := not FbAR2D;
end;
procedure TFormMain.ButtonShowClick(Sender: TObject);
@ -240,16 +308,13 @@ begin
if ImageCaptured.Visible then
begin
ButtonShow.Caption := '<< Hide cap.';
Self.Width := 1384;
Self.width := 1384;
end
else
begin
ButtonShow.Caption := 'Show cap. >>';
Self.Width := 746;
Self.width := 746;
end;
end;
end.

20071
samples/VCLDemo/vclOpenCVandOpenGL/dglOpenGL.pas Normal file
View File

File diff suppressed because it is too large Load Diff

20
samples/VCLDemo/vclOpenCVandOpenGL/uMainForm.dfm Normal file
View File

@ -0,0 +1,20 @@
object MainForm: TMainForm
Left = 0
Top = 0
Caption = 'OpenCV and OpenGL demo'
ClientHeight = 562
ClientWidth = 667
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
OnResize = FormResize
PixelsPerInch = 96
TextHeight = 13
end

283
samples/VCLDemo/vclOpenCVandOpenGL/uMainForm.pas Normal file
View File

@ -0,0 +1,283 @@
unit uMainForm;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
core_c,
core.types_c,
imgproc_c,
highgui_c,
dglOpenGL;
type
TMainForm = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
// ---- OpenGL ---------
DC : HDC; // êîíòåêñò óñòðîéñòâà
RC : HGLRC;
angle : GLfloat;
listIndex: GLuint;
texture : GLuint;
// ---- OpenCV ---------
capture: pCvCapture;
procedure SetupGL;
procedure IdleHandler(Sender: TObject; var Done: boolean);
procedure Render;
procedure ErrorHandler;
function ConvertIplToTexture(image: pIplImage): GLuint;
procedure DrawCube;
procedure SetupData;
procedure StartupDraw; // êîíòåêñò ðåíäåðèíãà
public
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
const
NearClipping = 1;
FarClipping = 1000;
function TMainForm.ConvertIplToTexture(image: pIplImage): GLuint;
begin
glGenTextures(
1,
@Result);
glBindTexture(
GL_TEXTURE_2D,
Result);
// ------------------------
glTexEnvf(
GL_TEXTURE_ENV,
GL_TEXTURE_ENV_MODE,
GL_DECAL);
glTexParameterf(
GL_TEXTURE_2D,
GL_TEXTURE_MIN_FILTER,
GL_LINEAR);
glTexParameterf(
GL_TEXTURE_2D,
GL_TEXTURE_MAG_FILTER,
GL_LINEAR);
glTexParameterf(
GL_TEXTURE_2D,
GL_TEXTURE_WRAP_S,
GL_REPEAT);
glTexParameterf(
GL_TEXTURE_2D,
GL_TEXTURE_WRAP_T,
GL_REPEAT);
// ------------------------
gluBuild2DMipmaps(
GL_TEXTURE_2D,
3,
image^.width,
image^.height,
GL_BGR,
GL_UNSIGNED_BYTE,
image^.imageData);
end;
procedure TMainForm.DrawCube;
var
frame: pIplImage;
begin
frame := cvQueryFrame(capture);
if Assigned(frame) then
begin
if texture <> 0 then
glDeleteTextures(
1,
@texture);
texture := ConvertIplToTexture(frame);
glEnable(GL_TEXTURE_2D);
glBindTexture(
GL_TEXTURE_2D,
texture);
glCallList(listIndex);
glDisable(GL_TEXTURE_2D);
end;
end;
procedure TMainForm.SetupGL;
begin
glClearColor(
0.0,
0.0,
0.0,
0.0); // öâåò ôîíà
glEnable(GL_DEPTH_TEST); // Âêëþ÷èòü òåñò ãëóáèíû
glEnable(GL_CULL_FACE); // ïîêàçûâàòü òîëüêî ïåðåäíèå ãðàíè
end;
procedure TMainForm.FormResize(Sender: TObject);
var
tmpBool: boolean;
begin
glViewport(
0,
0,
ClientWidth,
ClientHeight);
StartupDraw;
IdleHandler(
Sender,
tmpBool);
end;
procedure TMainForm.Render;
begin
gluLookAt(
0.0,
2.0,
1.5,
0.0,
0.0,
-0.5,
0.0,
-1.0,
0.0);
glRotatef(
angle,
0.0,
1.0,
0.0);
DrawCube;
angle := angle + 1.0;
end;
procedure TMainForm.ErrorHandler;
begin
Caption := gluErrorString(glGetError);
end;
procedure TMainForm.StartupDraw;
begin
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
gluPerspective(
60.0,
ClientWidth / ClientHeight,
NearClipping,
FarClipping);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
end;
procedure TMainForm.IdleHandler(Sender: TObject; var Done: boolean);
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); // î÷èùàåì áóôåð öâåòà è áóôåð ãëóáèíû
StartupDraw;
glPushMatrix;
try
Render;
except
ErrorHandler;
end;
glPopMatrix;
SwapBuffers(DC); // âûâîäèì ñîäåðæàíèå áóôåðà íà ýêðàí
Done := FALSE;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
if not InitOpenGL then
FatalAppExit(
0,
'Íå óäàëîñü ïðîèíèöèàëèçèðîâàòü OpenGL');
DC := GetDC(Handle); // îïðåäåëÿåì, ÷òî êîíòåêñòîì óñòðîéñòâà áóäåò íàøå îêíî
RC := CreateRenderingContext(
DC,
[opDoubleBuffered],
32,
24,
0,
0,
0,
0); // Çäåñü
// ñîçäàåì êîíòåêñò ðåíäåðèíãà, ñ íåîáõîäèìûìè ïàðàìåòðàìè
ActivateRenderingContext(
DC,
RC); // àêòèâèðóåì è ñâÿçûâàåì êîíòåêò ðåíäåðèíãà ñ
// ñ êîíòåêñòîì óñòðîéñòâà
SetupGL;
SetupData;
Application.OnIdle := IdleHandler;
end;
procedure TMainForm.SetupData;
const
vert: array [0 .. 47] of GLfloat = (-0.5, 0.0, 0.5, 0.5, 0.0, 0.5, 0.5, 1.0, 0.5, -0.5, 1.0, 0.5, -0.5, 1.0, -0.5,
0.5, 1.0, -0.5, 0.5, 0.0, -0.5, -0.5, 0.0, -0.5, 0.5, 0.0, 0.5, 0.5, 0.0, -0.5, 0.5, 1.0, -0.5, 0.5, 1.0, 0.5, -0.5,
0.0, -0.5, -0.5, 0.0, 0.5, -0.5, 1.0, 0.5, -0.5, 1.0, -0.5);
texcoords: array [0 .. 31] of GLfloat = (0.0, 0.0, 1.0, 0.0, 1.0, 1.0, 0.0, 1.0, 0.0, 0.0, 1.0, 0.0, 1.0, 1.0, 0.0,
1.0, 0.0, 0.0, 1.0, 0.0, 1.0, 1.0, 0.0, 1.0, 0.0, 0.0, 1.0, 0.0, 1.0, 1.0, 0.0, 1.0);
cubeIndices: array [0 .. 23] of GLubyte = (0, 1, 2, 3, 4, 5, 6, 7, 3, 2, 5, 4, 7, 6, 1, 0, 8, 9, 10, 11, 12,
13, 14, 15);
begin
capture := cvCreateCameraCapture(CV_CAP_ANY);
if not Assigned(capture) then
FatalAppExit(
0,
'Íå óäàëîñü ïðîèíèöèàëèçèðîâàòü çàõâàò ñ êàìåðû');
listIndex := glGenLists(1);
glNewList(
listIndex,
GL_COMPILE);
glEnableClientState(GL_TEXTURE_COORD_ARRAY);
glEnableClientState(GL_VERTEX_ARRAY);
glTexCoordPointer(
2,
GL_FLOAT,
0,
@texcoords);
glVertexPointer(
3,
GL_FLOAT,
0,
@vert);
glDrawElements(
GL_QUADS,
24,
GL_UNSIGNED_BYTE,
@cubeIndices);
glDisableClientState(GL_VERTEX_ARRAY);
glDisableClientState(GL_TEXTURE_COORD_ARRAY);
glEndList();
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
if Assigned(capture) then
cvReleaseCapture(capture);
DeactivateRenderingContext; // äåàêòèâèðóåì êîíòåêñò ðåíäåðèíãà
DestroyRenderingContext(RC); // ðàçðóøàåì êîíòåêñò ðåíäåðèíãà
ReleaseDC(
Handle,
DC); // ðàçðóøàåì êîíòåêñò óñòðîéñòâà
end;
end.

38
samples/VCLDemo/vclOpenCVandOpenGL/vclOCVaOGL.dpr Normal file
View File

@ -0,0 +1,38 @@
// *****************************************************************
// 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.
// *******************************************************************
program vclOCVaOGL;
uses
Vcl.Forms,
uMainForm in 'uMainForm.pas' {MainForm},
dglOpenGL in 'dglOpenGL.pas';
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

171
samples/VCLDemo/vclOpenCVandOpenGL/vclOCVaOGL.dproj Normal file
View File

@ -0,0 +1,171 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{AFAC16AE-8CE1-43E4-9A25-DC1ED8B0A497}</ProjectGuid>
<ProjectVersion>14.6</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>vclOCVaOGL.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Locale>1049</VerInfo_Locale>
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
<Manifest_File>None</Manifest_File>
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
<DCC_ExeOutput>..\..\..\Bin</DCC_ExeOutput>
<DCC_E>false</DCC_E>
<DCC_N>false</DCC_N>
<DCC_S>false</DCC_S>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<DCC_UsePackage>JvGlobus;dxBarRS18;dxPSCoreRS18;JvMM;JvManagedThreads;dxPScxPCProdRS18;cxTreeListRS18;dxDockingRS18;frxDB18;dxThemeRS18;dxPSdxOCLnkRS18;frxDBX18;JvCrypt;XiButtonXE4;DBXInterBaseDriver;DataSnapServer;DataSnapCommon;cxTreeListdxBarPopupMenuRS18;JvNet;JvDotNetCtrls;fsIBX18;DbxCommonDriver;OpenCV;vclimg;dbxcds;DatasnapConnectorsFreePascal;JvXPCtrls;vcldb;cxExportRS18;frxADO18;CustomIPTransport;dsnap;IndyIPServer;IndyCore;cxVerticalGridRS18;CloudService;dxPSdxDBOCLnkRS18;FmxTeeUI;dxADOServerModeRS18;JvDB;JvRuntimeDesign;dxPScxExtCommonRS18;cxEditorsRS18;cxPageControldxBarPopupMenuRS18;cxSchedulerRS18;dxSpellCheckerRS18;dxPScxVGridLnkRS18;JclDeveloperTools;dxRibbonRS18;bindcompfmx;vcldbx;cxBarEditItemRS18;cxPageControlRS18;dbrtl;bindcomp;inetdb;JvPluginSystem;FFmpegFmx_DXE4;DBXOdbcDriver;JvCmp;fsADO18;JvTimeFramework;xmlrtl;ibxpress;dxBarExtItemsRS18;frxe18;vclactnband;bindengine;soaprtl;FMXTee;FFmpegRtl_DXE4;bindcompvcl;dxPsPrVwAdvRS18;cxSpreadSheetRS18;Jcl;vclie;cxPivotGridRS18;dxmdsRS18;dxBarDBNavRS18;dxTileControlRS18;dxComnRS18;dxBarExtDBItemsRS18;DBXInformixDriver;dxPScxSchedulerLnkRS18;Intraweb;fsTee18;dxNavBarRS18;dsnapcon;DBXFirebirdDriver;dxPSTeeChartRS18;inet;dxPScxCommonRS18;JvPascalInterpreter;vclx;DBXSybaseASADriver;dxorgcRS18;dbexpress;IndyIPClient;JvBDE;dxGDIPlusRS18;dxLayoutControlRS18;DBXSqliteDriver;tmswizdXE4;fmx;JvDlgs;IndySystem;TeeDB;frx18;inetdbbde;vclib;DataSnapClient;dxPScxTLLnkRS18;cxSchedulerGridRS18;dxtrmdRS18;DataSnapProviderClient;DBXSybaseASEDriver;FFmpegVcl_DXE4;dxTabbedMDIRS18;MetropolisUILiveTile;dxPSLnksRS18;vcldsnap;dxPScxPivotGridLnkRS18;DBXDb2Driver;dxPScxSSLnkRS18;DBXOracleDriver;dxServerModeRS18;JvCore;vclribbon;dxdborRS18;fmxase;vcl;IndyIPCommon;DBXMSSQLDriver;CodeSiteExpressPkg;cxPivotGridChartRS18;frxBDE18;JvAppFrm;inetdbxpress;webdsnap;dxPScxGridLnkRS18;cxLibraryRS18;JvDocking;adortl;JvWizards;dxPSdxDBTVLnkRS18;JvHMI;tmsdXE4;JvBands;fs18;rtl;DbxClientDriver;Tee;JclContainers;CPortLibDXE;JvSystem;svnui;JvControls;dxDBXServerModeRS18;IndyProtocols;DBXMySQLDriver;dxFlowChartRS18;bindcompdbx;TeeUI;JvJans;JvPrintPreview;JvPageComps;JvStdCtrls;JvCustom;vcltouch;dxPSPrVwRibbonRS18;dxPSdxFCLnkRS18;tmsexdXE4;OverbyteIcsDXe4Run;VclSmp;cxGridRS18;CnPack_DXE4;DataSnapConnectors;dxPSDBTeeChartRS18;dxdbtrRS18;fsDB18;tmsxlsdXE4;frxIBX18;dxCoreRS18;fmxobj;JclVcl;svn;dxPSdxLCLnkRS18;fsBDE18;cxPivotGridOLAPRS18;fmxdae;cxDataRS18;bdertl;frxTee18;DataSnapIndy10ServerTransport;$(DCC_UsePackage)</DCC_UsePackage>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<DCC_UsePackage>dxBarRS18;dxPSCoreRS18;cxTreeListRS18;dxDockingRS18;dxThemeRS18;dxPSdxOCLnkRS18;DBXInterBaseDriver;DataSnapServer;DataSnapCommon;cxTreeListdxBarPopupMenuRS18;DbxCommonDriver;vclimg;dbxcds;DatasnapConnectorsFreePascal;vcldb;cxExportRS18;CustomIPTransport;dsnap;IndyIPServer;IndyCore;cxVerticalGridRS18;CloudService;dxPSdxDBOCLnkRS18;FmxTeeUI;dxADOServerModeRS18;dxPScxExtCommonRS18;cxEditorsRS18;cxPageControldxBarPopupMenuRS18;cxSchedulerRS18;dxSpellCheckerRS18;dxPScxVGridLnkRS18;dxRibbonRS18;bindcompfmx;cxBarEditItemRS18;cxPageControlRS18;dbrtl;bindcomp;inetdb;DBXOdbcDriver;xmlrtl;ibxpress;dxBarExtItemsRS18;vclactnband;bindengine;soaprtl;FMXTee;bindcompvcl;dxPsPrVwAdvRS18;cxSpreadSheetRS18;vclie;cxPivotGridRS18;dxmdsRS18;dxBarDBNavRS18;dxTileControlRS18;dxComnRS18;dxBarExtDBItemsRS18;DBXInformixDriver;dxPScxSchedulerLnkRS18;Intraweb;dxNavBarRS18;dsnapcon;DBXFirebirdDriver;dxPSTeeChartRS18;inet;dxPScxCommonRS18;vclx;DBXSybaseASADriver;dxorgcRS18;dbexpress;IndyIPClient;dxGDIPlusRS18;dxLayoutControlRS18;DBXSqliteDriver;fmx;IndySystem;TeeDB;vclib;DataSnapClient;dxPScxTLLnkRS18;cxSchedulerGridRS18;dxtrmdRS18;DataSnapProviderClient;DBXSybaseASEDriver;dxTabbedMDIRS18;MetropolisUILiveTile;dxPSLnksRS18;vcldsnap;dxPScxPivotGridLnkRS18;DBXDb2Driver;dxPScxSSLnkRS18;DBXOracleDriver;dxServerModeRS18;vclribbon;dxdborRS18;fmxase;vcl;IndyIPCommon;DBXMSSQLDriver;cxPivotGridChartRS18;inetdbxpress;webdsnap;dxPScxGridLnkRS18;cxLibraryRS18;adortl;dxPSdxDBTVLnkRS18;rtl;DbxClientDriver;Tee;dxDBXServerModeRS18;IndyProtocols;DBXMySQLDriver;dxFlowChartRS18;bindcompdbx;TeeUI;vcltouch;dxPSPrVwRibbonRS18;dxPSdxFCLnkRS18;OverbyteIcsDXe4Run;VclSmp;cxGridRS18;DataSnapConnectors;dxPSDBTeeChartRS18;dxdbtrRS18;dxCoreRS18;fmxobj;dxPSdxLCLnkRS18;cxPivotGridOLAPRS18;fmxdae;cxDataRS18;DataSnapIndy10ServerTransport;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_DebugDCUs>true</DCC_DebugDCUs>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
<DCC_RemoteDebug>true</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<DCC_RemoteDebug>false</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>false</DCC_DebugInformation>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="uMainForm.pas">
<Form>MainForm</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="dglOpenGL.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Debug">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">0</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
<VersionInfo Name="Private">False</VersionInfo>
<VersionInfo Name="DLL">False</VersionInfo>
<VersionInfo Name="Locale">1049</VersionInfo>
<VersionInfo Name="CodePage">1251</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName"/>
<VersionInfoKeys Name="FileDescription"/>
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName"/>
<VersionInfoKeys Name="LegalCopyright"/>
<VersionInfoKeys Name="LegalTrademarks"/>
<VersionInfoKeys Name="OriginalFilename"/>
<VersionInfoKeys Name="ProductName"/>
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments"/>
<VersionInfoKeys Name="CFBundleName"/>
<VersionInfoKeys Name="CFBundleDisplayName"/>
<VersionInfoKeys Name="UIDeviceFamily"/>
<VersionInfoKeys Name="CFBundleIdentifier"/>
<VersionInfoKeys Name="CFBundleVersion"/>
<VersionInfoKeys Name="CFBundlePackageType"/>
<VersionInfoKeys Name="CFBundleSignature"/>
<VersionInfoKeys Name="CFBundleAllowMixedLocalizations"/>
<VersionInfoKeys Name="UISupportedInterfaceOrientations"/>
<VersionInfoKeys Name="CFBundleExecutable"/>
<VersionInfoKeys Name="CFBundleResourceSpecification"/>
<VersionInfoKeys Name="LSRequiresIPhoneOS"/>
<VersionInfoKeys Name="CFBundleInfoDictionaryVersion"/>
<VersionInfoKeys Name="CFBundleDevelopmentRegion"/>
</VersionInfoKeys>
<Source>
<Source Name="MainSource">vclOCVaOGL.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp180.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k180.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Deployment/>
<Platforms>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>

BIN
samples/VCLDemo/vclOpenCVandOpenGL/vclOCVaOGL.res Normal file
View File

Binary file not shown.