|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Потоки, битмапы. Прошу помощи
задача у меня сделать относительно быстрый поиск фрагмента изображениия . решил начать с поиска фрагмента сделал. понял что работает медленно для ускарения решил разбить картинку поиска на несколько частей и пройтись поним в подзадачах и тут начались проблемы:
Имеется программа которая должно искать на большой картинке фрагмет. Вот код : Код:
procedure TForm1.Button1Click(Sender: TObject); var x: Integer; y: Integer; x1: Integer; y1:Integer; flag: Boolean; begin Form1.Caption :=''; for x := 1 to 100 Image2.Picture.Width do begin for y := 1 to 100 Image2.Picture.Height do begin flag := True; for x1 := 1 to Image1.Picture.Width-1 do begin for y1 := 1 to Image1.Picture.Height-1 do begin if Image2.Picture.Bitmap.Canvas.Pixels[x1+x,y1+y] <> Image1.Picture.Bitmap.Canvas.Pixels[x1,y1] then begin flag := False; Break; end; end; end; if flag = True then begin Form1.Caption := 'Нащел х='+x.ToString+' y='+y.ToString; Exit; end; Form1.Caption := 'не нащел х='+x.ToString+' y='+y.ToString; Application.ProcessMessages; end; end; end; Естественно это будет работать очень долго для ускорения процеса появилась идея разрезать исходную картинку на несколько частей и обрабатывать их в подзадачаз возвращая результат. Родился ваоттакой код : Код:
unit Unit2; interface uses System.Classes, System.SysUtils, Vcl.Graphics; type ClaasXZ = class(TThread) private procedure UpPoint(); protected procedure Execute; override; public end; implementation uses Unit1; { ClaasXZ } VAR Tx: Integer; Ty: Integer; Tx1: Integer; Ty1: Integer; Tflag: Boolean; tBworc :TBitmap; ttemplate: TBitmap; procedure ClaasXZ.UpPoint(); begin Form1.Caption := 'Нащел х=' + Tx.ToString + ' y=' + Ty.ToString; end; procedure ClaasXZ.Execute; begin tBworc:=TBitmap.Create; //Создаем битмапы и присваиваем им размеры tBworc.Width:= 100; tBworc.Height := 100; ttemplate:=TBitmap.Create; ttemplate.Width := 41 ; ttemplate.Height := 23; tBworc.LoadFromFile('1.BMP'); //Картинка на которой ищем ttemplate.LoadFromFile('1.bmp');//Картинка которую ищем for tx := 1 to tBworc.Width do begin for ty := 1 to tBworc.Height do begin tflag := True; for tx1 := 1 to ttemplate.Width - 1 do begin for ty1 := 1 to ttemplate.Height - 1 do begin if tBworc.Canvas.Pixels[Tx1 + Tx, Ty1 + Ty] <> ttemplate.Canvas.Pixels[Tx1, Ty1] then begin tflag := False; Break; end; end; end; if tflag = True then begin Synchronize(UpPoint); Terminate; Exit; end; end; end; end; end. посути это одно и тоже как я понимаю только в подзадаче работает через раз то срабатывает выводя верные координаты то не работает а именно примерно раз из 5 находит совпадения остальные 4 раза выдает неверные координаты (( !!! подскажите почему. Последний раз редактировалось Admin, 14.03.2016 в 20:35. |
#2
|
||||
|
||||
Первое что нужно сделать - отказаться от Pixels[] и работать со ScanLine.
Грамотно поставленный вопрос содержит не менее 50% ответа. Грамотно поставленная речь вызывает уважение, а у некоторых даже зависть. |