Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Звук, графика и видео > Сравнение изображений

Автор: xaOz 19.9.2005, 13:04

Ситуация такая - есть скриншот экрана (Картинка1), и маленькая картинка например 20 на 20 пикс (Картинка2), как можно быстро определить, что на Картинке1 есть Картинка2?

Автор: Snowy 19.9.2005, 13:42

Уменьшить и сравнить попиксельно.
Если уменьшение проводилось по тому же алгоритму, то совпадет.
Если нет, то нужно проверять с учетом допустимой погрешности (экскриментальным путем).

Автор: xaOz 19.9.2005, 14:25

Имелось ввиду найти на Картинке1 - Картинку 2, где Картинка 2 может быть элементом Картинки 1

Автор: Snowy 20.9.2005, 11:40

Быстро никак. Только перебором.
Естественно, если прерывать перебор при первом несовпадении, то будет не так медленно.
Ускорить можно диагональным сравнением.
Но это все с учетом, что скриншот и картинка не испорчены джпегом.

Автор: xaOz 20.9.2005, 12:18

Вот наваял, не подскажете как ускорить можно?

Код


function CompareImages(A, B : TBitmap): Boolean;
var
  i, j : integer;
  p1, p2 : PARGB;
begin
  Result:=False;

  for i := 0 to A.Height - 1 do begin
    p1 := A.ScanLine[i];
    p2 := B.ScanLine[i];
    for j := 0 to A.Width - 1 do begin
      if not ((p1[j].r = p2[j].r) and (p1[j].g = p2[j].g) and (p1[j].b = p2[j].b)) then exit;
    end;
  end;

  Result := True;
end;

function SearchImage(A, B : TBitmap): Boolean;
var
  x, y: Integer;
  Rect1, Rect2: TRect;
  C: TBitmap;
begin
  Result := True;

  try
    C :=  TBitmap.Create;
    C.Assign(B);

    Rect1.Left := 0;
    Rect1.Top := 0;
    Rect1.Right := B.Width - 1;
    Rect1.Bottom := B.Height - 1;

    for y := 0 to A.Height - B.Height do
      for x := 0 to A.Width - B.Width do begin

         Rect2.Left := x;
         Rect2.Top := y;
         Rect2.Right := B.Width - 1 + x;
         Rect2.Bottom := B.Height - 1 + y;

         C.Canvas.CopyRect(Rect1, A.Canvas, Rect2);

         if CompareImages(B, C) then Exit;
      end;

    Result := False;

  finally
    C.Free;
  end;
end;

Автор: Snowy 20.9.2005, 13:13

1. Создать два array[0..x,0..y] or dword; Прописать в них 4-байтные цвета каждой картинки. Обращение к массивам будет быстрее и можно будет сразу сравнивать цвета целиком, а не по составляющим.
2. Если речь идет и скриншотах, то быстрое отсеивание можно реализовать при сканировании главной диагонали, т.к. окна располагаются прямоугольно, то повторение вертикальных и горизонтальных пикселей происходит довольно часто, а вот диагональных нет. Если уж диагональ полностью совпала, то только тогда проводить полное сравнение.
3. Все написать в одной процедуре. Тогда не потребуется подготавливать данные для процедуры сравнения - сразу брать смещение по циклу.

Автор: xaOz 20.9.2005, 14:52

Цитата

Насчет одной процедуры что то никак дойти не могу как это сделать в одной smile

ScanLine эти мозги уже поломал думая как объеденить

Автор: Snowy 20.9.2005, 15:04

Для начала создай два массива, чтобы использовать их, а не сканлайны.
А объеденить просто - все, что у тебя написано внутри функции, запихни внутрь бегина.
Заведи флаг выхода. Вместо Exit, используй break. Замени третий for на while.

Автор: xaOz 21.9.2005, 08:18

После долгих мучений и напряжения серого вещества у меня получилась довольно быстрая фунция, при размере Картинки 1 - 1024 758, а в второй - 100 20, скорость меньше 1 сек:

Код


function SearchImage(A, B : TBitmap): Boolean;
var
  i, j, x, y: integer;
  p1, p2: PARGB;
  Stop: Bool;
begin
  Result := True;

  for y := 0 to A.Height - B.Height do
    for x := 0 to A.Width - B.Width do begin
      Stop := False;

      for i := 0 to B.Height - 1 do begin
        p1 := A.ScanLine[i + y];
        p2 := B.ScanLine[i];
        for j := 0 to B.Width - 1 do
          if not ((p1[j + x].r = p2[j].r) and (p1[j + x].g = p2[j].g) and (p1[j + x].b = p2[j].b)) then begin
            Stop := True;
            Break;
          end;
        if Stop then Break;
      end;

      if not Stop then Exit;
  end;

  Result := False;
end;