Распознание лиц на фото.

[koshel]

Блин уже третий день ламаю голову как выделить елипсом или кругом на оригинале те области которые были отфильтрованые и ничего не могу придумать. Ни у кого нет никаких идей по реализации этой проблемы???

[x128]

как вариант:
1) находишь черную точку
2) рекурсивно пробегаешь по рядом стоящим точкам
3) из полученных координат находишь минимальные и максимальные X и Y для построения прямоугольной области
4) имеешь прямоугольник или рассчитываешь вписанную окружность

[koshel]

чет все равно я не могу догнать.

рекурсивно пробегаешь по рядом стоящим точкам

это просто по ряду Х и У??
а как найти следующую зону??

[x128]

Сообщение от koshel

чет все равно я не могу догнать.
это просто по ряду Х и У??

просто обходишь все пикселы в окружении найденного

а как найти следующую зону??

как логика подскажет, можно просто проверенные пикселы обнулять и после нахождения очередной зоны переходить к следующим пикселам.

[x128]

попробовал реализовать предложенную схему, в общем работает =)
test.png

[koshel]

А код можно глянуть???
Я попробовал обеденить мелкие зоны,что бы кусков не было, и потом по этим зонам выделять так ничего не вышло(( опыта маловато наверное что то пропускаю((

[x128]

var
  xmax,ymax: integer;
  pnt: array of TPoint;
  rects: array of TRect;
...

procedure RegionSearch(x,y: integer);
var
  src: pByteArray;
begin
  if (x<0) or (x>=xmax) or (y<0) or (y>=ymax) then exit;
  src:=form1.Image1.Picture.Bitmap.ScanLine[y];
  if src[x*3]=0 then begin
    SetLength(pnt, length(pnt)+1);
    pnt[length(pnt)-1]:=Point(x,y);
    src[x*3]:=255;

    RegionSearch(x+1,y+0);
    RegionSearch(x+0,y+1);
    RegionSearch(x+1,y+1);
    RegionSearch(x-1,y+0);
    RegionSearch(x+0,y-1);
    RegionSearch(x-1,y-1);
    RegionSearch(x+1,y-1);
    RegionSearch(x-1,y+1);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  x,y,i: integer;
  minx,miny,maxx,maxy: integer;
  src: pByteArray;
begin
  if OpenPictureDialog1.Execute then begin
    image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
    xmax:=image1.Width;
    ymax:=image1.Height;
    rects:=nil;
    for y:=0 to ymax-1 do begin
      src:=image1.Picture.Bitmap.ScanLine[y];
      for x:=0 to xmax-1 do begin
        if src[x*3]=0 then begin
          pnt:=nil;
          RegionSearch(x,y);
          minx:=maxint; miny:=maxint; maxx:=0; maxy:=0;
          for i:=0 to length(pnt)-1 do if pnt[i].X<minx then minx:=pnt[i].X;
          for i:=0 to length(pnt)-1 do if pnt[i].X>maxx then maxx:=pnt[i].X;
          for i:=0 to length(pnt)-1 do if pnt[i].Y<miny then miny:=pnt[i].Y;
          for i:=0 to length(pnt)-1 do if pnt[i].Y>maxy then maxy:=pnt[i].Y;
          SetLength(rects, length(rects)+1);
          rects[length(rects)-1]:=Rect(minx, miny, maxx+1, maxy+1);
        end;
      end;
    end;
    image1.Canvas.Pen.Color:=clRed;
    image1.Canvas.Brush.Style:=bsClear;
    for i:=0 to length(rects)-1 do image1.Canvas.Ellipse(rects[i]);
  end;
end;

[koshel]

СПАСИБО ОГРОМНОЕ!

[koshel]

Не могли бы вы еще раз мне помоч, не подскажите как из вашей процедуры поочереди вытянуть кординаты всех елипсов и по их кординатам вернуть из орегинала изображения??

[x128]

for i:=0 to length(rects)-1 do image1.Canvas.Ellipse(rects[i]);

В этой строчке вывод эллипсов, rects это массив с координатами, т.е. все уже есть. Какая сложность скопировать оригинальные данные по имеющимся координатам?