Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 15.03.2016, 05:45   #1
stlcrash
Форумчанин
 
Регистрация: 04.07.2010
Сообщений: 131
По умолчанию Сравнение изображений.

Есть две картинки, практически одинаковых. Задача:
Вычесть одну картинку из другой. То есть:
Берем код цвета пикселя 1й картинки. Вычитаем из него аналогичный пиксель 2й картинки. Полученное значение рисуем в третьем TImmage.
И так полностью их сравнить.

После этого нужно на 3й (полученной) картинке найти области размером 20*20 с отличаем больше 200 точек и получить координаты этих областей.

Как это реализовать?
stlcrash вне форума Ответить с цитированием
Старый 15.03.2016, 06:32   #2
Pavia
Лис
Старожил
 
Аватар для Pavia
 
Регистрация: 18.09.2015
Сообщений: 2,409
По умолчанию

Код:
 ...
 Sub(bm2, bm0);
 
 bp:=ByteMap2BitMap(bm2);
 Image3.Picture.Bitmap:=bp; 
 bp.free
 Image3.Canvas.Brush.Style:=bsClear;
 Image3.Canvas.Pen.Color:=clRed;
 
 Blur(bm3, bm2);
 Threshold(bm3, bm3,Round(StrToFloat(Edit2.Text)),255,THRESH_BINARY);
 BlobsCount:=BlobsLabeling(im, bm3);
 for i:=0 to BlobsCount-1 do
   begin
   if GetAABBRect(rect, im, I) then
      begin
        If (Rect.Right-Rect.Left>=20) and
            (Rect.Bottom-Rect.Top>=20) then
             begin
               Image3.Canvas.Rectangle(rect);
             end;
      end;
   end;
Хорошо поставленный вопрос это уже половина ответа. | Каков вопрос, таков ответ.
У дзен программиста программа делает то что он хотел, а не то что он написал .
Pavia вне форума Ответить с цитированием
Старый 15.03.2016, 10:20   #3
stlcrash
Форумчанин
 
Регистрация: 04.07.2010
Сообщений: 131
По умолчанию

Цитата:
Сообщение от Pavia Посмотреть сообщение
Код:
 ...
 Sub(bm2, bm0);
 
 bp:=ByteMap2BitMap(bm2);
 Image3.Picture.Bitmap:=bp; 
 bp.free
 Image3.Canvas.Brush.Style:=bsClear;
 Image3.Canvas.Pen.Color:=clRed;
 
 Blur(bm3, bm2);
 Threshold(bm3, bm3,Round(StrToFloat(Edit2.Text)),255,THRESH_BINARY);
 BlobsCount:=BlobsLabeling(im, bm3);
 for i:=0 to BlobsCount-1 do
   begin
   if GetAABBRect(rect, im, I) then
      begin
        If (Rect.Right-Rect.Left>=20) and
            (Rect.Bottom-Rect.Top>=20) then
             begin
               Image3.Canvas.Rectangle(rect);
             end;
      end;
   end;
Можете выложить еще коды процедур?

Компоновка
[Ошибка] Unit1.pas(36): Undeclared identifier: 'Blur'
[Ошибка] Unit1.pas(37): Undeclared identifier: 'Threshold'
[Ошибка] Unit1.pas(41): Undeclared identifier: 'GetAABBRect'
[Ошибка] Unit1.pas(41): There is no overloaded version of 'Rect' that can be called with these arguments
stlcrash вне форума Ответить с цитированием
Старый 15.03.2016, 10:56   #4
stlcrash
Форумчанин
 
Регистрация: 04.07.2010
Сообщений: 131
По умолчанию

Работает ОЧЕНЬ медленно

Код:
procedure TForm1.Button1Click(Sender: TObject);
var
x,y:integer;
bmp:TBitMap;
begin

    bmp := TBitmap.Create;
    bmp.Width := Screen.Width;
    bmp.Height := Screen.Height;
    BitBlt(bmp.Canvas.Handle, 0,0, Screen.Width, Screen.Height,
           GetDC(0), 0,0,SRCCOPY);
    BMP1.Width := Screen.Width;
    BMP1.Height := Screen.Height;
    BMP1.Picture.Assign(bmp);
    bmp.Free;

    application.ProcessMessages;
    sleep(1000);

       bmp := TBitmap.Create;
    bmp.Width := Screen.Width;
    bmp.Height := Screen.Height;
    BitBlt(bmp.Canvas.Handle, 0,0, Screen.Width, Screen.Height,
           GetDC(0), 0,0,SRCCOPY);
    BMP2.Width := Screen.Width;
    BMP2.Height := Screen.Height;
    BMP2.Picture.Assign(bmp);
    bmp.Free;

    BMP3.Width := Screen.Width;
    BMP3.Height := Screen.Height;

for x:=0 to bmp1.Width do
 for y:=0 to bmp1.Height do
    begin
      application.ProcessMessages;
      if bmp1.Canvas.Pixels[x,y]<>bmp2.Canvas.Pixels[x,y] then
      bmp3.Canvas.Pixels[x,y]:=bmp1.Canvas.Pixels[x,y]
      else bmp3.Canvas.Pixels[x,y]:=0;
    end;
end;
stlcrash вне форума Ответить с цитированием
Старый 15.03.2016, 11:43   #5
vlad1389
Форумчанин
 
Регистрация: 02.02.2016
Сообщений: 290
По умолчанию

ScanLine используй. Будет быстрее.
vlad1389 вне форума Ответить с цитированием
Старый 15.03.2016, 12:58   #6
stlcrash
Форумчанин
 
Регистрация: 04.07.2010
Сообщений: 131
По умолчанию

Нашел такой кусок кода, но это не совсем то. Как его до ума довести?

Чтоб работал так:

Threshold(Bitmap, BMP: TBitmap);
Bitmap - 1е скрин экрана
BMP - 2й скрин экрана через секунуду.

Сравнить все пиксели данных скриншотов и те, которые отличаются закрасить в черный.

Тоесть сравнить 2 изображения, все отличия закрасить в черный цвет, а не отличающиеся в белый. КАк это реализовать? Помогите, только в этом ОГРОМНАЯ загвоздка

Код:
procedure Threshold(Bitmap: TBitmap; Value: Byte; Color1, Color2: TColor);
type TRGB = record B, G, R: Byte; end; pRGB = ^TRGB;
function ColorToRGB(Color: TColor): TRGB;
  begin
  with Result do
    begin
      R := Lo(Color);
      G := Lo(Color shr 8);
      B := Lo((Color shr 8) shr 8);
    end;
  end;
var x, y: Word; C1, C2: TRGB; Dest: pRGB;
begin
Bitmap.PixelFormat := pf24Bit;
C1 := ColorToRGB(Color1);
C2 := ColorToRGB(Color2);
for y := 0 to Bitmap.Height - 1 do
  begin
    Dest := Bitmap.ScanLine[y];
    for x := 0 to Bitmap.Width - 1 do
      begin
        if (Dest^.r + Dest^.g + Dest^.b) / 3 > Value then Dest^ := C1 else Dest^ := C2; Inc(Dest);
      end;
  end;
end;
stlcrash вне форума Ответить с цитированием
Старый 15.03.2016, 13:01   #7
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,656
По умолчанию

Тебе надо находить изменения на экране раз в секунду?
Сюда читал?
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 15.03.2016, 13:31   #8
stlcrash
Форумчанин
 
Регистрация: 04.07.2010
Сообщений: 131
По умолчанию

Цитата:
Сообщение от min@y™ Посмотреть сообщение
Тебе надо находить изменения на экране раз в секунду?
Сюда читал?
Прочитал. Да. Мне нужно найти изменения на экране. Пишу простенького бота для онлайн игры. Монстры в игре движутся. Все остальное неподвижно.
stlcrash вне форума Ответить с цитированием
Старый 15.03.2016, 13:34   #9
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,656
По умолчанию

Если ты сделаешь такую программу, то как ты её будешь использовать на практике?
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 15.03.2016, 13:42   #10
stlcrash
Форумчанин
 
Регистрация: 04.07.2010
Сообщений: 131
По умолчанию

Зная в каких местах изображение изменилось смогу получить координаты монстров. Найду самого ближнего к заданной точке монстра и убью его. И так до бесконечности. В это время я буду играть на гитаре, смотреть нешинл географик, заниматься в тренажерном зале и кучу прочих полезных дел.
stlcrash вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

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

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сравнение изображений. C# Serg94 Помощь студентам 1 27.11.2012 19:43
Сравнение 2 изображений wlords Помощь студентам 0 23.11.2010 20:47
Сравнение изображений AmbaQ Общие вопросы Delphi 1 07.08.2010 19:20
Delphi - сравнение изображений battlefrogg Помощь студентам 7 17.07.2010 18:58
Сравнение изображений DeDoK Общие вопросы Delphi 1 11.10.2008 21:16