Seguimiento de personas, animales y objetos con OpenCV en Delphi

OpenCV para los que no la conozcan, es una biblioteca libre enfocada hacia la visión artificial, inicialmente desarrollada por Intel bajo licencia BSD lo que permite que sea usada libremente para un propósito comercial o de investigación.


OpenCV es multiplataforma con versiones para Windows, Linux y Mac y contiene funciones que tratan los temas de proceso de visión, reconocimiento facial, calibrado de cámaras o robótica.
Esta biblioteca es la base de la herramienta Swistrack que sirve para hacer un seguimiento de personas, animales y objetos.

El siguiente código se puede ejecutar en Delphi XE2 o superior y lo que hace es, como veis en la imagen, un seguimiento de las personas que circulan por la calle rodeándolas con un rectángulo de color rojo a medida que se van desplazando.

(* /*****************************************************************
// Delphi-OpenCV Demo
// Copyright (C) 2013 Project Delphi-OpenCV
// ****************************************************************
// Contributor:
// Mikhail Grigorev
// email: sleuthhound@gmail.com
// ****************************************************************
// 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 MotionDetect;

{$APPTYPE CONSOLE}
{$POINTERMATH ON}
{$R *.res}

uses
System.SysUtils,
Math,
uLibName in '..\..\..\include\uLibName.pas',
highgui_c in '..\..\..\include\highgui\highgui_c.pas',
imgproc.types_c in '..\..\..\include\imgproc\imgproc.types_c.pas',
imgproc_c in '..\..\..\include\imgproc\imgproc_c.pas',
imgproc in '..\..\..\include\imgproc\imgproc.pas',
core in '..\..\..\include\core\core.pas',
core.types_c in '..\..\..\include\core\Core.types_c.pas',
core_c in '..\..\..\include\core\core_c.pas';

var
storage: pCvMemStorage = nil;
capture: pCvCapture = nil;
frame: pIplImage = nil;
frame_grey: pIplImage = nil;
difference_img: pIplImage = nil;
oldframe_grey: pIplImage = nil;
contours: pCvSeq = nil;
c: pCvSeq = nil;
// rect: TCvRect;
rect2d: TCvBox2D;
key: integer;
first: boolean = true;

begin
try
capture := cvCreateCameraCapture(0);
storage := cvCreateMemStorage(0);
frame := cvQueryFrame(capture);
frame_grey := cvCreateImage(cvSize(frame^.width, frame^.height), IPL_DEPTH_8U, 1);

while true do
begin
frame := cvQueryFrame(capture);
if frame = nil then
break;
cvCvtColor(frame, frame_grey, CV_RGB2GRAY);
if first then
begin
difference_img := cvCloneImage(frame_grey);
oldframe_grey := cvCloneImage(frame_grey);
cvConvertScale(frame_grey, oldframe_grey, 1.0, 0.0);
first := false;
end;
cvAbsDiff(oldframe_grey, frame_grey, difference_img);
cvSmooth(difference_img, difference_img, CV_BLUR);
cvThreshold(difference_img, difference_img, 25, 255, CV_THRESH_BINARY);
contours := AllocMem(SizeOf(TCvSeq));
cvFindContours(difference_img, storage, @contours, SizeOf(TCvContour), CV_RETR_LIST, CV_CHAIN_APPROX_NONE,
cvPoint(0, 0));
c := contours;
while (c <> nil) do
begin
rect2d := cvMinAreaRect2(c);
cvRectangle(frame, cvPoint(Round(rect2d.center.x - rect2d.size.width / 2),
Round(rect2d.center.y - rect2d.size.height / 2)), cvPoint(Round(rect2d.center.x + rect2d.size.width / 2),
Round(rect2d.center.y + rect2d.size.height / 2)), cvScalar(0, 0, 255, 0), 2, 8, 0);
c := c.h_next;
end;
cvShowImage('Output Image', frame);
cvShowImage('Difference Image', difference_img);
cvConvertScale(frame_grey, oldframe_grey, 1.0, 0.0);
cvClearMemStorage(storage);
c := nil;
FreeMem(contours, SizeOf(TCvSeq));
key := cvWaitKey(33);
if (key = 27) then
break;
end;
cvReleaseMemStorage(storage);
cvReleaseCapture(capture);
cvReleaseImage(oldframe_grey);
cvReleaseImage(difference_img);
cvReleaseImage(frame_grey);
cvDestroyAllWindows();
except
on E: Exception do
WriteLn(E.ClassName, ': ', E.Message);
end;

end.


Relacionado:

Conversor de Cabeceras API de C o C++ a Delphi

Conversion pack menu items

Por si alguna vez han tenido la necesidad de convertir units en C, C++ a Delphi aquí les dejo una utilidad freeware que les hará gran parte del trabajo. Según dice su autor no cubre todos los aspectos de la gramática en C, pero sí la mayoría por lo que después de hacer la conversión nos quedaría hacer un pequeño trabajo de detalle convirtiendo manualmente las líneas que el software no habría podido hacer.
Actualmente el soft implementa las siguientes funciones:

Conectar Delphi con Active Directory

Active Directory es un servicio de Microsoft que utiliza LDAP para almacenar información de los usuarios y equipos de la red, como el nombre, usuario, contraseña así como la gestión de políticas.
La interfaz de servicio de Active Directory (ADSI) proporciona una interfaz COM que utilizaremos en nuestro programa y para ello preparamos una interfaz en la que le pedimos al usuario su usuario / contraseña y la comparamos con las obtenidas utilizando las units ActiveDs_Tlb y Adshlp, no olvidar añadir también la unit ComObj.
Para hacer la llamada necesitamos además el nombre de dominio de la red y el tipo de autenticación.
Si al comparar ambos datos se produce un error es que no se encuentra el objeto buscado o hay un problema de conectividad de la red.
El ejemplo que está a continuación ha sido desarrollado en Delphi 2009 y probado en servidores Windows 2003 y 2008.
Aquí tienen la unit principal:


unit uAD;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls, ActiveX, adshlp, ActiveDs_Tlb, ComObj;
type
TfrmLogin = class(TForm)btnLogin: TButton;edtUsuario: TEdit;edtSenha: TEdit;lblUsuario: TLabel;lblSenha: TLabel;lblLogin: TLabel;

procedure btnLoginClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmLogin: TfrmLogin;

implementation

{$R *.dfm}

procedure TfrmLogin.btnLoginClick(Sender: TObject);
var
adObject: IADs;
begin
///Inicialização do COM
CoInitialize(nil);
try
ADsOpenObject('LDAP://', LowerCase(edtUsuario.Text), edtSenha.Text, ADS_SECURE_AUTHENTICATION, IADs, adObject);
ShowMessage('Login válido!');
except
on e: EOleException do
begin
if Pos('Falha de logon', e.Message) > 0 then
ShowMessage('Login inválido!')
else
ShowMessage(e.Message);
end;
end;
CoUninitialize;
end;

end.


begin
if Pos('Falha de logon', e.Message) > 0 then
ShowMessage('Login inválido!')
else
ShowMessage(e.Message);
end;
end;
CoUninitialize;
end;

enlace | Codigo
Por: Rodrigo Alves dos Santos 
Contacto: rod.alves88 @ gmail.com


Aqui tienen otro codigo que devuelve el nombre de usuario desde un objeto AD (Hay que utilizar la unit 
ADSISearch.pas)

try
ADSISearch1.Filter := WideString('samaccountname=' + GetUserFromWindows());

try
ADSISearch1.Search;
slTemp := ADSISearch1.GetFirstRow();
except
//uh-oh, this is a problem, get out of here
//must not have been able to talk to AD
//could be the user recently changed pwd and is logged in with
//their cached credentials
//just suppress this exception
bHomeDriveMappingFailed := True;
Result := bSuccess;
Exit;
end;

while (slTemp <> nil) do
begin
for ix := 0 to slTemp.Count - 1 do
begin
curLine := AnsiUpperCase(slTemp[ix]);
if AnsiStartsStr('HOMEDIRECTORY', curLine) then
begin
sADHomeDriveUncPath := AnsiReplaceStr(curLine, 'HOMEDIRECTORY=', '');
//sADHomeDriveUncPath := slTemp[ix];
end
else if AnsiStartsStr('HOMEDRIVE', curLine) then
begin
sADHomeDriveLetter := AnsiReplaceStr(curLine, 'HOMEDRIVE=', '');
//sADHomeDriveLetter := slTemp[ix];
end;
end;

FreeAndNil(slTemp);
slTemp := ADSISearch1.GetNextRow();
end;
except
//suppress this exception
bHomeDriveMappingFailed := True;
Exit;
end;




Relacionados

Utilizar el componente TWindowsMediaPlayer
Leer los datos del visor de sucesos
Modificar el brillo de la pantalla

Librería Exif
AntiKeylogger con Delphi
OCR con Tesseract
Delphi  Twain
Informacion de procesos de Windows