Форум: "Основная";
Текущий архив: 2005.10.30;
Скачать: [xml.tar.bz2];

Вниз

Как быстро сравнить два TBITMAP?   Найти похожие ветки 

← →
NikNet ©   (2005-10-03 08:34) [0]

и записать в другой TBitmap изменение...

---

← →
miek ©   (2005-10-03 08:45) [1]

наложить один на другой по XOR

---

← →
tesseract ©   (2005-10-03 10:28) [2]

> наложить один на другой по XOR


А почему не по AND ?

---

← →
XProger ©   (2005-10-04 03:26) [3]


function BMP_Equal(bmp1, bmp2: TBitmap): boolean;
var
x, y   : integer;
s1, s2 : integer;
p1, p2 : PByteArray;
begin
Result := false;
if (bmp1.Height <> bmp2.Height) and (bmp1.Width <> bmp2.Width) then Exit;
bmp1.pixelformat := pf24bit;
bmp2.pixelformat := pf24bit;
for y := 0 to bmp1.Height - 1 do
begin
p1 := bmp1.ScanLine(y);
p2 := bmp2.ScanLine(y);
for x := 0 to bmp1.Width - 1 do
 if p1[x] xor p2[x] <> 0 then Exit;
end;
Result := true;
end;

Писал прямо здесь, так что ошибки не исключены, но принцип должен быть понятен ;)

---

← →
tesseract ©   (2005-10-04 11:06) [4]

>> to xproger

А где изменения?


> for x := 0 to bmp1.Width - 1 do
>  if p1[x] xor p2[x] <> 0 then Exit;


Не понял и xor и сравнение

почему не p1[x]<>p2[x] ?

написано на коленке

function BMP_Equal(var bmp1, bmp2,resbmp: TBitmap):boolean;
var
x, y   : integer;
s1, s2 : integer;

begin
Result := false;
if (bmp1.Height <> bmp2.Height) and (bmp1.Width <> bmp2.Width) then Exit;
bmp1.pixelformat := pf24bit;
bmp2.pixelformat := pf24bit;
resbmp.pixelformat:=pf24bit;
resbmp.width:=bmp1.width;
resbmp.height:=bmp1.height;
resbmp.canvas.fillrect(rect(0,0,resbmp.height,resbmp,width));
for y := 0 to bmp1.Height - 1 do
begin
for x := 0 to bmp1.Width - 1 do
if bmp1.pixels[x,y]<>bmp2.pixels[x,y] then
 begin
  result:=false;
  resbmp.pixels[x,y]:=clBlack;
end
end;
Result := true;
end;

---

← →
Woolen ©   (2005-10-04 12:08) [5]

2 tesseract
Очень медленно. До невозможности.
bmp1.pixels[x,y]<>bmp2.pixels[x,y]
слишком медленная операция.
у тебя 2 раза вызывается GetPixel. TBitmap.GetPixel очень тормозной. Бродит внутрях винды подолгу. Совершает малопонятные (мне, о других не говорю) действия типа операций с критическими секциями. Короче все очень сложно и медленно. Раз в 10 по меньшей мере
Такие вещи делаются только так

> p1 := bmp1.ScanLine(y);
> p2 := bmp2.ScanLine(y);

А по повду xor и <> 0 или просто <>, существенной разницы не вижу. Хотя, наверняка какой-то вариант работает быстрее другого...

---

← →
tesseract ©   (2005-10-04 16:52) [6]

> у тебя 2 раза вызывается GetPixel. TBitmap.GetPixel очень
> тормозной. Бродит внутрях винды подолгу. Совершает малопонятные

Мне понятные - заботится делфи о надежности твоей прграммы :-)

> (мне, о других не говорю) действия типа операций с критическими
> секциями. Короче все очень сложно и медленно. Раз в 10 по
> меньшей мере


Профайлером мерил?

А хотишь быстрее - CreateCompatibleBitmap / GetBitmapBits/ AND по битам.

---

← →
Anatoly Podgoretsky ©   (2005-10-04 18:05) [7]

tesseract ©   (04.10.05 16:52) [6]
Опять ты своим AND сказали же XOR

---

← →
Fenik ©   (2005-10-04 18:30) [8]

Для растров без палитры:

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 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 ©   (2005-10-04 22:13) [9]

Прошу прощения, не дочитал вопрос. Моя функция только сравнивает.
Действительно, чтобы записать отличия в третий, - надо XOR"ом.

---

← →
kami ©   (2005-10-04 23:03) [10]

Fenik ©   (04.10.05 22:13) [9]
Моя функция
Ой ли ? :)

---

← →
Fenik ©   (2005-10-04 23:34) [11]

> [10] kami ©   (04.10.05 23:03)
> Fenik ©   (04.10.05 22:13) [9]
> Моя функция
> Ой ли ? :)


Эту функцию действительно я писал. А что такое?

---

← →
kami ©   (2005-10-05 00:16) [12]

Да нет, ничего... Тогда прошу прощения, увидел её (буква в букву) в посте Магнитоныча; само собой - нагло прихватизировал, и во всех исходниках + хелпах, где она использовалась, ставил его имя :))

---

← →
Fenik ©   (2005-10-05 00:19) [13]

> [12] kami ©   (05.10.05 00:16)


Магнитон Борыч - одна из моих бывших инкарнаций на этом форуме :)))

---

← →
kami ©   (2005-10-05 00:22) [14]

Ага, ну тогда я спокоен :)

---

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

Форум: "Основная";
Текущий архив: 2005.10.30;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.038 c