Показать сообщение отдельно
  #8  
Старый 25.01.2009, 01:39
ZZZRF413 ZZZRF413 вне форума
Прохожий
 
Регистрация: 16.10.2008
Сообщения: 38
Репутация: 10
По умолчанию

Чтото вроде этого (мой вариант решения упрощенной задачи)
Код:
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 мс укладывается.
Ответить с цитированием