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>не катит. Заранее пасиба говорить не буду, а то никто на вопрос так и не ответит :)

Jeer   (2004-10-08 13:44:00) [21]

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

DeadMeat   (2004-10-07 23:17:00) [22]


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

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

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

Mihey_temporary   (2004-10-07 23:00:00) [23]


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


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

XProger   (2004-10-07 22:27:00) [24]

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

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

Fenik   (2004-10-07 21:15:00) [25]

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

Предлагай :)

Fenik   (2004-10-07 21:14:00) [26]

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

Надо 255.

programania   (2004-10-07 19:21:00) [27]

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

Fenik   (2004-10-07 18:53:00) [28]

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

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;

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

Fenik   (2004-10-06 23:39:00) [29]

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

Fenik   (2004-09-24 21:25:00) [30]

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

Да.

Mihey_temporary   (2004-09-23 17:32:00) [31]


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


Должен.

Multy   (2004-09-23 15:25:00) [32]

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

Fenik   (2004-09-21 18:29:00) [33]

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

maxistent   (2004-09-16 12:14:00) [34]

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

Mihey_temporary   (2004-09-14 19:23:00) [35]


> Fenik   (14.09.04 16:20) [4]


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

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

Fenik   (2004-09-14 16:20:00) [36]

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;

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

MBo   (2004-09-14 08:40:00) [37]

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

maxistent   (2004-09-14 08:10:00) [38]

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

dmk   (2004-09-13 21:37:00) [39]

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

Страницы:   1 2

Наверх

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