|
Usuários |
|
30 Usuários Online
|
|
[Dicas]
Reconhecimento Facial em Delphi - Agora ficou mais fácil |
Publicado por patrix : Quinta, Dezembro 20, 2012 - 08:22 GMT-3 (2233 leituras)
 9 Comentários  Enviar para um amigo  Versão para impressão
|
Bom pessoal, podia estar roubando, matando ou vendendo o código, mas decidi postar gratuitamente para que vc´s EVOLUAM em um
ser de luz :D . Serei rápido e objetivo e o resto é com vcs. Peço apenas para quem compartilhar, não esquecer dos créditos. Segue a base para trabalhar com reconhecimento facial em Delphi:
Baixe os PAS e dll´s: Math,IPL, OpenCV, OpenCV_CV, OpenCV_CXCORE, OpenCV_HighGUI, etc...
Disponibilizei em http://www.4shared.com/file/9zY0Kevb/OPENCV.html
Segue o código.
{*******Desenvolvido por Patrick Grosch patrick@datasulbr.com - baseado na biblioteca OPENCV 2010***********}
unit unitrec;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls,Math,IPL, OpenCV, frmHistogram, jpeg, OpenCV_CV, OpenCV_CXCORE, OpenCV_HighGUI,
StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Timer1: TTimer;
Label1: TLabel;
Label2: TLabel;
Bevel1: TBevel;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure servoxTimer(Sender: TObject);
private
Capture: PCvCapture;
Storage: PCvMemStorage;
Xml: string;
Cascade2: PCvHaarClassifierCascade;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
BinArr: array of Byte;
calculax,tempx,tempposx,tempposy,calculay:integer;
i, bin_w: integer;
_vmin, _vmax: integer;
max_val: float;
val: integer ;
cs: CvSize;
rec: TRect;
{-----------------------}
image: pIplImage = nil;
hsv: pIplImage = nil;
hue: pIplImage = nil;
mask: pIplImage = nil;
backproject: pIplImage = nil;
histimg: pIplImage = nil;
hist: PCvHistogram = nil;
backproject_mode: longint = 0;
select_object: longint = 0;
track_object: longint = 0;
show_hist: longint = 0;
origin: CvPoint;
selection: CvRect;
track_window: CvRect;
track_box: CvBox2D;
track_comp: CvConnectedComp;
hdims: longint = 16;
hranges_arr: array[0..1] of float = (0, 180);
hranges: Pfloat = @hranges_arr;
capture: PCvCapture;
frame: PIplImage;
color: CvScalar;
bmp: TBitmap;
cr: TRect;
r: PCvRect;
faces: PCvSeq;
pt1, pt2: TCvPoint2D32f;
{-----------------------------}
sector_data : array[0..5] of array[0..2] of longint =
((0,2,1), (1,2,0), (1,0,2), (2,0,1), (2,1,0), (0,1,2));
{*************************************************************************}
implementation
{$R *.dfm}
function hsv2rgb(hue: float ): CvScalar ;
var
rgb : array[0..2] of longint;
p, sector: longint;
// sector_data : array[0..5] of array[0..2] of longint;
begin
hue := hue * 0.033333333333333333333333333333333;
sector := cvFloor(hue);
p := cvRound(255*(hue - sector));
if (sector and 1) <> 0 then
p := p xor 255
else
p := p xor 0;
rgb[sector_data[sector][0]] := 255;
rgb[sector_data[sector][1]] := 0;
rgb[sector_data[sector][2]] := p;
result := cvScalar_(rgb[2], rgb[1], rgb[0], 0);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
conta:integer;
begin
frame := cvQueryFrame( capture );
if not(assigned(frame) ) then
exit;
if not(assigned(image) ) then
begin
//Aloca em buffer
cs.width := frame.Width;
cs.height := frame.Height;
image := cvCreateImage( cs, 8, 3 );
image.Origin := frame.Origin;
hsv := cvCreateImage( cs, 8, 3 );
hue := cvCreateImage( cs, 8, 1 );
mask := cvCreateImage( cs, 8, 1 );
backproject := cvCreateImage( cs, 8, 1 );
hist := cvCreateHist( 1, @hdims, CV_HIST_ARRAY, @hranges, 1 );
histimg := cvCreateImage( cvSize_(320,200), 8, 3 );
cvZero( histimg );
end;
cvCopy( frame, image, nil );
cvCvtColor( image, hsv, CV_BGR2HSV );
frame := cvQueryFrame(Capture);
if not Assigned(frame) then Exit;
{visualize a câmera na janela}
IplImage2Bitmap(image, bmp);
rec := image1.canvas.ClipRect;
image1.canvas.StretchDraw(rec , bmp);
cvClearMemStorage(Storage);
faces := cvHaarDetectObjects(frame, Cascade2, Storage, 1.2, 2,CV_HAAR_DO_CANNY_PRUNING, CvSize_(40, 40));
IplImage2Bitmap(frame, bmp);
bmp.Canvas.Pen.Color := clRed;
bmp.Canvas.Pen.Width := 3;
bmp.Canvas.Brush.Style:= bsClear;
for i := 0 to Faces.total - 1 do begin
r := PCvRect(cvGetSeqElem(Faces, i));
pt1.x := r.x;
pt2.x := r.x + r.width;
pt1.y := r.y;
pt2.y := r.y + r.height;
if Faces.total>0 then
begin
for conta:=1 to Faces.total do
Bmp.Canvas.Rectangle(Round(pt1.x),Round(pt1.y), Round(pt2.x), Round(pt2.y));
if r.x>160 then
calculax:=abs((r.x-tempposx)-tempx) else
calculax:=abs((r.x+tempposx)+tempx);
tempposx:=r.x;
end else
//calculax:=84;
end;
cr := Image1.Canvas.ClipRect;
Image1.Canvas.StretchDraw(cr, Bmp);
{ if (show_hist <> 0) then
begin
IplImage2Bitmap(histimg, bmp);
fHistogram.histimage.canvas.StretchDraw(fHistogram.histimage.canvas.ClipRect , bmp);
end;}
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Storage := cvCreateMemStorage(0);
Xml := 'haarcascade_frontalface_alt.xml';
Cascade2 := PCvHaarClassifierCascade(cvLoad(PChar(Xml), nil, nil, nil ));
capture := cvCreateCameraCapture(0);
if not(assigned(capture )) then
begin
MessageDlg('Could not initialize capturing from camera!!', mtError, [mbOK], 0);
halt;
end;
bmp := TBitmap.Create;
bmp.PixelFormat := pf24bit;
timer1.enabled := true;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
cvReleaseCapture(@Capture);
FreeAndNil(Bmp);
if assigned(fHistogram) then
fHistogram.Destroy;
end;
{*******Desenvolvido por Patrick Grosch patrick@datasulbr.com - baseado na biblioteca OPENCV 2010***********}
end.
|
|
 Comentários | |
| | Comentários pertencem aos seus respectivos autores. Não somos responsáveis pelo seus conteúdos. |
por: EliomarOffice (eliomar0910@gmail.com)
: Dez 20, 2012 - 10:57
(Informações sobre o membro | Enviar uma mensagem)
|
é não consegui fazer funcionar não... da erro sempre, win7 64 bits; estranho que pegando o exe que esta dentro da pasta bin, dos fontes: http://opencvdelphi.googlecode.com/svn/trunk/demos/camshiftdemo/bin
camshiftdemo.exe pelo menos mostra a imagem e tal se eu compilar ai não funciona mais.
Alguém conseguiu fazer funcionar?
|
|
|
Edição 112 |
|
|
50 Programas Fontes |
|
|
Produtos |
|
|
