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

[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?