Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 15.05.2013, 20:25
sunday sunday вне форума
Прохожий
 
Регистрация: 29.05.2012
Сообщения: 3
Репутация: 10
Восклицание Доработать код поиска одного изображения в другом

Нашёл в интернете код, но не получается самому до делать, что бы в шаблонном изображение, при сравнение, игнорировался определённый цвет на пример цвет - 16711935, помогите пожалуйста.
Код поиска одного изображения в другом.
Код:
var
  Form1: TForm1;
  buf1, buf2: TBuf;

implementation

{$R *.dfm}

procedure LoagIMG(var buffer: TBuf; img: TImage; Name: String);
var
  x,y,c: integer;
  p: pByteArray;
begin
  img.Picture.LoadFromFile(Name);
  img.Picture.Bitmap.PixelFormat:=pf24Bit; // pf8Bit;
  SetLength(buffer, img.Height, img.Width);
  for y:=0 to img.Height-1 do begin
    p:=img.Picture.Bitmap.ScanLine[y];
    for x:=0 to img.Width-1 do begin
      c:=((p[x*3+0] shl 8+p[x*3+1]) shl 8)+p[x*3+2];
      buffer[y,x]:=c;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenPictureDialog1.Execute then
    LoagIMG(buf1, Image1, OpenPictureDialog1.FileName);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if OpenPictureDialog1.Execute then
    LoagIMG(buf2, Image2, OpenPictureDialog1.FileName);
end;

function TForm1.CompareIMG: FRes;
var
  y, x, yy, xx: integer;
begin
  y:=0;
  repeat
    x:=0;
    repeat
      Result.found:=true;
      yy:=0;
      repeat
        xx:=0;
        repeat
          if buf1[y+yy, x+xx]<>buf2[yy,xx] then Result.found:=false;
          inc(xx);
        until (xx>=Image2.Width) or (Not Result.found);
        inc(yy);
      until (yy>=Image2.Height) or (Not Result.found);
      inc(x);
    until (x>Image1.Width-Image2.Width) or (Result.found);
    inc(y);
  until (y>Image1.Height-Image2.Height) or (Result.found);
  if Result.found then begin
    Result.x:=x-1;
    Result.y:=y-1;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  FindResult: FRes;
  SearchTime: cardinal;
  Freq, StartCount, EndCount: int64;
  HiResTimer: boolean;
begin
  if (Image1.Width<Image2.Width) or (Image1.Height<Image2.Height) then
    ShowMessage('Îøèáêà! Img1 ìåíüøå Img2')
  else begin
    Screen.Cursor:=crHourGlass;
    HiResTimer:=QueryPerformanceFrequency(Freq);
    if HiResTimer then QueryPerformanceCounter(StartCount) else SearchTime:=GetTickCount;
    FindResult:=CompareIMG;
    if HiResTimer then begin
      QueryPerformanceCounter(EndCount);
      SearchTime:=round((EndCount-StartCount)*1000/Freq);
    end else SearchTime:=GetTickCount-SearchTime;
    Screen.Cursor:=crDefault;
    if FindResult.found then begin
      with Image1.Picture.Bitmap.Canvas do begin
        Pen.Color:=clRed;
        MoveTo(FindResult.x, FindResult.y);
        LineTo(FindResult.x+Image2.Width-1, FindResult.y);
        LineTo(FindResult.x+Image2.Width-1, FindResult.y+Image2.Height-1);
        LineTo(FindResult.x, FindResult.y+Image2.Height-1);
        LineTo(FindResult.x, FindResult.y);
      end;
      ScrollBox1.HorzScrollBar.Position:=FindResult.x;
      ScrollBox1.VertScrollBar.Position:=FindResult.y;
      ShowMessage('Åñòü ñîâïàäåíèå ;-)'+#10#13+'Âðåìÿ ïîèñêà: '+IntToStr(SearchTime)+' ms');
    end else ShowMessage('Íåò ñîâïâäåíèé!');
  end;
end;

end.
Ответить с цитированием
  #2  
Старый 15.05.2013, 21:11
Аватар для RusMaXXX
RusMaXXX RusMaXXX вне форума
Начинающий
 
Регистрация: 01.10.2008
Сообщения: 138
Версия Delphi: 7
Репутация: 21
По умолчанию

случаем не взлом "капчи" пишешь???
__________________
уволен в запас!!!
Ответить с цитированием
  #3  
Старый 15.05.2013, 21:14
sunday sunday вне форума
Прохожий
 
Регистрация: 29.05.2012
Сообщения: 3
Репутация: 10
По умолчанию

С капчей по сложнее будет, а этот алгоритм собираюсь использовать в мирных целях)
Ответить с цитированием
  #4  
Старый 16.05.2013, 11:35
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
 
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию

Цитата:
Сообщение от sunday
Нашёл в интернете код, но не получается самому до делать, что бы в шаблонном изображение, при сравнение, игнорировался определённый цвет на пример цвет - 16711935...
Что-то типа этого. Нужно найти более быстрый алгоритм, а то предложенный ну очень затратный.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 21:15.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter