задача у меня сделать относительно быстрый поиск фрагмента изображениия . решил начать с поиска фрагмента сделал. понял что работает медленно для ускарения решил разбить картинку поиска на несколько частей и пройтись поним в подзадачах и тут начались проблемы:
Имеется программа которая должно искать на большой картинке фрагмет. Вот код :
Код:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | 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;
|
Естественно это будет работать очень долго для ускорения процеса появилась идея разрезать исходную картинку на несколько частей и обрабатывать их в подзадачаз возвращая результат.
Родился ваоттакой код :
Код:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 | 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;
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 раза выдает неверные координаты (( !!! подскажите почему.
14.03.2016, 18:07
Потоки, битмапы. Прошу помощи
Линейный вид
