Виявлення обличчя на зображенні

pn:=pn+1;

px[pn]:=r;

py[pn]:=i;

g[i,r]:=true;

r:=r+1;

end;

r:=r-1;

t:=i+1;

repeat

e:=0; w:=0;

for p:=l to r do

if ((colshkr[t,p]) and (not(g[t,p]))) then

begin

pn:=pn+1;

px[pn]:=p;

py[pn]:=t;

g[t,p]:=true;

if ((colshkr[t,p]) and (e=0) ) then e:=p;

if ((colshkr[t,p]) and (e<>0)) then w:=p;

end;

l:=e; r:=w;

if l=r then break;

p:=l-1;

while ((colshkr[t,p]) and (not(g[t,p])) and (p>=1)) do

begin

pn:=pn+1;

px[pn]:=p;

py[pn]:=t;

g[t,p]:=true;

p:=p-1;

end;

l:=p+1;

p:=r+1;

while ((colshkr[t,p]) and (not(g[t,p])) and (p<=bmpin.Width)) do

begin

pn:=pn+1;

px[pn]:=p;

py[pn]:=t;

g[t,p]:=true;

p:=p+1;

end;

r:=p-1;

t:=t+1;

until ((r=l) or (t>bmpin.Height));

sx:=0; sy:=0; sw:=0;

for k:=1 to pn do

begin

col:=bmpin.Canvas.Pixels[px[k],py[k]];

rr:=GetRValue(col);

gg:=GetGValue(col);

bb:=GetBValue(col);

rr:=round(0.3*rr+0.59*gg+0.11*bb);

sw:=sw+rr;

sx:=sx+px[k]*rr;

sy:=sy+py[k]*rr;

end;

x:=round(sx/sw);

y:=round(sy/sw);

u1:=0; u20:=0; u02:=0;

for k:=1 to pn do

begin

col:=bmpin.Canvas.Pixels[px[k],py[k]];

rr:=GetRValue(col);

gg:=GetGValue(col);

bb:=GetBValue(col);

rr:=round(0.3*rr+0.59*gg+0.11*bb);

u1:=u1+(px[k]-x)*(py[k]-y)*rr;

u02:=u02+sqr(px[k]-x)*rr;

u20:=u20+sqr(py[k]-y)*rr;

end;

if u20=u02 then teta:=arctan(0)

else teta:=arctan(2*u1/(u20-u02))/2;

imin:=0; imax:=0;

for k:=1 to pn do

begin

imax:=imax+sqrt(abs((px[k]-x)*sin(teta)-(py[k]-y)*cos(teta)));

imin:=imin+sqrt(abs((px[k]-x)*cos(teta)-(py[k]-y)*sin(teta)));

end;

if imin=0 then u02:=0 else u02:=power(imax,3)/imin;

if imax=0 then u20:=0 else u20:=power(imin,3)/imax;

a:=round(power((4/pi),1/4)*power(u02,1/8));

b:=round(power((4/pi),1/4)*power(u20,1/8));

if (a<4*b) and (a>3*b) then ellipse(x,y,a,b,teta);

end;

end;

function min(r:byte;g:byte;b:byte):byte;

begin

result:=r;

if b<result then result:=b;

if g<result then result:=g;

end;

function max(r:byte;g:byte;b:byte):byte;

begin

result:=r;

if b>result then result:=b;

if g>result then result:=g;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

if openpicturedialog1.Execute then

begin

image1.Picture.LoadFromFile(openpicturedialog1.filename);

bmpin:=TBitmap.Create;

bmpin.assign(image1.Picture.Graphic);

Image1.AutoSize := true;

Image1.AutoSize := false;

HH := Image1.Height / h;

WW := Image1.Width / w;

if (HH > WW) then

begin

Image1.Height := trunc(Image1.Height / HH);

Image1.Width := trunc(Image1.Width / HH);

Image1.Stretch := True;

end

else

begin

Image1.Height := trunc(Image1.Height / WW);

Image1.Width := trunc(Image1.Width / WW);

Image1.Stretch := True;

end;

end;

end;

procedure TForm1.Button2Click(Sender: TObject);

var r,g,b:byte;

rr,gg,t,s,p:real;

color:Tcolor;

i,j,k,l,m:integer;

colshkr:boolarr;

z:array[1..9] of byte;

h1,h2,h3,h4,x:real;

bmpp: TBitmap;

begin

bmpout:=TBitmap.Create;

bmpout.Assign(bmpin);

bmpp:=TBitmap.Create;

bmpp.Assign(bmpin);

for i:=1 to bmpout.Width do

for j:=1 to bmpout.Height do

begin

color:=bmpout.Canvas.Pixels[i,j];

r:=GetRValue(color);

g:=GetGValue(color);

b:=GetBValue(color);

if ((r>95) and (g>40) and (b>20) and (r>g) and (r>b) and (abs(r-g)>15) and ((max(r,g,b)-min(r,g,b))>15)) or ((r>220)and (g>120) and (b>170) and (abs(r-g)<=15) and (r>b) and (g>b)) then

colshkr[i,j]:=true else colshkr[i,j]:=false;

if ((r>0) or (b>0) or (g>0)) then

begin

rr:=r;

gg:=g;

p:=r; p:=p+g; p:=p+b;

rr:=rr/p-1/3;

gg:=gg/p-1/3;

if gg=0 then t:=0;

if gg>0 then t:=(arctan(rr/gg))/(2*pi)+1/4;

if gg<0 then t:=(arctan(rr/gg))/(2*pi)+3/4;

if ((t>=0.45) and (t<=0.65) and colshkr[i,j]) then colshkr[i,j]:=true

else colshkr[i,j]:=false;

end

else colshkr[i,j]:=false;

end;

for i:=1 to bmpin.Width do

for j:=1 to bmpin.Height do

begin

color:=bmpin.Canvas.Pixels[i,j];

r:=GetRValue(color);

g:=GetGValue(color);

b:=GetBValue(color);

r:=round(0.3*r+0.59*g+0.11*b);

bmpp.Canvas.Pixels[i,j]:=rgb(r,r,r);

end;

for i:=2 to (bmpp.Width-1) do

for j:=2 to (bmpp.Height-1) do

begin

z[1]:=getrvalue(bmpp.Canvas.Pixels[i-1,j-1]);

z[2]:=getrvalue(bmpp.Canvas.Pixels[i,j-1]);

z[3]:=getrvalue(bmpp.Canvas.Pixels[i+1,j-1]);

z[4]:=getrvalue(bmpp.Canvas.Pixels[i-1,j]);

z[5]:=getrvalue(bmpp.Canvas.Pixels[i,j]);

z[6]:=getrvalue(bmpp.Canvas.Pixels[i+1,j]);

z[7]:=getrvalue(bmpp.Canvas.Pixels[i-1,j+1]);

z[8]:=getrvalue(bmpp.Canvas.Pixels[i,j+1]);

z[9]:=getrvalue(bmpp.Canvas.Pixels[i+1,j+1]);

h1:=abs(z[7]+2*z[8]+z[9]-z[1]-2*z[2]-z[3]);

h2:=abs(z[3]+2*z[6]+z[9]-z[1]-2*z[4]-z[7]);

h3:=abs(z[2]+2*z[3]-z[4]+z[6]-2*z[7]-z[8]);

h4:=abs(2*z[9]+z[8]+z[6]-z[4]-z[2]-2*z[1]);

x:=50;

if ((h1>x)or (h2>x) or (h3>x) or (h4>x)) then bmpp.Canvas.Pixels[i,j]:=clBlack

else bmpp.Canvas.Pixels[i,j]:=clWhite;

end;

znah(bmpin,bmpout,colshkr);

image3.Picture.Assign(bmpout);

Image3.AutoSize := true;

Image3.AutoSize := false;

HH := Image3.Height / h;

WW := Image3.Width / w;

if (HH > WW) then

begin

Image3.Height := trunc(Image3.Height / HH);

Image3.Width := trunc(Image3.Width / HH);

Image3.Stretch := True;

end

else

begin

Image3.Height := trunc(Image3.Height / WW);

Image3.Width := trunc(Image3.Width / WW);

Image3.Stretch := True;

end;

Размещено на Allbest.ru