VPF::Алгоритм поиска прямоугольников в bmp

Pcrepair

Дата 7.1.2025, 18:12 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 209
Регистрация: 16.1.2011

Репутация: нет
Всего: нет

Добрый день. Есть задача поиска прямоугольников в BMP файле со следующими параметрами:
1) исходный файл черно-белый (белый цвет значащий), разрядность 1-бит
2) размер файла 1920х1031 пиксель, но это не принципиально, размеры могут быть всякие
3) фигуры внутри файла могут быть всякие, но это не принципиально, нужны только прямоугольники, даже если сложная фигура будет определена как прямоугольник значения не имеет

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

Код


procedure TMain.Button1Click(Sender: TObject);
var
  rLeft, rTop, rRigth, rBottom, rMinH, rMinW: Integer;
  glBitMap: Vcl.Graphics.TBitmap;
  rRestsList: string;
begin  // запуск процесса поиска
  glBitMap := TBitmap.Create;
  try
    if FindRects(glBitMap, rRestsList) then
      Memo1.Lines.Add(rRestsList);
  finally
    FreeAndNil(glBitMap);
  end;
end;

(* 2024.12.21 to find all exseptable rectigies coordinates in bmp *)
function FindRects(const aBitmap: Vcl.Graphics.TBitmap; var aRestsList: string): Boolean;
var
  H, W, hStart, wStart: Integer;
  stFlg: Boolean;
  Clr, aLeft, aTop, aRigth, aBottom: Integer;
  RestsList: string;
begin
  Result := false;
  hStart := 0;  // установка поиска в начало координат файл.БМП
  wStart := 0;

  repeat // повтор поиска
    stFlg := false;
    
    // функция DefineRectCoo возвращает ДА и координаты лево-верх-справа-низ ПЕРВОГО! найденного прямоугольника в файл.БМП
    if DefineRectCoo(aBitmap, hStart, wStart, aLeft, aTop, aRigth, aBottom) then  
    begin
      (* send data to output *)  //сбор координат найденных прямоугольников
      Insert((IntToStr(aLeft) + ':' + IntToStr(aTop) + ':' + IntToStr(aRigth) + ':' + IntToStr(aBottom) +
        sLineBreak), aRestsList, (aRestsList.Length + 1));
      (* ---------------------- *)

      stFlg := true; //запуск повторного поиска
    end;

    (* next rigth-top rect *)
    hStart := aTop; wStart := aRigth + 1;  //поиск из новой начальной точки: верх-справа от найденного прямоугольника

  until (stFlg = false);

  if (aRestsList.Length > 0) then
    Result := true;
end;
(* -------------------------------------------- *)

все почти хорошо, но определяюттся только координаты всех прямоугольников которые справа от найденного hStart := aTop; wStart := aRigth + 1; никак не придумаю алгоритм для поиска всех прямоугольников
file.bmp входной файл
data.bmp результат поиска

вопрос: может кто что подскажет по алгоритму?

Заранее спасибо за ответы по ЗАДАННЫМ вопросам

Это сообщение отредактировал(а) Pcrepair - 7.1.2025, 18:17

Присоединённый файл ( Кол-во скачиваний: 3 )

bmp.zip 3,27 Kb

--------------------

Сборник рабочего кода Процедур и Функций DelPhi http://validcoderepo.narod.ru/

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »