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

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

Сравнивание TBitMap [D5, D7, Win95/98, WinXP]


Страницы:   1 2

maxistent ©   (2004-09-13 21:05:00) 

Привет всем и всем остальным :) Хто знаеть, как сравнить два Битмапа? Что-то типа <if Image1.Picture=Image2.Picture then>не катит. Заранее пасиба говорить не буду, а то никто на вопрос так и не ответит :)

Rem   (2004-10-19 09:46:00) [1]

>> Причем все это происходит с созданием метрики - к.е. определяю "величину схожести" - расстояние между картинками. Я использую метод энергии текстур, матрицу взаиморасположения и т.п.

Метрика, энергия текстур. Слова-то какие умные!
Да если бы Вы хотя бы упомянули критерии Стюдента или Колмогорова, я бы Вас услышал. А так - Ваша "метрика" или "расстояние между картинками" и гроша ломаного не стоят.
Короче, "читайте литературу" (С) Профессор
И копайте в сторону нейронных сетей. (Хотя...)

Fenik   (2004-10-17 13:43:00) [2]

> Rober  (17.10.04 11:37) [37]

Интересно. :) Этот алгоритм может определить похожие изображения, если они разного масштаба? И вообще было бы интересно взглянуть на его работу. Может быть выложите демку?

Rober   (2004-10-17 11:37:00) [3]

Я задачу сравнения двух изображений решаю по-другому. Но, возможно у меня и цели иные. Мне требуется не просто сравнение в лоб с точностью до бита. Мне требуется находить похожие изображения, которые на глаз похожи, но внутренне могут отличаться значительно. (Например, похожими должны считаться картинки с разным разрешением, со смещением по цвету, мелкими дефектами и т.д.). Причем все это происходит с созданием метрики - к.е. определяю "величину схожести" - расстояние между картинками. Я использую метод энергии текстур, матрицу взаиморасположения и т.п. Понимаю, что это немного выходит за рамки вашего вопроса, но если интересно, можем пообщаться.

TeNY   (2004-10-17 08:21:00) [4]


> Не понял. Полноцветный снимок экрана - 1024*768*3 = 2,25
> Mb. 3 - число байт на один пиксел.

биты,байты перевести забыл цветности 32бита на 1 пиксел 3байта на пиксел это 3*8=24бит.
Ошибочка у меня вышла...

Fenik   (2004-10-16 20:46:00) [5]

> Mihey_temporary ©  (13.10.04 22:04) [30]
> Есть юзать Qpixels, то там же вроде надо Attach делать - насколько он быстр?

Очень быстр. Там только указатель на растр присваивается ;-)

> TeNY ©  (15.10.04 21:02) [32]
> это скриншот моего экрана размером на 1024*768* 32=25mB

Не понял. Полноцветный снимок экрана - 1024*768* 3= 2,25 Mb. 3 - число байт на один пиксел.

> TeNY ©  (16.10.04 19:20) [34]

Пробуй, сравнивай, ищи лучшее. Мы будем тебе благодарны за тесты.

TeNY   (2004-10-16 19:20:00) [6]


> > ms1.Size div x
>
> В этом случае сравнивается только какая-то начальная часть
> изображений. То есть, если расхождение в остальной области,
> оно не будет обнаружено. А это неправильно.

зато нагрузка уменьшается кратно X кстати вместо strem наверное лучше поставить указатель типа @pointer(bmp1) это гораздо быстрее чем savetostream

Fenik   (2004-10-16 19:03:00) [7]

> Mihey_temporary ©

А если не преобразовывать в исходный формат, то придется выделять память под два временных растра, если их изменение недопустимо. Так что Qpixels, имхо, самое то..

> TeNY ©  (15.10.04 21:02) [32]

А мой метод таки не понравился? :)

> ms1.Size div x

В этом случае сравнивается только какая-то начальная часть изображений. То есть, если расхождение в остальной области, оно не будет обнаружено. А это неправильно.

TeNY   (2004-10-15 21:02:00) [8]

Мне особенно понравился метод


function BitmapsAreEqual(Bmp1, Bmp2: TBitmap): Boolean;
begin
 Result := False;
  Bmp1.SaveToStream(ms1);
  Bmp2.SaveToStream(ms2);
    if ms1.Size = ms2.Size then
      Result := CompareMem(ms1.Memory, ms2.Memory, ms1.Size)
    finally
  end
end
end;мне не очень выжна точность этого метода поэтому я ввёл коэффициент деления X
      Result := CompareMem(ms1.Memory, ms2.Memory, ms1.Size, divx )

и чем больше х тем больше скорость но появилась сложнось
bmp1 b bmp2 это скриншот моего экрана размером
на 1024*768*32=25mB картинки сравниваются 1 раз в секунду что вызывает загрузку проца на 90%(PII CPU 256мб) и при выяснении выяснилось что много времени загрузка в память
BmpЧ.SaveToStream(ms1);
пытался сделать  
Bmp1.Width  :=  Bmp1.Width div x;
Bmp1.Height :=  Bmp1.Height div x;
Bmp2.Width  :=  Bmp2.Width div x;
Bmp2.Height :=  Bmp2.Height ;
ЧТОб уменишить обьем памяти и ускорить загруку
но этот метод портит изображение

хотелось бы узнать можно грузить в память не всю картинку а лишь часть изображения или хотя бы преобразовать его в GrayScale.

Fenik   (2004-10-14 22:09:00) [9]

> Mihey_temporary ©  (13.10.04 22:04) [30]

Туда, потом обратно.. Фигня получится.
И не думаю, что быстрее (если обратно).

Mihey_temporary   (2004-10-13 22:04:00) [10]


> Я бы сказал - плохой способ.. Переводить в другой формат
> не есть хорошо. Лучше тогда для растров с палитрой юзать
> статью MBo.


А почему не есть? Преобразования в более широкий PixelFormat быстры. Есть юзать Qpixels, то там же вроде надо Attach делать - насколько он быстр?

Fenik   (2004-10-13 17:33:00) [11]

> Mihey_temporary ©  (12.10.04 00:11) [27]

Я бы сказал - плохой способ.. Переводить в другой формат не есть хорошо. Лучше тогда для растров с палитрой юзать статью MBo.

Mihey_temporary   (2004-10-12 00:13:00) [12]

If (Bmp1.PixelFormat <> pf24bit) or (Bmp1.PixelFormat <> pf32bit) then

исправить на

If (Bmp1.PixelFormat <> pf24bit) or (Bmp1.PixelFormat <> pf32bit) or (Bmp1.PixelFormat <> pf15bit) or (Bmp1.PixelFormat <> pf16bit) then

Mihey_temporary   (2004-10-12 00:11:00) [13]

Вообще, я имел ввиду такой способ:


function BitmapsEqual(Bmp1, Bmp2: TBitmap): Boolean;
var H, H2, LineLength, y: Integer;
  DS: TDIBSection;

function EqualLine(Line: Integer): Boolean;
begin
  Result := CompareMem(@Bmp1.ScanLine[Line]^,
                       @Bmp2.ScanLine[Line]^, LineLength)
end;

begin
Result := False;
{ Сравнение базовых параметров }
if (Bmp1.PixelFormat <> Bmp2.PixelFormat) or
   (Bmp1.Width <> Bmp2.Width) or (Bmp1.Height <> Bmp2.Height) or
   (Bmp1.Width < 1) or (Bmp1.Height < 1)
then Exit;

If (Bmp1.PixelFormat <> pf24bit) or (Bmp1.PixelFormat <> pf32bit) then
 begin
   If (Bmp1.Palette <> 0) or (Bmp2.Palette <> 0) then
    begin
     Bmp1.PixelFormat := pf24bit;
     Bmp2.PixelFormat := pf24bit;
    end;
 end;

if GetObject(Bmp1.Handle, SizeOf(DS), @DS) > 0
  then LineLength := DS.dsBm.bmWidthBytes
  else Exit; //error

H := Bmp1.Height - 1;
if H = 0 then
  Result := EqualLine(0)
else begin
  Result := True;
  H2 := ((H+1) div 2) - 1;

  { Сравниваем строки. Цикл проходит строки одновременно сверху
    и снизу, сходясь в центре: так больше вероятность
    скорейшего обнаружения отличающихся пикселей. }
  for y := 0 to H2 do
    if (not EqualLine(y)) or (not EqualLine(H-y)) then
    begin
      Result := False;
      Exit;
    end;

  { Если высота не кратна двум, сравниваем средние строки,
    которые пропустили в цикле. Это сделано, чтобы дважны
    не вызавать CompareMem для одной строки. }
  if (H mod 2) = 0 then
    Result := EqualLine(H2 + 1);
end;
end;

Fenik   (2004-10-11 23:55:00) [14]

> Mihey_temporary ©   (11.10.04 23:26) [25]
> Я тоже в затруднении. Получается, что Scanline'ом - единственный
> выход, который даёт результат гарантировано


Гарантированный? В каком смысле?

http://fenik.nm.ru/pic/1.bmp
http://fenik.nm.ru/pic/2.bmp
Сравни визуально и программно, но убрав строчки
if Result and (DS.dsBmih.biBitCount <= 8) then
  Result := ComparePal(Bmp1.Palette, Bmp2.Palette);

Mihey_temporary   (2004-10-11 23:26:00) [15]


> Что теперь делать? Палитру не трогать?


Я тоже в затруднении. Получается, что Scanline'ом - единственный выход, который даёт результат гарантировано, но никто не протестует против твоей функции, потому что она - самая практичная. ИМХО палитру можно и не трогать, но нужно оговорить это дело, чтобы пользователь знал, где может наколоться.

Fenik   (2004-10-11 22:36:00) [16]

> Но по идее, если сканлайнить, то изображения идентичны.

Что теперь делать? Палитру не трогать?

Mihey_temporary   (2004-10-11 21:06:00) [17]

Но по идее, если сканлайнить, то изображения идентичны.

Fenik   (2004-10-11 21:01:00) [18]

> Mihey_temporary ©  (10.10.04 19:55) [21]

Ну, процедура на то и рассчитана, чтобы находить только абсолютно одинаковые растры. Даже малейшее отличие индекса в палитре - всё, баста. Например при поиске и отсечении одинаковых иконок на диске может пригодится.
Каверзные тесты - это которые выявляют ошибки функции, а не специально подстроенные визуально-программные расхождения :)

Mihey_temporary   (2004-10-10 19:55:00) [19]

Каверзный тест. Сравни (визуально и программно):

http://www.hot.ee/mvps12/pic3.bmp
http://www.hot.ee/mvps12/pic4.bmp [56 Kb each]

Тут возникает вопрос - что значит одинаковые изображения?

Fenik   (2004-10-10 14:15:00) [20]

Надеюсь последнее исправление..
Помогите придумать каверзные тесты для этой функции.

function BitmapsEqual(Bmp1, Bmp2: TBitmap): Boolean;
var H, H2, LineLength, y: Integer;
   DS: TDIBSection;

 function ComparePal(P1, P2: HPALETTE): Boolean;
 var i, Size1, Size2: Integer;
     PalEntry1, PalEntry2: array [0..255] of TPaletteEntry;
 begin
   if (P1 <> 0) and (P2 <> 0) then begin
     { Палитры присутствуют. Сравним их содержимое. }
     Result := False;
     Size1 := 0;
     Size2 := 0;
     if (GetObject(P1, SizeOf(Size1), @Size1) <> 0) and
        (GetObject(P2, SizeOf(Size2), @Size2) <> 0) then
       if Size1 = Size2 then begin
         if Size1 = 0 then Exit;
         GetPaletteEntries(P1, 0, Size1, PalEntry1[0]);
         GetPaletteEntries(P2, 0, Size2, PalEntry2[0]);
         for i := 0 to Size1 - 1 do
           if (PalEntry1[i].peRed   <> PalEntry2[i].peRed) or
              (PalEntry1[i].peGreen <> PalEntry2[i].peGreen) or
              (PalEntry1[i].peBlue  <> PalEntry2[i].peBlue) or
              (PalEntry1[i].peFlags <> PalEntry2[i].peFlags)
           then begin
             Result := True;
             Break;
           end;
         Result := not Result;
       end;
   end
   else
     Result := (P1 = 0) and (P2 = 0);
 end;

 function EqualLine(Line: Integer): Boolean;
 begin
   Result := CompareMem(@Bmp1.ScanLine[Line]^,
                        @Bmp2.ScanLine[Line]^, LineLength)
 end;

begin
 Result := False;
 { Сравнение базовых параметров }
 if (Bmp1.PixelFormat <> Bmp2.PixelFormat) or
    (Bmp1.Width <> Bmp2.Width) or (Bmp1.Height <> Bmp2.Height) or
    (Bmp1.Width < 1) or (Bmp1.Height < 1)
 then Exit;

 if GetObject(Bmp1.Handle, SizeOf(DS), @DS) > 0
   then LineLength := DS.dsBm.bmWidthBytes
   else Exit; //error

 H := Bmp1.Height - 1;
 if H = 0 then
   Result := EqualLine(0)
 else begin
   Result := True;
   H2 := ((H+1) div 2) - 1;

   { Сравниваем строки. Цикл проходит строки одновременно сверху
     и снизу, сходясь в центре: так больше вероятность
     скорейшего обнаружения отличающихся пикселей. }
   for y := 0 to H2 do
     if (not EqualLine(y)) or (not EqualLine(H-y)) then
     begin
       Result := False;
       Exit;
     end;

   { Если высота не кратна двум, сравниваем средние строки,
     которые пропустили в цикле. Это сделано, чтобы дважны
     не вызавать CompareMem для одной строки. }
   if (H mod 2) = 0 then
     Result := EqualLine(H2 + 1);
 end;

 { Если отличий не обнаружено, проверяем палитры. }
 if Result and (DS.dsBmih.biBitCount <= 8) then
   Result := ComparePal(Bmp1.Palette, Bmp2.Palette);
end;

Страницы:   1 2

Наверх

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