Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Обход контура в BitMap [D4, WinXP]


Страницы:   1 2

Ozone ©   (2004-09-16 05:37:00) 

Есть некий замкнутый контур черного цвета (толщина = 1 пиксель) нарисованный на BitMap. Необходимо его обойти и раскрасить, к примеру, красным цветом.

Написал такую процедурку, но она работает не до конца (т.е. обходит только часть)


type
   TDirect = array [0..7, 0..1] of integer;
// т.е. 8 направлений обхода
const
   Locate : TDirect = ( (0,-1), (1,-1), (1,0), (1,1), (0,1), (-1,1), (-1,0), (-1,-1) );
procedure Test(p: TPoint; bmp: TBitMap; loct: integer;
 var count: integer);
var
  i : 0..7;
  flg: boolean;
  tmp_loct: integer;
begin

    if (bmp.Canvas.Pixels[p.x,p.y] = clWhite) then exit;

    // Ставим белую точку чтобы остановиться когда обойдем все
    if count = 0 then bmp.Canvas.Pixels[p.x,p.y] := clWhite;

    inc(count);

    bmp.Canvas.Pixels[p.x, p.y] := clRed;

    // "говорим" откуда пришли, чтобы он не смотрел туда
    tmp_loct := loct + 4;
    if tmp_loct > 7 then dec(tmp_loct,8);

    for i:=0 to 7 do
      if tmp_loct <> i then
        if bmp.Canvas.Pixels[p.x + Locate[i,0], p.y + Locate[i,1]] = clBlack then begin
          Test(Point(p.x + Locate[i,0], p.y + Locate[i,1]),bmp, i, count);
          break;
        end;
end;


// Ну и вызываю так

begin
    { здесь нахожу точку принадлежащию контуру - записываю ее в Point: TPoint}
    count := 0;
    Test(Point, bmp, 0, count);
    {...}
end;

Что я неправильно делаю? Может есть другой способ?


MBo   (2004-09-16 12:32:00) [21]

F1 Path functions в MSDN или SDKHelp ;)


Ozone   (2004-09-16 12:19:00) [22]

MBo ©   (16.09.04 12:08) [5]
? Path

Не разу об этом не слышал? Как это работает?


MBo   (2004-09-16 12:08:00) [23]

>Ozone ©   (16.09.04 12:03) [3]
Так ведь эти точки появились не сами по себе, а в результате рисования прямых и кривых - а значит, получать их вручную не нужно, а использовать функции работы с Path, затем перевести PathToRegion


Ozone   (2004-09-16 12:05:00) [24]

KilkennyCat ©   (16.09.04 08:59) [2]

//а зачем? коли мы знаем координаты, откуда начали, так может, лучше их и помнить?

Угу. Так лучше.
А на счет алгоритма - попробую, спасибо.


Ozone   (2004-09-16 12:03:00) [25]

Думкин ©   (16.09.04 06:28) [1]

Угадал :)


KilkennyCat   (2004-09-16 08:59:00) [26]

// Ставим белую точку чтобы остановиться когда обойдем все
   if count = 0 then bmp.Canvas.Pixels[p.x,p.y] := clWhite


а зачем? коли мы знаем координаты, откуда начали, так может, лучше их и помнить?

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


Думкин   (2004-09-16 06:28:00) [27]

Тебе в итоге регион создать надо?


Страницы:   1 2

Наверх

Титульная страница Поиск, карта сайта Написать письмо