Необходимо сравнивать два изображения

← →
Artog © (2003-01-08 19:01) [0]

Доброго времени суток.
Проблема следующая: необходимо сравнивать два изображения полученных с экрана.
Делаю так:

procedure TForm1.Button1Click(Sender: TObject);
var
dc : hdc;
bmp1, bmp2 : TBitMap;
MemStr1, MemStr2 : TMemoryStream;
begin
dc := GetDc(0);
bmp1 := TBitMap.Create;
bmp2 := TBitMap.Create;
bmp1.Width := 100;
bmp1.Height := 50;
bmp2.Width := 100;
bmp2.Height := 50;
MemStr1:=TMemoryStream.Create;
MemStr2:=TMemoryStream.Create;
BitBlt(bmp1.Canvas.Handle,0,0,100,50,dc,100,100,SRCCOPY);
BitBlt(bmp2.Canvas.Handle,0,0,100,50,dc,100,100,SRCCOPY);
bmp1.SaveToStream(MemStr1);
bmp2.SaveToStream(MemStr2);
MemStr1.Seek(0,0);
MemStr2.Seek(0,0);
if CompareMem(MemStr1.Memory,MemStr2.Memory,MemStr1.Size) then Edit1.Text := "Равны."
else
Edit1.Text := "НЕ равны";
bmp1.Free;
bmp2.Free;
MemStr1.Free;
MemStr2.Free;
end;

Выдает сообщение "НЕ равны". В тоже время функция ScanLine говорит что изображения равны (имхо, она медлено работает, а надо сравнивать много изображений). Как правильно использовать CompareMem для сравнения изображений? Спасибо.

← →
Dmitry V. Averuanov © (2003-01-09 13:38) [1]

- Зачем тут BitBlt ?
- Tak Детекторы движения не делают - не получится ввести поправку на точность (загрубление)

Спасибо. Я уже нашел вариант, который меня устроил:

P1, P2 : PByteArray;

for y := 0 to bmp1.height - 1 do
begin
P1 := bmp1.ScanLine[y];
P2 := bmp2.ScanLine[y];
MemStr1.Seek(0,0);
MemStr2.Seek(0,0);
MemStr1.WriteBuffer(P1^,bmp1.Width*2);
MemStr2.WriteBuffer(P2^,bmp1.Width*2);
MemStr1.Seek(0,0);
MemStr2.Seek(0,0);
if CompareMem(MemStr1.Memory,MemStr2.Memory,MemStr1.Size)
then Edit1.Text := "Равны."
else
Edit1.Text := "НЕ равны";
end;

Необходимо сравнивать два изображения Найти похожие ветки