Текущий архив: 2005.01.30;
Скачать: CL | DM;

Вниз

Сравнивание TBitMap   Найти похожие ветки 

← →
maxistent ©   (2004-09-13 21:05) [0]

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

---

← →
dmk ©   (2004-09-13 21:37) [1]

Сравнивай до первого несовпадающего пиксела
If TBitMap1.Canvas.Pixels[x,y] <> TBitMap2.Canvas.Pixels[x,y] then ... .

---

← →
maxistent ©   (2004-09-14 08:10) [2]

Смешно... :( эт я могу. Надо бы побыстрее...

---

← →
MBo ©   (2004-09-14 08:40) [3]

Побыстрее - используй Scanline.
Возможно, будет неплохо создать еще один битмап, нарисовать на него первый, потом второй с флагом SRCINVERT - исключающее ИЛИ - при этом одинаковые пикселы будут черными, останется только проверить это.

---

← →
Fenik   (2004-09-14 16:20) [4]

function BitmapsEqual(Bmp1, Bmp2: TBitmap): Boolean;
var H, L, Y: Integer;
begin
 if (Bmp1.PixelFormat <> Bmp2.PixelFormat) or
    (Bmp1.Width <> Bmp2.Width) or (Bmp1.Height <> Bmp2.Height) then
 begin
   Result := False;
   Exit;
 end;

 L := Bmp1.Width;
 case Bmp1.PixelFormat of
   pf1Bit:  L := L div 8 + L mod 8;
   pf4Bit:  L := L div 2 + L mod 2;
   pf15Bit: L := L*2;
   pf24Bit: L := L*3;
   pf32Bit: L := L*4;
   pfDevice,
   pfCustom: L := L*4; {А вот здесь не знаю, как лучше... Но так тоже прокатит :) }
 end;
 Result := True;
 H := Bmp1.Height-1;
 for y := 0 to (H div 2)+1 do
   if (not CompareMem(@Pointer(Bmp1.ScanLine[y])^,
                      @Pointer(Bmp2.ScanLine[y])^, L)) or
      (not CompareMem(@Pointer(Bmp1.ScanLine[H-y])^,
                      @Pointer(Bmp2.ScanLine[H-y])^, L))
   then begin
     Result := False;
     Break;
   end;
end;

Это самый быстрый из известных мне методов.

---

← →
Mihey_temporary ©   (2004-09-14 19:23) [5]

> Fenik   (14.09.04 16:20) [4]


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

Я получил, что надо 30 миллисекунд на PII 450 Mhz для точного сравнениях (т.е. максимальное время) двух TBitmap размером 1280x960, что вполне рабочий результат.

---

← →
maxistent ©   (2004-09-16 12:14) [6]

пасиба... будем пробавать... :)

---

← →
Fenik   (2004-09-21 18:29) [7]

Вот более корректный вариант:
http://delphibase.endimus.ru/?action=viewfunc&topic=mediaimg&id=10553

---

← →
Multy   (2004-09-23 15:25) [8]

А это работает на любых битмапах не зависимо от цвета?

---

← →
Mihey_temporary ©   (2004-09-23 17:32) [9]

> А это работает на любых битмапах не зависимо от цвета?


Должен.

---

← →
Fenik   (2004-09-24 21:25) [10]

> Multy  (23.09.04 15:25) [8]
> А это работает на любых битмапах не зависимо от цвета?

Да.

---

← →
Fenik   (2004-10-06 23:39) [11]

Внимание!
Функция, предложенная мной, не доработана: отсутствует сравнение палитр.

---

← →
Fenik   (2004-10-07 18:53) [12]

Вот, исправил.

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

 function PalettesAreEqual(P1, P2: HPALETTE): Boolean;
 var i, Size1, Size2: Integer;
     PalEntry1, PalEntry2: array [0..256] 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(
     @Pointer(Bmp1.ScanLine[Line])^,
     @Pointer(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.Monochrome <> Bmp2.Monochrome)
 then Exit;

 Result := True;
 with Bmp1 do
   if Height > 1 then begin
     H := Height - 1;
     H2 := (Height div 2) - 1;
     LineLength := Abs(Integer(ScanLine[0]) - Integer(ScanLine[1]));
   end
   else begin
     { Если доподлинно известно, что однострочные растры
       не будут сравниваться, этот код можно убрать. }
     case PixelFormat of
       pf1Bit:  LineLength := Width div 8 + Width mod 8;
       pf4Bit:  LineLength := Width div 2 + Width mod 2;
       pf8Bit:  LineLength := Width;
       pf15Bit,
       pf16Bit: LineLength := Width*2;
       pf24Bit: LineLength := Width*3;
       pfCustom: begin
         if GetObject(Handle, SizeOf(DS), @DS) > 0 then
           LineLength := Width * (DS.dsBmih.biBitCount div 8);
       end;
       else LineLength := Width*4;
     end;
     Result := EqualLine(0);
     Exit;
   end;

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

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

 { Сравнение палитр }
 if (Bmp1.PixelFormat = pf1Bit) or (Bmp1.Pixelformat = pf4Bit) or
    (Bmp1.Pixelformat = pf8Bit) then
   Result := PalettesAreEqual(Bmp1.Palette, Bmp2.Palette);
end;

Теперь вроде нормально работает. Но надо ещё тестировать и тестировать для всевозможных растров, чтобы снова не лопухнуться. %)
Кстати, прямое сравнение памяти:

function BitmapsAreEqual(Bmp1, Bmp2: TBitmap): Boolean;
var ms1, ms2: TMemoryStream;
begin
 Result := False;
 ms1    := TMemoryStream.Create;
 try
   Bmp1.SaveToStream(ms1);
   ms2 := TMemoryStream.Create;
   try
     Bmp2.SaveToStream(ms2);
     if ms1.Size = ms2.Size then
       Result := CompareMem(ms1.Memory, ms2.Memory, ms1.Size)
     finally
       ms2.Free
   end
 finally
   ms1.Free
 end
end;

иногда дает неверный результат...

---

← →
programania ©   (2004-10-07 19:21) [13]

А может вместо сравнения памяти обсудить сравнение
похожих картинок или даже их фрагментов с получением
степени похожести?
Это намного полезней и увлекательней потому что
именно это все делают хотя не знают как.

---

← →
Fenik   (2004-10-07 21:14) [14]

>Fenik  (07.10.04 18:53) [12]
>PalEntry1, PalEntry2: array [0..256] of TPaletteEntry;

Надо 255.

---

← →
Fenik   (2004-10-07 21:15) [15]

> programania ©  (07.10.04 19:21) [13]

Предлагай :)

---

← →
XProger ©   (2004-10-07 22:27) [16]

Пишем все пиксели первого бмп побайтно в буфер. Затем вычисляем CRC32 этого буфера.
Тоже самое проделываем и со вторым бмп.
В итоге, если эти два CRC32 будут идентичны => картинки равны :)

ЗЫ
Да, я извращенец такой... :)

---

← →
Mihey_temporary ©   (2004-10-07 23:00) [17]

> В итоге, если эти два CRC32 будут идентичны => картинки
> равны :)


Есть шанс, что нет.

---

← →
DeadMeat ©   (2004-10-07 23:17) [18]

> [16] XProger ©   (07.10.04 22:27)

А вот вторая будет чуть-чуть ярче и уже не равны...
Тут надо погрешность вводить...

---
...Death Is Only The Begining...

---

← →
Jeer ©   (2004-10-08 13:44) [19]

Где ? В CRC ?
Да отличие всего лишь в один px даст совершенно другой результат.
CRC годится лишь для нахождения абсолютно идентичных файлов.

---

← →
Fenik   (2004-10-10 14:15) [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;

---

← →
Mihey_temporary ©   (2004-10-10 19:55) [21]

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

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

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

---

← →
Fenik   (2004-10-11 21:01) [22]

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

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

---

← →
Mihey_temporary ©   (2004-10-11 21:06) [23]

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

---

← →
Fenik   (2004-10-11 22:36) [24]

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

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

---

← →
Mihey_temporary ©   (2004-10-11 23:26) [25]

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


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

---

← →
Fenik   (2004-10-11 23:55) [26]

> 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-12 00:11) [27]

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


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;


---

← →
Mihey_temporary ©   (2004-10-12 00:13) [28]

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

---

← →
Fenik   (2004-10-13 17:33) [29]

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

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

---

← →
Mihey_temporary ©   (2004-10-13 22:04) [30]

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


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

---

← →
Fenik   (2004-10-14 22:09) [31]

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

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

---

← →
TeNY ©   (2004-10-15 21:02) [32]

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


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,div x )

и чем больше х тем больше скорость но появилась сложнось
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-16 19:03) [33]

> Mihey_temporary ©

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

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

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

> ms1.Size div x

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

---

← →
TeNY ©   (2004-10-16 19:20) [34]

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

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

---

← →
Fenik   (2004-10-16 20:46) [35]

> 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-17 08:21) [36]

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

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

---

← →
Rober   (2004-10-17 11:37) [37]

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

---

← →
Fenik   (2004-10-17 13:43) [38]

> Rober  (17.10.04 11:37) [37]

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

---

← →
Rem   (2004-10-19 09:46) [39]

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

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

---

Страницы: 1 вся ветка

Текущий архив: 2005.01.30;
Скачать: CL | DM;

Наверх

Память: 0.59 MB
Время: 0.046 c