[czuryk]

Добрый день коллеги! Очень прошу помочь!

Давно уже бьюсь, но никак не могу расколоть сабжевую проблему, гугл выдает некую информацию, но мне никак не удается ее адаптировать для своих нужд. Учтите, речь идет не о сравнении одного изображения с другим.
Мне нужно организовать поиск одного изображения (маленького, порядка 100х50 пикселей) в другом - большом, порядка 1280х1024 пикселей, причем поиск должен осуществлятся максимально быстро < 1 сек. Результатом работы функкции должны быть координаты X,Y маленьгоко изображения в большом (исходном).
Причем поиск долже выполнятся по полному схождению части большого изображения и маленького. Так как если искать по нескольки ключевых точек, то такие функции в моем случае дают сбой.

Код:

procedure TForm1.Button4Click(Sender: TObject);
Type
  TRGBTripleArray =  ARRAY[WORD] OF TRGBTriple;
  pRGBTripleArray =  ^TRGBTripleArray;
  
var
  b1, b2: TBitmap;
//  c1, c2: PByteArray;
  c1, c2: pRGBTripleArray;
  x, y, i,: Integer;
  eq: boolean;
  resX, resY: integer;

begin

b1 := Image1.Picture.Bitmap;
b2 := Image2.Picture.Bitmap;
Assert(b1.PixelFormat = b2.PixelFormat); // they have to be equal

for y := 0 to b1.Height - 1 do // Внешний цикл по строкам оригинала
   begin
   c1 := b1.Scanline[y];
   c2 := b2.Scanline[0]; // Ищу на соответствие только по 1-й строке

   for x := 0 to b1.Width - 1 do
      begin
      eq := true;
      for i := 0 to b2.Width - 1 do // Цикл по строке искомой строки
         begin
         if (c1[x+i].RGBtRed <> c2[i].RGBtRed) or (c1[x+i].RGBtGreen <> c2[i].RGBtGreen) or (c1[x+i].RGBtBlue <> c2[i].RGBtBlue) then
            begin eq := false; break; end
         end;
      if ( eq ) then begin resX:=x; resY:=y; break; end;
      end;
   if ( eq ) then break;
   end;

if ( eq ) then
   begin
   Memo1.Lines.Add('FOUND');
   b1.canvas.Brush.Color := clRed;
   b1.canvas.Ellipse(resX-3, resY-3, resX+3, resY+3);
   end
   else Memo1.Lines.Add('NOT FOUND');
end;

Этот код работает, но не быстро (в силу его примитивности и неоптимизированности) и ищет только по первой строке второго изображения. Как оптимально сделать чтобы он искал быстро по всем строкам под-изображения я еще не придумал.

Есть другой вариант, с которым мне помогли, там очень быстро ищется под-изображение по 4-м точкам. Но этот алгоритм в силу его ограниченности часто дает сбой, а модифицировать его должным образом у меня не вышло.

Код:

...
...
 PInt = ^integer;
var
  Form1: TForm1;

implementation

{$R *.dfm}

function SearchBitmap(const bmMain,bmSub:TBitmap; var Res:TPoint):boolean;
var iMainHeight, iMainWidth,
    iSubHeight,  iSubWidth,
    iMainPXWidth, iSubPXWidth, iDiffPXWidth,
    iDiffHeight: integer;
    i,j:integer;
    eq: boolean;
    pRowMain, pRowSub : PByteArray;
    ltPt,rtPt,lbPt,rbPt : PInt;
    cPoints:array[0..3] of integer;
begin
  Res.X := -1;
  Res.Y := -1;
  SearchBitmap := false;
  bmMain.PixelFormat:=pf24bit;
  bmSub.PixelFormat:=pf24bit;
  iMainHeight := bmMain.Height;
  iMainWidth := bmMain.Width;
  iMainPXWidth := iMainWidth * 3;
  iSubHeight := bmSub.Height;
  iSubWidth := bmSub.Width ;
  iSubPXWidth := iSubWidth *3 ;
  iDiffPXWidth := iMainPXWidth - iSubPXWidth;

  iDiffHeight:= iMainHeight - iSubHeight;
  pRowSub := bmSub.ScanLine[0];
  cPoints[0]:= PInt(@(pRowSub^[0]))^ and $FFFFFF;
  cPoints[1]:= PInt(@(pRowSub^[iSubPXWidth-3]))^ and $FFFFFF;
  pRowSub := bmSub.ScanLine[iSubHeight-1];
  cPoints[2]:= PInt(@(pRowSub^[0]))^ and $FFFFFF;
  cPoints[3]:= PInt(@(pRowSub^[iSubPXWidth-3]))^ and $FFFFFF;
  eq:=false;
  for i:=0 to iDiffHeight - 1 do
  begin
    pRowMain := bmMain.ScanLine[i];
    pRowSub := bmMain.ScanLine[i+iSubHeight-1];
    j:=0;
    ltPt := PInt(@pRowMain^[j]);
    lbPt := PInt(@pRowSub^[j]);
    //rtPt := PInt(pRowMain + iSubPXWidth - 3);
    //rbPt := PInt(pRowSub + iSubPXWidth - 3);
    asm
      mov   eax,iSubPXWidth
      sub   eax,3
      mov   ecx,eax
      add   ecx,ltPt
      mov   rtPt,ecx
      mov   ecx,eax
      add   ecx,lbPt
      mov   rbPt,ecx
    end;

    while j<iDiffPXWidth do
    begin
      {
      eq := ((PInt(@(pRowMain^[j]))^ and $FFFFFF) = cPoints[0])
        and ((PInt(@(pRowMain^[j+iSubPXWidth-3]))^ and $FFFFFF) = cPoints[1])
        and ((PInt(@(pRowSub^[j]))^ and $FFFFFF ) = cPoints[2])
        and ((PInt(@(pRowSub^[j+iSubPXWidth-3]))^ and $FFFFFF) = cPoints[3]);
      }
      eq := ((ltPt^ and $FFFFFF) = cPoints[0])
        and ((rtPt^ and $FFFFFF) = cPoints[1])
        and ((lbPt^ and $FFFFFF) = cPoints[2])
        and ((rbPt^ and $FFFFFF) = cPoints[3]);
      if ( eq ) then
      begin
        Res.X := j div 3;
        Res.Y := i;
        SearchBitmap := true;
        break;
      end;
      asm
        add ltPt,3
        add rtPt,3
        add lbPt,3
        add rbPt,3
      end;
      inc(j,3);
    end;
    if eq then break;
  end;

end;



function CaptureScreenRect(ARect : TRect) : TBitmap; 
var
  ScreenDC: HDC;
begin
Result:=TBitmap.Create;
with result, ARect do
   begin
   Width:=Right-Left;
   Height:=Bottom-Top;
   ScreenDC:=GetDC(0);
   try
      BitBlt(Canvas.Handle, 0,0,Width,Height,ScreenDC, Left, Top, SRCCOPY );
   finally
   ReleaseDC(0, ScreenDC);
   end;
   end;
end; 



procedure Search(pattern: string; p_color: TColor);
var
  bmMain, bmSub: TBitmap;
  startPoint: TPoint;
  c: TCanvas;

begin
c := TCanvas.Create;
c.Handle := GetDC(0);

  bmMain := TBitmap.Create();
  bmSub  := TBitmap.Create();
  try
//  image1.Picture.Bitmap := CaptureScreenRect(Rect(0,0,Screen.Width,Screen.Height));
  bmMain := CaptureScreenRect(Rect(0,0,Screen.Width,Screen.Height));
//       bmMain.LoadFromFile('screen_main.bmp');
    bmSub.LoadFromFile(pattern);
    if (SearchBitmap(bmMain, bmSub, startPoint)) then
        begin
        c.Brush.Color := p_color;
        c.Ellipse(startPoint.x-3, startPoint.y-3, startPoint.x+3, startPoint.y+3);
        end;
  finally
    bmMain.Free;
    bmSub.Free;
    c.Free;
  end;
end;

[DungeonLords]

Хм.. сложновато для "Начинающих". Выкинь ка исходники и расскажи побольше информации, особенно про второй вариант кода (по 4 точкам). Если тебе помогли, то может они ещё и коментарии тебе дали?

P.S. И поведай нам, зачем такоя скорость? Да, чуть не забыл, расскажи, что делают ассемблерные вставки.

И вконце концов учти, что канва не сверхпроизводительная и операции с ней по природе тормознутые.

[czuryk]

К сожалению комментариев мне не дали, пришлось прорубать самому. Исходики я чесно сказать забыл с работы унести, остался только главный код, но он вполне работоспособный, если его скинуть в новый проект.
Что именно тебя интересует в варианте по четырем точкам?
Некоторые моментыя и сам не понял,
но примерно что там делается:
заносятся в масивы строки ScanLine из шаблона копируется четыре точки в переменные cPoints для дальнейшего сравнения.
В ассемблерной вставке просто вычисляются точки для сравнения (скоросто работы этого участка сомнительна, скорей просто для эксперемента.)
а потом сравниваются cPoints и указатель на содержимое массива:

Код:

     eq := ((ltPt^ and $FFFFFF) = cPoints[0])
        and ((rtPt^ and $FFFFFF) = cPoints[1])
        and ((lbPt^ and $FFFFFF) = cPoints[2])
        and ((rbPt^ and $FFFFFF) = cPoints[3]);

[ZZZRF413]

Я вот тоже думаю над похожей, но более сложной задачей. Мне надо также организовать поиск одного маленького изображения (порядка 25х25) в другом большом (порядка 1280х1024), причем за время меньшее чем < 100 миллисекунд и с учетом того, что маленькое изображение может быть повернуто на произвольный угл и не имеет четкую форму квадрата (т.е. например треугольник). Результатом работы функции также должны быть координаты X,Y маленьгоко изображения в большом.

[czuryk]

Сообщение от ZZZRF413

Я вот тоже думаю над похожей, но более сложной задачей. Мне надо также организовать поиск одного маленького изображения (порядка 25х25) в другом большом (порядка 1280х1024), причем за время меньшее чем < 100 миллисекунд и с учетом того, что маленькое изображение может быть повернуто на произвольный угл и не имеет четкую форму квадрата (т.е. например треугольник). Результатом работы функции также должны быть координаты X,Y маленьгоко изображения в большом.

Да, круто.
Есть какие-нибудь соображения только по моей, упрощенной части?
У меня основная загвостка именно в скорости.

А тебе нуджно обратится к материалам по обработки видео сигнала. Похожие алгоритмы применяют для замазывания логотипа теле-канала.

[ZZZRF413]

По упрощенной теме...
Мне кажется в первом варианте (поиск по первой строке) есть медленное место. Я попробую у себя в исходниках ещё глянуть. Может и найду чтонибудь подходящее.

[czuryk]

Спасибо, буду ждать!

[ZZZRF413]

Чтото вроде этого (мой вариант решения упрощенной задачи)

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  b1, b2: TBitmap;
  c1, c2: PByteArray;
  x, y, i,j: Integer;
  eq: boolean;
  resX, resY: integer;
  tick:int64;
  s,smax:integer;
begin
//tick:=gettickcount;
b1 := Image1.Picture.Bitmap;
b2 := Image2.Picture.Bitmap;
tick:=gettickcount;
Assert(b1.PixelFormat = b2.PixelFormat); // they have to be equal
smax:=0;
resx:=0;
resy:=0;
eq:=false;
for y:=0 to b1.Height-1  do begin
  c1 := b1.Scanline[y];
  c2 := b2.Scanline[1]; // Èùó íà ñîîòâåòñòâèå òîëüêî ïî 1-é ñòðîêå
  for x:=0 to b1.Width-1  do begin
    s:=0;
    if c1[(x)*3]=c2[(0)*3] then
    if c1[(x)*3+1]=c2[(0)*3+1] then
    if c1[(x)*3+2]=c2[(0)*3+2] then begin
      for i:=0 to b2.Width-1  do begin
        if x+i<b1.Width-1 then
        if c1[(i+x)*3]=c2[(i)*3] then
        if c1[(i+x)*3+1]=c2[(i)*3+1] then
        if c1[(i+x)*3+2]=c2[(i)*3+2] then s:=s+1;
      end;
    end;
    if s>=b2.Width-2 then begin
      eq:=true;
      resX:=x;
      ResY:=y;
      break;
    end;
  end;
  if (eq) then break;
end;
caption:='NOT FOUND';
if ( eq ) then
  begin
  caption:='OK'+inttostr(resx)+'/'+inttostr(resy)+' ||';
  for x:=0 to b2.Width-1  do begin
//   image1.Canvas.Pixels[x+resx,resy]:=cllime; // для проверки
   end;
end;
label1.Caption:='time '+inttostr(gettickcount-tick)+' ms';
end;

Пробуй.
Мой комп в 300 мс укладывается.

[czuryk]

Спасибо!
Вот тут описаны алгоритмы со скоростью работы от 8мс
http://forum.sources.ru/index.php?showtopic=263125
возможно тебе пригодится это в твоей задаче.