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

Posted by obzor under Delphi, Архив

На bmp изображении есть тела черного цвета самой причудливой формы, надо узнать координаты пикселей, которые входят в тот или иной объект изображения.перебераю пиксели пока не встречу первый черный. Потом думал рекурсивную функцию закинуть, но вот не знаю как организовать обработку того что соседе белые или черные(соседей 8). Перебирать все 256 вариантов для рекурсии нет смысла, а вот что-то более рациональное на ум не приходит.Может кто и сталкивался с такого рода задачами… Bmp можно перекрашивать на серый тон…

Cerebrum

Вот код(тут еще чуть лишнего кода, но это уже к моей программе отностится)

procedure sosed(a,b:integer);
begin
  with otpec[q] do begin
    if (GetRValue(bm.Canvas.Pixels[a-1,b])<=predelchern) and
      (GetGValue(bm.Canvas.Pixels[a-1,b])<=predelchern) and
      (GetBValue(bm.Canvas.Pixels[a-1,b])<=predelchern) then
    begin
      bm.Canvas.Pixels[a-1,b]:=clred;  //перекрашиваю, чтоб по кругу не гулять
      qp:=1+qp;                  //кол-во пикселей в нашем q-м объекте
      sosed(a-1,b);
    end;
    if (GetRValue(bm.Canvas.Pixels[a-1,b+1])<=predelchern) and
      (GetGValue(bm.Canvas.Pixels[a-1,b+1])<=predelchern) and
      (GetBValue(bm.Canvas.Pixels[a-1,b+1])<=predelchern) then
    begin
      bm.Canvas.Pixels[a-1,b+1]:=clred;
      qp:=1+qp;
      sosed(a-1,b+1);
    end;
    if (GetRValue(bm.Canvas.Pixels[a,b+1])<=predelchern) and
      (GetGValue(bm.Canvas.Pixels[a,b+1])<=predelchern) and
      (GetBValue(bm.Canvas.Pixels[a,b+1])<=predelchern) then
    begin
      bm.Canvas.Pixels[a,b+1]:=clred;
      qp:=1+qp;
      sosed(a,b+1);
    end;
    if (GetRValue(bm.Canvas.Pixels[a+1,b+1])<=predelchern) and
      (GetGValue(bm.Canvas.Pixels[a+1,b+1])<=predelchern) and
      (GetBValue(bm.Canvas.Pixels[a+1,b+1])<=predelchern) then
    begin
      bm.Canvas.Pixels[a+1,b+1]:=clred;
      qp:=1+qp;
      sosed(a+1,b+1);
    end;
    if (GetRValue(bm.Canvas.Pixels[a+1,b])<=predelchern) and
      (GetGValue(bm.Canvas.Pixels[a+1,b])<=predelchern) and
      (GetBValue(bm.Canvas.Pixels[a+1,b])<=predelchern) then
    begin
      bm.Canvas.Pixels[a+1,b]:=clred;
      qp:=1+qp;
      sosed(a+1,b);
    end;
    if (GetRValue(bm.Canvas.Pixels[a+1,b-1])<=predelchern) and
      (GetGValue(bm.Canvas.Pixels[a+1,b-1])<=predelchern) and
      (GetBValue(bm.Canvas.Pixels[a+1,b-1])<=predelchern) then
    begin
      bm.Canvas.Pixels[a+1,b-1]:=clred;
      qp:=1+qp;
      sosed(a+1,b-1);
    end;
    if (GetRValue(bm.Canvas.Pixels[a,b-1])<=predelchern) and
      (GetGValue(bm.Canvas.Pixels[a,b-1])<=predelchern) and
      (GetBValue(bm.Canvas.Pixels[a,b-1])<=predelchern) then
    begin
      bm.Canvas.Pixels[a,b-1]:=clred;
      qp:=1+qp;
      sosed(a,b-1);
    end;
    if (GetRValue(bm.Canvas.Pixels[a-1,b-1])<=predelchern) and
      (GetGValue(bm.Canvas.Pixels[a+1,b-1])<=predelchern) and
      (GetBValue(bm.Canvas.Pixels[a+1,b-1])<=predelchern) then
    begin
      bm.Canvas.Pixels[a-1,b-1]:=clred;
      qp:=1+qp;
      sosed(a-1,b-1);
    end;
  end;
end;

тема а форуме

Похожие статьи

• Нарисовать синусоиду или огибающую на PaintBbox с использованием BASS.DLL
• DirectShow отзеркалить или перевернуть изображение
• Создание видеофайла из множества BMP(JPEG) файлов
• Анимировать стрелку на изображении аналогового индикатора П-321М
• Текст по картинке
• Плавное появление/исчезновение объекта TImage
• Воспроизведение файлов .mp4 в Delphi
• Проигрывание MP4 файла, кроме WMP
• Фото с вебкамеры в Delphi
• Считывание звука с микрофона и его воспроизведение или запись