| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Как быстро сравнить два TBITMAP?
NikNet © (2005-10-03 08:34:00)и записать в другой TBitmap изменение...
kami (2005-10-05 00:22:00) [1]Ага, ну тогда я спокоен :)
Fenik (2005-10-05 00:19:00) [2]
> [12] kami © (05.10.05 00:16)
Магнитон Борыч - одна из моих бывших инкарнаций на этом форуме :)))
kami (2005-10-05 00:16:00) [3]Да нет, ничего... Тогда прошу прощения, увидел её (буква в букву) в посте Магнитоныча; само собой - нагло прихватизировал, и во всех исходниках + хелпах, где она использовалась, ставил его имя :))
Fenik (2005-10-04 23:34:00) [4]
> [10] kami © (04.10.05 23:03)
> Fenik © (04.10.05 22:13) [9]
> Моя функция
> Ой ли ? :)
Эту функцию действительно я писал. А что такое?
kami (2005-10-04 23:03:00) [5]Fenik © (04.10.05 22:13) [9]
Моя функция
Ой ли ? :)
Fenik (2005-10-04 22:13:00) [6]Прошу прощения, не дочитал вопрос. Моя функция только сравнивает.
Действительно, чтобы записать отличия в третий, - надо XOR'ом.
Fenik (2005-10-04 18:30:00) [7]Для растров без палитры:
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;
Anatoly Podgoretsky (2005-10-04 18:05:00) [8]tesseract © (04.10.05 16:52) [6]
Опять ты своим AND сказали же XOR
tesseract (2005-10-04 16:52:00) [9]
> у тебя 2 раза вызывается GetPixel. TBitmap.GetPixel очень
> тормозной. Бродит внутрях винды подолгу. Совершает малопонятные
Мне понятные - заботится делфи о надежности твоей прграммы :-)
> (мне, о других не говорю) действия типа операций с критическими
> секциями. Короче все очень сложно и медленно. Раз в 10 по
> меньшей мере
Профайлером мерил?
А хотишь быстрее - CreateCompatibleBitmap / GetBitmapBits/ AND по битам.
Woolen (2005-10-04 12:08:00) [10]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 11:06:00) [11]>> 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;
XProger (2005-10-04 03:26:00) [12]
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-03 10:28:00) [13]
> наложить один на другой по XOR
А почему не по AND ?
miek (2005-10-03 08:45:00) [14]наложить один на другой по XOR
| |
