Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 29.08.2011, 20:20
Pcrepair
 
Сообщения: n/a
По умолчанию Алгоритм выделения объектов из BMP 1bit файла

Добрый день!
Вопросы к программистам, хорошо знающим работу с графикой
Исходные данные:
- есть test1.bmp (1bit, черный цвет -фон, белый цвет - значащий)
- размеры файла 1280х1024 пик (скрин экрана дисплея)
- в изображении есть символы и геометрические фигуры
Задача:
- сгенерировать BMP 1bit файлы 1280х1024 пик из исходного test1.bmp, в количестве равном общему числу символов и фигур в исходном файле
- в каждом новом файле должна быть только один символ или фигура, остальным присвоен цвет = черный
- фигурой или символом считать совокупность пикселей имеющих между собой контакт
- каждый новый файл должен иметь свое имя (координаты первого пикселя символа или фигуры - верхний левый, типа 23-57.bmp) и быть записн на ЖД в том же каталоге

Хотелось бы обсудить, с теми кто знает, алгоритмы работы такой программы
если есть примеры кода на ДЕЛФИ, хорошо бы взглянуть

Заранее спасибо всем!
Ответить с цитированием
  #2  
Старый 29.08.2011, 20:23
Pcrepair
 
Сообщения: n/a
По умолчанию

вот файл БМП
Вложения
Тип файла: zip test1.zip (9.1 Кбайт, 9 просмотров)
Ответить с цитированием
  #3  
Старый 29.08.2011, 20:42
Аватар для Pilot_Red
Pilot_Red Pilot_Red вне форума
Продвинутый
 
Регистрация: 01.11.2006
Адрес: Карелия
Сообщения: 702
Версия Delphi: D7
Репутация: 11581
По умолчанию

а если будет фигура в фигуре??
Ответить с цитированием
  #4  
Старый 29.08.2011, 20:48
Pcrepair
 
Сообщения: n/a
По умолчанию

ну, после определения 1-й фигуры, ее значащие пиксели (белые) приравниваются к черным и при следующем анализе файла эта фигура уже никому не мешает
Ответить с цитированием
  #5  
Старый 29.08.2011, 20:54
Аватар для Pilot_Red
Pilot_Red Pilot_Red вне форума
Продвинутый
 
Регистрация: 01.11.2006
Адрес: Карелия
Сообщения: 702
Версия Delphi: D7
Репутация: 11581
По умолчанию

Цитата:
Сообщение от Pcrepair
ну, после определения 1-й фигуры, ее значащие пиксели (белые) приравниваются к черным и при следующем анализе файла эта фигура уже никому не мешает

Это понятно, но если допустим, у тебя будет треугольник в круге, должно будет создаться 2 файла или же один(круг)
Ответить с цитированием
  #6  
Старый 29.08.2011, 21:06
Pcrepair
 
Сообщения: n/a
По умолчанию

два конечно, вначале круг, затем треугольник
Ответить с цитированием
  #7  
Старый 29.08.2011, 23:21
Аватар для AND_REY
AND_REY AND_REY вне форума
Активный
 
Регистрация: 31.03.2009
Адрес: Украина, г.Днепропетровск
Сообщения: 324
Версия Delphi: Delphi7
Репутация: 3877
По умолчанию

Прикольная задачка, вот набросал: BmpParser.rar
__________________
If end Then begin;
Ответить с цитированием
  #8  
Старый 29.08.2011, 23:48
Аватар для Pilot_Red
Pilot_Red Pilot_Red вне форума
Продвинутый
 
Регистрация: 01.11.2006
Адрес: Карелия
Сообщения: 702
Версия Delphi: D7
Репутация: 11581
По умолчанию

AND_REY, а чё ScanLine-ом не пользовался при прохождении по строкам?? получилось бы в раз 500 быстрее
Ответить с цитированием
  #9  
Старый 30.08.2011, 00:05
Аватар для AND_REY
AND_REY AND_REY вне форума
Активный
 
Регистрация: 31.03.2009
Адрес: Украина, г.Днепропетровск
Сообщения: 324
Версия Delphi: Delphi7
Репутация: 3877
По умолчанию

Чтоб поменьше думать На рекурсию больше внимание обратил.
Можно переписать и сравнить скорость.
__________________
If end Then begin;
Ответить с цитированием
  #10  
Старый 30.08.2011, 00:16
Аватар для Pilot_Red
Pilot_Red Pilot_Red вне форума
Продвинутый
 
Регистрация: 01.11.2006
Адрес: Карелия
Сообщения: 702
Версия Delphi: D7
Репутация: 11581
По умолчанию

Цитата:
Сообщение от AND_REY
Чтоб поменьше думать На рекурсию больше внимание обратил.
Можно переписать и сравнить скорость.

Напиши, посмотрим. Я бы сам сделал, но ой как не охотца с битами работать....
Ответить с цитированием
  #11  
Старый 30.08.2011, 00:38
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Цитата:
Сообщение от Pilot_Red
Напиши, посмотрим. Я бы сам сделал, но ой как не охотца с битами работать....
Тогда работай с байтами, быстрее будет.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #12  
Старый 30.08.2011, 00:54
Аватар для Pilot_Red
Pilot_Red Pilot_Red вне форума
Продвинутый
 
Регистрация: 01.11.2006
Адрес: Карелия
Сообщения: 702
Версия Delphi: D7
Репутация: 11581
По умолчанию

Цитата:
Сообщение от angvelem
Тогда работай с байтами, быстрее будет.
Там вообще работать с байтам и приходится, только в однобитном изображении каждый байт это одна строчка из восьми пикселей(каждый пиксель-бит). А это не есть удобно..
Заморочиться можно, но лень
Если бы для себя делал, то я тупо конвертнул изображение из 1bit в 8bit
а потом сидел бы и улыбался
Ответить с цитированием
  #13  
Старый 30.08.2011, 02:16
Аватар для AND_REY
AND_REY AND_REY вне форума
Активный
 
Регистрация: 31.03.2009
Адрес: Украина, г.Днепропетровск
Сообщения: 324
Версия Delphi: Delphi7
Репутация: 3877
По умолчанию

Ой наворотил , но работает.
Код:
Var
  InBmp, OutBmp: TBitmap;
  InP, OutP: Array of PByteArray;

Function GetPixelInP(x, y: Integer): Boolean;
begin
 Result:= ((InP[y]^[x Div 8] Shr (7 - (x Mod 8))) And 1) = 1;
end;

Function GetPixelOutP(x, y: Integer): Boolean;
begin
 Result:= ((OutP[y]^[x Div 8] Shr (7 - (x Mod 8))) And 1) = 1;
end;

Procedure ChangePixelInP(x, y: Integer);
begin
 InP[y]^[x Div 8]:= (Inp[y]^[x Div 8]) Xor (1 Shl (7 - (x Mod 8)));
end;

Procedure ChangePixelOutP(x, y: Integer);
begin
 OutP[y]^[x Div 8]:= (OutP[y]^[x Div 8]) Xor (1 Shl (7 - (x Mod 8)));
end;

Procedure RekursBmp(x, y: Integer);
begin
 if Not GetPixelInP(x, y) Then Exit;
 ChangePixelInP(x, y);
 ChangePixelOutP(x, y);
 if (x-1) >= 0 Then
  if GetPixelInP(x-1, y) Then RekursBmp(x-1, y);
 if (y-1) >= 0 Then
  if GetPixelInP(x, y-1) Then RekursBmp(x, y-1);
 if (x+1) <= InBmp.Width Then
  if GetPixelInP(x+1, y) Then RekursBmp(x+1, y);
 if (y+1) <= InBmp.Height Then
  if GetPixelInP(x, y+1) Then RekursBmp(x, y+1);
 if ((x-1) >= 0) And ((y-1) >= 0) Then
  if GetPixelInP(x-1, y-1) Then RekursBmp(x-1, y-1);
 if ((x+1) <= InBmp.Width) And ((y+1) <= InBmp.Height) Then
  if GetPixelInP(x+1, y+1) Then RekursBmp(x+1, y+1);
 if ((x-1) >= 0) And ((y+1) <= InBmp.Height) Then
  if GetPixelInP(x-1, y+1) Then RekursBmp(x-1, y+1);
 if ((x+1) <= InBmp.Width) And ((y-1) >= 0) Then
  if GetPixelInP(x+1, y-1) Then RekursBmp(x+1, y-1);
end;

Procedure ClearOutP;
Var
 i, j: Integer;
begin
 For j:= 0 To OutBmp.Height - 1 Do
  For i:= 0 To OutBmp.Height - 1 Do
   if GetPixelOutP(i, j) Then ChangePixelOutP(i, j);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 i, j, n: Integer;
begin
 n:= 1;
 InBmp:= TBitmap.Create;
 OutBmp:= TBitmap.Create;
 InBmp.PixelFormat:= pf1bit;
 InBmp.LoadFromFile('1.bmp');
 OutBmp.PixelFormat:= pf1bit;
 OutBmp.Width:= InBmp.Width;
 OutBmp.Height:= InBmp.Height;
 OutBmp.Canvas.Brush.Color:= 0;
 OutBmp.Canvas.Pen.Color:= 0;
 SetLength(InP, InBmp.Height);
 SetLength(OutP, OutBmp.Height);
 For j:= 0 To InBmp.Height - 1 Do
  begin
   InP[j]:= InBmp.ScanLine[j];
   OutP[j]:= OutBmp.ScanLine[j];
  end;
 For j:= 0 To InBmp.Height - 1 Do
  For i:= 0 To InBmp.Width - 1 Do
   if GetPixelInP(i, j) Then
    begin
     ClearOutP;
     RekursBmp(i, j);
     OutBmp.SaveToFile('Рис. №'+IntToStr(n)+'.bmp');
     Label1.Caption:= 'Штук = '+IntToStr(n);
     Application.ProcessMessages;
     Inc(n);
    end;
 OutBmp.Free;
 InBmp.Free;
end;
__________________
If end Then begin;
Ответить с цитированием
  #14  
Старый 30.08.2011, 16:25
Pcrepair
 
Сообщения: n/a
По умолчанию

AND_REY, спасибо за помощь
1-й пример кода работает на все 100%
2-й пример кода на реальном файле (скрин экрана 1280х1024) дает справа белое поле с черными символами.
но главное есть, в ходе просмотра полученных файлов удалось найти большой косяк - латинская буква k с другими буквами сливается, прийдется в дальнейшем что с этим делать

по ходу дискуссии всплыло, что проще было бы использовать BMP 8bit для выделения фигур. исходный файл как раз такой - 8 бит.

будет ли обработка 8 бит файла проще и быстрее чем 1бит?
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 00:21.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025