mirror of
https://github.com/Laex/Delphi-OpenCV.git
synced 2024-11-16 08:15:52 +01:00
275 lines
8.3 KiB
ObjectPascal
275 lines
8.3 KiB
ObjectPascal
// *****************************************************************
|
|
// 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://public.cranfield.ac.uk/c5354/teaching/ml/examples/c/haar_cascade/haar_cascade.cc
|
|
// *******************************************************************
|
|
//
|
|
// Example : run haar cascade classifier on image / video / camera
|
|
// usage: prog {<image_name> | <video_name>}
|
|
|
|
program FaceDetect;
|
|
|
|
{$APPTYPE CONSOLE}
|
|
{$R *.res}
|
|
|
|
uses
|
|
System.Character,
|
|
System.SysUtils,
|
|
System.Math,
|
|
Core.types_c,
|
|
core_c,
|
|
highgui_c,
|
|
objdetect,
|
|
imgproc_c,
|
|
imgproc.types_c,
|
|
cvUtils;
|
|
|
|
Const
|
|
// ******************************************************************************/
|
|
// setup the cameras properly based on OS platform
|
|
CAMERA_INDEX = CV_CAP_ANY;
|
|
// ******************************************************************************/
|
|
windowName = 'Haar Cascade Detection'; // window name
|
|
cascade_name: pCVChar = 'FaceDetectXML\haarcascade_frontalface_alt.xml'; // cascade file
|
|
|
|
Var
|
|
img : pIplImage = nil; // image object
|
|
frame : pIplImage = nil;
|
|
capture : pCvCapture = nil; // capture object
|
|
detected_objects: pCvSeq = nil; // list of detected items
|
|
key : Integer; // user input
|
|
EVENT_LOOP_DELAY: Integer = 40; // delay for GUI window 40 ms equates to 1000ms/25fps=40ms per frame
|
|
cascade : pCvHaarClassifierCascade;
|
|
storage : pCvMemStorage;
|
|
gray : pIplImage;
|
|
imgcopy : pIplImage;
|
|
i : Integer;
|
|
r : pCvRect;
|
|
isCapture:Boolean = false;
|
|
|
|
begin
|
|
try
|
|
// if command line arguments are provided try to read image/video_name
|
|
// otherwise default to capture from attached H/W camera
|
|
if ParamCount = 1 then
|
|
begin
|
|
img := cvLoadImage(
|
|
c_str(ParamStr(1)),
|
|
CV_LOAD_IMAGE_UNCHANGED);
|
|
if not Assigned(img) then
|
|
begin
|
|
capture := cvCreateFileCapture(c_str(ParamStr(1)));
|
|
isCapture:=True;
|
|
end;
|
|
end;
|
|
|
|
if (not Assigned(img)) and (not Assigned(capture)) then
|
|
begin
|
|
capture := cvCreateCameraCapture(CAMERA_INDEX);
|
|
isCapture:=True;
|
|
end;
|
|
if not Assigned(capture) then
|
|
Halt(1);
|
|
|
|
// create window object (use flag:=0 to allow resize, 1 to auto fix size)
|
|
cvNamedWindow(
|
|
windowName,
|
|
0);
|
|
|
|
// load the trained haar cascade classifier from file
|
|
// and create storage required for detections
|
|
cascade := cvLoad(
|
|
cascade_name,
|
|
nil,
|
|
nil,
|
|
nil);
|
|
if Assigned(cascade) then
|
|
Writeln(
|
|
'LOADED : ',
|
|
cascade_name)
|
|
else
|
|
begin
|
|
Writeln(
|
|
'ERROR: Could not load classifier cascade : ',
|
|
cascade_name);
|
|
Halt(1);
|
|
end;
|
|
try
|
|
storage := cvCreateMemStorage(0);
|
|
|
|
// if capture object in use (i.e. video/camera)
|
|
// get initial image from capture object
|
|
if Assigned(capture) then
|
|
begin
|
|
// cvQueryFrame is just a combination of cvGrabFrame
|
|
// and cvRetrieveFrame in one call.
|
|
img := cvQueryFrame(capture);
|
|
if not Assigned(img) then
|
|
begin
|
|
if ParamCount = 1 then
|
|
Writeln('End of video file reached')
|
|
else
|
|
Writeln('ERROR: cannot get next fram from camera');
|
|
Halt(0);
|
|
end;
|
|
end;
|
|
|
|
// create a greyscale image upon which to run the classifier
|
|
gray := cvCreateImage(
|
|
cvSize(img^.width, img^.height),
|
|
img^.depth,
|
|
1);
|
|
|
|
// create a copy of the image upon which to do detection and box drawing
|
|
imgcopy := cvCloneImage(img);
|
|
|
|
// start main loop
|
|
while True do
|
|
begin
|
|
// if capture object in use (i.e. video/camera)
|
|
// get image from capture object
|
|
if Assigned(capture) then
|
|
begin
|
|
// cvQueryFrame is just a combination of cvGrabFrame
|
|
// and cvRetrieveFrame in one call.
|
|
frame := cvQueryFrame(capture);
|
|
if not Assigned(frame) then
|
|
begin
|
|
if ParamCount = 1 then
|
|
Writeln('End of video file reached')
|
|
else
|
|
Writeln('ERROR: cannot get next fram from camera');
|
|
Halt(0);
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
// if not a capture object set event delay to zero so it waits
|
|
// indefinitely (as single image file, no need to loop)
|
|
EVENT_LOOP_DELAY := 0;
|
|
end;
|
|
|
|
// N.B. as haar features are orientation dependent (and
|
|
// the haar function operate directly on the pixel
|
|
// array in memory) we'll just check the image
|
|
// is using Top-Left origin in actual memory
|
|
// and if not flip it (use a copy which is not the
|
|
// capture object buffer)
|
|
if (img^.origin = IPL_ORIGIN_TL) then
|
|
begin
|
|
cvCopy(
|
|
frame,
|
|
imgcopy);
|
|
end
|
|
else
|
|
begin
|
|
cvFlip(
|
|
frame,
|
|
imgcopy);
|
|
imgcopy^.origin := IPL_ORIGIN_TL;
|
|
end;
|
|
gray^.origin := imgcopy^.origin;
|
|
|
|
// convert input image to grayscale
|
|
cvCvtColor(
|
|
imgcopy,
|
|
gray,
|
|
CV_BGR2GRAY);
|
|
|
|
// histogram equalize it also to maximize the region differences
|
|
cvEqualizeHist(
|
|
gray,
|
|
gray);
|
|
|
|
// run the haar cascade detection
|
|
// with parameters scale:=1.2, neighbours := 4 and with Canny pruning
|
|
// turned on with minimum detection scale 30x30 pixels
|
|
detected_objects := cvHaarDetectObjects(
|
|
gray,
|
|
cascade,
|
|
storage,
|
|
1.2,
|
|
4,
|
|
CV_HAAR_DO_CANNY_PRUNING,
|
|
cvSize(30, 30),
|
|
cvSize(0, 0));
|
|
|
|
// draw a red rectangle around any detected objects
|
|
i := 0;
|
|
While i < ifthen(Assigned(detected_objects), detected_objects^.total, 0) do
|
|
begin
|
|
r := pCvRect(cvGetSeqElem(detected_objects, i));
|
|
cvRectangle(
|
|
imgcopy,
|
|
cvPoint(r^.x, r^.y),
|
|
cvPoint((r^.x) + (r^.width), (r^.y) + (r^.height)),
|
|
CV_RGB(255, 0, 0),
|
|
2,
|
|
8,
|
|
0);
|
|
Inc(i);
|
|
end;
|
|
// if Assigned(detected_objects) then
|
|
// cvClearSeq(detected_objects);
|
|
// cvClearMemStorage(storage);
|
|
|
|
// display image in window
|
|
cvShowImage(
|
|
windowName,
|
|
imgcopy);
|
|
|
|
// start event processing loop (very important,in fact essential for GUI)
|
|
// 40 ms roughly equates to 1000ms/25fps := 4ms per frame
|
|
key := cvWaitKey(EVENT_LOOP_DELAY);
|
|
if key = 27 then
|
|
begin
|
|
// if user presses 'ESC' then exit
|
|
Writeln('Keyboard exit requested : exiting now - bye!');
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
// destroy window objects
|
|
// (triggered by event loop *only* window is closed)
|
|
cvDestroyAllWindows();
|
|
cvReleaseImage(gray);
|
|
cvReleaseImage(imgcopy);
|
|
finally
|
|
if Assigned(img) and (not isCapture) then
|
|
cvReleaseImage(img);
|
|
// destroy image objects (if it does not originate from a capture object)
|
|
if Assigned(capture) then
|
|
cvReleaseCapture(capture);
|
|
if Assigned(storage) then
|
|
cvReleaseMemStorage(storage);
|
|
end;
|
|
|
|
except
|
|
on E: Exception do
|
|
Writeln(
|
|
E.ClassName,
|
|
': ',
|
|
E.Message);
|
|
end;
|
|
|
|
end.
|