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

Delphi Sources



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

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 14.03.2016, 18:07
Buboner Buboner вне форума
Прохожий
 
Регистрация: 14.03.2016
Сообщения: 1
Версия Delphi: RAD Studio 10
Репутация: 10
По умолчанию Потоки, битмапы. Прошу помощи

задача у меня сделать относительно быстрый поиск фрагмента изображениия . решил начать с поиска фрагмента сделал. понял что работает медленно для ускарения решил разбить картинку поиска на несколько частей и пройтись поним в подзадачах и тут начались проблемы:

Имеется программа которая должно искать на большой картинке фрагмет. Вот код :
Код:
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  
Старый 14.03.2016, 19:01
Аватар для dr. F.I.N.
dr. F.I.N. dr. F.I.N. вне форума
I Like it!
 
Регистрация: 12.12.2009
Адрес: Россия, г. Новосибирск
Сообщения: 660
Версия Delphi: D6/D7
Репутация: 26643
По умолчанию

Первое что нужно сделать - отказаться от Pixels[] и работать со ScanLine.
__________________
Грамотно поставленный вопрос содержит не менее 50% ответа.
Грамотно поставленная речь вызывает уважение, а у некоторых даже зависть.
Ответить с цитированием
Ответ


Delphi Sources

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

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

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

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


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


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

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

ВКонтакте   Facebook   Twitter