рекурсивный обход всех пикселей картинки, распознавание образов Опции

[Rian]

сдрасте экспериментирую с распознаванием образов...
вобщем на картинке есть фигура (условно элипс)синего цвета
надо определить границы этой фигуры (верх-низ тд)

я нахожу любой синий пиксел и рекурсивно обхожу все соседние, перерисовывая в красный каждый проверенный

вот ток с возвратом результата что не так
подскажите где меня заклинило))

procedure analiz_pict(const image:timage;vis:tvis);
var
x,y,z:integer;
circles:array of TRect;

  function place_circ(const image:timage;x,y:integer):trect;
  var
  tempr:trect;
  begin
  result.Left:=x;
  result.Top:=y;
  result.Right:=x;
  Result.Bottom:=y;

  image.Canvas.Pixels[x,y]:=255;
  image.Invalidate;

  {if x<Result.Left then result.Left:=x;
  if x>result.Right then Result.Right:=x;
  if y<Result.Top then result.Top:=y;
  if y>Result.Bottom then Result.Bottom:=y;}


    if GetBValue(image.Canvas.Pixels[x-1,y])=255 then begin
    tempr:=place_circ(image,x-1,y);
    if tempr.Left<Result.Left then Result.Left:=tempr.Left;
    end;

    if GetBValue(image.Canvas.Pixels[x+1,y])=255 then begin
    tempr:=place_circ(image,x+1,y);
    if tempr.Right>Result.Right then Result.Right:=tempr.Right;
    end;

    if GetBValue(image.Canvas.Pixels[x,y-1])=255 then begin
    tempr:=place_circ(image,x,y-1);
    if tempr.top<Result.top then Result.top:=tempr.top;
    end;

    if GetBValue(image.Canvas.Pixels[x,y+1])=255 then begin
    tempr:=place_circ(image,x,y+1);
    if tempr.Bottom<Result.Bottom then Result.Bottom:=tempr.Bottom;
    end;
  end;
  label ex;
begin
  for x:=1 to image.Width-1 do
  for y:=1 to image.Height-1 do
  begin
  //z:=GetBValue(image.Canvas.Pixels[x,y]);
  //z:=0;
  if GetBValue(image.Canvas.Pixels[x,y])=255  then
  begin
  SetLength(circles,1);
  circles[0]:=place_circ(image,x,y);
  goto ex;
  end;
  end;
  ex: z:=0
end;

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

Сообщение отредактировано: feniks25 - 6.01.2010 22:24

[Lapp]

А что эта тема делает в Задачах?
Перенести в Delphi?

[Rian]

Перенести а Delfi?

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

result.Left:=x;
  result.Top:=y;
  result.Right:=x;
  Result.Bottom:=y;

и вот тут (для нижней границы проверяю через (<)

if GetBValue(image.Canvas.Pixels[x,y+1])=255 then begin
    tempr:=place_circ(image,x,y+1);
    if tempr.Bottom<Result.Bottom then Result.Bottom:=tempr.Bottom;

[volvo]

Непонятны 2 вещи:
во-первых, с чего ты решил, что для определения "синий цвет" достаточно, чтобы GetBValue было равно 255? У белого оно тоже 255. Сравнивай с синим цветом:

if image.Canvas.Pixels[x,y]=clBlue then ...

А во-вторых, для того, чтобы определить границы эллипса, недостаточно проверить ТОЛЬКО точки, находящиеся строго вверху, внизу, слева и справа. Надо еще проверять и угловые: выше-левее, ниже-левее, выше-правее, ниже-правее. Вот это, к примеру, выдает правильные границы эллипса:

procedure analiz_pict(const image:timage);

  function place_circ(const image:timage;x,y:integer):trect;
  const
    delta: array[1 .. 8] of record dx, dy: integer; end =
    (
      (dx:0; dy:1),
      (dx:1; dy:0),
      (dx:0; dy:-1),
      (dx:-1; dy:0),
      (dx:1; dy:1),
      (dx:1; dy:-1),
      (dx:-1; dy:1),
      (dx:-1; dy:-1)
    );

  var
  tempr:trect;
  i: integer;
  begin
    with result do
    begin
      Left := x; Top := y;
      Right := x; Bottom := y;
    end;
    image.Canvas.Pixels[x, y] := 255;
    image.Invalidate;

    for i := 1 to 8 do
    begin
      if image.Canvas.Pixels[x+delta[i].dx,y+delta[i].dy] = clBlue then begin
        tempr := place_circ(image, x+delta[i].dx,y+delta[i].dy);
        if tempr.Left < result.left then result.Left := tempr.Left;
        if tempr.right > result.right then result.right := tempr.right;
        if tempr.top < result.top then result.top := tempr.top;
        if tempr.bottom > result.bottom then result.bottom := tempr.bottom;
      end;
    end;
  end;

var
  x,y,z:integer;
  circles:array of TRect;

  label ex;
begin
  for x:=1 to image.Width-1 do
    for y:=1 to image.Height-1 do
    begin
      if image.Canvas.Pixels[x,y]=clBlue then
      begin
        SetLength(circles,1);
        circles[0]:=place_circ(image,x,y);
        showmessage(
          format('left:%d, top:%d, right:%d, bottom:%d',
          [circles[0].left, circles[0].Top, circles[0].Right, circles[0].Bottom])
        );
        goto ex;
      end;
    end;
  ex:
  z:=0
end;

[Rian]

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


вопрос
для чего проверять диагонали 159 753? если проверять крестом то для 5 проверяются 4268 для 4-12...
123
456
789
или например по диоганалям впринципе можно за границы области выйти
000х
00х1
0х11
х111

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

canvas же считает от 1 а не от 0? почему так?

[volvo]

canvas же считает от 1 а не от 0?

С чего бы? Всегда с 0 индексация была...

для чего проверять диагонали 159 753? если проверять крестом то для 5 проверяются 4268 для 4-12...

Для того, чтобы найти фигуру, надо проверять всех ближайших соседей точки.

[Rian]

С чего бы? Всегда с 0 индексация была...
Для того, чтобы найти фигуру, надо проверять всех ближайших соседей точки.

мда с 0... засчитался
но диагонали мне не подойдут:

_111___
11111___
11111___
_____1111
_____1111

вариант маловероятный, но возможный