Delphi/Delphi-OpenCV
1
0
Fork 0
mirror of https://github.com/Laex/Delphi-OpenCV.git synced 2024-11-16 16:25:53 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity
cf19dc0b3b
Delphi-OpenCV/samples/MultiDemo/FrameRecon/FrameRecon.dpr
Laex cf19dc0b3b Fixed issues #3 
Signed-off-by: Laex <laex@bk.ru>
2013-04-18 10:34:16 +04:00

441 lines
13 KiB
ObjectPascal
Raw Blame History

(* /*****************************************************************
// Delphi-OpenCV Demo
// Copyright (C) 2013 Project Delphi-OpenCV
// ****************************************************************
// Contributor:
// laentir Valetov
// email:laex@bk.ru
// ****************************************************************
// You may retrieve the latest version of this file at the GitHub,
// located at git://github.com/Laex/Delphi-OpenCV.git
// ****************************************************************
// The contents of this file are used with permission, subject to
// the Mozilla Public License Version 1.1 (the "License"); you may
// not use this file except in compliance with the License. You may
// obtain a copy of the License at
// http://www.mozilla.org/MPL/MPL-1_1Final.html
//
// Software distributed under the License is distributed on an
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
// implied. See the License for the specific language governing
// rights and limitations under the License.
******************************************************************* *)
// JCL_DEBUG_EXPERT_GENERATEJDBG OFF
// JCL_DEBUG_EXPERT_INSERTJDBG OFF
// JCL_DEBUG_EXPERT_DELETEMAPFILE OFF
program FrameRecon;
{$APPTYPE CONSOLE}
{$POINTERMATH ON}
{$R *.res}
uses
System.SysUtils,
uLibName in '..\..\..\include\uLibName.pas',
highgui_c in '..\..\..\include\highgui\highgui_c.pas',
core_c in '..\..\..\include\core\core_c.pas',
Core.types_c in '..\..\..\include\core\Core.types_c.pas',
imgproc.types_c in '..\..\..\include\imgproc\imgproc.types_c.pas',
imgproc_c in '..\..\..\include\imgproc\imgproc_c.pas',
legacy in '..\..\..\include\legacy\legacy.pas',
calib3d in '..\..\..\include\calib3d\calib3d.pas',
imgproc in '..\..\..\include\imgproc\imgproc.pas',
haar in '..\..\..\include\objdetect\haar.pas',
objdetect in '..\..\..\include\objdetect\objdetect.pas',
tracking in '..\..\..\include\video\tracking.pas',
Core in '..\..\..\include\core\core.pas';
Var
image: pIplImage = nil;
imageDiv: pIplImage;
outImg: pIplImage = nil;
extractedFrame: pIplImage;
// gray: pIplImage;
pgray, pcontor: pIplImage;
intrinsic: PCvMat;
distortion: PCvMat;
obj, pro: PCvMat;
rot, tra: PCvMat;
mapMatrix: PCvMat;
origQuad, quad: array [0 .. 3] of TCvPoint2D32f;
capture: PCvCapture;
frame: pIplImage;
selcam: longint = 0;
cont: integer;
// Canny/Threshold parameters
cbCannyChecked: Boolean = false;
sePar1Value: Double = 100;
sePar2Value: Double = 50;
cbPar3Value: integer = 3;
// approx poly param.
cbDisplayContChecked: Boolean = false;
sePolyPar1Value: Double = 7;
sePolyPar2Value: integer = 0;
// max perim ratio difference %
sePerimRatioDiffValue: Double = 20;
procedure drawPerspective(image: pIplImage);
var
i: integer;
pt1, pt2: TCvPoint;
begin
cvZero(pro);
cvProjectPoints2(obj, rot, tra, intrinsic, distortion, pro);
cvCircle(image, cvPoint(round(cvGet(pro, 0, 0)), round(cvGet(pro, 0, 1))), 10, cv_rgb(255, 0, 0));
for i := 0 to 3 do
begin
pt1.x := round(cvGet(pro, i, 0));
pt1.y := round(cvGet(pro, i, 1));
if i < 3 then
begin
pt2.x := round(cvGet(pro, i + 1, 0));
pt2.y := round(cvGet(pro, i + 1, 1));
end
else
begin
pt2.x := round(cvGet(pro, 0, 0));
pt2.y := round(cvGet(pro, 0, 1));
end;
cvLine(image, pt1, pt2, cv_rgb(0, 255, 0), 1, CV_AA, 0);
end;
end;
procedure extractContours(const origImg, image: pIplImage; const storage: pCvMemStorage; var contList: PCvSeq);
var
nc: integer;
contours: PCvSeq;
begin
// *********** find contours in Canny result image
// find contours and store them all as a list
contours := nil;
if (origImg.NChannels > 1) then
begin
pgray := cvCreateImage(cvSize(image.width, image.height), IPL_DEPTH_8U, 1);
cvCvtColor(origImg, pgray, CV_BGR2GRAY)
end
else
pgray := cvCloneImage(origImg);
pcontor := cvCreateImage(cvSize(image.width, image.height), IPL_DEPTH_8U, 1);
if cbCannyChecked then
cvCanny(pgray, pcontor, sePar1Value, sePar2Value, cbPar3Value)
else
cvThreshold(pgray, pcontor, sePar1Value, 255, CV_THRESH_BINARY_INV);
if (image.NChannels > 1) and (cbDisplayContChecked) then
cvCvtColor(pcontor, image, CV_GRAY2BGR);
// warning! findcontours destroy the input image, so display it before the call
nc := cvFindContours(pcontor, storage, @contours, sizeof(TCvContour), CV_RETR_TREE, CV_CHAIN_APPROX_SIMPLE,
cvPoint(0, 0));
if nc = 0 then
contList := nil
else
contList := contours;
cvReleaseImage(pgray);
cvReleaseImage(pcontor);
end;
procedure drawFrame(const origImg, image: pIplImage);
var
nc, i: integer;
contList, contours: PCvSeq;
seqResult, hole, hole2: PCvSeq;
storage: pCvMemStorage;
a, p: Double;
bRect: TCvRect;
nholes: integer;
bol1, bol2, bol3: Boolean;
m1, q1: single;
m2, q2: single;
vert1, vert2: Boolean;
mi1, qi1: single;
mi2, qi2: single;
vertH1, vertH2: Boolean;
p1, p2: PCvPoint;
p1Ext: TCvPoint;
frame_found: Boolean;
moments: PCvMoments;
compactness: Double;
begin
storage := cvCreateMemStorage(0);
extractContours(origImg, image, storage, contList);
// test each contour
contours := contList;
while (contours <> nil) do
begin
a := cvContourArea(contours, CV_WHOLE_SEQ);
if (abs(a) > 500) and (contours.total > 3) then
begin
seqResult := cvApproxPoly(contours, sizeof(TCvContour), storage, CV_POLY_APPROX_DP, sePolyPar1Value,
sePolyPar2Value);
if seqResult.total = 4 then
begin
Writeln('ContourArea ', a:2:2);
Writeln('ApproxPoly total ', seqResult.total);
frame_found := false;
// calcola coefficienti delle rette diagonali del contorno esterno
p1 := PCvPoint(cvGetSeqElem(seqResult, 0));
p1Ext.x := p1.x;
p1Ext.y := p1.y;
p2 := PCvPoint(cvGetSeqElem(seqResult, 2));
if (p1.x <> p2.x) then
begin
vert1 := false;
m1 := (p2.y - p1.y) / (p2.x - p1.x);
q1 := (p2.x * p1.y - p1.x * p2.y) / (p2.x - p1.x);
end
else
begin
vert1 := true;
end;
p1 := PCvPoint(cvGetSeqElem(seqResult, 1));
p2 := PCvPoint(cvGetSeqElem(seqResult, 3));
if (p1.x <> p2.x) then
begin
vert2 := false;
m2 := (p2.y - p1.y) / (p2.x - p1.x);
q2 := (p2.x * p1.y - p1.x * p2.y) / (p2.x - p1.x);
end
else
begin
vert2 := true;
end;
// internal contours with CV_RETR_TREE
hole := contours.v_next;
nholes := 0;
// 4) scorre i contorni interni (TREE)
while (hole <> nil) do
begin
inc(nholes);
if nholes > 1 then
break;
if hole.total <= 3 then
Continue;
// 4.1) approssima ogni contorno con pilogono
hole2 := cvApproxPoly(hole, sizeof(TCvContour), storage, CV_POLY_APPROX_DP, sePolyPar1Value, sePolyPar2Value);
// 4.2) verifica se poligono ha 4 vertici
if hole2.total <> 4 then
Continue;
p1 := PCvPoint(cvGetSeqElem(hole2, 0));
// 4.3) calcola coefficienti delle rette diagonali
p2 := PCvPoint(cvGetSeqElem(hole2, 2));
if (p1.x <> p2.x) then
begin
vertH1 := false;
mi1 := (p2.y - p1.y) / (p2.x - p1.x);
qi1 := (p2.x * p1.y - p1.x * p2.y) / (p2.x - p1.x);
end
else
begin
vertH1 := true;
end;
p1 := PCvPoint(cvGetSeqElem(hole2, 1));
p2 := PCvPoint(cvGetSeqElem(hole2, 3));
if (p1.x <> p2.x) then
begin
vertH2 := false;
mi2 := (p2.y - p1.y) / (p2.x - p1.x);
qi2 := (p2.x * p1.y - p1.x * p2.y) / (p2.x - p1.x);
end
else
begin
vertH2 := true;
end;
// 4.4) se i coefficienti delle diagonali del poligono interno
// sono uguali a quelli del poligono esterno, a meno di errore dato,
// la ricerca e' positiva, uscire dalla funzione
if (vert1 = vertH1) and (vert2 = vertH2) and (abs(m1 - mi1) / m1 <= (sePerimRatioDiffValue / 100)) and
(abs(q1 - qi1) / q1 <= (sePerimRatioDiffValue / 100)) and
(abs(m2 - mi2) / m2 <= (sePerimRatioDiffValue / 100)) and
(abs(q2 - qi2) / q2 <= (sePerimRatioDiffValue / 100)) then
begin
frame_found := true;
break;
end;
hole := hole.h_next;
end; // while hole
if (frame_found) then
begin
Writeln('frame_found');
cvZero(rot);
cvZero(tra);
// copy projection data to CvMat array
for i := 0 to 3 do
begin
p1 := PCvPoint(cvGetSeqElem(seqResult, i));
cvSet(pro, i, 0, p1.x);
cvSet(pro, i, 1, p1.y);
quad[i].x := p1.x;
quad[i].y := p1.y;
end;
cvFindExtrinsicCameraParams2(obj, pro, intrinsic, distortion, rot, tra);
Writeln('Z dist. ' + FloatToStr(trunc(cvGet(tra, 0, 2))));
cvGetPerspectiveTransform(@origQuad, @quad, mapMatrix);
bRect := pcvcontour(seqResult).rect;
cvZero(extractedFrame);
cvWarpPerspective(origImg, extractedFrame, mapMatrix,
(CV_INTER_LINEAR + CV_WARP_FILL_OUTLIERS + CV_WARP_INVERSE_MAP), cvScalar(0, 0, 0, 0));
cvDrawContours(image, PCvSeq(seqResult), cv_rgb(255, 0, 0), cv_rgb(0, 255, 0), 0, 4, CV_AA, cvPoint(0, 0));
break;
end;
end; // if seqresult.total=4
end; // if abs
// take the next contour
contours := contours.h_next;
end;
cvRelease(contList);
cvReleaseMemStorage(storage);
end;
procedure main_cycle(frame: pIplImage);
var
cs: TCvSize;
begin
if not(assigned(image)) then
begin
// * allocate all the buffers
cs.width := frame.width;
cs.height := frame.height;
image := cvCreateImage(cs, 8, 3);
image.Origin := frame.Origin;
imageDiv := cvCreateImage(cvSize(cs.width div 2, cs.height div 2), 8, 3);
imageDiv.Origin := frame.Origin;
outImg := cvCreateImage(cs, 8, 3);
outImg.Origin := frame.Origin;
end;
cvCopy(frame, image);
cvSmooth(image, image, CV_GAUSSIAN, 3, 3);
cvCopy(image, outImg);
drawFrame(image, outImg);
if cont = 20 then
begin
cont := 1;
cvShowImage('Paint window', extractedFrame);
end
else
inc(cont);
drawPerspective(outImg);
cvCopy(outImg, frame);
end;
procedure Help;
begin
Writeln('c - CannyChecked');
Writeln('d - DisplayContChecked');
end;
begin
try
///
// Calibration: Resource\Calibration_Chess.png
// Test: Resource\frame.png
///
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
capture := cvCreateCameraCapture(CV_CAP_ANY);
if not assigned(capture) then
Halt;
cvNamedWindow('Paint window', 1);
cvNamedWindow('Original', 1);
intrinsic := cvLoad('Resource\Intrinsics.xml');
// multiply by 2 because the matrix is computed on 320x240 image
cvConvertScale(intrinsic, intrinsic, 2.0, 0);
distortion := cvLoad('Resource\Distortion.xml');
obj := cvCreateMat(4, 3, CV_32FC1);
pro := cvCreateMat(4, 2, CV_32FC1);
rot := cvCreateMat(1, 3, CV_32FC1);
tra := cvCreateMat(1, 3, CV_32FC1);
mapMatrix := cvCreateMat(3, 3, CV_32FC1);
cvSet(obj, 0, 0, -100);
cvSet(obj, 0, 1, -100);
cvSet(obj, 0, 2, 0.0);
origQuad[0].x := 0;
origQuad[0].y := 0;
cvSet(obj, 1, 0, 100.0);
cvSet(obj, 1, 1, -100);
cvSet(obj, 1, 2, 0.0);
origQuad[1].x := 300;
origQuad[1].y := 0;
cvSet(obj, 2, 0, 100.0);
cvSet(obj, 2, 1, 100.0);
cvSet(obj, 2, 2, 0.0);
origQuad[2].x := 300;
origQuad[2].y := 300;
cvSet(obj, 3, 0, -100);
cvSet(obj, 3, 1, 100.0);
cvSet(obj, 3, 2, 0.0);
origQuad[3].x := 0;
origQuad[3].y := 300;
cvSet(rot, 0, 0, 0.0);
cvSet(rot, 0, 1, 0.0);
cvSet(rot, 0, 2, 0.0);
cvSet(tra, 0, 0, 0.0);
cvSet(tra, 0, 1, 0.0);
// the Z coord on translation vector is set to focal length
cvSet(tra, 0, 2, cvGet(intrinsic, 0, 0));
// appo image for warp perspective
extractedFrame := cvCreateImage(cvSize(800, 600), 8, 3);
Help;
while true do
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
frame := cvQueryFrame(capture);
if not assigned(frame) then
break;
cvShowImage('Original', frame);
main_cycle(frame);
case cvWaitKey(10) of
27:
break;
Ord('c'):
cbCannyChecked := not cbCannyChecked;
Ord('d'):
cbDisplayContChecked := not cbDisplayContChecked;
end;
end;
cvReleaseCapture(capture);
cvReleaseImage(image);
cvReleaseImage(outImg);
cvReleaseImage(extractedFrame);
cvDestroyAllWindows;
except
on e: Exception do
Writeln(e.ClassName, ': ', e.Message);
end;
end.
Reference in New Issue View Git Blame Copy Permalink