Добрый день. Есть задача поиска прямоугольников в BMP файле со следующими параметрами:
1) исходный файл черно-белый (белый цвет значащий), разрядность 1-бит
2) размер файла 1920х1031 пиксель, но это не принципиально, размеры могут быть всякие
3) фигуры внутри файла могут быть всякие, но это не принципиально, нужны только прямоугольники, даже если сложная фигура будет определена как прямоугольник значения не имеет
текущий код позволяет найти координаты прямоугольников те что справа после первого найденного прямоугольники
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
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 результат поиска
вопрос: может кто что подскажет по алгоритму?
Заранее спасибо за ответы по ЗАДАННЫМ вопросам
